-- |
-- 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 = (SignalHandler a -> IORef ()
forall a. SignalHandler a -> IORef ()
handlerRef SignalHandler a
x) IORef () -> IORef () -> Bool
forall a. Eq a => a -> a -> Bool
== (SignalHandler a -> IORef ()
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 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
signal a -> Event ()
h
     () -> Event ()
forall a. a -> Event a
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 <- Event DisposableEvent -> Composite DisposableEvent
forall a. Event a -> Composite a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event DisposableEvent -> Composite DisposableEvent)
-> Event DisposableEvent -> Composite DisposableEvent
forall a b. (a -> b) -> a -> b
$ Signal a -> (a -> Event ()) -> Event DisposableEvent
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 =
  (Run -> IO (SignalSource a)) -> Simulation (SignalSource a)
forall a. (Run -> IO a) -> Simulation a
Simulation ((Run -> IO (SignalSource a)) -> Simulation (SignalSource a))
-> (Run -> IO (SignalSource a)) -> Simulation (SignalSource a)
forall a b. (a -> b) -> a -> b
$ \Run
r ->
  do IORef [SignalHandler a]
list <- [SignalHandler a] -> IO (IORef [SignalHandler a])
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 =
           (Point -> IO DisposableEvent) -> Event DisposableEvent
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO DisposableEvent) -> Event DisposableEvent)
-> (Point -> IO DisposableEvent) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \Point
p ->
           do SignalHandler a
x <- SignalHandlerQueue a -> (a -> Event ()) -> IO (SignalHandler a)
forall a.
SignalHandlerQueue a -> (a -> Event ()) -> IO (SignalHandler a)
enqueueSignalHandler SignalHandlerQueue a
queue a -> Event ()
h
              DisposableEvent -> IO DisposableEvent
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DisposableEvent -> IO DisposableEvent)
-> DisposableEvent -> IO DisposableEvent
forall a b. (a -> b) -> a -> b
$
                Event () -> DisposableEvent
DisposableEvent (Event () -> DisposableEvent) -> Event () -> DisposableEvent
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 -> SignalHandlerQueue a -> SignalHandler a -> IO ()
forall a. SignalHandlerQueue a -> SignalHandler a -> IO ()
dequeueSignalHandler SignalHandlerQueue a
queue SignalHandler a
x
         trigger :: a -> Event ()
trigger a
a =
           (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 -> SignalHandlerQueue a -> a -> Point -> IO ()
forall a. SignalHandlerQueue a -> a -> Point -> IO ()
triggerSignalHandlers SignalHandlerQueue a
queue a
a Point
p
     SignalSource a -> IO (SignalSource a)
forall a. a -> IO a
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 <- IORef [SignalHandler a] -> IO [SignalHandler a]
forall a. IORef a -> IO a
readIORef (SignalHandlerQueue a -> IORef [SignalHandler a]
forall a. SignalHandlerQueue a -> IORef [SignalHandler a]
queueList SignalHandlerQueue a
q)
     [SignalHandler a] -> (SignalHandler a -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SignalHandler a]
hs ((SignalHandler a -> IO ()) -> IO ())
-> (SignalHandler a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SignalHandler a
h ->
       Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ SignalHandler a -> a -> Event ()
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 <- () -> IO (IORef ())
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 }
     IORef [SignalHandler a]
-> ([SignalHandler a] -> [SignalHandler a]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (SignalHandlerQueue a -> IORef [SignalHandler a]
forall a. SignalHandlerQueue a -> IORef [SignalHandler a]
queueList SignalHandlerQueue a
q) (SignalHandler a
handler SignalHandler a -> [SignalHandler a] -> [SignalHandler a]
forall a. a -> [a] -> [a]
:)
     SignalHandler a -> IO (SignalHandler a)
forall a. a -> IO 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 = 
  IORef [SignalHandler a]
-> ([SignalHandler a] -> [SignalHandler a]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (SignalHandlerQueue a -> IORef [SignalHandler a]
forall a. SignalHandlerQueue a -> IORef [SignalHandler a]
queueList SignalHandlerQueue a
q) (([SignalHandler a] -> [SignalHandler a]) -> IO ())
-> ([SignalHandler a] -> [SignalHandler a]) -> IO ()
forall a b. (a -> b) -> a -> b
$ SignalHandler a -> [SignalHandler a] -> [SignalHandler a]
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 = (a -> b) -> Signal a -> Signal b
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal

instance Semigroup (Signal a) where
  <> :: Signal a -> Signal a -> Signal a
(<>) = 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]) = Signal a -> Signal a -> Signal a
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]) = Signal a -> Signal a -> Signal a -> Signal a
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]) = Signal a -> Signal a -> Signal a -> Signal a -> Signal a
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]) = Signal a
-> Signal a -> Signal a -> Signal a -> Signal a -> Signal a
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) =
    NonEmpty (Signal a) -> Signal a
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (Signal a) -> Signal a)
-> NonEmpty (Signal a) -> Signal a
forall a b. (a -> b) -> a -> b
$ Signal a
-> Signal a -> Signal a -> Signal a -> Signal a -> Signal a
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 Signal a -> [Signal a] -> NonEmpty (Signal a)
forall a. a -> [a] -> NonEmpty a
:| [Signal a]
xs

instance Monoid (Signal a) where 
  
  mempty :: Signal a
mempty = Signal a
forall a. Signal a
emptySignal
  
  mappend :: Signal a -> Signal a -> Signal a
mappend = Signal a -> Signal a -> Signal a
forall a. Semigroup a => a -> a -> a
(<>)
  
  mconcat :: [Signal a] -> Signal a
mconcat [] = Signal a
forall a. Signal a
emptySignal
  mconcat (Signal a
h : [Signal a]
t) = NonEmpty (Signal a) -> Signal a
forall a. Semigroup a => NonEmpty a -> a
sconcat (Signal a
h Signal a -> [Signal a] -> NonEmpty (Signal a)
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 -> 
            Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m ((a -> Event ()) -> Event DisposableEvent)
-> (a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ b -> Event ()
h (b -> Event ()) -> (a -> b) -> a -> Event ()
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 ->
            Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m ((a -> Event ()) -> Event DisposableEvent)
-> (a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \a
a ->
            Bool -> Event () -> Event ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
a) (Event () -> Event ()) -> Event () -> Event ()
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 ->
            Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m ((a -> Event ()) -> Event DisposableEvent)
-> (a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \a
a ->
            Bool -> Event () -> Event ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
a) (Event () -> Event ()) -> Event () -> Event ()
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 ->
            Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m ((a -> Event ()) -> Event DisposableEvent)
-> (a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \a
a ->
            do Bool
x <- a -> Event Bool
p a
a
               Bool -> Event () -> Event ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
x (Event () -> Event ()) -> Event () -> Event ()
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 ->
            Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m ((a -> Event ()) -> Event DisposableEvent)
-> (a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \a
a ->
            do Bool
x <- a -> Event Bool
p a
a
               Bool -> Event () -> Event ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
x (Event () -> Event ()) -> Event () -> Event ()
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 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m1 a -> Event ()
h
               DisposableEvent
x2 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m2 a -> Event ()
h
               DisposableEvent -> Event DisposableEvent
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (DisposableEvent -> Event DisposableEvent)
-> DisposableEvent -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ DisposableEvent
x1 DisposableEvent -> DisposableEvent -> DisposableEvent
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 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m1 a -> Event ()
h
               DisposableEvent
x2 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m2 a -> Event ()
h
               DisposableEvent
x3 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m3 a -> Event ()
h
               DisposableEvent -> Event DisposableEvent
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (DisposableEvent -> Event DisposableEvent)
-> DisposableEvent -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ DisposableEvent
x1 DisposableEvent -> DisposableEvent -> DisposableEvent
forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x2 DisposableEvent -> DisposableEvent -> DisposableEvent
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 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m1 a -> Event ()
h
               DisposableEvent
x2 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m2 a -> Event ()
h
               DisposableEvent
x3 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m3 a -> Event ()
h
               DisposableEvent
x4 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m4 a -> Event ()
h
               DisposableEvent -> Event DisposableEvent
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (DisposableEvent -> Event DisposableEvent)
-> DisposableEvent -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ DisposableEvent
x1 DisposableEvent -> DisposableEvent -> DisposableEvent
forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x2 DisposableEvent -> DisposableEvent -> DisposableEvent
forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x3 DisposableEvent -> DisposableEvent -> DisposableEvent
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 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m1 a -> Event ()
h
               DisposableEvent
x2 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m2 a -> Event ()
h
               DisposableEvent
x3 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m3 a -> Event ()
h
               DisposableEvent
x4 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m4 a -> Event ()
h
               DisposableEvent
x5 <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m5 a -> Event ()
h
               DisposableEvent -> Event DisposableEvent
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (DisposableEvent -> Event DisposableEvent)
-> DisposableEvent -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ DisposableEvent
x1 DisposableEvent -> DisposableEvent -> DisposableEvent
forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x2 DisposableEvent -> DisposableEvent -> DisposableEvent
forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x3 DisposableEvent -> DisposableEvent -> DisposableEvent
forall a. Semigroup a => a -> a -> a
<> DisposableEvent
x4 DisposableEvent -> DisposableEvent -> DisposableEvent
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 ->
            Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m (a -> Event b
f (a -> Event b) -> (b -> Event ()) -> a -> Event ()
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 ->
            Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m ((a -> Event ()) -> Event DisposableEvent)
-> (a -> Event ()) -> Event DisposableEvent
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 -> DisposableEvent -> Event DisposableEvent
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return DisposableEvent
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 =
  Maybe a -> Signal a -> Composite (SignalHistory a)
forall a. Maybe a -> Signal a -> Composite (SignalHistory a)
newSignalHistoryStartingWith Maybe a
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 <- IO (Vector Double) -> Composite (Vector Double)
forall a. IO a -> Composite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Vector Double)
forall a. Unboxed a => IO (Vector a)
UV.newVector
     Vector a
xs <- IO (Vector a) -> Composite (Vector a)
forall a. IO a -> Composite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Vector a)
forall a. IO (Vector a)
V.newVector
     case Maybe a
init of
       Maybe a
Nothing -> () -> Composite ()
forall a. a -> Composite a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just a
a ->
         do Double
t <- Dynamics Double -> Composite Double
forall a. Dynamics a -> Composite a
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
            IO () -> Composite ()
forall a. IO a -> Composite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Composite ()) -> IO () -> Composite ()
forall a b. (a -> b) -> a -> b
$
              do Vector Double -> Double -> IO ()
forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
ts Double
t
                 Vector a -> a -> IO ()
forall a. Vector a -> a -> IO ()
V.appendVector Vector a
xs a
a
     Signal a -> (a -> Event ()) -> Composite ()
forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal a
signal ((a -> Event ()) -> Composite ())
-> (a -> Event ()) -> Composite ()
forall a b. (a -> b) -> a -> b
$ \a
a ->
       (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 Vector Double -> Double -> IO ()
forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
ts (Point -> Double
pointTime Point
p)
          Vector a -> a -> IO ()
forall a. Vector a -> a -> IO ()
V.appendVector Vector a
xs a
a
     SignalHistory a -> Composite (SignalHistory a)
forall a. a -> Composite 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 <- IO (Array Int Double) -> Event (Array Int Double)
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array Int Double) -> Event (Array Int Double))
-> IO (Array Int Double) -> Event (Array Int Double)
forall a b. (a -> b) -> a -> b
$ Vector Double -> IO (Array Int Double)
forall a. Unboxed a => Vector a -> IO (Array Int a)
UV.freezeVector (SignalHistory a -> Vector Double
forall a. SignalHistory a -> Vector Double
signalHistoryTimes SignalHistory a
history)
     Array Int a
ys <- IO (Array Int a) -> Event (Array Int a)
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array Int a) -> Event (Array Int a))
-> IO (Array Int a) -> Event (Array Int a)
forall a b. (a -> b) -> a -> b
$ Vector a -> IO (Array Int a)
forall a. Vector a -> IO (Array Int a)
V.freezeVector (SignalHistory a -> Vector a
forall a. SignalHistory a -> Vector a
signalHistoryValues SignalHistory a
history)
     (Array Int Double, Array Int a)
-> Event (Array Int Double, Array Int a)
forall a. a -> Event a
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 =
  (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
$ SignalSource Double -> Double -> Event ()
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 <- Simulation (SignalSource Double) -> Event (SignalSource Double)
forall a. Simulation a -> Event a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation (SignalSource Double)
forall a. Simulation (SignalSource a)
newSignalSource
     [Double] -> Event () -> Event ()
enqueueEventWithTimes [Double]
xs (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Event ()
triggerSignalWithCurrentTime SignalSource Double
s
     Signal Double -> Event (Signal Double)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal Double -> Event (Signal Double))
-> Signal Double -> Event (Signal Double)
forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Signal Double
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 <- Simulation (SignalSource Double) -> Event (SignalSource Double)
forall a. Simulation a -> Event a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation (SignalSource Double)
forall a. Simulation (SignalSource a)
newSignalSource
     Event () -> Event ()
enqueueEventWithIntegTimes (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Event ()
triggerSignalWithCurrentTime SignalSource Double
s
     Signal Double -> Event (Signal Double)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal Double -> Event (Signal Double))
-> Signal Double -> Event (Signal Double)
forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Signal Double
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 <- Simulation (SignalSource Double) -> Event (SignalSource Double)
forall a. Simulation a -> Event a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation (SignalSource Double)
forall a. Simulation (SignalSource a)
newSignalSource
     Double
t <- Parameter Double -> Event Double
forall a. Parameter a -> Event a
forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Double
starttime
     Double -> Event () -> Event ()
enqueueEvent Double
t (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Event ()
triggerSignalWithCurrentTime SignalSource Double
s
     Signal Double -> Event (Signal Double)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal Double -> Event (Signal Double))
-> Signal Double -> Event (Signal Double)
forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Signal Double
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 <- Simulation (SignalSource Double) -> Event (SignalSource Double)
forall a. Simulation a -> Event a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation (SignalSource Double)
forall a. Simulation (SignalSource a)
newSignalSource
     Double
t <- Parameter Double -> Event Double
forall a. Parameter a -> Event a
forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Double
stoptime
     Double -> Event () -> Event ()
enqueueEvent Double
t (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Event ()
triggerSignalWithCurrentTime SignalSource Double
s
     Signal Double -> Event (Signal Double)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal Double -> Event (Signal Double))
-> Signal Double -> Event (Signal Double)
forall a b. (a -> b) -> a -> b
$ SignalSource Double -> Signal Double
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 <- Parameter Specs -> Event Specs
forall a. Parameter a -> Event a
forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Specs
simulationSpecs
     SignalSource Int
s  <- Simulation (SignalSource Int) -> Event (SignalSource Int)
forall a. Simulation a -> Event a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation (SignalSource Int)
forall a. Simulation (SignalSource a)
newSignalSource
     let loop :: [(Int, Double)] -> Event ()
loop []            = () -> Event ()
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         loop ((Int
i, Double
t) : [(Int, Double)]
xs) = Double -> Event () -> Event ()
enqueueEvent Double
t (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$
                              do SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal SignalSource Int
s Int
i
                                 [(Int, Double)] -> Event ()
loop [(Int, Double)]
xs
     [(Int, Double)] -> Event ()
loop ([(Int, Double)] -> Event ()) -> [(Int, Double)] -> Event ()
forall a b. (a -> b) -> a -> b
$ Specs -> Int -> [(Int, Double)]
timeGrid Specs
sc Int
n
     Signal Int -> Event (Signal Int)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal Int -> Event (Signal Int))
-> Signal Int -> Event (Signal Int)
forall a b. (a -> b) -> a -> b
$ SignalSource Int -> Signal Int
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 = (() -> Event a) -> Signal () -> Signal a
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event a -> () -> Event a
forall a b. a -> b -> a
const (Event a -> () -> Event a) -> Event a -> () -> Event a
forall a b. (a -> b) -> a -> b
$ Signalable a -> Event a
forall a. Signalable a -> Event a
readSignalable Signalable a
x) (Signal () -> Signal a) -> Signal () -> Signal a
forall a b. (a -> b) -> a -> b
$ Signalable a -> Signal ()
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 = fmap f (readSignalable x) }

instance Semigroup a => Semigroup (Signalable a) where
  <> :: Signalable a -> Signalable a -> Signalable a
(<>) = 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 = Signalable a
forall a. Monoid a => Signalable a
emptySignalable
  mappend :: Signalable a -> Signalable a -> Signalable a
mappend = Signalable a -> Signalable a -> Signalable a
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 = a -> Event a
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty,
               signalableChanged_ :: Signal ()
signalableChanged_ = Signal ()
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 = (a -> a -> a) -> Event a -> Event a -> Event a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (Signalable a -> Event a
forall a. Signalable a -> Event a
readSignalable Signalable a
m1) (Signalable a -> Event a
forall a. Signalable a -> Event a
readSignalable Signalable a
m2),
               signalableChanged_ :: Signal ()
signalableChanged_ = (Signalable a -> Signal ()
forall a. Signalable a -> Signal ()
signalableChanged_ Signalable a
m1) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<> (Signalable a -> Signal ()
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 ->
             (Point -> IO DisposableEvent) -> Event DisposableEvent
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO DisposableEvent) -> Event DisposableEvent)
-> (Point -> IO DisposableEvent) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \Point
p ->
             do IORef (Maybe Double)
r <- Maybe Double -> IO (IORef (Maybe Double))
forall a. a -> IO (IORef a)
newIORef Maybe Double
forall a. Maybe a
Nothing
                Point -> Event DisposableEvent -> IO DisposableEvent
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event DisposableEvent -> IO DisposableEvent)
-> Event DisposableEvent -> IO DisposableEvent
forall a b. (a -> b) -> a -> b
$
                  Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m ((a -> Event ()) -> Event DisposableEvent)
-> (a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \a
a ->
                  (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 Maybe Double
t0 <- IORef (Maybe Double) -> IO (Maybe Double)
forall a. IORef a -> IO a
readIORef IORef (Maybe Double)
r
                     let t :: Double
t = Point -> Double
pointTime Point
p
                     IORef (Maybe Double) -> Maybe Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Double)
r (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t)
                     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
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 -> Maybe Double
forall a. Maybe a
Nothing
                                       Just Double
t0 -> Double -> Maybe Double
forall a. a -> Maybe a
Just (Double
t Double -> Double -> Double
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 <- IO (IORef Bool) -> Event (IORef Bool)
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> Event (IORef Bool))
-> IO (IORef Bool) -> Event (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
               DisposableEvent
h <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m ((a -> Event ()) -> Event DisposableEvent)
-> (a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \a
a ->
                 (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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
delta) (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ 
                 do Bool
x <- IO Bool -> Event Bool
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Event Bool) -> IO Bool -> Event Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
r
                    Bool -> Event () -> Event ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
x (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ a -> Event ()
h a
a
               DisposableEvent -> Event DisposableEvent
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (DisposableEvent -> Event DisposableEvent)
-> DisposableEvent -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ Event () -> DisposableEvent
DisposableEvent (Event () -> DisposableEvent) -> Event () -> DisposableEvent
forall a b. (a -> b) -> a -> b
$
                 DisposableEvent -> Event ()
disposeEvent DisposableEvent
h Event () -> Event () -> Event ()
forall a b. Event a -> Event b -> Event b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                 (IO () -> Event ()
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
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 <- IO (IORef Bool) -> Event (IORef Bool)
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> Event (IORef Bool))
-> IO (IORef Bool) -> Event (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
               DisposableEvent
h <- Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m ((a -> Event ()) -> Event DisposableEvent)
-> (a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \a
a ->
                 (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 Double
delta' <- Point -> Event Double -> IO Double
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event Double
delta
                    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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
delta') (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ 
                      do Bool
x <- IO Bool -> Event Bool
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Event Bool) -> IO Bool -> Event Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
r
                         Bool -> Event () -> Event ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
x (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ a -> Event ()
h a
a
               DisposableEvent -> Event DisposableEvent
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return (DisposableEvent -> Event DisposableEvent)
-> DisposableEvent -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ Event () -> DisposableEvent
DisposableEvent (Event () -> DisposableEvent) -> Event () -> DisposableEvent
forall a b. (a -> b) -> a -> b
$
                 DisposableEvent -> Event ()
disposeEvent DisposableEvent
h Event () -> Event () -> Event ()
forall a b. Event a -> Event b -> Event b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                 (IO () -> Event ()
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
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 ->
            Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
m ((a -> Event ()) -> Event DisposableEvent)
-> (a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ String -> Event () -> Event ()
forall a. String -> Event a -> Event a
traceEvent String
message (Event () -> Event ()) -> (a -> Event ()) -> a -> Event ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Event ()
h }