-- |
-- 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 <- SamplingStats Double -> Simulation (Ref (SamplingStats Double))
forall a. a -> Simulation (Ref a)
newRef SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
     SignalSource ()
s <- Simulation (SignalSource ())
forall a. Simulation (SignalSource a)
newSignalSource
     ArrivalTimer -> Simulation ArrivalTimer
forall (m :: * -> *) a. Monad m => a -> m a
return ArrivalTimer :: Ref (SamplingStats Double) -> SignalSource () -> ArrivalTimer
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 = Ref (SamplingStats Double) -> Event (SamplingStats Double)
forall a. Ref a -> Event a
readRef (Ref (SamplingStats Double) -> Event (SamplingStats Double))
-> (ArrivalTimer -> Ref (SamplingStats Double))
-> ArrivalTimer
-> Event (SamplingStats Double)
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 =
  (() -> Event (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event (SamplingStats Double) -> () -> Event (SamplingStats Double)
forall a b. a -> b -> a
const (Event (SamplingStats Double)
 -> () -> Event (SamplingStats Double))
-> Event (SamplingStats Double)
-> ()
-> Event (SamplingStats Double)
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 =
  SignalSource () -> Signal ()
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 :: ArrivalTimer -> Processor (Arrival a) (Arrival a)
arrivalTimerProcessor ArrivalTimer
timer =
  (Stream (Arrival a) -> Stream (Arrival a))
-> Processor (Arrival a) (Arrival a)
forall a b. (Stream a -> Stream b) -> Processor a b
Processor ((Stream (Arrival a) -> Stream (Arrival a))
 -> Processor (Arrival a) (Arrival a))
-> (Stream (Arrival a) -> Stream (Arrival a))
-> Processor (Arrival a) (Arrival a)
forall a b. (a -> b) -> a -> b
$ \Stream (Arrival a)
xs -> Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
forall a. Process (a, Stream a) -> Stream a
Cons (Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a))
-> Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
forall a b. (a -> b) -> a -> b
$ Stream (Arrival a) -> Process (Arrival a, Stream (Arrival a))
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) <- Stream (Arrival a) -> Process (Arrival a, Stream (Arrival a))
forall a. Stream a -> Process (a, Stream a)
runStream Stream (Arrival a)
xs
         Event () -> Process ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$
           do Double
t <- Dynamics Double -> Event Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
              Ref (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> Event ()
forall a. Ref a -> (a -> a) -> Event ()
modifyRef (ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef ArrivalTimer
timer) ((SamplingStats Double -> SamplingStats Double) -> Event ())
-> (SamplingStats Double -> SamplingStats Double) -> Event ()
forall a b. (a -> b) -> a -> b
$
                Double -> SamplingStats Double -> SamplingStats Double
forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Arrival a -> Double
forall a. Arrival a -> Double
arrivalTime Arrival a
a)
              SignalSource () -> () -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (ArrivalTimer -> SignalSource ()
arrivalProcessingTimeChangedSource ArrivalTimer
timer) ()
         (Arrival a, Stream (Arrival a))
-> Process (Arrival a, Stream (Arrival a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Arrival a
a, Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
forall a. Process (a, Stream a) -> Stream a
Cons (Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a))
-> Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
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 :: ArrivalTimer -> Signal (Arrival a) -> Signal (Arrival a)
arrivalTimerSignal ArrivalTimer
timer Signal (Arrival a)
sa =
  Signal :: forall a. ((a -> Event ()) -> Event DisposableEvent) -> Signal a
Signal { handleSignal :: (Arrival a -> Event ()) -> Event DisposableEvent
handleSignal = \Arrival a -> Event ()
h ->
            Signal (Arrival a)
-> (Arrival a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal (Arrival a)
sa ((Arrival a -> Event ()) -> Event DisposableEvent)
-> (Arrival a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \Arrival a
a ->
            do Double
t <- Dynamics Double -> Event Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
               Ref (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> Event ()
forall a. Ref a -> (a -> a) -> Event ()
modifyRef (ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef ArrivalTimer
timer) ((SamplingStats Double -> SamplingStats Double) -> Event ())
-> (SamplingStats Double -> SamplingStats Double) -> Event ()
forall a b. (a -> b) -> a -> b
$
                 Double -> SamplingStats Double -> SamplingStats Double
forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Arrival a -> Double
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 :: ArrivalTimer -> Channel (Arrival a) (Arrival a)
arrivalTimerChannel ArrivalTimer
timer =
  (Signal (Arrival a) -> Composite (Signal (Arrival a)))
-> Channel (Arrival a) (Arrival a)
forall a b. (Signal a -> Composite (Signal b)) -> Channel a b
Channel ((Signal (Arrival a) -> Composite (Signal (Arrival a)))
 -> Channel (Arrival a) (Arrival a))
-> (Signal (Arrival a) -> Composite (Signal (Arrival a)))
-> Channel (Arrival a) (Arrival a)
forall a b. (a -> b) -> a -> b
$ \Signal (Arrival a)
sa ->
  Signal (Arrival a) -> Composite (Signal (Arrival a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal (Arrival a) -> Composite (Signal (Arrival a)))
-> Signal (Arrival a) -> Composite (Signal (Arrival a))
forall a b. (a -> b) -> a -> b
$ ArrivalTimer -> Signal (Arrival a) -> Signal (Arrival a)
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 Ref (SamplingStats Double) -> SamplingStats Double -> Event ()
forall a. Ref a -> a -> Event ()
writeRef (ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef ArrivalTimer
timer) SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
     SignalSource () -> () -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (ArrivalTimer -> SignalSource ()
arrivalProcessingTimeChangedSource ArrivalTimer
timer) ()