{-# LANGUAGE RecursiveDo, RankNTypes #-}
module Simulation.Aivika.Internal.Event
(
Event(..),
EventLift(..),
EventProcessing(..),
invokeEvent,
runEvent,
runEventWith,
runEventInStartTime,
runEventInStopTime,
EventPriority(..),
enqueueEvent,
enqueueEventWithPriority,
enqueueEventWithCancellation,
enqueueEventWithStartTime,
enqueueEventWithStopTime,
enqueueEventWithTimes,
enqueueEventWithPoints,
enqueueEventWithIntegTimes,
yieldEvent,
eventQueueCount,
eventPriority,
EventCancellation,
cancelEvent,
eventCancelled,
eventFinished,
catchEvent,
finallyEvent,
throwEvent,
memoEvent,
memoEventInTime,
DisposableEvent(..),
retryEvent,
traceEvent) where
import Data.IORef
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 qualified Simulation.Aivika.PriorityQueue.EventQueue as PQ
import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Parameter
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Dynamics
newtype Event a = Event (Point -> IO a)
instance Monad Event where
Event a
m >>= :: forall a b. Event a -> (a -> Event b) -> Event b
>>= a -> Event b
k = Event a -> (a -> Event b) -> Event b
forall a b. Event a -> (a -> Event b) -> Event b
bindE Event a
m a -> Event b
k
returnE :: a -> Event a
{-# INLINE returnE #-}
returnE :: forall a. a -> Event a
returnE a
a = (Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event (\Point
p -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a)
bindE :: Event a -> (a -> Event b) -> Event b
{-# INLINE bindE #-}
bindE :: forall a b. Event a -> (a -> Event b) -> Event b
bindE (Event Point -> IO a
m) a -> Event b
k =
(Point -> IO b) -> Event b
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO b) -> Event b) -> (Point -> IO b) -> Event b
forall a b. (a -> b) -> a -> b
$ \Point
p ->
do a
a <- Point -> IO a
m Point
p
let Event Point -> IO b
m' = a -> Event b
k a
a
Point -> IO b
m' Point
p
instance Functor Event where
fmap :: forall a b. (a -> b) -> Event a -> Event b
fmap = (a -> b) -> Event a -> Event b
forall a b. (a -> b) -> Event a -> Event b
liftME
instance Applicative Event where
pure :: forall a. a -> Event a
pure = a -> Event a
forall a. a -> Event a
returnE
<*> :: forall a b. Event (a -> b) -> Event a -> Event b
(<*>) = Event (a -> b) -> Event a -> Event b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance MonadFail Event where
fail :: forall a. String -> Event a
fail = String -> Event a
forall a. HasCallStack => String -> a
error
liftME :: (a -> b) -> Event a -> Event b
{-# INLINE liftME #-}
liftME :: forall a b. (a -> b) -> Event a -> Event b
liftME a -> b
f (Event Point -> IO a
x) =
(Point -> IO b) -> Event b
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO b) -> Event b) -> (Point -> IO b) -> Event b
forall a b. (a -> b) -> a -> b
$ \Point
p -> do { a
a <- Point -> IO a
x Point
p; b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a }
instance MonadIO Event where
liftIO :: forall a. IO a -> Event a
liftIO IO a
m = (Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ IO a -> Point -> IO a
forall a b. a -> b -> a
const IO a
m
instance ParameterLift Event where
liftParameter :: forall a. Parameter a -> Event a
liftParameter = Parameter a -> Event a
forall a. Parameter a -> Event a
liftPS
instance SimulationLift Event where
liftSimulation :: forall a. Simulation a -> Event a
liftSimulation = Simulation a -> Event a
forall a. Simulation a -> Event a
liftES
instance DynamicsLift Event where
liftDynamics :: forall a. Dynamics a -> Event a
liftDynamics = Dynamics a -> Event a
forall a. Dynamics a -> Event a
liftDS
liftPS :: Parameter a -> Event a
{-# INLINE liftPS #-}
liftPS :: forall a. Parameter a -> Event a
liftPS (Parameter Run -> IO a
m) =
(Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p -> Run -> IO a
m (Run -> IO a) -> Run -> IO a
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p
liftES :: Simulation a -> Event a
{-# INLINE liftES #-}
liftES :: forall a. Simulation a -> Event a
liftES (Simulation Run -> IO a
m) =
(Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p -> Run -> IO a
m (Run -> IO a) -> Run -> IO a
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p
liftDS :: Dynamics a -> Event a
{-# INLINE liftDS #-}
liftDS :: forall a. Dynamics a -> Event a
liftDS (Dynamics Point -> IO a
m) =
(Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event Point -> IO a
m
class EventLift m where
liftEvent :: Event a -> m a
instance EventLift Event where
liftEvent :: forall a. Event a -> Event a
liftEvent = Event a -> Event a
forall a. a -> a
id
catchEvent :: Exception e => Event a -> (e -> Event a) -> Event a
catchEvent :: forall e a. Exception e => Event a -> (e -> Event a) -> Event a
catchEvent (Event Point -> IO a
m) e -> Event a
h =
(Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Point -> IO a
m Point
p) ((e -> IO a) -> IO a) -> (e -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \e
e ->
let Event Point -> IO a
m' = e -> Event a
h e
e in Point -> IO a
m' Point
p
finallyEvent :: Event a -> Event b -> Event a
finallyEvent :: forall a b. Event a -> Event b -> Event a
finallyEvent (Event Point -> IO a
m) (Event Point -> IO b
m') =
(Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
IO a -> IO b -> IO a
forall a b. IO a -> IO b -> IO a
finally (Point -> IO a
m Point
p) (Point -> IO b
m' Point
p)
throwEvent :: Exception e => e -> Event a
throwEvent :: forall e a. Exception e => e -> Event a
throwEvent = e -> Event a
forall a e. Exception e => e -> a
throw
maskEvent :: ((forall a. Event a -> Event a) -> Event b) -> Event b
maskEvent :: forall b. ((forall a. Event a -> Event a) -> Event b) -> Event b
maskEvent (forall a. Event a -> Event a) -> Event b
a =
(Point -> IO b) -> Event b
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO b) -> Event b) -> (Point -> IO b) -> Event b
forall a b. (a -> b) -> a -> b
$ \Point
p ->
((forall a. IO a -> IO a) -> IO b) -> IO b
forall b.
HasCallStack =>
((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
u ->
Point -> Event b -> IO b
forall a. Point -> Event a -> IO a
invokeEvent Point
p ((forall a. Event a -> Event a) -> Event b
a ((forall a. Event a -> Event a) -> Event b)
-> (forall a. Event a -> Event a) -> Event b
forall a b. (a -> b) -> a -> b
$ (IO a -> IO a) -> Event a -> Event a
forall {a} {a}. (IO a -> IO a) -> Event a -> Event a
q IO a -> IO a
forall a. IO a -> IO a
u)
where q :: (IO a -> IO a) -> Event a -> Event a
q IO a -> IO a
u (Event Point -> IO a
b) = (Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event (IO a -> IO a
u (IO a -> IO a) -> (Point -> IO a) -> Point -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> IO a
b)
uninterruptibleMaskEvent :: ((forall a. Event a -> Event a) -> Event b) -> Event b
uninterruptibleMaskEvent :: forall b. ((forall a. Event a -> Event a) -> Event b) -> Event b
uninterruptibleMaskEvent (forall a. Event a -> Event a) -> Event b
a =
(Point -> IO b) -> Event b
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO b) -> Event b) -> (Point -> IO b) -> Event b
forall a b. (a -> b) -> a -> b
$ \Point
p ->
((forall a. IO a -> IO a) -> IO b) -> IO b
forall b.
HasCallStack =>
((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
MC.uninterruptibleMask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
u ->
Point -> Event b -> IO b
forall a. Point -> Event a -> IO a
invokeEvent Point
p ((forall a. Event a -> Event a) -> Event b
a ((forall a. Event a -> Event a) -> Event b)
-> (forall a. Event a -> Event a) -> Event b
forall a b. (a -> b) -> a -> b
$ (IO a -> IO a) -> Event a -> Event a
forall {a} {a}. (IO a -> IO a) -> Event a -> Event a
q IO a -> IO a
forall a. IO a -> IO a
u)
where q :: (IO a -> IO a) -> Event a -> Event a
q IO a -> IO a
u (Event Point -> IO a
b) = (Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event (IO a -> IO a
u (IO a -> IO a) -> (Point -> IO a) -> Point -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> IO a
b)
generalBracketEvent :: Event a
-> (a -> MC.ExitCase b -> Event c)
-> (a -> Event b)
-> Event (b, c)
generalBracketEvent :: forall a b c.
Event a
-> (a -> ExitCase b -> Event c) -> (a -> Event b) -> Event (b, c)
generalBracketEvent Event a
acquire a -> ExitCase b -> Event c
release a -> Event b
use =
(Point -> IO (b, c)) -> Event (b, c)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (b, c)) -> Event (b, c))
-> (Point -> IO (b, c)) -> Event (b, c)
forall a b. (a -> b) -> a -> b
$ \Point
p -> do
IO a -> (a -> ExitCase b -> IO c) -> (a -> IO b) -> IO (b, c)
forall a b c.
HasCallStack =>
IO a -> (a -> ExitCase b -> IO c) -> (a -> IO b) -> IO (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 -> Event a -> IO a
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event a
acquire)
(\a
resource ExitCase b
e -> Point -> Event c -> IO c
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event c -> IO c) -> Event c -> IO c
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> Event c
release a
resource ExitCase b
e)
(\a
resource -> Point -> Event b -> IO b
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event b -> IO b) -> Event b -> IO b
forall a b. (a -> b) -> a -> b
$ a -> Event b
use a
resource)
invokeEvent :: Point -> Event a -> IO a
{-# INLINE invokeEvent #-}
invokeEvent :: forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event Point -> IO a
m) = Point -> IO a
m Point
p
instance MonadFix Event where
mfix :: forall a. (a -> Event a) -> Event a
mfix a -> Event a
f =
(Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
do { rec { a
a <- Point -> Event a -> IO a
forall a. Point -> Event a -> IO a
invokeEvent Point
p (a -> Event a
f a
a) }; a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a }
instance MC.MonadThrow Event where
throwM :: forall e a. (HasCallStack, Exception e) => e -> Event a
throwM = e -> Event a
forall e a. Exception e => e -> Event a
throwEvent
instance MC.MonadCatch Event where
catch :: forall e a.
(HasCallStack, Exception e) =>
Event a -> (e -> Event a) -> Event a
catch = Event a -> (e -> Event a) -> Event a
forall e a. Exception e => Event a -> (e -> Event a) -> Event a
catchEvent
instance MC.MonadMask Event where
mask :: forall b.
HasCallStack =>
((forall a. Event a -> Event a) -> Event b) -> Event b
mask = ((forall a. Event a -> Event a) -> Event b) -> Event b
forall b. ((forall a. Event a -> Event a) -> Event b) -> Event b
maskEvent
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Event a -> Event a) -> Event b) -> Event b
uninterruptibleMask = ((forall a. Event a -> Event a) -> Event b) -> Event b
forall b. ((forall a. Event a -> Event a) -> Event b) -> Event b
uninterruptibleMaskEvent
generalBracket :: forall a b c.
HasCallStack =>
Event a
-> (a -> ExitCase b -> Event c) -> (a -> Event b) -> Event (b, c)
generalBracket = Event a
-> (a -> ExitCase b -> Event c) -> (a -> Event b) -> Event (b, c)
forall a b c.
Event a
-> (a -> ExitCase b -> Event c) -> (a -> Event b) -> Event (b, c)
generalBracketEvent
data EventProcessing = CurrentEvents
| EarlierEvents
| CurrentEventsOrFromPast
| EarlierEventsOrFromPast
deriving (EventProcessing -> EventProcessing -> Bool
(EventProcessing -> EventProcessing -> Bool)
-> (EventProcessing -> EventProcessing -> Bool)
-> Eq EventProcessing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventProcessing -> EventProcessing -> Bool
== :: EventProcessing -> EventProcessing -> Bool
$c/= :: EventProcessing -> EventProcessing -> Bool
/= :: EventProcessing -> EventProcessing -> Bool
Eq, Eq EventProcessing
Eq EventProcessing =>
(EventProcessing -> EventProcessing -> Ordering)
-> (EventProcessing -> EventProcessing -> Bool)
-> (EventProcessing -> EventProcessing -> Bool)
-> (EventProcessing -> EventProcessing -> Bool)
-> (EventProcessing -> EventProcessing -> Bool)
-> (EventProcessing -> EventProcessing -> EventProcessing)
-> (EventProcessing -> EventProcessing -> EventProcessing)
-> Ord EventProcessing
EventProcessing -> EventProcessing -> Bool
EventProcessing -> EventProcessing -> Ordering
EventProcessing -> EventProcessing -> EventProcessing
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EventProcessing -> EventProcessing -> Ordering
compare :: EventProcessing -> EventProcessing -> Ordering
$c< :: EventProcessing -> EventProcessing -> Bool
< :: EventProcessing -> EventProcessing -> Bool
$c<= :: EventProcessing -> EventProcessing -> Bool
<= :: EventProcessing -> EventProcessing -> Bool
$c> :: EventProcessing -> EventProcessing -> Bool
> :: EventProcessing -> EventProcessing -> Bool
$c>= :: EventProcessing -> EventProcessing -> Bool
>= :: EventProcessing -> EventProcessing -> Bool
$cmax :: EventProcessing -> EventProcessing -> EventProcessing
max :: EventProcessing -> EventProcessing -> EventProcessing
$cmin :: EventProcessing -> EventProcessing -> EventProcessing
min :: EventProcessing -> EventProcessing -> EventProcessing
Ord, Int -> EventProcessing -> ShowS
[EventProcessing] -> ShowS
EventProcessing -> String
(Int -> EventProcessing -> ShowS)
-> (EventProcessing -> String)
-> ([EventProcessing] -> ShowS)
-> Show EventProcessing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventProcessing -> ShowS
showsPrec :: Int -> EventProcessing -> ShowS
$cshow :: EventProcessing -> String
show :: EventProcessing -> String
$cshowList :: [EventProcessing] -> ShowS
showList :: [EventProcessing] -> ShowS
Show)
enqueueEvent :: Double -> Event () -> Event ()
enqueueEvent :: Double -> Event () -> Event ()
enqueueEvent Double
t (Event Point -> IO ()
m) =
(Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
let pq :: PriorityQueue (Point -> IO ())
pq = EventQueue -> PriorityQueue (Point -> IO ())
queuePQ (EventQueue -> PriorityQueue (Point -> IO ()))
-> EventQueue -> PriorityQueue (Point -> IO ())
forall a b. (a -> b) -> a -> b
$ Run -> EventQueue
runEventQueue (Run -> EventQueue) -> Run -> EventQueue
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p
in PriorityQueue (Point -> IO ())
-> Double -> Int -> (Point -> IO ()) -> IO ()
forall a. PriorityQueue a -> Double -> Int -> a -> IO ()
PQ.enqueue PriorityQueue (Point -> IO ())
pq Double
t (Point -> Int
pointPriority Point
p) Point -> IO ()
m
enqueueEventWithPriority :: Double -> EventPriority -> Event () -> Event ()
enqueueEventWithPriority :: Double -> Int -> Event () -> Event ()
enqueueEventWithPriority Double
t Int
priority (Event Point -> IO ()
m) =
(Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
let pq :: PriorityQueue (Point -> IO ())
pq = EventQueue -> PriorityQueue (Point -> IO ())
queuePQ (EventQueue -> PriorityQueue (Point -> IO ()))
-> EventQueue -> PriorityQueue (Point -> IO ())
forall a b. (a -> b) -> a -> b
$ Run -> EventQueue
runEventQueue (Run -> EventQueue) -> Run -> EventQueue
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p
in PriorityQueue (Point -> IO ())
-> Double -> Int -> (Point -> IO ()) -> IO ()
forall a. PriorityQueue a -> Double -> Int -> a -> IO ()
PQ.enqueue PriorityQueue (Point -> IO ())
pq Double
t Int
priority Point -> IO ()
m
processPendingEventsCore :: Bool -> Dynamics ()
processPendingEventsCore :: Bool -> Dynamics ()
processPendingEventsCore Bool
includingCurrentEvents = (Point -> IO ()) -> Dynamics ()
forall a. (Point -> IO a) -> Dynamics a
Dynamics Point -> IO ()
r where
r :: Point -> IO ()
r Point
p =
do let q :: EventQueue
q = Run -> EventQueue
runEventQueue (Run -> EventQueue) -> Run -> EventQueue
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p
f :: IORef Bool
f = EventQueue -> IORef Bool
queueBusy EventQueue
q
Bool
f' <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
f
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f' (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
f Bool
True
EventQueue -> Point -> IO ()
call EventQueue
q Point
p
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
f Bool
False
call :: EventQueue -> Point -> IO ()
call EventQueue
q Point
p =
do let pq :: PriorityQueue (Point -> IO ())
pq = EventQueue -> PriorityQueue (Point -> IO ())
queuePQ EventQueue
q
r :: Run
r = Point -> Run
pointRun Point
p
Bool
f <- PriorityQueue (Point -> IO ()) -> IO Bool
forall a. PriorityQueue a -> IO Bool
PQ.queueNull PriorityQueue (Point -> IO ())
pq
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do (Double
t2, Int
priority2, Point -> IO ()
c2) <- PriorityQueue (Point -> IO ()) -> IO (Double, Int, Point -> IO ())
forall a. PriorityQueue a -> IO (Double, Int, a)
PQ.queueFront PriorityQueue (Point -> IO ())
pq
let t :: IORef Double
t = EventQueue -> IORef Double
queueTime EventQueue
q
Double
t' <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef IORef Double
t
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
t2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
t') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall a. HasCallStack => String -> a
error String
"The time value is too small: processPendingEventsCore"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Double
t2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Point -> Double
pointTime Point
p) Bool -> Bool -> Bool
||
(Bool
includingCurrentEvents Bool -> Bool -> Bool
&& (Double
t2 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Point -> Double
pointTime Point
p))) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do IORef Double -> Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Double
t Double
t2
PriorityQueue (Point -> IO ()) -> IO ()
forall a. PriorityQueue a -> IO ()
PQ.dequeue PriorityQueue (Point -> IO ())
pq
let sc :: Specs
sc = Point -> Specs
pointSpecs Point
p
t0 :: Double
t0 = Specs -> Double
spcStartTime Specs
sc
dt :: Double
dt = Specs -> Double
spcDT Specs
sc
n2 :: Int
n2 = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dt)
Point -> IO ()
c2 (Point -> IO ()) -> Point -> IO ()
forall a b. (a -> b) -> a -> b
$ Point
p { pointTime = t2,
pointPriority = priority2,
pointIteration = n2,
pointPhase = -1 }
EventQueue -> Point -> IO ()
call EventQueue
q Point
p
processPendingEvents :: Bool -> Dynamics ()
processPendingEvents :: Bool -> Dynamics ()
processPendingEvents Bool
includingCurrentEvents = (Point -> IO ()) -> Dynamics ()
forall a. (Point -> IO a) -> Dynamics a
Dynamics Point -> IO ()
r where
r :: Point -> IO ()
r Point
p =
do let q :: EventQueue
q = Run -> EventQueue
runEventQueue (Run -> EventQueue) -> Run -> EventQueue
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p
t :: IORef Double
t = EventQueue -> IORef Double
queueTime EventQueue
q
Double
t' <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef IORef Double
t
if Point -> Double
pointTime Point
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
t'
then String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"The current time is less than " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"the time in the queue: processPendingEvents"
else Point -> Dynamics () -> IO ()
forall a. Point -> Dynamics a -> IO a
invokeDynamics Point
p Dynamics ()
m
m :: Dynamics ()
m = Bool -> Dynamics ()
processPendingEventsCore Bool
includingCurrentEvents
processEventsIncludingCurrent :: Dynamics ()
processEventsIncludingCurrent = Bool -> Dynamics ()
processPendingEvents Bool
True
processEventsIncludingEarlier :: Dynamics ()
processEventsIncludingEarlier = Bool -> Dynamics ()
processPendingEvents Bool
False
processEventsIncludingCurrentCore :: Dynamics ()
processEventsIncludingCurrentCore = Bool -> Dynamics ()
processPendingEventsCore Bool
True
processEventsIncludingEarlierCore :: Dynamics ()
processEventsIncludingEarlierCore = Bool -> Dynamics ()
processPendingEventsCore Bool
True
processEvents :: EventProcessing -> Dynamics ()
processEvents :: EventProcessing -> Dynamics ()
processEvents EventProcessing
CurrentEvents = Dynamics ()
processEventsIncludingCurrent
processEvents EventProcessing
EarlierEvents = Dynamics ()
processEventsIncludingEarlier
processEvents EventProcessing
CurrentEventsOrFromPast = Dynamics ()
processEventsIncludingCurrentCore
processEvents EventProcessing
EarlierEventsOrFromPast = Dynamics ()
processEventsIncludingEarlierCore
runEvent :: Event a -> Dynamics a
runEvent :: forall a. Event a -> Dynamics a
runEvent = EventProcessing -> Event a -> Dynamics a
forall a. EventProcessing -> Event a -> Dynamics a
runEventWith EventProcessing
CurrentEvents
runEventWith :: EventProcessing -> Event a -> Dynamics a
runEventWith :: forall a. EventProcessing -> Event a -> Dynamics a
runEventWith EventProcessing
processing (Event Point -> IO a
e) =
(Point -> IO a) -> Dynamics a
forall a. (Point -> IO a) -> Dynamics a
Dynamics ((Point -> IO a) -> Dynamics a) -> (Point -> IO a) -> Dynamics a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Point -> Dynamics () -> IO ()
forall a. Point -> Dynamics a -> IO a
invokeDynamics Point
p (Dynamics () -> IO ()) -> Dynamics () -> IO ()
forall a b. (a -> b) -> a -> b
$ EventProcessing -> Dynamics ()
processEvents EventProcessing
processing
Point -> IO a
e Point
p
runEventInStartTime :: Event a -> Simulation a
runEventInStartTime :: forall a. Event a -> Simulation a
runEventInStartTime = Dynamics a -> Simulation a
forall a. Dynamics a -> Simulation a
runDynamicsInStartTime (Dynamics a -> Simulation a)
-> (Event a -> Dynamics a) -> Event a -> Simulation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Dynamics a
forall a. Event a -> Dynamics a
runEvent
runEventInStopTime :: Event a -> Simulation a
runEventInStopTime :: forall a. Event a -> Simulation a
runEventInStopTime = Dynamics a -> Simulation a
forall a. Dynamics a -> Simulation a
runDynamicsInStopTime (Dynamics a -> Simulation a)
-> (Event a -> Dynamics a) -> Event a -> Simulation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Dynamics a
forall a. Event a -> Dynamics a
runEvent
eventQueueCount :: Event Int
eventQueueCount :: Event Int
eventQueueCount =
(Point -> IO Int) -> Event Int
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Int) -> Event Int) -> (Point -> IO Int) -> Event Int
forall a b. (a -> b) -> a -> b
$ PriorityQueue (Point -> IO ()) -> IO Int
forall a. PriorityQueue a -> IO Int
PQ.queueCount (PriorityQueue (Point -> IO ()) -> IO Int)
-> (Point -> PriorityQueue (Point -> IO ())) -> Point -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventQueue -> PriorityQueue (Point -> IO ())
queuePQ (EventQueue -> PriorityQueue (Point -> IO ()))
-> (Point -> EventQueue) -> Point -> PriorityQueue (Point -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run -> EventQueue
runEventQueue (Run -> EventQueue) -> (Point -> Run) -> Point -> EventQueue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Run
pointRun
eventPriority :: Event EventPriority
eventPriority :: Event Int
eventPriority =
(Point -> IO Int) -> Event Int
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Int) -> Event Int) -> (Point -> IO Int) -> Event Int
forall a b. (a -> b) -> a -> b
$ Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> (Point -> Int) -> Point -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Int
pointPriority
enqueueEventWithTimes :: [Double] -> Event () -> Event ()
enqueueEventWithTimes :: [Double] -> Event () -> Event ()
enqueueEventWithTimes [Double]
ts Event ()
e = [Double] -> Event ()
loop [Double]
ts
where loop :: [Double] -> Event ()
loop [] = () -> Event ()
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop (Double
t : [Double]
ts) = Double -> Event () -> Event ()
enqueueEvent Double
t (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ Event ()
e Event () -> Event () -> Event ()
forall a b. Event a -> Event b -> Event b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Double] -> Event ()
loop [Double]
ts
enqueueEventWithPoints :: [Point] -> Event () -> Event ()
enqueueEventWithPoints :: [Point] -> Event () -> Event ()
enqueueEventWithPoints [Point]
xs (Event Point -> IO ()
e) = [Point] -> Event ()
loop [Point]
xs
where loop :: [Point] -> Event ()
loop [] = () -> Event ()
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop (Point
x : [Point]
xs) = Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
x) (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$
(Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Point -> IO ()
e Point
x
Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Point] -> Event ()
loop [Point]
xs
enqueueEventWithIntegTimes :: Event () -> Event ()
enqueueEventWithIntegTimes :: Event () -> Event ()
enqueueEventWithIntegTimes Event ()
e =
(Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
let points :: [Point]
points = Point -> [Point]
integPointsStartingFrom Point
p
in Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Point] -> Event () -> Event ()
enqueueEventWithPoints [Point]
points Event ()
e
enqueueEventWithStartTime :: Event () -> Event ()
enqueueEventWithStartTime :: Event () -> Event ()
enqueueEventWithStartTime Event ()
e =
(Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
let p0 :: Point
p0 = Run -> Point
integStartPoint (Run -> Point) -> Run -> Point
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p
in Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Point] -> Event () -> Event ()
enqueueEventWithPoints [Point
p0] Event ()
e
enqueueEventWithStopTime :: Event () -> Event ()
enqueueEventWithStopTime :: Event () -> Event ()
enqueueEventWithStopTime Event ()
e =
(Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
let p0 :: Point
p0 = Run -> Point
simulationStopPoint (Run -> Point) -> Run -> Point
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p
in Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Point] -> Event () -> Event ()
enqueueEventWithPoints [Point
p0] Event ()
e
data EventCancellation =
EventCancellation { EventCancellation -> Event ()
cancelEvent :: Event (),
EventCancellation -> Event Bool
eventCancelled :: Event Bool,
EventCancellation -> Event Bool
eventFinished :: Event Bool
}
enqueueEventWithCancellation :: Double -> Event () -> Event EventCancellation
enqueueEventWithCancellation :: Double -> Event () -> Event EventCancellation
enqueueEventWithCancellation Double
t Event ()
e =
(Point -> IO EventCancellation) -> Event EventCancellation
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO EventCancellation) -> Event EventCancellation)
-> (Point -> IO EventCancellation) -> Event EventCancellation
forall a b. (a -> b) -> a -> b
$ \Point
p ->
do IORef Bool
cancelledRef <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
IORef Bool
cancellableRef <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True
IORef Bool
finishedRef <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
let cancel :: Event ()
cancel =
(Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Bool
x <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
cancellableRef
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
x (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
cancelledRef Bool
True
cancelled :: Event Bool
cancelled =
(Point -> IO Bool) -> Event Bool
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Bool) -> Event Bool)
-> (Point -> IO Bool) -> Event Bool
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
cancelledRef
finished :: Event Bool
finished =
(Point -> IO Bool) -> Event Bool
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Bool) -> Event Bool)
-> (Point -> IO Bool) -> Event Bool
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
finishedRef
Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
Double -> Event () -> Event ()
enqueueEvent Double
t (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$
(Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
do IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
cancellableRef Bool
False
Bool
x <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
cancelledRef
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
x (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
e
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
finishedRef Bool
True
EventCancellation -> IO EventCancellation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EventCancellation { cancelEvent :: Event ()
cancelEvent = Event ()
cancel,
eventCancelled :: Event Bool
eventCancelled = Event Bool
cancelled,
eventFinished :: Event Bool
eventFinished = Event Bool
finished }
memoEvent :: Event a -> Simulation (Event a)
memoEvent :: forall a. Event a -> Simulation (Event a)
memoEvent Event a
m =
do IORef (Maybe a)
ref <- IO (IORef (Maybe a)) -> Simulation (IORef (Maybe a))
forall a. IO a -> Simulation a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe a)) -> Simulation (IORef (Maybe a)))
-> IO (IORef (Maybe a)) -> Simulation (IORef (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> IO (IORef (Maybe a))
forall a. a -> IO (IORef a)
newIORef Maybe a
forall a. Maybe a
Nothing
Event a -> Simulation (Event a)
forall a. a -> Simulation a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event a -> Simulation (Event a))
-> Event a -> Simulation (Event a)
forall a b. (a -> b) -> a -> b
$ (Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Maybe a
x <- IORef (Maybe a) -> IO (Maybe a)
forall a. IORef a -> IO a
readIORef IORef (Maybe a)
ref
case Maybe a
x of
Just a
v -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
Maybe a
Nothing ->
do a
v <- Point -> Event a -> IO a
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event a
m
IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
ref (a -> Maybe a
forall a. a -> Maybe a
Just a
v)
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
memoEventInTime :: Event a -> Simulation (Event a)
memoEventInTime :: forall a. Event a -> Simulation (Event a)
memoEventInTime Event a
m =
do IORef (Maybe (Double, a))
ref <- IO (IORef (Maybe (Double, a)))
-> Simulation (IORef (Maybe (Double, a)))
forall a. IO a -> Simulation a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (Double, a)))
-> Simulation (IORef (Maybe (Double, a))))
-> IO (IORef (Maybe (Double, a)))
-> Simulation (IORef (Maybe (Double, a)))
forall a b. (a -> b) -> a -> b
$ Maybe (Double, a) -> IO (IORef (Maybe (Double, a)))
forall a. a -> IO (IORef a)
newIORef Maybe (Double, a)
forall a. Maybe a
Nothing
Event a -> Simulation (Event a)
forall a. a -> Simulation a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event a -> Simulation (Event a))
-> Event a -> Simulation (Event a)
forall a b. (a -> b) -> a -> b
$ (Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Maybe (Double, a)
x <- IORef (Maybe (Double, a)) -> IO (Maybe (Double, a))
forall a. IORef a -> IO a
readIORef IORef (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 -> Double
pointTime Point
p ->
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
Maybe (Double, a)
_ ->
do a
v <- Point -> Event a -> IO a
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event a
m
IORef (Maybe (Double, a)) -> Maybe (Double, a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Double, a))
ref ((Double, a) -> Maybe (Double, a)
forall a. a -> Maybe a
Just (Point -> Double
pointTime Point
p, a
v))
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
yieldEvent :: Event () -> Event ()
yieldEvent :: Event () -> Event ()
yieldEvent Event ()
m =
(Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) Event ()
m
newtype DisposableEvent =
DisposableEvent { DisposableEvent -> Event ()
disposeEvent :: Event ()
}
instance Semigroup DisposableEvent where
DisposableEvent Event ()
x <> :: DisposableEvent -> DisposableEvent -> DisposableEvent
<> DisposableEvent Event ()
y = Event () -> DisposableEvent
DisposableEvent (Event () -> DisposableEvent) -> Event () -> DisposableEvent
forall a b. (a -> b) -> a -> b
$ Event ()
x Event () -> Event () -> Event ()
forall a b. Event a -> Event b -> Event b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Event ()
y
instance Monoid DisposableEvent where
mempty :: DisposableEvent
mempty = Event () -> DisposableEvent
DisposableEvent (Event () -> DisposableEvent) -> Event () -> DisposableEvent
forall a b. (a -> b) -> a -> b
$ () -> Event ()
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mappend :: DisposableEvent -> DisposableEvent -> DisposableEvent
mappend = DisposableEvent -> DisposableEvent -> DisposableEvent
forall a. Semigroup a => a -> a -> a
(<>)
retryEvent :: String -> Event a
retryEvent :: forall a. String -> Event a
retryEvent String
message = SimulationRetry -> Event a
forall e a. Exception e => e -> Event a
throwEvent (SimulationRetry -> Event a) -> SimulationRetry -> Event a
forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
message
traceEvent :: String -> Event a -> Event a
traceEvent :: forall a. String -> Event a -> Event a
traceEvent String
message Event a
m =
(Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
String -> IO a -> IO a
forall a. String -> a -> a
trace (String
"t = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show (Point -> Double
pointTime Point
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
message) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
Point -> Event a -> IO a
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event a
m