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(..))
data ArrivalTimer m =
ArrivalTimer { forall (m :: * -> *).
ArrivalTimer m -> Ref m (SamplingStats Double)
arrivalProcessingTimeRef :: Ref m (SamplingStats Double),
forall (m :: * -> *). ArrivalTimer m -> SignalSource m ()
arrivalProcessingTimeChangedSource :: SignalSource m () }
newArrivalTimer :: MonadDES m => Simulation m (ArrivalTimer m)
{-# INLINABLE newArrivalTimer #-}
newArrivalTimer :: forall (m :: * -> *). MonadDES m => 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 a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return ArrivalTimer { arrivalProcessingTimeRef :: Ref m (SamplingStats Double)
arrivalProcessingTimeRef = Ref m (SamplingStats Double)
r,
arrivalProcessingTimeChangedSource :: SignalSource m ()
arrivalProcessingTimeChangedSource = SignalSource m ()
s }
arrivalProcessingTime :: MonadDES m => ArrivalTimer m -> Event m (SamplingStats Double)
{-# INLINABLE arrivalProcessingTime #-}
arrivalProcessingTime :: forall (m :: * -> *).
MonadDES m =>
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
arrivalProcessingTimeChanged :: MonadDES m => ArrivalTimer m -> Signal m (SamplingStats Double)
{-# INLINABLE arrivalProcessingTimeChanged #-}
arrivalProcessingTimeChanged :: forall (m :: * -> *).
MonadDES m =>
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)
arrivalProcessingTimeChanged_ :: MonadDES m => ArrivalTimer m -> Signal m ()
{-# INLINABLE arrivalProcessingTimeChanged_ #-}
arrivalProcessingTimeChanged_ :: forall (m :: * -> *). MonadDES m => 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)
arrivalTimerProcessor :: MonadDES m => ArrivalTimer m -> Processor m (Arrival a) (Arrival a)
{-# INLINABLE arrivalTimerProcessor #-}
arrivalTimerProcessor :: forall (m :: * -> *) a.
MonadDES m =>
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 a. Event m a -> Process m a
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 a. Dynamics m a -> Event m a
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 a. a -> Process m 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)
arrivalTimerSignal :: MonadDES m => ArrivalTimer m -> Signal m (Arrival a) -> Signal m (Arrival a)
{-# INLINABLE arrivalTimerSignal #-}
arrivalTimerSignal :: forall (m :: * -> *) a.
MonadDES m =>
ArrivalTimer m -> Signal m (Arrival a) -> Signal m (Arrival a)
arrivalTimerSignal ArrivalTimer m
timer Signal m (Arrival a)
sa =
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 a. Dynamics m a -> Event m a
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
}
arrivalTimerChannel :: MonadDES m => ArrivalTimer m -> Channel m (Arrival a) (Arrival a)
{-# INLINABLE arrivalTimerChannel #-}
arrivalTimerChannel :: forall (m :: * -> *) a.
MonadDES m =>
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 a. a -> Composite m 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
resetArrivalTimer :: MonadDES m => ArrivalTimer m -> Event m ()
{-# INLINABLE resetArrivalTimer #-}
resetArrivalTimer :: forall (m :: * -> *). MonadDES m => 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) ()