-- |
-- Module     : Simulation.Aivika.Trans.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.Trans.Signal
       (-- * Handling and Triggering Signal
        Signal(..),
        handleSignal_,
        handleSignalComposite,
        SignalSource,
        newSignalSource,
        newSignalSource0,
        publishSignal,
        triggerSignal,
        -- * Useful Combinators
        mapSignal,
        mapSignalM,
        apSignal,
        filterSignal,
        filterSignal_,
        filterSignalM,
        filterSignalM_,
        emptySignal,
        merge2Signals,
        merge3Signals,
        merge4Signals,
        merge5Signals,
        -- * Signal Arriving
        arrivalSignal,
        -- * Delaying Signal
        delaySignal,
        delaySignalM,
        -- * Signal History
        SignalHistory,
        signalHistorySignal,
        newSignalHistory,
        newSignalHistoryStartingWith,
        readSignalHistory,
        -- * Creating Signal in Time Points
        newSignalInTimes,
        newSignalInIntegTimes,
        newSignalInStartTime,
        newSignalInStopTime,
        newSignalInTimeGrid,
        -- * Signalable Computations
        Signalable(..),
        signalableChanged,
        emptySignalable,
        appendSignalable,
        -- * Debugging
        traceSignal) where

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.Trans.Ref.Base
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Parameter
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Dynamics
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Composite
import Simulation.Aivika.Arrival (Arrival(..))

-- | The signal source that can publish its signal.
data SignalSource m a =
  SignalSource { forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal :: Signal m a,
                                  -- ^ Publish the signal.
                 forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal :: a -> Event m ()
                                  -- ^ Trigger the signal actuating 
                                  -- all its handlers at the current 
                                  -- simulation time point.
               }
  
-- | The signal that can have disposable handlers.  
data Signal m a =
  Signal { forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
           -- ^ 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 m a =
  SignalHandlerQueue { forall (m :: * -> *) a.
SignalHandlerQueue m a -> Ref m [SignalHandler m a]
queueList :: Ref m [SignalHandler m a] }
  
-- | It contains the information about the disposable queue handler.
data SignalHandler m a =
  SignalHandler { forall (m :: * -> *) a. SignalHandler m a -> a -> Event m ()
handlerComp :: a -> Event m (),
                  forall (m :: * -> *) a. SignalHandler m a -> Ref m ()
handlerRef  :: Ref m () }

instance MonadDES m => Eq (SignalHandler m a) where

  {-# INLINE (==) #-}
  SignalHandler m a
x == :: SignalHandler m a -> SignalHandler m a -> Bool
== SignalHandler m a
y = (forall (m :: * -> *) a. SignalHandler m a -> Ref m ()
handlerRef SignalHandler m a
x) forall a. Eq a => a -> a -> Bool
== (forall (m :: * -> *) a. SignalHandler m a -> Ref m ()
handlerRef SignalHandler m a
y)

-- | Subscribe the handler to the specified signal forever.
-- To subscribe the disposable handlers, use function 'handleSignal'.
handleSignal_ :: MonadDES m => Signal m a -> (a -> Event m ()) -> Event m ()
{-# INLINE handleSignal_ #-}
handleSignal_ :: forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> (a -> Event m ()) -> Event m ()
handleSignal_ Signal m a
signal a -> Event m ()
h = 
  do DisposableEvent m
x <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
signal a -> Event m ()
h
     forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Like 'handleSignal' but within the 'Composite' computation.
handleSignalComposite :: MonadDES m => Signal m a -> (a -> Event m ()) -> Composite m ()
{-# INLINABLE handleSignalComposite #-}
handleSignalComposite :: forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> (a -> Event m ()) -> Composite m ()
handleSignalComposite Signal m a
signal a -> Event m ()
h =
  do DisposableEvent m
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
signal a -> Event m ()
h
     forall (m :: * -> *).
Monad m =>
DisposableEvent m -> Composite m ()
disposableComposite DisposableEvent m
x
     
-- | Create a new signal source.
newSignalSource :: MonadDES m => Simulation m (SignalSource m a)
{-# INLINABLE newSignalSource #-}
newSignalSource :: forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource =
  do Ref m [SignalHandler m a]
list <- forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef []
     let queue :: SignalHandlerQueue m a
queue  = SignalHandlerQueue { queueList :: Ref m [SignalHandler m a]
queueList = Ref m [SignalHandler m a]
list }
         signal :: Signal m a
signal = Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = (a -> Event m ()) -> Event m (DisposableEvent m)
handle }
         source :: SignalSource m a
source = SignalSource { publishSignal :: Signal m a
publishSignal = Signal m a
signal, 
                                 triggerSignal :: a -> Event m ()
triggerSignal = a -> Event m ()
trigger }
         handle :: (a -> Event m ()) -> Event m (DisposableEvent m)
handle a -> Event m ()
h =
           forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
           do SignalHandler m a
x <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
SignalHandlerQueue m a
-> (a -> Event m ()) -> Event m (SignalHandler m a)
enqueueSignalHandler SignalHandlerQueue m a
queue a -> Event m ()
h
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *). Event m () -> DisposableEvent m
DisposableEvent forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a.
MonadDES m =>
SignalHandlerQueue m a -> SignalHandler m a -> Event m ()
dequeueSignalHandler SignalHandlerQueue m a
queue SignalHandler m a
x
         trigger :: a -> Event m ()
trigger a
a =
           forall (m :: * -> *) a.
MonadDES m =>
SignalHandlerQueue m a -> a -> Event m ()
triggerSignalHandlers SignalHandlerQueue m a
queue a
a
     forall (m :: * -> *) a. Monad m => a -> m a
return SignalSource m a
source
     
-- | Create a new signal source within more low level computation than 'Simulation'.
newSignalSource0 :: (MonadDES m, MonadRef0 m) => m (SignalSource m a)
{-# INLINABLE newSignalSource0 #-}
newSignalSource0 :: forall (m :: * -> *) a.
(MonadDES m, MonadRef0 m) =>
m (SignalSource m a)
newSignalSource0 =
  do Ref m [SignalHandler m a]
list <- forall (m :: * -> *) a. MonadRef0 m => a -> m (Ref m a)
newRef0 []
     let queue :: SignalHandlerQueue m a
queue  = SignalHandlerQueue { queueList :: Ref m [SignalHandler m a]
queueList = Ref m [SignalHandler m a]
list }
         signal :: Signal m a
signal = Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = (a -> Event m ()) -> Event m (DisposableEvent m)
handle }
         source :: SignalSource m a
source = SignalSource { publishSignal :: Signal m a
publishSignal = Signal m a
signal, 
                                 triggerSignal :: a -> Event m ()
triggerSignal = a -> Event m ()
trigger }
         handle :: (a -> Event m ()) -> Event m (DisposableEvent m)
handle a -> Event m ()
h =
           forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
           do SignalHandler m a
x <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
SignalHandlerQueue m a
-> (a -> Event m ()) -> Event m (SignalHandler m a)
enqueueSignalHandler SignalHandlerQueue m a
queue a -> Event m ()
h
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *). Event m () -> DisposableEvent m
DisposableEvent forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a.
MonadDES m =>
SignalHandlerQueue m a -> SignalHandler m a -> Event m ()
dequeueSignalHandler SignalHandlerQueue m a
queue SignalHandler m a
x
         trigger :: a -> Event m ()
trigger a
a =
           forall (m :: * -> *) a.
MonadDES m =>
SignalHandlerQueue m a -> a -> Event m ()
triggerSignalHandlers SignalHandlerQueue m a
queue a
a
     forall (m :: * -> *) a. Monad m => a -> m a
return SignalSource m a
source

-- | Trigger all next signal handlers.
triggerSignalHandlers :: MonadDES m => SignalHandlerQueue m a -> a -> Event m ()
{-# INLINABLE triggerSignalHandlers #-}
triggerSignalHandlers :: forall (m :: * -> *) a.
MonadDES m =>
SignalHandlerQueue m a -> a -> Event m ()
triggerSignalHandlers SignalHandlerQueue m a
q a
a =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do [SignalHandler m a]
hs <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a.
SignalHandlerQueue m a -> Ref m [SignalHandler m a]
queueList SignalHandlerQueue m a
q)
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SignalHandler m a]
hs forall a b. (a -> b) -> a -> b
$ \SignalHandler m a
h ->
       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. SignalHandler m a -> a -> Event m ()
handlerComp SignalHandler m a
h a
a
            
-- | Enqueue the handler and return its representative in the queue.            
enqueueSignalHandler :: MonadDES m => SignalHandlerQueue m a -> (a -> Event m ()) -> Event m (SignalHandler m a)
{-# INLINABLE enqueueSignalHandler #-}
enqueueSignalHandler :: forall (m :: * -> *) a.
MonadDES m =>
SignalHandlerQueue m a
-> (a -> Event m ()) -> Event m (SignalHandler m a)
enqueueSignalHandler SignalHandlerQueue m a
q a -> Event m ()
h =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Ref m ()
r <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation (forall (m :: * -> *). Point m -> Run m
pointRun Point m
p) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef ()
     let handler :: SignalHandler m a
handler = SignalHandler { handlerComp :: a -> Event m ()
handlerComp = a -> Event m ()
h,
                                   handlerRef :: Ref m ()
handlerRef  = Ref m ()
r }
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (forall (m :: * -> *) a.
SignalHandlerQueue m a -> Ref m [SignalHandler m a]
queueList SignalHandlerQueue m a
q) (SignalHandler m a
handler forall a. a -> [a] -> [a]
:)
     forall (m :: * -> *) a. Monad m => a -> m a
return SignalHandler m a
handler

-- | Dequeue the handler representative.
dequeueSignalHandler :: MonadDES m => SignalHandlerQueue m a -> SignalHandler m a -> Event m ()
{-# INLINABLE dequeueSignalHandler #-}
dequeueSignalHandler :: forall (m :: * -> *) a.
MonadDES m =>
SignalHandlerQueue m a -> SignalHandler m a -> Event m ()
dequeueSignalHandler SignalHandlerQueue m a
q SignalHandler m a
h = 
  forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (forall (m :: * -> *) a.
SignalHandlerQueue m a -> Ref m [SignalHandler m a]
queueList SignalHandlerQueue m a
q) (forall a. Eq a => a -> [a] -> [a]
delete SignalHandler m a
h)

instance MonadDES m => Functor (Signal m) where

  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> Signal m a -> Signal m b
fmap = forall (m :: * -> *) a b.
MonadDES m =>
(a -> b) -> Signal m a -> Signal m b
mapSignal
  
instance MonadDES m => Semigroup (Signal m a) where

  {-# INLINE (<>) #-}
  <> :: Signal m a -> Signal m a -> Signal m a
(<>) = forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> Signal m a -> Signal m a
merge2Signals

  {-# INLINABLE sconcat #-}
  sconcat :: NonEmpty (Signal m a) -> Signal m a
sconcat (Signal m a
x1 :| []) = Signal m a
x1
  sconcat (Signal m a
x1 :| [Signal m a
x2]) = forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> Signal m a -> Signal m a
merge2Signals Signal m a
x1 Signal m a
x2
  sconcat (Signal m a
x1 :| [Signal m a
x2, Signal m a
x3]) = forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> Signal m a -> Signal m a -> Signal m a
merge3Signals Signal m a
x1 Signal m a
x2 Signal m a
x3
  sconcat (Signal m a
x1 :| [Signal m a
x2, Signal m a
x3, Signal m a
x4]) = forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> Signal m a -> Signal m a -> Signal m a -> Signal m a
merge4Signals Signal m a
x1 Signal m a
x2 Signal m a
x3 Signal m a
x4
  sconcat (Signal m a
x1 :| [Signal m a
x2, Signal m a
x3, Signal m a
x4, Signal m a
x5]) = forall (m :: * -> *) a.
MonadDES m =>
Signal m a
-> Signal m a
-> Signal m a
-> Signal m a
-> Signal m a
-> Signal m a
merge5Signals Signal m a
x1 Signal m a
x2 Signal m a
x3 Signal m a
x4 Signal m a
x5
  sconcat (Signal m a
x1 :| (Signal m a
x2 : Signal m a
x3 : Signal m a
x4 : Signal m a
x5 : [Signal m a]
xs)) = 
    forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
Signal m a
-> Signal m a
-> Signal m a
-> Signal m a
-> Signal m a
-> Signal m a
merge5Signals Signal m a
x1 Signal m a
x2 Signal m a
x3 Signal m a
x4 Signal m a
x5 forall a. a -> [a] -> NonEmpty a
:| [Signal m a]
xs

instance MonadDES m => Monoid (Signal m a) where 

  {-# INLINE mempty #-}
  mempty :: Signal m a
mempty = forall (m :: * -> *) a. MonadDES m => Signal m a
emptySignal

  {-# INLINE mappend #-}
  mappend :: Signal m a -> Signal m a -> Signal m a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

  {-# INLINABLE mconcat #-}
  mconcat :: [Signal m a] -> Signal m a
mconcat [] = forall a. Monoid a => a
mempty
  mconcat (Signal m a
h:[Signal m a]
t) = forall a. Semigroup a => NonEmpty a -> a
sconcat (Signal m a
h forall a. a -> [a] -> NonEmpty a
:| [Signal m a]
t)
  
-- | Map the signal according the specified function.
mapSignal :: MonadDES m => (a -> b) -> Signal m a -> Signal m b
{-# INLINABLE mapSignal #-}
mapSignal :: forall (m :: * -> *) a b.
MonadDES m =>
(a -> b) -> Signal m a -> Signal m b
mapSignal a -> b
f Signal m a
m =
  Signal { handleSignal :: (b -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \b -> Event m ()
h -> 
            forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m forall a b. (a -> b) -> a -> b
$ b -> Event m ()
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 :: MonadDES m => (a -> Bool) -> Signal m a -> Signal m a
{-# INLINABLE filterSignal #-}
filterSignal :: forall (m :: * -> *) a.
MonadDES m =>
(a -> Bool) -> Signal m a -> Signal m a
filterSignal a -> Bool
p Signal m a
m =
  Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \a -> Event m ()
h ->
            forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m 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 m ()
h a
a }

-- | Filter only those signal values that satisfy 
-- the specified predicate, but then ignoring the values.
filterSignal_ :: MonadDES m => (a -> Bool) -> Signal m a -> Signal m ()
{-# INLINABLE filterSignal_ #-}
filterSignal_ :: forall (m :: * -> *) a.
MonadDES m =>
(a -> Bool) -> Signal m a -> Signal m ()
filterSignal_ a -> Bool
p Signal m a
m =
  Signal { handleSignal :: (() -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \() -> Event m ()
h ->
            forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m 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 m ()
h () }
  
-- | Filter only those signal values that satisfy 
-- the specified predicate.
filterSignalM :: MonadDES m => (a -> Event m Bool) -> Signal m a -> Signal m a
{-# INLINABLE filterSignalM #-}
filterSignalM :: forall (m :: * -> *) a.
MonadDES m =>
(a -> Event m Bool) -> Signal m a -> Signal m a
filterSignalM a -> Event m Bool
p Signal m a
m =
  Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \a -> Event m ()
h ->
            forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
            do Bool
x <- a -> Event m Bool
p a
a
               forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
x forall a b. (a -> b) -> a -> b
$ a -> Event m ()
h a
a }
  
-- | Filter only those signal values that satisfy 
-- the specified predicate, but then ignoring the values.
filterSignalM_ :: MonadDES m => (a -> Event m Bool) -> Signal m a -> Signal m ()
{-# INLINABLE filterSignalM_ #-}
filterSignalM_ :: forall (m :: * -> *) a.
MonadDES m =>
(a -> Event m Bool) -> Signal m a -> Signal m ()
filterSignalM_ a -> Event m Bool
p Signal m a
m =
  Signal { handleSignal :: (() -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \() -> Event m ()
h ->
            forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
            do Bool
x <- a -> Event m Bool
p a
a
               forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
x forall a b. (a -> b) -> a -> b
$ () -> Event m ()
h () }
  
-- | Merge two signals.
merge2Signals :: MonadDES m => Signal m a -> Signal m a -> Signal m a
{-# INLINABLE merge2Signals #-}
merge2Signals :: forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> Signal m a -> Signal m a
merge2Signals Signal m a
m1 Signal m a
m2 =
  Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \a -> Event m ()
h ->
            do DisposableEvent m
x1 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m1 a -> Event m ()
h
               DisposableEvent m
x2 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m2 a -> Event m ()
h
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DisposableEvent m
x1 forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
x2 }

-- | Merge three signals.
merge3Signals :: MonadDES m => Signal m a -> Signal m a -> Signal m a -> Signal m a
{-# INLINABLE merge3Signals #-}
merge3Signals :: forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> Signal m a -> Signal m a -> Signal m a
merge3Signals Signal m a
m1 Signal m a
m2 Signal m a
m3 =
  Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \a -> Event m ()
h ->
            do DisposableEvent m
x1 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m1 a -> Event m ()
h
               DisposableEvent m
x2 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m2 a -> Event m ()
h
               DisposableEvent m
x3 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m3 a -> Event m ()
h
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DisposableEvent m
x1 forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
x2 forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
x3 }

-- | Merge four signals.
merge4Signals :: MonadDES m
                 => Signal m a -> Signal m a -> Signal m a
                 -> Signal m a -> Signal m a
{-# INLINABLE merge4Signals #-}
merge4Signals :: forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> Signal m a -> Signal m a -> Signal m a -> Signal m a
merge4Signals Signal m a
m1 Signal m a
m2 Signal m a
m3 Signal m a
m4 =
  Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \a -> Event m ()
h ->
            do DisposableEvent m
x1 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m1 a -> Event m ()
h
               DisposableEvent m
x2 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m2 a -> Event m ()
h
               DisposableEvent m
x3 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m3 a -> Event m ()
h
               DisposableEvent m
x4 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m4 a -> Event m ()
h
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DisposableEvent m
x1 forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
x2 forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
x3 forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
x4 }
           
-- | Merge five signals.
merge5Signals :: MonadDES m
                 => Signal m a -> Signal m a -> Signal m a
                 -> Signal m a -> Signal m a -> Signal m a
{-# INLINABLE merge5Signals #-}
merge5Signals :: forall (m :: * -> *) a.
MonadDES m =>
Signal m a
-> Signal m a
-> Signal m a
-> Signal m a
-> Signal m a
-> Signal m a
merge5Signals Signal m a
m1 Signal m a
m2 Signal m a
m3 Signal m a
m4 Signal m a
m5 =
  Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \a -> Event m ()
h ->
            do DisposableEvent m
x1 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m1 a -> Event m ()
h
               DisposableEvent m
x2 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m2 a -> Event m ()
h
               DisposableEvent m
x3 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m3 a -> Event m ()
h
               DisposableEvent m
x4 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m4 a -> Event m ()
h
               DisposableEvent m
x5 <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m5 a -> Event m ()
h
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DisposableEvent m
x1 forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
x2 forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
x3 forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
x4 forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
x5 }

-- | Compose the signal.
mapSignalM :: MonadDES m => (a -> Event m b) -> Signal m a -> Signal m b
{-# INLINABLE mapSignalM #-}
mapSignalM :: forall (m :: * -> *) a b.
MonadDES m =>
(a -> Event m b) -> Signal m a -> Signal m b
mapSignalM a -> Event m b
f Signal m a
m =
  Signal { handleSignal :: (b -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \b -> Event m ()
h ->
            forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m (a -> Event m b
f forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> Event m ()
h) }
  
-- | Transform the signal.
apSignal :: MonadDES m => Event m (a -> b) -> Signal m a -> Signal m b
{-# INLINABLE apSignal #-}
apSignal :: forall (m :: * -> *) a b.
MonadDES m =>
Event m (a -> b) -> Signal m a -> Signal m b
apSignal Event m (a -> b)
f Signal m a
m =
  Signal { handleSignal :: (b -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \b -> Event m ()
h ->
            forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m forall a b. (a -> b) -> a -> b
$ \a
a -> do { a -> b
x <- Event m (a -> b)
f; b -> Event m ()
h (a -> b
x a
a) } }

-- | An empty signal which is never triggered.
emptySignal :: MonadDES m => Signal m a
{-# INLINABLE emptySignal #-}
emptySignal :: forall (m :: * -> *) a. MonadDES m => Signal m a
emptySignal =
  Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \a -> Event m ()
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 m a =
  SignalHistory { forall (m :: * -> *) a. SignalHistory m a -> Signal m a
signalHistorySignal :: Signal m a,  
                  -- ^ The signal for which the history is created.
                  forall (m :: * -> *) a. SignalHistory m a -> Ref m [Double]
signalHistoryTimes  :: Ref m [Double],
                  forall (m :: * -> *) a. SignalHistory m a -> Ref m [a]
signalHistoryValues :: Ref m [a] }

-- | Create a history of the signal values.
newSignalHistory :: MonadDES m => Signal m a -> Composite m (SignalHistory m a)
{-# INLINABLE newSignalHistory #-}
newSignalHistory :: forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> Composite m (SignalHistory m a)
newSignalHistory =
  forall (m :: * -> *) a.
MonadDES m =>
Maybe a -> Signal m a -> Composite m (SignalHistory m a)
newSignalHistoryStartingWith forall a. Maybe a
Nothing

-- | Create a history of the signal values starting with
-- the optional initial value.
newSignalHistoryStartingWith :: MonadDES m => Maybe a -> Signal m a -> Composite m (SignalHistory m a)
{-# INLINABLE newSignalHistoryStartingWith #-}
newSignalHistoryStartingWith :: forall (m :: * -> *) a.
MonadDES m =>
Maybe a -> Signal m a -> Composite m (SignalHistory m a)
newSignalHistoryStartingWith Maybe a
init Signal m a
signal =
  do Ref m [Double]
ts <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef []
     Ref m [a]
xs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef []
     case Maybe a
init of
       Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just a
a ->
         forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$
         do Double
t <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
DynamicsLift t m =>
Dynamics m a -> t m a
liftDynamics forall (m :: * -> *). Monad m => Dynamics m Double
time
            forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m [Double]
ts (Double
t forall a. a -> [a] -> [a]
:)
            forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m [a]
xs (a
a forall a. a -> [a] -> [a]
:)
     forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> (a -> Event m ()) -> Composite m ()
handleSignalComposite Signal m a
signal forall a b. (a -> b) -> a -> b
$ \a
a ->
       do Double
t <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
DynamicsLift t m =>
Dynamics m a -> t m a
liftDynamics forall (m :: * -> *). Monad m => Dynamics m Double
time
          forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m [Double]
ts (Double
t forall a. a -> [a] -> [a]
:)
          forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m [a]
xs (a
a forall a. a -> [a] -> [a]
:)
     forall (m :: * -> *) a. Monad m => a -> m a
return SignalHistory { signalHistorySignal :: Signal m a
signalHistorySignal = Signal m a
signal,
                            signalHistoryTimes :: Ref m [Double]
signalHistoryTimes  = Ref m [Double]
ts,
                            signalHistoryValues :: Ref m [a]
signalHistoryValues = Ref m [a]
xs }
       
-- | Read the history of signal values.
readSignalHistory :: MonadDES m => SignalHistory m a -> Event m (Array Int Double, Array Int a)
{-# INLINABLE readSignalHistory #-}
readSignalHistory :: forall (m :: * -> *) a.
MonadDES m =>
SignalHistory m a -> Event m (Array Int Double, Array Int a)
readSignalHistory SignalHistory m a
history =
  do [Double]
xs0 <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. SignalHistory m a -> Ref m [Double]
signalHistoryTimes SignalHistory m a
history)
     [a]
ys0 <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *) a. SignalHistory m a -> Ref m [a]
signalHistoryValues SignalHistory m a
history)
     let n :: Int
n  = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs0
         xs :: Array Int Double
xs = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int
n forall a. Num a => a -> a -> a
- Int
1) (forall a. [a] -> [a]
reverse [Double]
xs0)
         ys :: Array Int a
ys = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int
n forall a. Num a => a -> a -> a
- Int
1) (forall a. [a] -> [a]
reverse [a]
ys0)
     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 :: MonadDES m => SignalSource m Double -> Event m ()
{-# INLINABLE triggerSignalWithCurrentTime #-}
triggerSignalWithCurrentTime :: forall (m :: * -> *).
MonadDES m =>
SignalSource m Double -> Event m ()
triggerSignalWithCurrentTime SignalSource m Double
s =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p -> forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal SignalSource m Double
s (forall (m :: * -> *). Point m -> Double
pointTime Point m
p)

-- | Return a signal that is triggered in the specified time points.
newSignalInTimes :: MonadDES m => [Double] -> Event m (Signal m Double)
{-# INLINABLE newSignalInTimes #-}
newSignalInTimes :: forall (m :: * -> *).
MonadDES m =>
[Double] -> Event m (Signal m Double)
newSignalInTimes [Double]
xs =
  do SignalSource m Double
s <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
     forall (m :: * -> *).
MonadDES m =>
[Double] -> Event m () -> Event m ()
enqueueEventWithTimes [Double]
xs forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadDES m =>
SignalSource m Double -> Event m ()
triggerSignalWithCurrentTime SignalSource m Double
s
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal SignalSource m Double
s
       
-- | Return a signal that is triggered in the integration time points.
-- It should be called with help of 'runEventInStartTime'.
newSignalInIntegTimes :: MonadDES m => Event m (Signal m Double)
{-# INLINABLE newSignalInIntegTimes #-}
newSignalInIntegTimes :: forall (m :: * -> *). MonadDES m => Event m (Signal m Double)
newSignalInIntegTimes =
  do SignalSource m Double
s <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
     forall (m :: * -> *). MonadDES m => Event m () -> Event m ()
enqueueEventWithIntegTimes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadDES m =>
SignalSource m Double -> Event m ()
triggerSignalWithCurrentTime SignalSource m Double
s
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal SignalSource m Double
s
     
-- | Return a signal that is triggered in the start time.
-- It should be called with help of 'runEventInStartTime'.
newSignalInStartTime :: MonadDES m => Event m (Signal m Double)
{-# INLINABLE newSignalInStartTime #-}
newSignalInStartTime :: forall (m :: * -> *). MonadDES m => Event m (Signal m Double)
newSignalInStartTime =
  do SignalSource m Double
s <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
     Double
t <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
ParameterLift t m =>
Parameter m a -> t m a
liftParameter forall (m :: * -> *). Monad m => Parameter m Double
starttime
     forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadDES m =>
SignalSource m Double -> Event m ()
triggerSignalWithCurrentTime SignalSource m Double
s
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal SignalSource m Double
s

-- | Return a signal that is triggered in the final time.
newSignalInStopTime :: MonadDES m => Event m (Signal m Double)
{-# INLINABLE newSignalInStopTime #-}
newSignalInStopTime :: forall (m :: * -> *). MonadDES m => Event m (Signal m Double)
newSignalInStopTime =
  do SignalSource m Double
s <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
     Double
t <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
ParameterLift t m =>
Parameter m a -> t m a
liftParameter forall (m :: * -> *). Monad m => Parameter m Double
stoptime
     forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadDES m =>
SignalSource m Double -> Event m ()
triggerSignalWithCurrentTime SignalSource m Double
s
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal SignalSource m Double
s

-- | Return a signal that is trigged in the grid by specified size.
newSignalInTimeGrid :: MonadDES m => Int -> Event m (Signal m Int)
{-# INLINABLE newSignalInTimeGrid #-}
-- | Return a signal that is trigged in the grid by specified size.
newSignalInTimeGrid :: forall (m :: * -> *). MonadDES m => Int -> Event m (Signal m Int)
newSignalInTimeGrid Int
n =
  do Specs m
sc <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
ParameterLift t m =>
Parameter m a -> t m a
liftParameter forall (m :: * -> *). Monad m => Parameter m (Specs m)
simulationSpecs
     SignalSource m Int
s  <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
     let loop :: [(Int, Double)] -> Event m ()
loop []            = forall (m :: * -> *) a. Monad m => a -> m a
return ()
         loop ((Int
i, Double
t) : [(Int, Double)]
xs) = forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$
                              do forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal SignalSource m Int
s Int
i
                                 [(Int, Double)] -> Event m ()
loop [(Int, Double)]
xs
     [(Int, Double)] -> Event m ()
loop forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Specs m -> Int -> [(Int, Double)]
timeGrid Specs m
sc Int
n
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal SignalSource m Int
s

-- | Describes a computation that also signals when changing its value.
data Signalable m a =
  Signalable { forall (m :: * -> *) a. Signalable m a -> Event m a
readSignalable :: Event m a,
               -- ^ Return a computation of the value.
               forall (m :: * -> *) a. Signalable m a -> Signal m ()
signalableChanged_ :: Signal m ()
               -- ^ 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 :: MonadDES m => Signalable m a -> Signal m a
{-# INLINABLE signalableChanged #-}
signalableChanged :: forall (m :: * -> *) a. MonadDES m => Signalable m a -> Signal m a
signalableChanged Signalable m a
x = forall (m :: * -> *) a b.
MonadDES m =>
(a -> Event m b) -> Signal m a -> Signal m b
mapSignalM (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Signalable m a -> Event m a
readSignalable Signalable m a
x) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Signalable m a -> Signal m ()
signalableChanged_ Signalable m a
x

instance Functor m => Functor (Signalable m) where

  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> Signalable m a -> Signalable m b
fmap a -> b
f Signalable m a
x = Signalable m a
x { readSignalable :: Event m b
readSignalable = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (forall (m :: * -> *) a. Signalable m a -> Event m a
readSignalable Signalable m a
x) }

instance (MonadDES m, Semigroup a) => Semigroup (Signalable m a) where

  {-# INLINE (<>) #-}
  <> :: Signalable m a -> Signalable m a -> Signalable m a
(<>) = forall (m :: * -> *) a.
(MonadDES m, Semigroup a) =>
Signalable m a -> Signalable m a -> Signalable m a
appendSignalable

instance (MonadDES m, Monoid a, Semigroup a) => Monoid (Signalable m a) where

  {-# INLINE mempty #-}
  mempty :: Signalable m a
mempty = forall (m :: * -> *) a. (MonadDES m, Monoid a) => Signalable m a
emptySignalable

  {-# INLINE mappend #-}
  mappend :: Signalable m a -> Signalable m a -> Signalable m a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Return an identity.
emptySignalable :: (MonadDES m, Monoid a) => Signalable m a
{-# INLINABLE emptySignalable #-}
emptySignalable :: forall (m :: * -> *) a. (MonadDES m, Monoid a) => Signalable m a
emptySignalable =
  Signalable { readSignalable :: Event m a
readSignalable = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty,
               signalableChanged_ :: Signal m ()
signalableChanged_ = forall a. Monoid a => a
mempty }

-- | An associative operation.
appendSignalable :: (MonadDES m, Semigroup a) => Signalable m a -> Signalable m a -> Signalable m a
{-# INLINABLE appendSignalable #-}
appendSignalable :: forall (m :: * -> *) a.
(MonadDES m, Semigroup a) =>
Signalable m a -> Signalable m a -> Signalable m a
appendSignalable Signalable m a
m1 Signalable m a
m2 =
  Signalable { readSignalable :: Event m 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 (m :: * -> *) a. Signalable m a -> Event m a
readSignalable Signalable m a
m1) (forall (m :: * -> *) a. Signalable m a -> Event m a
readSignalable Signalable m a
m2),
               signalableChanged_ :: Signal m ()
signalableChanged_ = (forall (m :: * -> *) a. Signalable m a -> Signal m ()
signalableChanged_ Signalable m a
m1) forall a. Semigroup a => a -> a -> a
<> (forall (m :: * -> *) a. Signalable m a -> Signal m ()
signalableChanged_ Signalable m 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 :: MonadDES m => Signal m a -> Signal m (Arrival a)
{-# INLINABLE arrivalSignal #-}
arrivalSignal :: forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> Signal m (Arrival a)
arrivalSignal Signal m a
m = 
  Signal { handleSignal :: (Arrival a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \Arrival a -> Event m ()
h ->
             do Ref m (Maybe Double)
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
                forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
                  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                  do Maybe Double
t0 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe Double)
r
                     let t :: Double
t = forall (m :: * -> *). Point m -> Double
pointTime Point m
p
                     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe Double)
r (forall a. a -> Maybe a
Just Double
t)
                     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                       Arrival a -> Event m ()
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 :: MonadDES m => Double -> Signal m a -> Signal m a
{-# INLINABLE delaySignal #-}
delaySignal :: forall (m :: * -> *) a.
MonadDES m =>
Double -> Signal m a -> Signal m a
delaySignal Double
delta Signal m a
m =
  Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \a -> Event m ()
h ->
            do Ref m Bool
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
               DisposableEvent m
h <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
                 forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                 forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                 forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (forall (m :: * -> *). Point m -> Double
pointTime Point m
p forall a. Num a => a -> a -> a
+ Double
delta) forall a b. (a -> b) -> a -> b
$ 
                 do Bool
x <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Bool
r
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
x forall a b. (a -> b) -> a -> b
$ a -> Event m ()
h a
a
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Event m () -> DisposableEvent m
DisposableEvent forall a b. (a -> b) -> a -> b
$
                 forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                 forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m Bool
r Bool
True
         }

-- | Delay the signal values for time intervals recalculated for each value.
delaySignalM :: MonadDES m => Event m Double -> Signal m a -> Signal m a
{-# INLINABLE delaySignalM #-}
delaySignalM :: forall (m :: * -> *) a.
MonadDES m =>
Event m Double -> Signal m a -> Signal m a
delaySignalM Event m Double
delta Signal m a
m =
  Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \a -> Event m ()
h ->
            do Ref m Bool
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
               DisposableEvent m
h <- forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m forall a b. (a -> b) -> a -> b
$ \a
a ->
                 forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                 do Double
delta' <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m Double
delta
                    forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                      forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (forall (m :: * -> *). Point m -> Double
pointTime Point m
p forall a. Num a => a -> a -> a
+ Double
delta') forall a b. (a -> b) -> a -> b
$ 
                      do Bool
x <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Bool
r
                         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
x forall a b. (a -> b) -> a -> b
$ a -> Event m ()
h a
a
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Event m () -> DisposableEvent m
DisposableEvent forall a b. (a -> b) -> a -> b
$
                 forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                 forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m Bool
r Bool
True
         }

-- | Show the debug message with the current simulation time.
traceSignal :: MonadDES m => String -> Signal m a -> Signal m a 
{-# INLINABLE traceSignal #-}
traceSignal :: forall (m :: * -> *) a.
MonadDES m =>
String -> Signal m a -> Signal m a
traceSignal String
message Signal m a
m =
  Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \a -> Event m ()
h ->
            forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
m forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
String -> Event m a -> Event m a
traceEvent String
message forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Event m ()
h }