-- |
-- Module     : Simulation.Aivika.Trans.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.Trans.Arrival
       (Arrival(..),
        ArrivalTimer,
        newArrivalTimer,
        arrivalTimerProcessor,
        arrivalTimerSignal,
        arrivalTimerChannel,
        arrivalProcessingTime,
        arrivalProcessingTimeChanged,
        arrivalProcessingTimeChanged_,
        resetArrivalTimer) where

import Control.Monad
import Control.Monad.Trans

import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Dynamics
import Simulation.Aivika.Trans.Event
import Simulation.Aivika.Trans.Composite
import Simulation.Aivika.Trans.Processor
import Simulation.Aivika.Trans.Stream
import Simulation.Aivika.Trans.Statistics
import Simulation.Aivika.Trans.Ref
import Simulation.Aivika.Trans.Signal
import Simulation.Aivika.Trans.Channel
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Arrival (Arrival(..))

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

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

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

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

-- | Return a signal raised when the the processing time statistics changes.
arrivalProcessingTimeChanged_ :: MonadDES m => ArrivalTimer m -> Signal m ()
{-# INLINABLE arrivalProcessingTimeChanged_ #-}
arrivalProcessingTimeChanged_ :: ArrivalTimer m -> Signal m ()
arrivalProcessingTimeChanged_ ArrivalTimer m
timer =
  SignalSource m () -> Signal m ()
forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal (ArrivalTimer m -> SignalSource m ()
forall (m :: * -> *). ArrivalTimer m -> SignalSource m ()
arrivalProcessingTimeChangedSource ArrivalTimer m
timer)

-- | Return a processor that actually measures how much time has passed from
-- the time of arriving the events.
arrivalTimerProcessor :: MonadDES m => ArrivalTimer m -> Processor m (Arrival a) (Arrival a)
{-# INLINABLE arrivalTimerProcessor #-}
arrivalTimerProcessor :: ArrivalTimer m -> Processor m (Arrival a) (Arrival a)
arrivalTimerProcessor ArrivalTimer m
timer =
  (Stream m (Arrival a) -> Stream m (Arrival a))
-> Processor m (Arrival a) (Arrival a)
forall (m :: * -> *) a b.
(Stream m a -> Stream m b) -> Processor m a b
Processor ((Stream m (Arrival a) -> Stream m (Arrival a))
 -> Processor m (Arrival a) (Arrival a))
-> (Stream m (Arrival a) -> Stream m (Arrival a))
-> Processor m (Arrival a) (Arrival a)
forall a b. (a -> b) -> a -> b
$ \Stream m (Arrival a)
xs -> Process m (Arrival a, Stream m (Arrival a)) -> Stream m (Arrival a)
forall (m :: * -> *) a. Process m (a, Stream m a) -> Stream m a
Cons (Process m (Arrival a, Stream m (Arrival a))
 -> Stream m (Arrival a))
-> Process m (Arrival a, Stream m (Arrival a))
-> Stream m (Arrival a)
forall a b. (a -> b) -> a -> b
$ Stream m (Arrival a) -> Process m (Arrival a, Stream m (Arrival a))
forall a.
Stream m (Arrival a) -> Process m (Arrival a, Stream m (Arrival a))
loop Stream m (Arrival a)
xs where
    loop :: Stream m (Arrival a) -> Process m (Arrival a, Stream m (Arrival a))
loop Stream m (Arrival a)
xs =
      do (Arrival a
a, Stream m (Arrival a)
xs) <- Stream m (Arrival a) -> Process m (Arrival a, Stream m (Arrival a))
forall (m :: * -> *) a. Stream m a -> Process m (a, Stream m a)
runStream Stream m (Arrival a)
xs
         Event m () -> Process m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Process m ()) -> Event m () -> Process m ()
forall a b. (a -> b) -> a -> b
$
           do Double
t <- Dynamics m Double -> Event m Double
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
DynamicsLift t m =>
Dynamics m a -> t m a
liftDynamics Dynamics m Double
forall (m :: * -> *). Monad m => Dynamics m Double
time
              Ref m (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (ArrivalTimer m -> Ref m (SamplingStats Double)
forall (m :: * -> *).
ArrivalTimer m -> Ref m (SamplingStats Double)
arrivalProcessingTimeRef ArrivalTimer m
timer) ((SamplingStats Double -> SamplingStats Double) -> Event m ())
-> (SamplingStats Double -> SamplingStats Double) -> Event m ()
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 m () -> () -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (ArrivalTimer m -> SignalSource m ()
forall (m :: * -> *). ArrivalTimer m -> SignalSource m ()
arrivalProcessingTimeChangedSource ArrivalTimer m
timer) ()
         (Arrival a, Stream m (Arrival a))
-> Process m (Arrival a, Stream m (Arrival a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Arrival a
a, Process m (Arrival a, Stream m (Arrival a)) -> Stream m (Arrival a)
forall (m :: * -> *) a. Process m (a, Stream m a) -> Stream m a
Cons (Process m (Arrival a, Stream m (Arrival a))
 -> Stream m (Arrival a))
-> Process m (Arrival a, Stream m (Arrival a))
-> Stream m (Arrival a)
forall a b. (a -> b) -> a -> b
$ Stream m (Arrival a) -> Process m (Arrival a, Stream m (Arrival a))
loop Stream m (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 :: MonadDES m => ArrivalTimer m -> Signal m (Arrival a) -> Signal m (Arrival a)
{-# INLINABLE arrivalTimerSignal #-}
arrivalTimerSignal :: ArrivalTimer m -> Signal m (Arrival a) -> Signal m (Arrival a)
arrivalTimerSignal ArrivalTimer m
timer Signal m (Arrival a)
sa =
  Signal :: forall (m :: * -> *) a.
((a -> Event m ()) -> Event m (DisposableEvent m)) -> Signal m a
Signal { handleSignal :: (Arrival a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal = \Arrival a -> Event m ()
h ->
            Signal m (Arrival a)
-> (Arrival a -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m (Arrival a)
sa ((Arrival a -> Event m ()) -> Event m (DisposableEvent m))
-> (Arrival a -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \Arrival a
a ->
            do Double
t <- Dynamics m Double -> Event m Double
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
DynamicsLift t m =>
Dynamics m a -> t m a
liftDynamics Dynamics m Double
forall (m :: * -> *). Monad m => Dynamics m Double
time
               Ref m (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (ArrivalTimer m -> Ref m (SamplingStats Double)
forall (m :: * -> *).
ArrivalTimer m -> Ref m (SamplingStats Double)
arrivalProcessingTimeRef ArrivalTimer m
timer) ((SamplingStats Double -> SamplingStats Double) -> Event m ())
-> (SamplingStats Double -> SamplingStats Double) -> Event m ()
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 m ()
h Arrival a
a
         }

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

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