-- |
-- Module     : Simulation.Aivika.Signal
-- 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
--
-- This module defines the signal which we can subscribe handlers to. 
-- These handlers can be disposed. The signal is triggered in the 
-- current time point actuating the corresponded computations from 
-- the handlers. 
--
module Simulation.Aivika.Signal
       (-- * Handling and Triggering Signal
        Signal(..),
        handleSignal_,
        handleSignalComposite,
        SignalSource,
        newSignalSource,
        publishSignal,
        triggerSignal,
        -- * Useful Combinators
        mapSignal,
        mapSignalM,
        apSignal,
        filterSignal,
        filterSignal_,
        filterSignalM,
        filterSignalM_,
        emptySignal,
        merge2Signals,
        merge3Signals,
        merge4Signals,
        merge5Signals,
        -- * Signal Arriving
        arrivalSignal,
        -- * Creating Signal in Time Points
        newSignalInTimes,
        newSignalInIntegTimes,
        newSignalInStartTime,
        newSignalInStopTime,
        newSignalInTimeGrid,
        -- * Delaying Signal
        delaySignal,
        delaySignalM,
        -- * Signal History
        SignalHistory,
        signalHistorySignal,
        newSignalHistory,
        newSignalHistoryStartingWith,
        readSignalHistory,
        -- * Signalable Computations
        Signalable(..),
        signalableChanged,
        emptySignalable,
        appendSignalable,
        -- * Debugging
        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

-- | The signal source that can publish its signal.
data SignalSource a =
  SignalSource { forall a. SignalSource a -> Signal a
publishSignal :: Signal a,
                                  -- ^ Publish the signal.
                 forall a. SignalSource a -> a -> Event ()
triggerSignal :: a -> Event ()
                                  -- ^ Trigger the signal actuating 
                                  -- all its handlers at the current 
                                  -- simulation time point.
               }
  
-- | The signal that can have disposable handlers.  
data Signal a =
  Signal { forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal :: (a -> Event ()) -> Event DisposableEvent
           -- ^ Subscribe the handler to the specified 
           -- signal and return a nested computation
           -- within a disposable object that, being applied,
           -- unsubscribes the handler from this signal.
         }
  
-- | The queue of signal handlers.
data SignalHandlerQueue a =
  SignalHandlerQueue { forall a. SignalHandlerQueue a -> IORef [SignalHandler a]
queueList :: IORef [SignalHandler a] }
  
-- | It contains the information about the disposable queue handler.
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)

-- | Subscribe the handler to the specified signal forever.
-- To subscribe the disposable handlers, use function 'handleSignal'.
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 ()

-- | Like 'handleSignal' but within the 'Composite' computation.
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
     
-- | Create a new signal source.
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

-- | Trigger all next signal handlers.
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
            
-- | Enqueue the handler and return its representative in the queue.            
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

-- | Dequeue the handler representative.
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. 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)
  
-- | Map the signal according the specified function.
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 }

-- | Filter only those signal values that satisfy 
-- the specified predicate.
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 }

-- | Filter only those signal values that satisfy
-- the specified predicate, but then ignoring the values.
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 () }
  
-- | Filter only those signal values that satisfy
-- the specified predicate.
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 }
  
-- | Filter only those signal values that satisfy
-- the specified predicate, but then ignoring the values.
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 () }
  
-- | Merge two signals.
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 }

-- | Merge three signals.
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 }

-- | Merge four signals.
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 }
           
-- | Merge five signals.
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 }

-- | Compose the signal.
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) }
  
-- | Transform the signal.
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) } }

-- | An empty signal which is never triggered.
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 }
                                    
-- | Represents the history of the signal values.
data SignalHistory a =
  SignalHistory { forall a. SignalHistory a -> Signal a
signalHistorySignal :: Signal a,  
                  -- ^ The signal for which the history is created.
                  forall a. SignalHistory a -> Vector Double
signalHistoryTimes  :: UV.Vector Double,
                  forall a. SignalHistory a -> Vector a
signalHistoryValues :: V.Vector a }

-- | Create a history of the signal values.
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

-- | Create a history of the signal values starting with
-- the optional initial value.
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 }
       
-- | Read the history of signal values.
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)     
     
-- | Trigger the signal with the current time.
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)

-- | Return a signal that is triggered in the specified time points.
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
       
-- | Return a signal that is triggered in the integration time points.
-- It should be called with help of 'runEventInStartTime'.
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
     
-- | Return a signal that is triggered in the start time.
-- It should be called with help of 'runEventInStartTime'.
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

-- | Return a signal that is triggered in the final time.
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

-- | Return a signal that is trigged in the grid by specified size.
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

-- | Describes a computation that also signals when changing its value.
data Signalable a =
  Signalable { forall a. Signalable a -> Event a
readSignalable :: Event a,
               -- ^ Return a computation of the value.
               forall a. Signalable a -> Signal ()
signalableChanged_ :: Signal ()
               -- ^ Return a signal notifying that the value has changed
               -- but without providing the information about the changed value.
             }

-- | Return a signal notifying that the value has changed.
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
(<>)

-- | Return an identity.
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 }

-- | An associative operation.
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) }

-- | Transform a signal so that the resulting signal returns a sequence of arrivals
-- saving the information about the time points at which the original signal was received.
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) }
         }

-- | Delay the signal values for the specified time interval.
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)
         }

-- | Delay the signal values for time intervals recalculated for each value.
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)
         }

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