{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, MonoLocalBinds, RankNTypes #-}

-- |
-- Module     : Simulation.Aivika.Trans.Internal.Event
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The module defines the 'Event' monad transformer which is very similar to the 'Dynamics'
-- monad transformer but only now the computation is strongly synchronized with the event queue.
--
module Simulation.Aivika.Trans.Internal.Event
       (-- * Event Monad
        Event(..),
        EventLift(..),
        EventProcessing(..),
        invokeEvent,
        runEventInStartTime,
        runEventInStopTime,
        -- * Event Queue
        EventPriority(..),
        EventQueueing(..),
        enqueueEventWithCancellation,
        enqueueEventWithStartTime,
        enqueueEventWithStopTime,
        enqueueEventWithTimes,
        enqueueEventWithPoints,
        enqueueEventWithIntegTimes,
        yieldEvent,
        eventPriority,
        -- * Cancelling Event
        EventCancellation,
        cancelEvent,
        eventCancelled,
        eventFinished,
        -- * Error Handling
        catchEvent,
        finallyEvent,
        throwEvent,
        -- * Memoization
        memoEvent,
        memoEventInTime,
        -- * Disposable
        DisposableEvent(..),
        -- * Retrying Computation
        retryEvent,
        -- * Synchronizing IO Actions
        EventIOQueueing(..),
        enqueueEventIOWithStartTime,
        enqueueEventIOWithStopTime,
        enqueueEventIOWithTimes,
        enqueueEventIOWithPoints,
        enqueueEventIOWithIntegTimes,
        -- * Debugging
        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

-- | A type class to lift the 'Event' computations into other computations.
class EventLift t m where
  
  -- | Lift the specified 'Event' computation into another computation.
  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

-- | Exception handling within 'Event' computations.
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
                           
-- | A computation with finalization part like the 'finally' function.
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)

-- | Like the standard 'throw' function.
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

-- | Runs an action with asynchronous exceptions disabled.
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)

-- | Like 'maskEvent', but the masked computation is not interruptible.
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)

-- | An implementation of 'generalBracket'.
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

-- | Run the 'Event' computation in the start time involving all
-- pending 'CurrentEvents' in the processing too.
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

-- | Run the 'Event' computation in the stop time involving all
-- pending 'CurrentEvents' in the processing too.
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

-- | Return the current event priority.
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

-- | Actuate the event handler in the specified time points.
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
       
-- | Actuate the event handler in the specified time points.
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    -- N.B. we substitute the time point!
                           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
                           
-- | Actuate the event handler in the integration time points.
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

-- | Actuate the event handler in the start time point.
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

-- | Actuate the event handler in the final time point.
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

-- | It allows cancelling the event.
data EventCancellation m =
  EventCancellation { forall (m :: * -> *). EventCancellation m -> Event m ()
cancelEvent :: Event m (),
                      -- ^ Cancel the event.
                      forall (m :: * -> *). EventCancellation m -> Event m Bool
eventCancelled :: Event m Bool,
                      -- ^ Test whether the event was cancelled.
                      forall (m :: * -> *). EventCancellation m -> Event m Bool
eventFinished :: Event m Bool
                      -- ^ Test whether the event was processed and finished.
                    }

-- | Enqueue the event with an ability to cancel it.
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 }

-- | Memoize the 'Event' computation, always returning the same value
-- within a simulation run.
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

-- | Memoize the 'Event' computation, always returning the same value
-- in the same modeling time. After the time changes, the value is
-- recalculated by demand.
--
-- It is possible to implement this function efficiently, for the 'Event'
-- computation is always synchronized with the event queue which time
-- flows in one direction only. This synchronization is a key difference
-- between the 'Event' and 'Dynamics' computations.
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

-- | Enqueue the event which must be actuated with the current modeling time but later.
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

-- | Defines a computation disposing some entity.
newtype DisposableEvent m =
  DisposableEvent { forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent :: Event m ()
                    -- ^ Dispose something within the 'Event' computation.
                  }

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
(<>)

-- | Retry the current computation as possible, using the specified argument
-- as a 'SimulationRetry' exception message in case of failure. It makes sense
-- for parallel distributed simulation, when we have to make a rollback,
-- awaiting for incoming messages.
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

-- | Show the debug message with the current simulation time.
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

-- | A type class of monads that allows synchronizing the global modeling time
-- before calling the event handler so that it is rather safe to perform 'IO' actions
-- within such a handler. It is mainly destined for parallel distributed simulation,
-- but it should be supported in other cases too.
--
class (EventQueueing m, MonadIO (Event m)) => EventIOQueueing m where

  -- | Like 'enqueueEvent' but synchronizes the global modeling time before
  -- calling the specified event handler.
  enqueueEventIO :: Double -> Event m () -> Event m ()

-- | Like 'enqueueEventWithTimes' but synchronizes the global modeling time
-- before calling the specified event handler.
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
       
-- | Like 'enqueueEventWithPoints' but synchronizes the global modeling time
-- before calling the specified event handler.
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    -- N.B. we substitute the time point!
                           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
                           
-- | Like 'enqueueEventWithIntegTimes' but synchronizes the global modeling time
-- before calling the specified event handler.
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

-- | Like 'enqueueEventWithStartTime' but synchronizes the global modeling time
-- before calling the specified event handler.
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

-- | Like 'enqueueEventWithStopTime' but synchronizes the global modeling time
-- before calling the specified event handler.
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