module Simulation.Aivika.Activity
(
Activity,
ActivityInterruption(..),
newActivity,
newStateActivity,
newInterruptibleActivity,
newInterruptibleStateActivity,
activityNet,
activityInitState,
activityState,
activityTotalUtilisationTime,
activityTotalIdleTime,
activityUtilisationTime,
activityIdleTime,
activityUtilisationFactor,
activityIdleFactor,
activitySummary,
activityStateChanged,
activityStateChanged_,
activityTotalUtilisationTimeChanged,
activityTotalUtilisationTimeChanged_,
activityTotalIdleTimeChanged,
activityTotalIdleTimeChanged_,
activityUtilisationTimeChanged,
activityUtilisationTimeChanged_,
activityIdleTimeChanged,
activityIdleTimeChanged_,
activityUtilisationFactorChanged,
activityUtilisationFactorChanged_,
activityIdleFactorChanged,
activityIdleFactorChanged_,
activityUtilising,
activityUtilised,
activityInterrupted,
activityChanged_) where
import Data.IORef
import Data.Monoid
import Control.Monad
import Control.Monad.Trans
import Control.Arrow
import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Signal
import Simulation.Aivika.Resource
import Simulation.Aivika.Cont
import Simulation.Aivika.Process
import Simulation.Aivika.Net
import Simulation.Aivika.Server
import Simulation.Aivika.Statistics
data Activity s a b =
Activity { activityInitState :: s,
activityStateRef :: IORef s,
activityProcess :: s -> a -> Process (s, b),
activityProcessInterruptible :: Bool,
activityTotalUtilisationTimeRef :: IORef Double,
activityTotalIdleTimeRef :: IORef Double,
activityUtilisationTimeRef :: IORef (SamplingStats Double),
activityIdleTimeRef :: IORef (SamplingStats Double),
activityUtilisingSource :: SignalSource a,
activityUtilisedSource :: SignalSource (a, b),
activityInterruptedSource :: SignalSource (ActivityInterruption a)
}
data ActivityInterruption a =
ActivityInterruption { activityInterruptedInput :: a,
activityStartProcessingTime :: Double,
activityInterruptionTime :: Double
}
newActivity :: (a -> Process b)
-> Simulation (Activity () a b)
newActivity = newInterruptibleActivity False
newStateActivity :: (s -> a -> Process (s, b))
-> s
-> Simulation (Activity s a b)
newStateActivity = newInterruptibleStateActivity False
newInterruptibleActivity :: Bool
-> (a -> Process b)
-> Simulation (Activity () a b)
newInterruptibleActivity interruptible provide =
flip (newInterruptibleStateActivity interruptible) () $ \s a ->
do b <- provide a
return (s, b)
newInterruptibleStateActivity :: Bool
-> (s -> a -> Process (s, b))
-> s
-> Simulation (Activity s a b)
newInterruptibleStateActivity interruptible provide state =
do r0 <- liftIO $ newIORef state
r1 <- liftIO $ newIORef 0
r2 <- liftIO $ newIORef 0
r3 <- liftIO $ newIORef emptySamplingStats
r4 <- liftIO $ newIORef emptySamplingStats
s1 <- newSignalSource
s2 <- newSignalSource
s3 <- newSignalSource
return Activity { activityInitState = state,
activityStateRef = r0,
activityProcess = provide,
activityProcessInterruptible = interruptible,
activityTotalUtilisationTimeRef = r1,
activityTotalIdleTimeRef = r2,
activityUtilisationTimeRef = r3,
activityIdleTimeRef = r4,
activityUtilisingSource = s1,
activityUtilisedSource = s2,
activityInterruptedSource = s3 }
activityNet :: Activity s a b -> Net a b
activityNet act = Net $ loop (activityInitState act) Nothing
where
loop s r a =
do t0 <- liftDynamics time
liftEvent $
do case r of
Nothing -> return ()
Just t' ->
liftIO $
do modifyIORef' (activityTotalIdleTimeRef act) (+ (t0 t'))
modifyIORef' (activityIdleTimeRef act) $
addSamplingStats (t0 t')
triggerSignal (activityUtilisingSource act) a
(s', b) <- activityProcess act s a
(s', b) <- if activityProcessInterruptible act
then activityProcessInterrupting act s a
else activityProcess act s a
t1 <- liftDynamics time
liftEvent $
do liftIO $
do writeIORef (activityStateRef act) $! s'
modifyIORef' (activityTotalUtilisationTimeRef act) (+ (t1 t0))
modifyIORef' (activityUtilisationTimeRef act) $
addSamplingStats (t1 t0)
triggerSignal (activityUtilisedSource act) (a, b)
return (b, Net $ loop s' (Just t1))
activityProcessInterrupting :: Activity s a b -> s -> a -> Process (s, b)
activityProcessInterrupting act s a =
do pid <- processId
t0 <- liftDynamics time
finallyProcess
(activityProcess act s a)
(liftEvent $
do cancelled <- processCancelled pid
when cancelled $
do t1 <- liftDynamics time
liftIO $
do modifyIORef' (activityTotalUtilisationTimeRef act) (+ (t1 t0))
modifyIORef' (activityUtilisationTimeRef act) $
addSamplingStats (t1 t0)
let x = ActivityInterruption a t0 t1
triggerSignal (activityInterruptedSource act) x)
activityState :: Activity s a b -> Event s
activityState act =
Event $ \p -> readIORef (activityStateRef act)
activityStateChanged :: Activity s a b -> Signal s
activityStateChanged act =
mapSignalM (const $ activityState act) (activityStateChanged_ act)
activityStateChanged_ :: Activity s a b -> Signal ()
activityStateChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityTotalUtilisationTime :: Activity s a b -> Event Double
activityTotalUtilisationTime act =
Event $ \p -> readIORef (activityTotalUtilisationTimeRef act)
activityTotalUtilisationTimeChanged :: Activity s a b -> Signal Double
activityTotalUtilisationTimeChanged act =
mapSignalM (const $ activityTotalUtilisationTime act) (activityTotalUtilisationTimeChanged_ act)
activityTotalUtilisationTimeChanged_ :: Activity s a b -> Signal ()
activityTotalUtilisationTimeChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityTotalIdleTime :: Activity s a b -> Event Double
activityTotalIdleTime act =
Event $ \p -> readIORef (activityTotalIdleTimeRef act)
activityTotalIdleTimeChanged :: Activity s a b -> Signal Double
activityTotalIdleTimeChanged act =
mapSignalM (const $ activityTotalIdleTime act) (activityTotalIdleTimeChanged_ act)
activityTotalIdleTimeChanged_ :: Activity s a b -> Signal ()
activityTotalIdleTimeChanged_ act =
mapSignal (const ()) (activityUtilising act)
activityUtilisationTime :: Activity s a b -> Event (SamplingStats Double)
activityUtilisationTime act =
Event $ \p -> readIORef (activityUtilisationTimeRef act)
activityUtilisationTimeChanged :: Activity s a b -> Signal (SamplingStats Double)
activityUtilisationTimeChanged act =
mapSignalM (const $ activityUtilisationTime act) (activityUtilisationTimeChanged_ act)
activityUtilisationTimeChanged_ :: Activity s a b -> Signal ()
activityUtilisationTimeChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityIdleTime :: Activity s a b -> Event (SamplingStats Double)
activityIdleTime act =
Event $ \p -> readIORef (activityIdleTimeRef act)
activityIdleTimeChanged :: Activity s a b -> Signal (SamplingStats Double)
activityIdleTimeChanged act =
mapSignalM (const $ activityIdleTime act) (activityIdleTimeChanged_ act)
activityIdleTimeChanged_ :: Activity s a b -> Signal ()
activityIdleTimeChanged_ act =
mapSignal (const ()) (activityUtilising act)
activityUtilisationFactor :: Activity s a b -> Event Double
activityUtilisationFactor act =
Event $ \p ->
do x1 <- readIORef (activityTotalUtilisationTimeRef act)
x2 <- readIORef (activityTotalIdleTimeRef act)
return (x1 / (x1 + x2))
activityUtilisationFactorChanged :: Activity s a b -> Signal Double
activityUtilisationFactorChanged act =
mapSignalM (const $ activityUtilisationFactor act) (activityUtilisationFactorChanged_ act)
activityUtilisationFactorChanged_ :: Activity s a b -> Signal ()
activityUtilisationFactorChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act)
activityIdleFactor :: Activity s a b -> Event Double
activityIdleFactor act =
Event $ \p ->
do x1 <- readIORef (activityTotalUtilisationTimeRef act)
x2 <- readIORef (activityTotalIdleTimeRef act)
return (x2 / (x1 + x2))
activityIdleFactorChanged :: Activity s a b -> Signal Double
activityIdleFactorChanged act =
mapSignalM (const $ activityIdleFactor act) (activityIdleFactorChanged_ act)
activityIdleFactorChanged_ :: Activity s a b -> Signal ()
activityIdleFactorChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act)
activityUtilising :: Activity s a b -> Signal a
activityUtilising = publishSignal . activityUtilisingSource
activityUtilised :: Activity s a b -> Signal (a, b)
activityUtilised = publishSignal . activityUtilisedSource
activityInterrupted :: Activity s a b -> Signal (ActivityInterruption a)
activityInterrupted = publishSignal . activityInterruptedSource
activityChanged_ :: Activity s a b -> Signal ()
activityChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act) <>
mapSignal (const ()) (activityInterrupted act)
activitySummary :: Activity s a b -> Int -> Event ShowS
activitySummary act indent =
Event $ \p ->
do tx1 <- readIORef (activityTotalUtilisationTimeRef act)
tx2 <- readIORef (activityTotalIdleTimeRef act)
let xf1 = tx1 / (tx1 + tx2)
xf2 = tx2 / (tx1 + tx2)
xs1 <- readIORef (activityUtilisationTimeRef act)
xs2 <- readIORef (activityIdleTimeRef act)
let tab = replicate indent ' '
return $
showString tab .
showString "total utilisation time = " . shows tx1 .
showString "\n" .
showString tab .
showString "total idle time = " . shows tx2 .
showString "\n" .
showString tab .
showString "utilisation factor (from 0 to 1) = " . shows xf1 .
showString "\n" .
showString tab .
showString "idle factor (from 0 to 1) = " . shows xf2 .
showString "\n" .
showString tab .
showString "utilisation time (locked while awaiting the input):\n\n" .
samplingStatsSummary xs1 (2 + indent) .
showString "\n\n" .
showString tab .
showString "idle time:\n\n" .
samplingStatsSummary xs2 (2 + indent)