{-# LANGUAGE MultiParamTypeClasses, RecursiveDo #-}
module Simulation.Aivika.Composite
(
Composite,
CompositeLift(..),
runComposite,
runComposite_,
runCompositeInStartTime_,
runCompositeInStopTime_,
disposableComposite) where
import Data.Monoid
import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Fix
import Control.Monad.Fail
import Control.Applicative
import Simulation.Aivika.Parameter
import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Event
newtype Composite a = Composite { forall a.
Composite a -> DisposableEvent -> Event (a, DisposableEvent)
runComposite :: DisposableEvent -> Event (a, DisposableEvent)
}
runComposite_ :: Composite a -> Event a
runComposite_ :: forall a. Composite a -> Event a
runComposite_ Composite a
m =
do (a
a, DisposableEvent
_) <- Composite a -> DisposableEvent -> Event (a, DisposableEvent)
forall a.
Composite a -> DisposableEvent -> Event (a, DisposableEvent)
runComposite Composite a
m DisposableEvent
forall a. Monoid a => a
mempty
a -> Event a
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
runCompositeInStartTime_ :: Composite a -> Simulation a
runCompositeInStartTime_ :: forall a. Composite a -> Simulation a
runCompositeInStartTime_ = Event a -> Simulation a
forall a. Event a -> Simulation a
runEventInStartTime (Event a -> Simulation a)
-> (Composite a -> Event a) -> Composite a -> Simulation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Composite a -> Event a
forall a. Composite a -> Event a
runComposite_
runCompositeInStopTime_ :: Composite a -> Simulation a
runCompositeInStopTime_ :: forall a. Composite a -> Simulation a
runCompositeInStopTime_ = Event a -> Simulation a
forall a. Event a -> Simulation a
runEventInStopTime (Event a -> Simulation a)
-> (Composite a -> Event a) -> Composite a -> Simulation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Composite a -> Event a
forall a. Composite a -> Event a
runComposite_
disposableComposite :: DisposableEvent -> Composite ()
disposableComposite :: DisposableEvent -> Composite ()
disposableComposite DisposableEvent
h = (DisposableEvent -> Event ((), DisposableEvent)) -> Composite ()
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event ((), DisposableEvent)) -> Composite ())
-> (DisposableEvent -> Event ((), DisposableEvent)) -> Composite ()
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 -> ((), DisposableEvent) -> Event ((), DisposableEvent)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), DisposableEvent
h0 DisposableEvent -> DisposableEvent -> DisposableEvent
forall a. Semigroup a => a -> a -> a
<> DisposableEvent
h)
instance Functor Composite where
fmap :: forall a b. (a -> b) -> Composite a -> Composite b
fmap a -> b
f (Composite DisposableEvent -> Event (a, DisposableEvent)
m) =
(DisposableEvent -> Event (b, DisposableEvent)) -> Composite b
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (b, DisposableEvent)) -> Composite b)
-> (DisposableEvent -> Event (b, DisposableEvent)) -> Composite b
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
do (a
a, DisposableEvent
h) <- DisposableEvent -> Event (a, DisposableEvent)
m DisposableEvent
h0
(b, DisposableEvent) -> Event (b, DisposableEvent)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a, DisposableEvent
h)
instance Applicative Composite where
pure :: forall a. a -> Composite a
pure a
a = (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 -> (a, DisposableEvent) -> Event (a, DisposableEvent)
forall a. a -> Event a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, DisposableEvent
h0)
<*> :: forall a b. Composite (a -> b) -> Composite a -> Composite b
(<*>) = Composite (a -> b) -> Composite a -> Composite b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Composite where
(Composite DisposableEvent -> Event (a, DisposableEvent)
m) >>= :: forall a b. Composite a -> (a -> Composite b) -> Composite b
>>= a -> Composite b
k =
(DisposableEvent -> Event (b, DisposableEvent)) -> Composite b
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (b, DisposableEvent)) -> Composite b)
-> (DisposableEvent -> Event (b, DisposableEvent)) -> Composite b
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
do (a
a, DisposableEvent
h) <- DisposableEvent -> Event (a, DisposableEvent)
m DisposableEvent
h0
let Composite DisposableEvent -> Event (b, DisposableEvent)
m' = a -> Composite b
k a
a
(b
b, DisposableEvent
h') <- DisposableEvent -> Event (b, DisposableEvent)
m' DisposableEvent
h
(b, DisposableEvent) -> Event (b, DisposableEvent)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, DisposableEvent
h')
instance MonadFail Composite where
fail :: forall a. String -> Composite a
fail = String -> Composite a
forall a. HasCallStack => String -> a
error
instance MonadIO Composite where
liftIO :: forall a. IO a -> Composite a
liftIO IO a
m =
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
do a
a <- IO a -> Event a
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m
(a, DisposableEvent) -> Event (a, DisposableEvent)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h0)
instance MonadFix Composite where
mfix :: forall a. (a -> Composite a) -> Composite a
mfix a -> Composite a
f =
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
do rec (a
a, DisposableEvent
h) <- Composite a -> DisposableEvent -> Event (a, DisposableEvent)
forall a.
Composite a -> DisposableEvent -> Event (a, DisposableEvent)
runComposite (a -> Composite a
f a
a) DisposableEvent
h0
(a, DisposableEvent) -> Event (a, DisposableEvent)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h)
instance ParameterLift Composite where
liftParameter :: forall a. Parameter a -> Composite a
liftParameter Parameter a
m =
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
do a
a <- Parameter a -> Event a
forall a. Parameter a -> Event a
forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter a
m
(a, DisposableEvent) -> Event (a, DisposableEvent)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h0)
instance SimulationLift Composite where
liftSimulation :: forall a. Simulation a -> Composite a
liftSimulation Simulation a
m =
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
do a
a <- Simulation a -> Event a
forall a. Simulation a -> Event a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation a
m
(a, DisposableEvent) -> Event (a, DisposableEvent)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h0)
instance DynamicsLift Composite where
liftDynamics :: forall a. Dynamics a -> Composite a
liftDynamics Dynamics a
m =
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
do a
a <- Dynamics a -> Event a
forall a. Dynamics a -> Event a
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics a
m
(a, DisposableEvent) -> Event (a, DisposableEvent)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h0)
instance EventLift Composite where
liftEvent :: forall a. Event a -> Composite a
liftEvent Event a
m =
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
do a
a <- Event a -> Event a
forall a. Event a -> Event a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent Event a
m
(a, DisposableEvent) -> Event (a, DisposableEvent)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h0)
class CompositeLift m where
liftComposite :: Composite a -> m a
instance CompositeLift Composite where
liftComposite :: forall a. Composite a -> Composite a
liftComposite = Composite a -> Composite a
forall a. a -> a
id