-- |
-- Module : Simulation.Aivika.Trans.Arrival
-- Copyright : Copyright (c) 2009-2014, David Sorokin
-- License : BSD3
-- Maintainer : David Sorokin
-- Stability : experimental
-- Tested with: GHC 7.8.3
--
-- 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,
arrivalProcessingTime,
arrivalProcessingTimeChanged,
arrivalProcessingTimeChanged_) 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.Processor
import Simulation.Aivika.Trans.Stream
import Simulation.Aivika.Trans.Statistics
import Simulation.Aivika.Trans.Ref
import Simulation.Aivika.Trans.Signal
import Simulation.Aivika.Arrival (Arrival(..))
-- | Accumulates the statistics about that how long the arrived events are processed.
data ArrivalTimer m =
ArrivalTimer { arrivalProcessingTimeRef :: Ref m (SamplingStats Double),
arrivalProcessingTimeChangedSource :: SignalSource m () }
-- | Create a new timer that measures how long the arrived events are processed.
newArrivalTimer :: MonadComp m => Simulation m (ArrivalTimer m)
{-# INLINE newArrivalTimer #-}
newArrivalTimer =
do r <- newRef emptySamplingStats
s <- newSignalSource
return ArrivalTimer { arrivalProcessingTimeRef = r,
arrivalProcessingTimeChangedSource = s }
-- | Return the statistics about that how long the arrived events were processed.
arrivalProcessingTime :: MonadComp m => ArrivalTimer m -> Event m (SamplingStats Double)
{-# INLINE arrivalProcessingTime #-}
arrivalProcessingTime = readRef . arrivalProcessingTimeRef
-- | Return a signal raised when the the processing time statistics changes.
arrivalProcessingTimeChanged :: MonadComp m => ArrivalTimer m -> Signal m (SamplingStats Double)
{-# INLINE arrivalProcessingTimeChanged #-}
arrivalProcessingTimeChanged timer =
mapSignalM (const $ arrivalProcessingTime timer) (arrivalProcessingTimeChanged_ timer)
-- | Return a signal raised when the the processing time statistics changes.
arrivalProcessingTimeChanged_ :: MonadComp m => ArrivalTimer m -> Signal m ()
{-# INLINE arrivalProcessingTimeChanged_ #-}
arrivalProcessingTimeChanged_ timer =
publishSignal (arrivalProcessingTimeChangedSource timer)
-- | Return a processor that actually measures how much time has passed from
-- the time of arriving the events.
arrivalTimerProcessor :: MonadComp m => ArrivalTimer m -> Processor m (Arrival a) (Arrival a)
{-# INLINABLE arrivalTimerProcessor #-}
{-# SPECIALISE arrivalTimerProcessor :: ArrivalTimer IO -> Processor IO (Arrival a) (Arrival a) #-}
arrivalTimerProcessor timer =
Processor $ \xs -> Cons $ loop xs where
loop xs =
do (a, xs) <- runStream xs
liftEvent $
do t <- liftDynamics time
modifyRef (arrivalProcessingTimeRef timer) $
addSamplingStats (t - arrivalTime a)
triggerSignal (arrivalProcessingTimeChangedSource timer) ()
return (a, Cons $ loop xs)