{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, MonoLocalBinds, RankNTypes #-}
module Simulation.Aivika.Trans.Internal.Event
(
Event(..),
EventLift(..),
EventProcessing(..),
invokeEvent,
runEventInStartTime,
runEventInStopTime,
EventPriority(..),
EventQueueing(..),
enqueueEventWithCancellation,
enqueueEventWithStartTime,
enqueueEventWithStopTime,
enqueueEventWithTimes,
enqueueEventWithPoints,
enqueueEventWithIntegTimes,
yieldEvent,
eventPriority,
EventCancellation,
cancelEvent,
eventCancelled,
eventFinished,
catchEvent,
finallyEvent,
throwEvent,
memoEvent,
memoEventInTime,
DisposableEvent(..),
retryEvent,
EventIOQueueing(..),
enqueueEventIOWithStartTime,
enqueueEventIOWithStopTime,
enqueueEventIOWithTimes,
enqueueEventIOWithPoints,
enqueueEventIOWithIntegTimes,
traceEvent) where
import Data.Monoid hiding ((<>))
import Data.Semigroup (Semigroup(..))
import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Fix
import Control.Monad.Fail
import qualified Control.Monad.Catch as MC
import Control.Applicative
import Debug.Trace (trace)
import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Types
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Parameter
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Dynamics
instance Monad m => Monad (Event m) where
{-# INLINE (>>=) #-}
(Event Point m -> m a
m) >>= :: forall a b. Event m a -> (a -> Event m b) -> Event m b
>>= a -> Event m b
k =
(Point m -> m b) -> Event m b
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m b) -> Event m b) -> (Point m -> m b) -> Event m b
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do a
a <- Point m -> m a
m Point m
p
let Event Point m -> m b
m' = a -> Event m b
k a
a
Point m -> m b
m' Point m
p
instance Functor m => Functor (Event m) where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Event m a -> Event m b
fmap a -> b
f (Event Point m -> m a
x) = (Point m -> m b) -> Event m b
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m b) -> Event m b) -> (Point m -> m b) -> Event m b
forall a b. (a -> b) -> a -> b
$ \Point m
p -> (a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> m a -> m b
forall a b. (a -> b) -> a -> b
$ Point m -> m a
x Point m
p
instance Applicative m => Applicative (Event m) where
{-# INLINE pure #-}
pure :: forall a. a -> Event m a
pure = (Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a)
-> (a -> Point m -> m a) -> a -> Event m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Point m -> m a
forall a b. a -> b -> a
const (m a -> Point m -> m a) -> (a -> m a) -> a -> Point m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE (<*>) #-}
(Event Point m -> m (a -> b)
x) <*> :: forall a b. Event m (a -> b) -> Event m a -> Event m b
<*> (Event Point m -> m a
y) = (Point m -> m b) -> Event m b
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m b) -> Event m b) -> (Point m -> m b) -> Event m b
forall a b. (a -> b) -> a -> b
$ \Point m
p -> Point m -> m (a -> b)
x Point m
p m (a -> b) -> m a -> m b
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point m -> m a
y Point m
p
instance Monad m => MonadFail (Event m) where
{-# INLINE fail #-}
fail :: forall a. String -> Event m a
fail = String -> Event m a
forall a. HasCallStack => String -> a
error
instance MonadTrans Event where
{-# INLINE lift #-}
lift :: forall (m :: * -> *) a. Monad m => m a -> Event m a
lift = (Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a)
-> (m a -> Point m -> m a) -> m a -> Event m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Point m -> m a
forall a b. a -> b -> a
const
instance MonadIO m => MonadIO (Event m) where
{-# INLINE liftIO #-}
liftIO :: forall a. IO a -> Event m a
liftIO = (Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a)
-> (IO a -> Point m -> m a) -> IO a -> Event m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Point m -> m a
forall a b. a -> b -> a
const (m a -> Point m -> m a) -> (IO a -> m a) -> IO a -> Point m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance Monad m => MonadCompTrans Event m where
{-# INLINE liftComp #-}
liftComp :: forall a. m a -> Event m a
liftComp = (Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a)
-> (m a -> Point m -> m a) -> m a -> Event m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Point m -> m a
forall a b. a -> b -> a
const
class EventLift t m where
liftEvent :: Event m a -> t m a
instance Monad m => EventLift Event m where
{-# INLINE liftEvent #-}
liftEvent :: forall a. Event m a -> Event m a
liftEvent = Event m a -> Event m a
forall a. a -> a
id
instance Monad m => DynamicsLift Event m where
{-# INLINE liftDynamics #-}
liftDynamics :: forall a. Dynamics m a -> Event m a
liftDynamics (Dynamics Point m -> m a
x) = (Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event Point m -> m a
x
instance Monad m => SimulationLift Event m where
{-# INLINE liftSimulation #-}
liftSimulation :: forall a. Simulation m a -> Event m a
liftSimulation (Simulation Run m -> m a
x) = (Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a) -> (Point m -> m a) -> Event m a
forall a b. (a -> b) -> a -> b
$ Run m -> m a
x (Run m -> m a) -> (Point m -> Run m) -> Point m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun
instance Monad m => ParameterLift Event m where
{-# INLINE liftParameter #-}
liftParameter :: forall a. Parameter m a -> Event m a
liftParameter (Parameter Run m -> m a
x) = (Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a) -> (Point m -> m a) -> Event m a
forall a b. (a -> b) -> a -> b
$ Run m -> m a
x (Run m -> m a) -> (Point m -> Run m) -> Point m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun
catchEvent :: (MonadException m, Exception e) => Event m a -> (e -> Event m a) -> Event m a
{-# INLINABLE catchEvent #-}
catchEvent :: forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Event m a -> (e -> Event m a) -> Event m a
catchEvent (Event Point m -> m a
m) e -> Event m a
h =
(Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a) -> (Point m -> m a) -> Event m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
m a -> (e -> m a) -> m a
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp (Point m -> m a
m Point m
p) ((e -> m a) -> m a) -> (e -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \e
e ->
let Event Point m -> m a
m' = e -> Event m a
h e
e in Point m -> m a
m' Point m
p
finallyEvent :: MonadException m => Event m a -> Event m b -> Event m a
{-# INLINABLE finallyEvent #-}
finallyEvent :: forall (m :: * -> *) a b.
MonadException m =>
Event m a -> Event m b -> Event m a
finallyEvent (Event Point m -> m a
m) (Event Point m -> m b
m') =
(Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a) -> (Point m -> m a) -> Event m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
m a -> m b -> m a
forall a b. m a -> m b -> m a
forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
finallyComp (Point m -> m a
m Point m
p) (Point m -> m b
m' Point m
p)
throwEvent :: (MonadException m, Exception e) => e -> Event m a
{-# INLINABLE throwEvent #-}
throwEvent :: forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent e
e =
(Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a) -> (Point m -> m a) -> Event m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
e -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp e
e
maskEvent :: MC.MonadMask m => ((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
{-# INLINABLE maskEvent #-}
maskEvent :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
maskEvent (forall a. Event m a -> Event m a) -> Event m b
a =
(Point m -> m b) -> Event m b
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m b) -> Event m b) -> (Point m -> m b) -> Event m b
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
((forall a. m a -> m a) -> m b) -> m b
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u ->
Point m -> Event m b -> m b
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p ((forall a. Event m a -> Event m a) -> Event m b
a ((forall a. Event m a -> Event m a) -> Event m b)
-> (forall a. Event m a -> Event m a) -> Event m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> Event m a -> Event m a
forall {m :: * -> *} {a} {a}.
(m a -> m a) -> Event m a -> Event m a
q m a -> m a
forall a. m a -> m a
u)
where q :: (m a -> m a) -> Event m a -> Event m a
q m a -> m a
u (Event Point m -> m a
b) = (Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event (m a -> m a
u (m a -> m a) -> (Point m -> m a) -> Point m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> m a
b)
uninterruptibleMaskEvent :: MC.MonadMask m => ((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
{-# INLINABLE uninterruptibleMaskEvent #-}
uninterruptibleMaskEvent :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
uninterruptibleMaskEvent (forall a. Event m a -> Event m a) -> Event m b
a =
(Point m -> m b) -> Event m b
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m b) -> Event m b) -> (Point m -> m b) -> Event m b
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
((forall a. m a -> m a) -> m b) -> m b
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
MC.uninterruptibleMask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u ->
Point m -> Event m b -> m b
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p ((forall a. Event m a -> Event m a) -> Event m b
a ((forall a. Event m a -> Event m a) -> Event m b)
-> (forall a. Event m a -> Event m a) -> Event m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> Event m a -> Event m a
forall {m :: * -> *} {a} {a}.
(m a -> m a) -> Event m a -> Event m a
q m a -> m a
forall a. m a -> m a
u)
where q :: (m a -> m a) -> Event m a -> Event m a
q m a -> m a
u (Event Point m -> m a
b) = (Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event (m a -> m a
u (m a -> m a) -> (Point m -> m a) -> Point m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> m a
b)
generalBracketEvent :: MC.MonadMask m
=> Event m a
-> (a -> MC.ExitCase b -> Event m c)
-> (a -> Event m b)
-> Event m (b, c)
{-# INLINABLE generalBracketEvent #-}
generalBracketEvent :: forall (m :: * -> *) a b c.
MonadMask m =>
Event m a
-> (a -> ExitCase b -> Event m c)
-> (a -> Event m b)
-> Event m (b, c)
generalBracketEvent Event m a
acquire a -> ExitCase b -> Event m c
release a -> Event m b
use =
(Point m -> m (b, c)) -> Event m (b, c)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (b, c)) -> Event m (b, c))
-> (Point m -> m (b, c)) -> Event m (b, c)
forall a b. (a -> b) -> a -> b
$ \Point m
p -> do
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
MC.generalBracket
(Point m -> Event m a -> m a
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m a
acquire)
(\a
resource ExitCase b
e -> Point m -> Event m c -> m c
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m c -> m c) -> Event m c -> m c
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> Event m c
release a
resource ExitCase b
e)
(\a
resource -> Point m -> Event m b -> m b
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m b -> m b) -> Event m b -> m b
forall a b. (a -> b) -> a -> b
$ a -> Event m b
use a
resource)
instance MonadFix m => MonadFix (Event m) where
{-# INLINE mfix #-}
mfix :: forall a. (a -> Event m a) -> Event m a
mfix a -> Event m a
f =
(Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a) -> (Point m -> m a) -> Event m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do { rec { a
a <- Point m -> Event m a -> m a
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (a -> Event m a
f a
a) }; a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a }
instance MonadException m => MC.MonadThrow (Event m) where
{-# INLINE throwM #-}
throwM :: forall e a. (HasCallStack, Exception e) => e -> Event m a
throwM = e -> Event m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent
instance MonadException m => MC.MonadCatch (Event m) where
{-# INLINE catch #-}
catch :: forall e a.
(HasCallStack, Exception e) =>
Event m a -> (e -> Event m a) -> Event m a
catch = Event m a -> (e -> Event m a) -> Event m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Event m a -> (e -> Event m a) -> Event m a
catchEvent
instance (MonadException m, MC.MonadMask m) => MC.MonadMask (Event m) where
{-# INLINE mask #-}
mask :: forall b.
HasCallStack =>
((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
mask = ((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
maskEvent
{-# INLINE uninterruptibleMask #-}
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
uninterruptibleMask = ((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
uninterruptibleMaskEvent
{-# INLINE generalBracket #-}
generalBracket :: forall a b c.
HasCallStack =>
Event m a
-> (a -> ExitCase b -> Event m c)
-> (a -> Event m b)
-> Event m (b, c)
generalBracket = Event m a
-> (a -> ExitCase b -> Event m c)
-> (a -> Event m b)
-> Event m (b, c)
forall (m :: * -> *) a b c.
MonadMask m =>
Event m a
-> (a -> ExitCase b -> Event m c)
-> (a -> Event m b)
-> Event m (b, c)
generalBracketEvent
runEventInStartTime :: MonadDES m => Event m a -> Simulation m a
{-# INLINE runEventInStartTime #-}
runEventInStartTime :: forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStartTime = Dynamics m a -> Simulation m a
forall (m :: * -> *) a. Dynamics m a -> Simulation m a
runDynamicsInStartTime (Dynamics m a -> Simulation m a)
-> (Event m a -> Dynamics m a) -> Event m a -> Simulation m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event m a -> Dynamics m a
forall a. Event m a -> Dynamics m a
forall (m :: * -> *) a.
EventQueueing m =>
Event m a -> Dynamics m a
runEvent
runEventInStopTime :: MonadDES m => Event m a -> Simulation m a
{-# INLINE runEventInStopTime #-}
runEventInStopTime :: forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStopTime = Dynamics m a -> Simulation m a
forall (m :: * -> *) a. Dynamics m a -> Simulation m a
runDynamicsInStopTime (Dynamics m a -> Simulation m a)
-> (Event m a -> Dynamics m a) -> Event m a -> Simulation m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event m a -> Dynamics m a
forall a. Event m a -> Dynamics m a
forall (m :: * -> *) a.
EventQueueing m =>
Event m a -> Dynamics m a
runEvent
eventPriority :: MonadDES m => Event m EventPriority
{-# INLINE eventPriority #-}
eventPriority :: forall (m :: * -> *). MonadDES m => Event m EventPriority
eventPriority =
(Point m -> m EventPriority) -> Event m EventPriority
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m EventPriority) -> Event m EventPriority)
-> (Point m -> m EventPriority) -> Event m EventPriority
forall a b. (a -> b) -> a -> b
$ EventPriority -> m EventPriority
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EventPriority -> m EventPriority)
-> (Point m -> EventPriority) -> Point m -> m EventPriority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> EventPriority
forall (m :: * -> *). Point m -> EventPriority
pointPriority
enqueueEventWithTimes :: MonadDES m => [Double] -> Event m () -> Event m ()
{-# INLINABLE enqueueEventWithTimes #-}
enqueueEventWithTimes :: forall (m :: * -> *).
MonadDES m =>
[Double] -> Event m () -> Event m ()
enqueueEventWithTimes [Double]
ts Event m ()
e = [Double] -> Event m ()
loop [Double]
ts
where loop :: [Double] -> Event m ()
loop [] = () -> Event m ()
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop (Double
t : [Double]
ts) = Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$ Event m ()
e Event m () -> Event m () -> Event m ()
forall a b. Event m a -> Event m b -> Event m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Double] -> Event m ()
loop [Double]
ts
enqueueEventWithPoints :: MonadDES m => [Point m] -> Event m () -> Event m ()
{-# INLINABLE enqueueEventWithPoints #-}
enqueueEventWithPoints :: forall (m :: * -> *).
MonadDES m =>
[Point m] -> Event m () -> Event m ()
enqueueEventWithPoints [Point m]
xs (Event Point m -> m ()
e) = [Point m] -> Event m ()
loop [Point m]
xs
where loop :: [Point m] -> Event m ()
loop [] = () -> Event m ()
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop (Point m
x : [Point m]
xs) = Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
x) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> m ()
e Point m
x
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Point m] -> Event m ()
loop [Point m]
xs
enqueueEventWithIntegTimes :: MonadDES m => Event m () -> Event m ()
{-# INLINABLE enqueueEventWithIntegTimes #-}
enqueueEventWithIntegTimes :: forall (m :: * -> *). MonadDES m => Event m () -> Event m ()
enqueueEventWithIntegTimes Event m ()
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
let points :: [Point m]
points = Point m -> [Point m]
forall (m :: * -> *). Point m -> [Point m]
integPointsStartingFrom Point m
p
in Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Point m] -> Event m () -> Event m ()
forall (m :: * -> *).
MonadDES m =>
[Point m] -> Event m () -> Event m ()
enqueueEventWithPoints [Point m]
points Event m ()
e
enqueueEventWithStartTime :: MonadDES m => Event m () -> Event m ()
{-# INLINABLE enqueueEventWithStartTime #-}
enqueueEventWithStartTime :: forall (m :: * -> *). MonadDES m => Event m () -> Event m ()
enqueueEventWithStartTime Event m ()
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
let p0 :: Point m
p0 = Run m -> Point m
forall (m :: * -> *). Run m -> Point m
integStartPoint (Run m -> Point m) -> Run m -> Point m
forall a b. (a -> b) -> a -> b
$ Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
in Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Point m] -> Event m () -> Event m ()
forall (m :: * -> *).
MonadDES m =>
[Point m] -> Event m () -> Event m ()
enqueueEventWithPoints [Point m
p0] Event m ()
e
enqueueEventWithStopTime :: MonadDES m => Event m () -> Event m ()
{-# INLINABLE enqueueEventWithStopTime #-}
enqueueEventWithStopTime :: forall (m :: * -> *). MonadDES m => Event m () -> Event m ()
enqueueEventWithStopTime Event m ()
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
let p0 :: Point m
p0 = Run m -> Point m
forall (m :: * -> *). Run m -> Point m
simulationStopPoint (Run m -> Point m) -> Run m -> Point m
forall a b. (a -> b) -> a -> b
$ Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
in Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Point m] -> Event m () -> Event m ()
forall (m :: * -> *).
MonadDES m =>
[Point m] -> Event m () -> Event m ()
enqueueEventWithPoints [Point m
p0] Event m ()
e
data EventCancellation m =
EventCancellation { forall (m :: * -> *). EventCancellation m -> Event m ()
cancelEvent :: Event m (),
forall (m :: * -> *). EventCancellation m -> Event m Bool
eventCancelled :: Event m Bool,
forall (m :: * -> *). EventCancellation m -> Event m Bool
eventFinished :: Event m Bool
}
enqueueEventWithCancellation :: MonadDES m => Double -> Event m () -> Event m (EventCancellation m)
{-# INLINABLE enqueueEventWithCancellation #-}
enqueueEventWithCancellation :: forall (m :: * -> *).
MonadDES m =>
Double -> Event m () -> Event m (EventCancellation m)
enqueueEventWithCancellation Double
t Event m ()
e =
(Point m -> m (EventCancellation m))
-> Event m (EventCancellation m)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (EventCancellation m))
-> Event m (EventCancellation m))
-> (Point m -> m (EventCancellation m))
-> Event m (EventCancellation m)
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
Ref m Bool
cancelledRef <- Run m -> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Bool) -> m (Ref m Bool))
-> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Simulation m (Ref m Bool)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
Ref m Bool
cancellableRef <- Run m -> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Bool) -> m (Ref m Bool))
-> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Simulation m (Ref m Bool)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
True
Ref m Bool
finishedRef <- Run m -> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Bool) -> m (Ref m Bool))
-> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Simulation m (Ref m Bool)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
let cancel :: Event m ()
cancel =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
x <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Bool
cancellableRef
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
x (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m Bool
cancelledRef Bool
True
cancelled :: Event m Bool
cancelled =
Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Bool
cancelledRef
finished :: Event m Bool
finished =
Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Bool
finishedRef
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m Bool
cancellableRef Bool
False
Bool
x <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Bool
cancelledRef
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
x (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
e
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m Bool
finishedRef Bool
True
EventCancellation m -> m (EventCancellation m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EventCancellation { cancelEvent :: Event m ()
cancelEvent = Event m ()
cancel,
eventCancelled :: Event m Bool
eventCancelled = Event m Bool
cancelled,
eventFinished :: Event m Bool
eventFinished = Event m Bool
finished }
memoEvent :: MonadDES m => Event m a -> Simulation m (Event m a)
{-# INLINABLE memoEvent #-}
memoEvent :: forall (m :: * -> *) a.
MonadDES m =>
Event m a -> Simulation m (Event m a)
memoEvent Event m a
m =
(Run m -> m (Event m a)) -> Simulation m (Event m a)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Event m a)) -> Simulation m (Event m a))
-> (Run m -> m (Event m a)) -> Simulation m (Event m a)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
do Ref m (Maybe a)
ref <- Run m -> Simulation m (Ref m (Maybe a)) -> m (Ref m (Maybe a))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe a)) -> m (Ref m (Maybe a)))
-> Simulation m (Ref m (Maybe a)) -> m (Ref m (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Simulation m (Ref m (Maybe a))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe a
forall a. Maybe a
Nothing
Event m a -> m (Event m a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event m a -> m (Event m a)) -> Event m a -> m (Event m a)
forall a b. (a -> b) -> a -> b
$ (Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a) -> (Point m -> m a) -> Event m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Maybe a
x <- Point m -> Event m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe a) -> m (Maybe a))
-> Event m (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe a) -> Event m (Maybe a)
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe a)
ref
case Maybe a
x of
Just a
v -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
Maybe a
Nothing ->
do a
v <- Point m -> Event m a -> m a
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m a
m
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe a) -> Maybe a -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe a)
ref (a -> Maybe a
forall a. a -> Maybe a
Just a
v)
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
memoEventInTime :: MonadDES m => Event m a -> Simulation m (Event m a)
{-# INLINABLE memoEventInTime #-}
memoEventInTime :: forall (m :: * -> *) a.
MonadDES m =>
Event m a -> Simulation m (Event m a)
memoEventInTime Event m a
m =
(Run m -> m (Event m a)) -> Simulation m (Event m a)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Event m a)) -> Simulation m (Event m a))
-> (Run m -> m (Event m a)) -> Simulation m (Event m a)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
do Ref m (Maybe (Double, a))
ref <- Run m
-> Simulation m (Ref m (Maybe (Double, a)))
-> m (Ref m (Maybe (Double, a)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (Double, a)))
-> m (Ref m (Maybe (Double, a))))
-> Simulation m (Ref m (Maybe (Double, a)))
-> m (Ref m (Maybe (Double, a)))
forall a b. (a -> b) -> a -> b
$ Maybe (Double, a) -> Simulation m (Ref m (Maybe (Double, a)))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (Double, a)
forall a. Maybe a
Nothing
Event m a -> m (Event m a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event m a -> m (Event m a)) -> Event m a -> m (Event m a)
forall a b. (a -> b) -> a -> b
$ (Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a) -> (Point m -> m a) -> Event m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Maybe (Double, a)
x <- Point m -> Event m (Maybe (Double, a)) -> m (Maybe (Double, a))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (Double, a)) -> m (Maybe (Double, a)))
-> Event m (Maybe (Double, a)) -> m (Maybe (Double, a))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (Double, a)) -> Event m (Maybe (Double, a))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (Double, a))
ref
case Maybe (Double, a)
x of
Just (Double
t, a
v) | Double
t Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p ->
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
Maybe (Double, a)
_ ->
do a
v <- Point m -> Event m a -> m a
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m a
m
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (Double, a)) -> Maybe (Double, a) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (Double, a))
ref ((Double, a) -> Maybe (Double, a)
forall a. a -> Maybe a
Just (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p, a
v))
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
yieldEvent :: MonadDES m => Event m () -> Event m ()
{-# INLINABLE yieldEvent #-}
yieldEvent :: forall (m :: * -> *). MonadDES m => Event m () -> Event m ()
yieldEvent Event m ()
m =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) Event m ()
m
newtype DisposableEvent m =
DisposableEvent { forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent :: Event m ()
}
instance Monad m => Semigroup (DisposableEvent m) where
{-# INLINE (<>) #-}
DisposableEvent Event m ()
x <> :: DisposableEvent m -> DisposableEvent m -> DisposableEvent m
<> DisposableEvent Event m ()
y = Event m () -> DisposableEvent m
forall (m :: * -> *). Event m () -> DisposableEvent m
DisposableEvent (Event m () -> DisposableEvent m)
-> Event m () -> DisposableEvent m
forall a b. (a -> b) -> a -> b
$ Event m ()
x Event m () -> Event m () -> Event m ()
forall a b. Event m a -> Event m b -> Event m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Event m ()
y
instance Monad m => Monoid (DisposableEvent m) where
{-# INLINE mempty #-}
mempty :: DisposableEvent m
mempty = Event m () -> DisposableEvent m
forall (m :: * -> *). Event m () -> DisposableEvent m
DisposableEvent (Event m () -> DisposableEvent m)
-> Event m () -> DisposableEvent m
forall a b. (a -> b) -> a -> b
$ () -> Event m ()
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE mappend #-}
mappend :: DisposableEvent m -> DisposableEvent m -> DisposableEvent m
mappend = DisposableEvent m -> DisposableEvent m -> DisposableEvent m
forall a. Semigroup a => a -> a -> a
(<>)
retryEvent :: MonadException m => String -> Event m a
retryEvent :: forall (m :: * -> *) a. MonadException m => String -> Event m a
retryEvent String
message = SimulationRetry -> Event m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent (SimulationRetry -> Event m a) -> SimulationRetry -> Event m a
forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
message
traceEvent :: MonadDES m => String -> Event m a -> Event m a
{-# INLINABLE traceEvent #-}
traceEvent :: forall (m :: * -> *) a.
MonadDES m =>
String -> Event m a -> Event m a
traceEvent String
message Event m a
m =
(Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a) -> (Point m -> m a) -> Event m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
String -> m a -> m a
forall a. String -> a -> a
trace (String
"t = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
message) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$
Point m -> Event m a -> m a
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m a
m
class (EventQueueing m, MonadIO (Event m)) => EventIOQueueing m where
enqueueEventIO :: Double -> Event m () -> Event m ()
enqueueEventIOWithTimes :: (MonadDES m, EventIOQueueing m) => [Double] -> Event m () -> Event m ()
{-# INLINABLE enqueueEventIOWithTimes #-}
enqueueEventIOWithTimes :: forall (m :: * -> *).
(MonadDES m, EventIOQueueing m) =>
[Double] -> Event m () -> Event m ()
enqueueEventIOWithTimes [Double]
ts Event m ()
e = [Double] -> Event m ()
loop [Double]
ts
where loop :: [Double] -> Event m ()
loop [] = () -> Event m ()
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop (Double
t : [Double]
ts) = Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventIOQueueing m =>
Double -> Event m () -> Event m ()
enqueueEventIO Double
t (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$ Event m ()
e Event m () -> Event m () -> Event m ()
forall a b. Event m a -> Event m b -> Event m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Double] -> Event m ()
loop [Double]
ts
enqueueEventIOWithPoints :: (MonadDES m, EventIOQueueing m) => [Point m] -> Event m () -> Event m ()
{-# INLINABLE enqueueEventIOWithPoints #-}
enqueueEventIOWithPoints :: forall (m :: * -> *).
(MonadDES m, EventIOQueueing m) =>
[Point m] -> Event m () -> Event m ()
enqueueEventIOWithPoints [Point m]
xs (Event Point m -> m ()
e) = [Point m] -> Event m ()
loop [Point m]
xs
where loop :: [Point m] -> Event m ()
loop [] = () -> Event m ()
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop (Point m
x : [Point m]
xs) = Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventIOQueueing m =>
Double -> Event m () -> Event m ()
enqueueEventIO (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
x) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> m ()
e Point m
x
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Point m] -> Event m ()
loop [Point m]
xs
enqueueEventIOWithIntegTimes :: (MonadDES m, EventIOQueueing m) => Event m () -> Event m ()
{-# INLINABLE enqueueEventIOWithIntegTimes #-}
enqueueEventIOWithIntegTimes :: forall (m :: * -> *).
(MonadDES m, EventIOQueueing m) =>
Event m () -> Event m ()
enqueueEventIOWithIntegTimes Event m ()
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
let points :: [Point m]
points = Point m -> [Point m]
forall (m :: * -> *). Point m -> [Point m]
integPointsStartingFrom Point m
p
in Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Point m] -> Event m () -> Event m ()
forall (m :: * -> *).
(MonadDES m, EventIOQueueing m) =>
[Point m] -> Event m () -> Event m ()
enqueueEventIOWithPoints [Point m]
points Event m ()
e
enqueueEventIOWithStartTime :: (MonadDES m, EventIOQueueing m) => Event m () -> Event m ()
{-# INLINABLE enqueueEventIOWithStartTime #-}
enqueueEventIOWithStartTime :: forall (m :: * -> *).
(MonadDES m, EventIOQueueing m) =>
Event m () -> Event m ()
enqueueEventIOWithStartTime Event m ()
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
let p0 :: Point m
p0 = Run m -> Point m
forall (m :: * -> *). Run m -> Point m
integStartPoint (Run m -> Point m) -> Run m -> Point m
forall a b. (a -> b) -> a -> b
$ Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
in Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Point m] -> Event m () -> Event m ()
forall (m :: * -> *).
(MonadDES m, EventIOQueueing m) =>
[Point m] -> Event m () -> Event m ()
enqueueEventIOWithPoints [Point m
p0] Event m ()
e
enqueueEventIOWithStopTime :: (MonadDES m, EventIOQueueing m) => Event m () -> Event m ()
{-# INLINABLE enqueueEventIOWithStopTime #-}
enqueueEventIOWithStopTime :: forall (m :: * -> *).
(MonadDES m, EventIOQueueing m) =>
Event m () -> Event m ()
enqueueEventIOWithStopTime Event m ()
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
let p0 :: Point m
p0 = Run m -> Point m
forall (m :: * -> *). Run m -> Point m
simulationStopPoint (Run m -> Point m) -> Run m -> Point m
forall a b. (a -> b) -> a -> b
$ Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
in Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Point m] -> Event m () -> Event m ()
forall (m :: * -> *).
(MonadDES m, EventIOQueueing m) =>
[Point m] -> Event m () -> Event m ()
enqueueEventIOWithPoints [Point m
p0] Event m ()
e