module Simulation.Aivika.Signal
(
Signal(..),
handleSignal_,
handleSignalComposite,
SignalSource,
newSignalSource,
publishSignal,
triggerSignal,
mapSignal,
mapSignalM,
apSignal,
filterSignal,
filterSignal_,
filterSignalM,
filterSignalM_,
emptySignal,
merge2Signals,
merge3Signals,
merge4Signals,
merge5Signals,
arrivalSignal,
newSignalInTimes,
newSignalInIntegTimes,
newSignalInStartTime,
newSignalInStopTime,
newSignalInTimeGrid,
delaySignal,
delaySignalM,
SignalHistory,
signalHistorySignal,
newSignalHistory,
newSignalHistoryStartingWith,
readSignalHistory,
Signalable(..),
signalableChanged,
emptySignalable,
appendSignalable,
traceSignal) where
import Data.IORef
import Data.Monoid hiding ((<>))
import Data.Semigroup (Semigroup(..))
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.List
import Data.Array
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Parameter
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Dynamics
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Arrival
import Simulation.Aivika.Composite
import qualified Simulation.Aivika.Vector as V
import qualified Simulation.Aivika.Vector.Unboxed as UV
data SignalSource a =
SignalSource { forall a. SignalSource a -> Signal a
publishSignal :: Signal a,
forall a. SignalSource a -> a -> Event ()
triggerSignal :: a -> Event ()
}
data Signal a =
Signal { forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal :: (a -> Event ()) -> Event DisposableEvent
}
data SignalHandlerQueue a =
SignalHandlerQueue { forall a. SignalHandlerQueue a -> IORef [SignalHandler a]
queueList :: IORef [SignalHandler a] }
data SignalHandler a =
SignalHandler { forall a. SignalHandler a -> a -> Event ()
handlerComp :: a -> Event (),
forall a. SignalHandler a -> IORef ()
handlerRef :: IORef () }
instance Eq (SignalHandler a) where
SignalHandler a
x == :: SignalHandler a -> SignalHandler a -> Bool
== SignalHandler a
y = (forall a. SignalHandler a -> IORef ()
handlerRef SignalHandler a
x) forall a. Eq a => a -> a -> Bool
== (forall a. SignalHandler a -> IORef ()
handlerRef SignalHandler a
y)
handleSignal_ :: Signal a -> (a -> Event ()) -> Event ()
handleSignal_ :: forall a. Signal a -> (a -> Event ()) -> Event ()
handleSignal_ Signal a
signal a -> Event ()
h =
do DisposableEvent
x <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
signal a -> Event ()
h
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleSignalComposite :: Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite :: forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal a
signal a -> Event ()
h =
do DisposableEvent
x <- forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
signal a -> Event ()
h
DisposableEvent -> Composite ()
disposableComposite DisposableEvent
x
newSignalSource :: Simulation (SignalSource a)
newSignalSource :: forall a. Simulation (SignalSource a)
newSignalSource =
forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ \Run
r ->
do IORef [SignalHandler a]
list <- forall a. a -> IO (IORef a)
newIORef []
let queue :: SignalHandlerQueue a
queue = SignalHandlerQueue { queueList :: IORef [SignalHandler a]
queueList = IORef [SignalHandler a]
list }
signal :: Signal a
signal = Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent
handleSignal = (a -> Event ()) -> Event DisposableEvent
handle }
source :: SignalSource a
source = SignalSource { publishSignal :: Signal a
publishSignal = Signal a
signal,
triggerSignal :: a -> Event ()
triggerSignal = a -> Event ()
trigger }
handle :: (a -> Event ()) -> Event DisposableEvent
handle a -> Event ()
h =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do SignalHandler a
x <- forall a.
SignalHandlerQueue a -> (a -> Event ()) -> IO (SignalHandler a)
enqueueSignalHandler SignalHandlerQueue a
queue a -> Event ()
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
Event () -> DisposableEvent
DisposableEvent forall a b. (a -> b) -> a -> b
$
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> forall a. SignalHandlerQueue a -> SignalHandler a -> IO ()
dequeueSignalHandler SignalHandlerQueue a
queue SignalHandler a
x
trigger :: a -> Event ()
trigger a
a =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> forall a. SignalHandlerQueue a -> a -> Point -> IO ()
triggerSignalHandlers SignalHandlerQueue a
queue a
a Point
p
forall (m :: * -> *) a. Monad m => a -> m a
return SignalSource a
source
triggerSignalHandlers :: SignalHandlerQueue a -> a -> Point -> IO ()
{-# INLINE triggerSignalHandlers #-}
triggerSignalHandlers :: forall a. SignalHandlerQueue a -> a -> Point -> IO ()
triggerSignalHandlers SignalHandlerQueue a
q a
a Point
p =
do [SignalHandler a]
hs <- forall a. IORef a -> IO a
readIORef (forall a. SignalHandlerQueue a -> IORef [SignalHandler a]
queueList SignalHandlerQueue a
q)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SignalHandler a]
hs forall a b. (a -> b) -> a -> b
$ \SignalHandler a
h ->
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. SignalHandler a -> a -> Event ()
handlerComp SignalHandler a
h a
a
enqueueSignalHandler :: SignalHandlerQueue a -> (a -> Event ()) -> IO (SignalHandler a)
{-# INLINE enqueueSignalHandler #-}
enqueueSignalHandler :: forall a.
SignalHandlerQueue a -> (a -> Event ()) -> IO (SignalHandler a)
enqueueSignalHandler SignalHandlerQueue a
q a -> Event ()
h =
do IORef ()
r <- forall a. a -> IO (IORef a)
newIORef ()
let handler :: SignalHandler a
handler = SignalHandler { handlerComp :: a -> Event ()
handlerComp = a -> Event ()
h,
handlerRef :: IORef ()
handlerRef = IORef ()
r }
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (forall a. SignalHandlerQueue a -> IORef [SignalHandler a]
queueList SignalHandlerQueue a
q) (SignalHandler a
handler forall a. a -> [a] -> [a]
:)
forall (m :: * -> *) a. Monad m => a -> m a
return SignalHandler a
handler
dequeueSignalHandler :: SignalHandlerQueue a -> SignalHandler a -> IO ()
{-# INLINE dequeueSignalHandler #-}
dequeueSignalHandler :: forall a. SignalHandlerQueue a -> SignalHandler a -> IO ()
dequeueSignalHandler SignalHandlerQueue a
q SignalHandler a
h =
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (forall a. SignalHandlerQueue a -> IORef [SignalHandler a]
queueList SignalHandlerQueue a
q) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete SignalHandler a
h
instance Functor Signal where
fmap :: forall a b. (a -> b) -> Signal a -> Signal b
fmap = forall a b. (a -> b) -> Signal a -> Signal b
mapSignal
instance Semigroup (Signal a) where
<> :: Signal a -> Signal a -> Signal a
(<>) = forall a. Signal a -> Signal a -> Signal a
merge2Signals
sconcat :: NonEmpty (Signal a) -> Signal a
sconcat (Signal a
x1 :| []) = Signal a
x1
sconcat (Signal a
x1 :| [Signal a
x2]) = forall a. Signal a -> Signal a -> Signal a
merge2Signals Signal a
x1 Signal a
x2
sconcat (Signal a
x1 :| [Signal a
x2, Signal a
x3]) = forall a. Signal a -> Signal a -> Signal a -> Signal a
merge3Signals Signal a
x1 Signal a
x2 Signal a
x3
sconcat (Signal a
x1 :| [Signal a
x2, Signal a
x3, Signal a
x4]) = forall a. Signal a -> Signal a -> Signal a -> Signal a -> Signal a
merge4Signals Signal a
x1 Signal a
x2 Signal a
x3 Signal a
x4
sconcat (Signal a
x1 :| [Signal a
x2, Signal a
x3, Signal a
x4, Signal a
x5]) = forall a.
Signal a
-> Signal a -> Signal a -> Signal a -> Signal a -> Signal a
merge5Signals Signal a
x1 Signal a
x2 Signal a
x3 Signal a
x4 Signal a
x5
sconcat (Signal a
x1 :| Signal a
x2 : Signal a
x3 : Signal a
x4 : Signal a
x5 : [Signal a]
xs) =
forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ forall a.
Signal a
-> Signal a -> Signal a -> Signal a -> Signal a -> Signal a
merge5Signals Signal a
x1 Signal a
x2 Signal a
x3 Signal a
x4 Signal a
x5 forall a. a -> [a] -> NonEmpty a
:| [Signal a]
xs
instance Monoid (Signal a) where
mempty :: Signal a
mempty = forall a. Signal a
emptySignal
mappend :: Signal a -> Signal a -> Signal a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
mconcat :: [Signal a] -> Signal a
mconcat [] = forall a. Signal a
emptySignal
mconcat (Signal a
h : [Signal a]
t) = forall a. Semigroup a => NonEmpty a -> a
sconcat (Signal a
h forall a. a -> [a] -> NonEmpty a
:| [Signal a]
t)
mapSignal :: (a -> b) -> Signal a -> Signal b
mapSignal :: forall a b. (a -> b) -> Signal a -> Signal b
mapSignal a -> b
f Signal a
m =
Signal { handleSignal :: (b -> Event ()) -> Event DisposableEvent
handleSignal = \b -> Event ()
h ->
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m forall a b. (a -> b) -> a -> b
$ b -> Event ()
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f }
filterSignal :: (a -> Bool) -> Signal a -> Signal a
filterSignal :: forall a. (a -> Bool) -> Signal a -> Signal a
filterSignal a -> Bool
p Signal a
m =
Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent
handleSignal = \a -> Event ()
h ->
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
a) forall a b. (a -> b) -> a -> b
$ a -> Event ()
h a
a }
filterSignal_ :: (a -> Bool) -> Signal a -> Signal ()
filterSignal_ :: forall a. (a -> Bool) -> Signal a -> Signal ()
filterSignal_ a -> Bool
p Signal a
m =
Signal { handleSignal :: (() -> Event ()) -> Event DisposableEvent
handleSignal = \() -> Event ()
h ->
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
a) forall a b. (a -> b) -> a -> b
$ () -> Event ()
h () }
filterSignalM :: (a -> Event Bool) -> Signal a -> Signal a
filterSignalM :: forall a. (a -> Event Bool) -> Signal a -> Signal a
filterSignalM a -> Event Bool
p Signal a
m =
Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent
handleSignal = \a -> Event ()
h ->
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
do Bool
x <- a -> Event Bool
p a
a
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
x forall a b. (a -> b) -> a -> b
$ a -> Event ()
h a
a }
filterSignalM_ :: (a -> Event Bool) -> Signal a -> Signal ()
filterSignalM_ :: forall a. (a -> Event Bool) -> Signal a -> Signal ()
filterSignalM_ a -> Event Bool
p Signal a
m =
Signal { handleSignal :: (() -> Event ()) -> Event DisposableEvent
handleSignal = \() -> Event ()
h ->
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
do Bool
x <- a -> Event Bool
p a
a
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
x forall a b. (a -> b) -> a -> b
$ () -> Event ()
h () }
merge2Signals :: Signal a -> Signal a -> Signal a
merge2Signals :: forall a. Signal a -> Signal a -> Signal a
merge2Signals Signal a
m1 Signal a
m2 =
Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent
handleSignal = \a -> Event ()
h ->
do DisposableEvent
x1 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m1 a -> Event ()
h
DisposableEvent
x2 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m2 a -> Event ()
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DisposableEvent
x1 forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x2 }
merge3Signals :: Signal a -> Signal a -> Signal a -> Signal a
merge3Signals :: forall a. Signal a -> Signal a -> Signal a -> Signal a
merge3Signals Signal a
m1 Signal a
m2 Signal a
m3 =
Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent
handleSignal = \a -> Event ()
h ->
do DisposableEvent
x1 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m1 a -> Event ()
h
DisposableEvent
x2 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m2 a -> Event ()
h
DisposableEvent
x3 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m3 a -> Event ()
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DisposableEvent
x1 forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x2 forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x3 }
merge4Signals :: Signal a -> Signal a -> Signal a ->
Signal a -> Signal a
merge4Signals :: forall a. Signal a -> Signal a -> Signal a -> Signal a -> Signal a
merge4Signals Signal a
m1 Signal a
m2 Signal a
m3 Signal a
m4 =
Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent
handleSignal = \a -> Event ()
h ->
do DisposableEvent
x1 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m1 a -> Event ()
h
DisposableEvent
x2 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m2 a -> Event ()
h
DisposableEvent
x3 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m3 a -> Event ()
h
DisposableEvent
x4 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m4 a -> Event ()
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DisposableEvent
x1 forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x2 forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x3 forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x4 }
merge5Signals :: Signal a -> Signal a -> Signal a ->
Signal a -> Signal a -> Signal a
merge5Signals :: forall a.
Signal a
-> Signal a -> Signal a -> Signal a -> Signal a -> Signal a
merge5Signals Signal a
m1 Signal a
m2 Signal a
m3 Signal a
m4 Signal a
m5 =
Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent
handleSignal = \a -> Event ()
h ->
do DisposableEvent
x1 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m1 a -> Event ()
h
DisposableEvent
x2 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m2 a -> Event ()
h
DisposableEvent
x3 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m3 a -> Event ()
h
DisposableEvent
x4 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m4 a -> Event ()
h
DisposableEvent
x5 <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m5 a -> Event ()
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DisposableEvent
x1 forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x2 forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x3 forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x4 forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x5 }
mapSignalM :: (a -> Event b) -> Signal a -> Signal b
mapSignalM :: forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM a -> Event b
f Signal a
m =
Signal { handleSignal :: (b -> Event ()) -> Event DisposableEvent
handleSignal = \b -> Event ()
h ->
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m (a -> Event b
f forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> Event ()
h) }
apSignal :: Event (a -> b) -> Signal a -> Signal b
apSignal :: forall a b. Event (a -> b) -> Signal a -> Signal b
apSignal Event (a -> b)
f Signal a
m =
Signal { handleSignal :: (b -> Event ()) -> Event DisposableEvent
handleSignal = \b -> Event ()
h ->
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m forall a b. (a -> b) -> a -> b
$ \a
a -> do { a -> b
x <- Event (a -> b)
f; b -> Event ()
h (a -> b
x a
a) } }
emptySignal :: Signal a
emptySignal :: forall a. Signal a
emptySignal =
Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent
handleSignal = \a -> Event ()
h -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty }
data SignalHistory a =
SignalHistory { forall a. SignalHistory a -> Signal a
signalHistorySignal :: Signal a,
forall a. SignalHistory a -> Vector Double
signalHistoryTimes :: UV.Vector Double,
forall a. SignalHistory a -> Vector a
signalHistoryValues :: V.Vector a }
newSignalHistory :: Signal a -> Composite (SignalHistory a)
newSignalHistory :: forall a. Signal a -> Composite (SignalHistory a)
newSignalHistory =
forall a. Maybe a -> Signal a -> Composite (SignalHistory a)
newSignalHistoryStartingWith forall a. Maybe a
Nothing
newSignalHistoryStartingWith :: Maybe a -> Signal a -> Composite (SignalHistory a)
newSignalHistoryStartingWith :: forall a. Maybe a -> Signal a -> Composite (SignalHistory a)
newSignalHistoryStartingWith Maybe a
init Signal a
signal =
do Vector Double
ts <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. Unboxed a => IO (Vector a)
UV.newVector
Vector a
xs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (Vector a)
V.newVector
case Maybe a
init of
Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just a
a ->
do Double
t <- forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
ts Double
t
forall a. Vector a -> a -> IO ()
V.appendVector Vector a
xs a
a
forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal a
signal forall a b. (a -> b) -> a -> b
$ \a
a ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
ts (Point -> Double
pointTime Point
p)
forall a. Vector a -> a -> IO ()
V.appendVector Vector a
xs a
a
forall (m :: * -> *) a. Monad m => a -> m a
return SignalHistory { signalHistorySignal :: Signal a
signalHistorySignal = Signal a
signal,
signalHistoryTimes :: Vector Double
signalHistoryTimes = Vector Double
ts,
signalHistoryValues :: Vector a
signalHistoryValues = Vector a
xs }
readSignalHistory :: SignalHistory a -> Event (Array Int Double, Array Int a)
readSignalHistory :: forall a. SignalHistory a -> Event (Array Int Double, Array Int a)
readSignalHistory SignalHistory a
history =
do Array Int Double
xs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Unboxed a => Vector a -> IO (Array Int a)
UV.freezeVector (forall a. SignalHistory a -> Vector Double
signalHistoryTimes SignalHistory a
history)
Array Int a
ys <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> IO (Array Int a)
V.freezeVector (forall a. SignalHistory a -> Vector a
signalHistoryValues SignalHistory a
history)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array Int Double
xs, Array Int a
ys)
triggerSignalWithCurrentTime :: SignalSource Double -> Event ()
triggerSignalWithCurrentTime :: SignalSource Double -> Event ()
triggerSignalWithCurrentTime SignalSource Double
s =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> a -> Event ()
triggerSignal SignalSource Double
s (Point -> Double
pointTime Point
p)
newSignalInTimes :: [Double] -> Event (Signal Double)
newSignalInTimes :: [Double] -> Event (Signal Double)
newSignalInTimes [Double]
xs =
do SignalSource Double
s <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a. Simulation (SignalSource a)
newSignalSource
[Double] -> Event () -> Event ()
enqueueEventWithTimes [Double]
xs forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Event ()
triggerSignalWithCurrentTime SignalSource Double
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> Signal a
publishSignal SignalSource Double
s
newSignalInIntegTimes :: Event (Signal Double)
newSignalInIntegTimes :: Event (Signal Double)
newSignalInIntegTimes =
do SignalSource Double
s <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a. Simulation (SignalSource a)
newSignalSource
Event () -> Event ()
enqueueEventWithIntegTimes forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Event ()
triggerSignalWithCurrentTime SignalSource Double
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> Signal a
publishSignal SignalSource Double
s
newSignalInStartTime :: Event (Signal Double)
newSignalInStartTime :: Event (Signal Double)
newSignalInStartTime =
do SignalSource Double
s <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a. Simulation (SignalSource a)
newSignalSource
Double
t <- forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Double
starttime
Double -> Event () -> Event ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Event ()
triggerSignalWithCurrentTime SignalSource Double
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> Signal a
publishSignal SignalSource Double
s
newSignalInStopTime :: Event (Signal Double)
newSignalInStopTime :: Event (Signal Double)
newSignalInStopTime =
do SignalSource Double
s <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a. Simulation (SignalSource a)
newSignalSource
Double
t <- forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Double
stoptime
Double -> Event () -> Event ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Event ()
triggerSignalWithCurrentTime SignalSource Double
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> Signal a
publishSignal SignalSource Double
s
newSignalInTimeGrid :: Int -> Event (Signal Int)
newSignalInTimeGrid :: Int -> Event (Signal Int)
newSignalInTimeGrid Int
n =
do Specs
sc <- forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Specs
simulationSpecs
SignalSource Int
s <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a. Simulation (SignalSource a)
newSignalSource
let loop :: [(Int, Double)] -> Event ()
loop [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop ((Int
i, Double
t) : [(Int, Double)]
xs) = Double -> Event () -> Event ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$
do forall a. SignalSource a -> a -> Event ()
triggerSignal SignalSource Int
s Int
i
[(Int, Double)] -> Event ()
loop [(Int, Double)]
xs
[(Int, Double)] -> Event ()
loop forall a b. (a -> b) -> a -> b
$ Specs -> Int -> [(Int, Double)]
timeGrid Specs
sc Int
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> Signal a
publishSignal SignalSource Int
s
data Signalable a =
Signalable { forall a. Signalable a -> Event a
readSignalable :: Event a,
forall a. Signalable a -> Signal ()
signalableChanged_ :: Signal ()
}
signalableChanged :: Signalable a -> Signal a
signalableChanged :: forall a. Signalable a -> Signal a
signalableChanged Signalable a
x = forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. Signalable a -> Event a
readSignalable Signalable a
x) forall a b. (a -> b) -> a -> b
$ forall a. Signalable a -> Signal ()
signalableChanged_ Signalable a
x
instance Functor Signalable where
fmap :: forall a b. (a -> b) -> Signalable a -> Signalable b
fmap a -> b
f Signalable a
x = Signalable a
x { readSignalable :: Event b
readSignalable = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (forall a. Signalable a -> Event a
readSignalable Signalable a
x) }
instance Semigroup a => Semigroup (Signalable a) where
<> :: Signalable a -> Signalable a -> Signalable a
(<>) = forall a.
Semigroup a =>
Signalable a -> Signalable a -> Signalable a
appendSignalable
instance (Monoid a, Semigroup a) => Monoid (Signalable a) where
mempty :: Signalable a
mempty = forall a. Monoid a => Signalable a
emptySignalable
mappend :: Signalable a -> Signalable a -> Signalable a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
emptySignalable :: Monoid a => Signalable a
emptySignalable :: forall a. Monoid a => Signalable a
emptySignalable =
Signalable { readSignalable :: Event a
readSignalable = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty,
signalableChanged_ :: Signal ()
signalableChanged_ = forall a. Monoid a => a
mempty }
appendSignalable :: Semigroup a => Signalable a -> Signalable a -> Signalable a
appendSignalable :: forall a.
Semigroup a =>
Signalable a -> Signalable a -> Signalable a
appendSignalable Signalable a
m1 Signalable a
m2 =
Signalable { readSignalable :: Event a
readSignalable = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Semigroup a => a -> a -> a
(<>) (forall a. Signalable a -> Event a
readSignalable Signalable a
m1) (forall a. Signalable a -> Event a
readSignalable Signalable a
m2),
signalableChanged_ :: Signal ()
signalableChanged_ = (forall a. Signalable a -> Signal ()
signalableChanged_ Signalable a
m1) forall a. Semigroup a => a -> a -> a
<> (forall a. Signalable a -> Signal ()
signalableChanged_ Signalable a
m2) }
arrivalSignal :: Signal a -> Signal (Arrival a)
arrivalSignal :: forall a. Signal a -> Signal (Arrival a)
arrivalSignal Signal a
m =
Signal { handleSignal :: (Arrival a -> Event ()) -> Event DisposableEvent
handleSignal = \Arrival a -> Event ()
h ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do IORef (Maybe Double)
r <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Maybe Double
t0 <- forall a. IORef a -> IO a
readIORef IORef (Maybe Double)
r
let t :: Double
t = Point -> Double
pointTime Point
p
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Double)
r (forall a. a -> Maybe a
Just Double
t)
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
Arrival a -> Event ()
h Arrival { arrivalValue :: a
arrivalValue = a
a,
arrivalTime :: Double
arrivalTime = Double
t,
arrivalDelay :: Maybe Double
arrivalDelay =
case Maybe Double
t0 of
Maybe Double
Nothing -> forall a. Maybe a
Nothing
Just Double
t0 -> forall a. a -> Maybe a
Just (Double
t forall a. Num a => a -> a -> a
- Double
t0) }
}
delaySignal :: Double -> Signal a -> Signal a
delaySignal :: forall a. Double -> Signal a -> Signal a
delaySignal Double
delta Signal a
m =
Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent
handleSignal = \a -> Event ()
h ->
do IORef Bool
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
DisposableEvent
h <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p forall a. Num a => a -> a -> a
+ Double
delta) forall a b. (a -> b) -> a -> b
$
do Bool
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Bool
r
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
x forall a b. (a -> b) -> a -> b
$ a -> Event ()
h a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Event () -> DisposableEvent
DisposableEvent forall a b. (a -> b) -> a -> b
$
DisposableEvent -> Event ()
disposeEvent DisposableEvent
h forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
r Bool
True)
}
delaySignalM :: Event Double -> Signal a -> Signal a
delaySignalM :: forall a. Event Double -> Signal a -> Signal a
delaySignalM Event Double
delta Signal a
m =
Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent
handleSignal = \a -> Event ()
h ->
do IORef Bool
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
DisposableEvent
h <- forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Double
delta' <- forall a. Point -> Event a -> IO a
invokeEvent Point
p Event Double
delta
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p forall a. Num a => a -> a -> a
+ Double
delta') forall a b. (a -> b) -> a -> b
$
do Bool
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Bool
r
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
x forall a b. (a -> b) -> a -> b
$ a -> Event ()
h a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Event () -> DisposableEvent
DisposableEvent forall a b. (a -> b) -> a -> b
$
DisposableEvent -> Event ()
disposeEvent DisposableEvent
h forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
r Bool
True)
}
traceSignal :: String -> Signal a -> Signal a
traceSignal :: forall a. String -> Signal a -> Signal a
traceSignal String
message Signal a
m =
Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent
handleSignal = \a -> Event ()
h ->
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m forall a b. (a -> b) -> a -> b
$ forall a. String -> Event a -> Event a
traceEvent String
message forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Event ()
h }