-- |
-- Module     : Simulation.Aivika.Arrival
-- 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 types and functions for working with the events
-- that can represent something that arrive from outside the model, or
-- represent other things which computation is delayed and hence is not synchronized.
--
-- Therefore, the additional information is provided about the time and delay of arrival.

module Simulation.Aivika.Arrival
       (Arrival(..),
        ArrivalTimer,
        newArrivalTimer,
        arrivalTimerProcessor,
        arrivalTimerSignal,
        arrivalTimerChannel,
        arrivalProcessingTime,
        arrivalProcessingTimeChanged,
        arrivalProcessingTimeChanged_,
        resetArrivalTimer) where

import Control.Monad
import Control.Monad.Trans

import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Event
import Simulation.Aivika.Composite
import Simulation.Aivika.Processor
import Simulation.Aivika.Stream
import Simulation.Aivika.Statistics
import Simulation.Aivika.Ref
import Simulation.Aivika.Signal
import Simulation.Aivika.Channel
import Simulation.Aivika.Internal.Arrival

-- | Accumulates the statistics about that how long the arrived events are processed.
data ArrivalTimer =
  ArrivalTimer { ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef :: Ref (SamplingStats Double),
                 ArrivalTimer -> SignalSource ()
arrivalProcessingTimeChangedSource :: SignalSource () }

-- | Create a new timer that measures how long the arrived events are processed.
newArrivalTimer :: Simulation ArrivalTimer
newArrivalTimer :: Simulation ArrivalTimer
newArrivalTimer =
  do Ref (SamplingStats Double)
r <- forall a. a -> Simulation (Ref a)
newRef forall a. SamplingData a => SamplingStats a
emptySamplingStats
     SignalSource ()
s <- forall a. Simulation (SignalSource a)
newSignalSource
     forall (m :: * -> *) a. Monad m => a -> m a
return ArrivalTimer { arrivalProcessingTimeRef :: Ref (SamplingStats Double)
arrivalProcessingTimeRef = Ref (SamplingStats Double)
r,
                           arrivalProcessingTimeChangedSource :: SignalSource ()
arrivalProcessingTimeChangedSource = SignalSource ()
s }

-- | Return the statistics about that how long the arrived events were processed.
arrivalProcessingTime :: ArrivalTimer -> Event (SamplingStats Double)
arrivalProcessingTime :: ArrivalTimer -> Event (SamplingStats Double)
arrivalProcessingTime = forall a. Ref a -> Event a
readRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef

-- | Return a signal raised when the the processing time statistics changes.
arrivalProcessingTimeChanged :: ArrivalTimer -> Signal (SamplingStats Double)
arrivalProcessingTimeChanged :: ArrivalTimer -> Signal (SamplingStats Double)
arrivalProcessingTimeChanged ArrivalTimer
timer =
  forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ ArrivalTimer -> Event (SamplingStats Double)
arrivalProcessingTime ArrivalTimer
timer) (ArrivalTimer -> Signal ()
arrivalProcessingTimeChanged_ ArrivalTimer
timer)

-- | Return a signal raised when the the processing time statistics changes.
arrivalProcessingTimeChanged_ :: ArrivalTimer -> Signal ()
arrivalProcessingTimeChanged_ :: ArrivalTimer -> Signal ()
arrivalProcessingTimeChanged_ ArrivalTimer
timer =
  forall a. SignalSource a -> Signal a
publishSignal (ArrivalTimer -> SignalSource ()
arrivalProcessingTimeChangedSource ArrivalTimer
timer)

-- | Return a processor that actually measures how much time has passed from
-- the time of arriving the events.
arrivalTimerProcessor :: ArrivalTimer -> Processor (Arrival a) (Arrival a)
arrivalTimerProcessor :: forall a. ArrivalTimer -> Processor (Arrival a) (Arrival a)
arrivalTimerProcessor ArrivalTimer
timer =
  forall a b. (Stream a -> Stream b) -> Processor a b
Processor forall a b. (a -> b) -> a -> b
$ \Stream (Arrival a)
xs -> forall a. Process (a, Stream a) -> Stream a
Cons forall a b. (a -> b) -> a -> b
$ forall {a}.
Stream (Arrival a) -> Process (Arrival a, Stream (Arrival a))
loop Stream (Arrival a)
xs where
    loop :: Stream (Arrival a) -> Process (Arrival a, Stream (Arrival a))
loop Stream (Arrival a)
xs =
      do (Arrival a
a, Stream (Arrival a)
xs) <- forall a. Stream a -> Process (a, Stream a)
runStream Stream (Arrival a)
xs
         forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
           do Double
t <- forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
              forall a. Ref a -> (a -> a) -> Event ()
modifyRef (ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef ArrivalTimer
timer) forall a b. (a -> b) -> a -> b
$
                forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats (Double
t forall a. Num a => a -> a -> a
- forall a. Arrival a -> Double
arrivalTime Arrival a
a)
              forall a. SignalSource a -> a -> Event ()
triggerSignal (ArrivalTimer -> SignalSource ()
arrivalProcessingTimeChangedSource ArrivalTimer
timer) ()
         forall (m :: * -> *) a. Monad m => a -> m a
return (Arrival a
a, forall a. Process (a, Stream a) -> Stream a
Cons forall a b. (a -> b) -> a -> b
$ Stream (Arrival a) -> Process (Arrival a, Stream (Arrival a))
loop Stream (Arrival a)
xs)

-- | Return a signal that actually measures how much time has passed from
-- the time of arriving the events.
--
-- Note that the statistics is counted each time you subscribe to the output signal.
-- For example, if you subscribe twice then the statistics counting is duplicated.
-- Ideally, you should subscribe to the output signal only once.
arrivalTimerSignal :: ArrivalTimer -> Signal (Arrival a) -> Signal (Arrival a)
arrivalTimerSignal :: forall a. ArrivalTimer -> Signal (Arrival a) -> Signal (Arrival a)
arrivalTimerSignal ArrivalTimer
timer Signal (Arrival a)
sa =
  Signal { handleSignal :: (Arrival a -> Event ()) -> Event DisposableEvent
handleSignal = \Arrival a -> Event ()
h ->
            forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal (Arrival a)
sa forall a b. (a -> b) -> a -> b
$ \Arrival a
a ->
            do Double
t <- forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
               forall a. Ref a -> (a -> a) -> Event ()
modifyRef (ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef ArrivalTimer
timer) forall a b. (a -> b) -> a -> b
$
                 forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats (Double
t forall a. Num a => a -> a -> a
- forall a. Arrival a -> Double
arrivalTime Arrival a
a)
               Arrival a -> Event ()
h Arrival a
a
         }

-- | Like 'arrivalTimerSignal' but measures how much time has passed from
-- the time of arriving the events in the channel.
arrivalTimerChannel :: ArrivalTimer -> Channel (Arrival a) (Arrival a)
arrivalTimerChannel :: forall a. ArrivalTimer -> Channel (Arrival a) (Arrival a)
arrivalTimerChannel ArrivalTimer
timer =
  forall a b. (Signal a -> Composite (Signal b)) -> Channel a b
Channel forall a b. (a -> b) -> a -> b
$ \Signal (Arrival a)
sa ->
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ArrivalTimer -> Signal (Arrival a) -> Signal (Arrival a)
arrivalTimerSignal ArrivalTimer
timer Signal (Arrival a)
sa

-- | Reset the statistics.
resetArrivalTimer :: ArrivalTimer -> Event ()
resetArrivalTimer :: ArrivalTimer -> Event ()
resetArrivalTimer ArrivalTimer
timer =
  do forall a. Ref a -> a -> Event ()
writeRef (ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef ArrivalTimer
timer) forall a. SamplingData a => SamplingStats a
emptySamplingStats
     forall a. SignalSource a -> a -> Event ()
triggerSignal (ArrivalTimer -> SignalSource ()
arrivalProcessingTimeChangedSource ArrivalTimer
timer) ()