-- |
-- Module     : Simulation.Aivika.GPSS.Storage
-- Copyright  : Copyright (c) 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 GPSS Storage entity.
--
module Simulation.Aivika.GPSS.Storage
       (-- * Storage Type
        Storage,
        -- * Creating Storage
        newStorage,
        -- * Storage Properties
        storageCapacity,
        storageEmpty,
        storageFull,
        storageContent,
        storageContentStats,
        storageUseCount,
        storageUsedContent,
        storageUtilisationCount,
        storageUtilisationCountStats,
        storageQueueCount,
        storageQueueCountStats,
        storageTotalWaitTime,
        storageWaitTime,
        storageAverageHoldingTime,
        -- * Entering-Leaving Storage
        enterStorage,
        leaveStorage,
        leaveStorageWithinEvent,
        -- * Statistics Reset
        resetStorage,
        -- * Signals
        storageContentChanged,
        storageContentChanged_,
        storageUseCountChanged,
        storageUseCountChanged_,
        storageUsedContentChanged,
        storageUsedContentChanged_,
        storageUtilisationCountChanged,
        storageUtilisationCountChanged_,
        storageQueueCountChanged,
        storageQueueCountChanged_,
        storageWaitTimeChanged,
        storageWaitTimeChanged_,
        storageChanged_) where

import Data.IORef
import Data.Monoid
import Data.Maybe

import Control.Monad
import Control.Monad.Trans
import Control.Exception

import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Cont
import Simulation.Aivika.Internal.Process
import Simulation.Aivika.QueueStrategy
import Simulation.Aivika.Statistics
import Simulation.Aivika.Signal

import Simulation.Aivika.GPSS.Transact
import Simulation.Aivika.GPSS.TransactQueueStrategy

-- | Represents a GPSS Storage entity.
data Storage = 
  Storage { Storage -> Int
storageCapacity :: Int,
            -- ^ Return the storage capacity.
            Storage -> IORef Int
storageContentRef :: IORef Int,
            Storage -> IORef (TimingStats Int)
storageContentStatsRef :: IORef (TimingStats Int),
            Storage -> SignalSource Int
storageContentSource :: SignalSource Int,
            Storage -> IORef Int
storageUseCountRef :: IORef Int,
            Storage -> SignalSource Int
storageUseCountSource :: SignalSource Int,
            Storage -> IORef Int
storageUsedContentRef :: IORef Int,
            Storage -> SignalSource Int
storageUsedContentSource :: SignalSource Int,
            Storage -> IORef Int
storageUtilisationCountRef :: IORef Int,
            Storage -> IORef (TimingStats Int)
storageUtilisationCountStatsRef :: IORef (TimingStats Int),
            Storage -> SignalSource Int
storageUtilisationCountSource :: SignalSource Int,
            Storage -> IORef Int
storageQueueCountRef :: IORef Int,
            Storage -> IORef (TimingStats Int)
storageQueueCountStatsRef :: IORef (TimingStats Int),
            Storage -> SignalSource Int
storageQueueCountSource :: SignalSource Int,
            Storage -> IORef Double
storageTotalWaitTimeRef :: IORef Double,
            Storage -> IORef (SamplingStats Double)
storageWaitTimeRef :: IORef (SamplingStats Double),
            Storage -> SignalSource ()
storageWaitTimeSource :: SignalSource (),
            Storage
-> StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
storageDelayChain :: StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem }

-- | Identifies an item that was delayed.
data StorageDelayedItem =
  StorageDelayedItem { StorageDelayedItem -> Double
delayedItemTime :: Double,
                       StorageDelayedItem -> Int
delayedItemDecrement :: Int,
                       StorageDelayedItem -> FrozenCont ()
delayedItemCont :: FrozenCont () }

instance Eq Storage where
  Storage
x == :: Storage -> Storage -> Bool
== Storage
y = Storage -> IORef Int
storageContentRef Storage
x IORef Int -> IORef Int -> Bool
forall a. Eq a => a -> a -> Bool
== Storage -> IORef Int
storageContentRef Storage
y  -- unique references

-- | Create a new storage by the specified capacity.
newStorage :: Int -> Event Storage
newStorage :: Int -> Event Storage
newStorage Int
capacity =
  (Point -> IO Storage) -> Event Storage
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Storage) -> Event Storage)
-> (Point -> IO Storage) -> Event Storage
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let r :: Run
r = Point -> Run
pointRun Point
p
         t :: Double
t = Point -> Double
pointTime Point
p
     IORef Int
contentRef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
capacity
     IORef (TimingStats Int)
contentStatsRef <- TimingStats Int -> IO (IORef (TimingStats Int))
forall a. a -> IO (IORef a)
newIORef (TimingStats Int -> IO (IORef (TimingStats Int)))
-> TimingStats Int -> IO (IORef (TimingStats Int))
forall a b. (a -> b) -> a -> b
$ Double -> Int -> TimingStats Int
forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
capacity
     SignalSource Int
contentSource <- Run -> Simulation (SignalSource Int) -> IO (SignalSource Int)
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource Int)
forall a. Simulation (SignalSource a)
newSignalSource
     IORef Int
useCountRef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     SignalSource Int
useCountSource <- Run -> Simulation (SignalSource Int) -> IO (SignalSource Int)
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource Int)
forall a. Simulation (SignalSource a)
newSignalSource
     IORef Int
usedContentRef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     SignalSource Int
usedContentSource <- Run -> Simulation (SignalSource Int) -> IO (SignalSource Int)
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource Int)
forall a. Simulation (SignalSource a)
newSignalSource
     IORef Int
utilCountRef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     IORef (TimingStats Int)
utilCountStatsRef <- TimingStats Int -> IO (IORef (TimingStats Int))
forall a. a -> IO (IORef a)
newIORef (TimingStats Int -> IO (IORef (TimingStats Int)))
-> TimingStats Int -> IO (IORef (TimingStats Int))
forall a b. (a -> b) -> a -> b
$ Double -> Int -> TimingStats Int
forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
0
     SignalSource Int
utilCountSource <- Run -> Simulation (SignalSource Int) -> IO (SignalSource Int)
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource Int)
forall a. Simulation (SignalSource a)
newSignalSource
     IORef Int
queueCountRef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     IORef (TimingStats Int)
queueCountStatsRef <- TimingStats Int -> IO (IORef (TimingStats Int))
forall a. a -> IO (IORef a)
newIORef (TimingStats Int -> IO (IORef (TimingStats Int)))
-> TimingStats Int -> IO (IORef (TimingStats Int))
forall a b. (a -> b) -> a -> b
$ Double -> Int -> TimingStats Int
forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
0
     SignalSource Int
queueCountSource <- Run -> Simulation (SignalSource Int) -> IO (SignalSource Int)
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource Int)
forall a. Simulation (SignalSource a)
newSignalSource
     IORef Double
totalWaitTimeRef <- Double -> IO (IORef Double)
forall a. a -> IO (IORef a)
newIORef Double
0
     IORef (SamplingStats Double)
waitTimeRef <- SamplingStats Double -> IO (IORef (SamplingStats Double))
forall a. a -> IO (IORef a)
newIORef SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
     SignalSource ()
waitTimeSource <- Run -> Simulation (SignalSource ()) -> IO (SignalSource ())
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource ())
forall a. Simulation (SignalSource a)
newSignalSource
     StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
delayChain <- Run
-> Simulation
     (StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem)
-> IO
     (StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem)
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r (Simulation
   (StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem)
 -> IO
      (StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem))
-> Simulation
     (StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem)
-> IO
     (StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem)
forall a b. (a -> b) -> a -> b
$ TransactQueueStrategy FCFS
-> Simulation
     (StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem)
forall s i. QueueStrategy s => s -> Simulation (StrategyQueue s i)
newStrategyQueue (FCFS -> TransactQueueStrategy FCFS
forall s. s -> TransactQueueStrategy s
TransactQueueStrategy FCFS
FCFS)
     Storage -> IO Storage
forall (m :: * -> *) a. Monad m => a -> m a
return Storage :: Int
-> IORef Int
-> IORef (TimingStats Int)
-> SignalSource Int
-> IORef Int
-> SignalSource Int
-> IORef Int
-> SignalSource Int
-> IORef Int
-> IORef (TimingStats Int)
-> SignalSource Int
-> IORef Int
-> IORef (TimingStats Int)
-> SignalSource Int
-> IORef Double
-> IORef (SamplingStats Double)
-> SignalSource ()
-> StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
-> Storage
Storage { storageCapacity :: Int
storageCapacity = Int
capacity,
                      storageContentRef :: IORef Int
storageContentRef = IORef Int
contentRef,
                      storageContentStatsRef :: IORef (TimingStats Int)
storageContentStatsRef = IORef (TimingStats Int)
contentStatsRef,
                      storageContentSource :: SignalSource Int
storageContentSource = SignalSource Int
contentSource,
                      storageUseCountRef :: IORef Int
storageUseCountRef = IORef Int
useCountRef,
                      storageUseCountSource :: SignalSource Int
storageUseCountSource = SignalSource Int
useCountSource,
                      storageUsedContentRef :: IORef Int
storageUsedContentRef = IORef Int
usedContentRef,
                      storageUsedContentSource :: SignalSource Int
storageUsedContentSource = SignalSource Int
usedContentSource,
                      storageUtilisationCountRef :: IORef Int
storageUtilisationCountRef = IORef Int
utilCountRef,
                      storageUtilisationCountStatsRef :: IORef (TimingStats Int)
storageUtilisationCountStatsRef = IORef (TimingStats Int)
utilCountStatsRef,
                      storageUtilisationCountSource :: SignalSource Int
storageUtilisationCountSource = SignalSource Int
utilCountSource,
                      storageQueueCountRef :: IORef Int
storageQueueCountRef = IORef Int
queueCountRef,
                      storageQueueCountStatsRef :: IORef (TimingStats Int)
storageQueueCountStatsRef = IORef (TimingStats Int)
queueCountStatsRef,
                      storageQueueCountSource :: SignalSource Int
storageQueueCountSource = SignalSource Int
queueCountSource,
                      storageTotalWaitTimeRef :: IORef Double
storageTotalWaitTimeRef = IORef Double
totalWaitTimeRef,
                      storageWaitTimeRef :: IORef (SamplingStats Double)
storageWaitTimeRef = IORef (SamplingStats Double)
waitTimeRef,
                      storageWaitTimeSource :: SignalSource ()
storageWaitTimeSource = SignalSource ()
waitTimeSource,
                      storageDelayChain :: StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
storageDelayChain = StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
delayChain }

-- | Whether the storage is empty, i.e. completely unused.
storageEmpty :: Storage -> Event Bool
storageEmpty :: Storage -> Event Bool
storageEmpty Storage
r =
  (Point -> IO Bool) -> Event Bool
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Bool) -> Event Bool)
-> (Point -> IO Bool) -> Event Bool
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
n <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Storage -> Int
storageCapacity Storage
r)

-- | Whether the storage is full, i.e. completely used.
storageFull :: Storage -> Event Bool
storageFull :: Storage -> Event Bool
storageFull Storage
r =
  (Point -> IO Bool) -> Event Bool
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Bool) -> Event Bool)
-> (Point -> IO Bool) -> Event Bool
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
n <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)

-- | Return the current storage content available for use.
storageContent :: Storage -> Event Int
storageContent :: Storage -> Event Int
storageContent Storage
r =
  (Point -> IO Int) -> Event Int
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Int) -> Event Int) -> (Point -> IO Int) -> Event Int
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)

-- | Return the statistics of the storage content available for use.
storageContentStats :: Storage -> Event (TimingStats Int)
storageContentStats :: Storage -> Event (TimingStats Int)
storageContentStats Storage
r =
  (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (TimingStats Int)) -> Event (TimingStats Int))
-> (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (TimingStats Int) -> IO (TimingStats Int)
forall a. IORef a -> IO a
readIORef (Storage -> IORef (TimingStats Int)
storageContentStatsRef Storage
r)

-- | Signal triggered when the 'storageContent' property changes.
storageContentChanged :: Storage -> Signal Int
storageContentChanged :: Storage -> Signal Int
storageContentChanged Storage
r =
  SignalSource Int -> Signal Int
forall a. SignalSource a -> Signal a
publishSignal (SignalSource Int -> Signal Int) -> SignalSource Int -> Signal Int
forall a b. (a -> b) -> a -> b
$ Storage -> SignalSource Int
storageContentSource Storage
r

-- | Signal triggered when the 'storageContent' property changes.
storageContentChanged_ :: Storage -> Signal ()
storageContentChanged_ :: Storage -> Signal ()
storageContentChanged_ Storage
r =
  (Int -> ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> Int -> ()
forall a b. a -> b -> a
const ()) (Signal Int -> Signal ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> a -> b
$ Storage -> Signal Int
storageContentChanged Storage
r

-- | Return the total use count of the storage.
storageUseCount :: Storage -> Event Int
storageUseCount :: Storage -> Event Int
storageUseCount Storage
r =
  (Point -> IO Int) -> Event Int
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Int) -> Event Int) -> (Point -> IO Int) -> Event Int
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUseCountRef Storage
r)

-- | Signal triggered when the 'storageUseCount' property changes.
storageUseCountChanged :: Storage -> Signal Int
storageUseCountChanged :: Storage -> Signal Int
storageUseCountChanged Storage
r =
  SignalSource Int -> Signal Int
forall a. SignalSource a -> Signal a
publishSignal (SignalSource Int -> Signal Int) -> SignalSource Int -> Signal Int
forall a b. (a -> b) -> a -> b
$ Storage -> SignalSource Int
storageUseCountSource Storage
r

-- | Signal triggered when the 'storageUseCount' property changes.
storageUseCountChanged_ :: Storage -> Signal ()
storageUseCountChanged_ :: Storage -> Signal ()
storageUseCountChanged_ Storage
r =
  (Int -> ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> Int -> ()
forall a b. a -> b -> a
const ()) (Signal Int -> Signal ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> a -> b
$ Storage -> Signal Int
storageUseCountChanged Storage
r

-- | Return the total used content of the storage.
storageUsedContent :: Storage -> Event Int
storageUsedContent :: Storage -> Event Int
storageUsedContent Storage
r =
  (Point -> IO Int) -> Event Int
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Int) -> Event Int) -> (Point -> IO Int) -> Event Int
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUsedContentRef Storage
r)

-- | Signal triggered when the 'storageUsedContent' property changes.
storageUsedContentChanged :: Storage -> Signal Int
storageUsedContentChanged :: Storage -> Signal Int
storageUsedContentChanged Storage
r =
  SignalSource Int -> Signal Int
forall a. SignalSource a -> Signal a
publishSignal (SignalSource Int -> Signal Int) -> SignalSource Int -> Signal Int
forall a b. (a -> b) -> a -> b
$ Storage -> SignalSource Int
storageUsedContentSource Storage
r

-- | Signal triggered when the 'storageUsedContent' property changes.
storageUsedContentChanged_ :: Storage -> Signal ()
storageUsedContentChanged_ :: Storage -> Signal ()
storageUsedContentChanged_ Storage
r =
  (Int -> ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> Int -> ()
forall a b. a -> b -> a
const ()) (Signal Int -> Signal ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> a -> b
$ Storage -> Signal Int
storageUsedContentChanged Storage
r

-- | Return the current utilisation count of the storage.
storageUtilisationCount :: Storage -> Event Int
storageUtilisationCount :: Storage -> Event Int
storageUtilisationCount Storage
r =
  (Point -> IO Int) -> Event Int
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Int) -> Event Int) -> (Point -> IO Int) -> Event Int
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUtilisationCountRef Storage
r)

-- | Return the statistics for the utilisation count of the storage.
storageUtilisationCountStats :: Storage -> Event (TimingStats Int)
storageUtilisationCountStats :: Storage -> Event (TimingStats Int)
storageUtilisationCountStats Storage
r =
  (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (TimingStats Int)) -> Event (TimingStats Int))
-> (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (TimingStats Int) -> IO (TimingStats Int)
forall a. IORef a -> IO a
readIORef (Storage -> IORef (TimingStats Int)
storageUtilisationCountStatsRef Storage
r)

-- | Signal triggered when the 'storageUtilisationCount' property changes.
storageUtilisationCountChanged :: Storage -> Signal Int
storageUtilisationCountChanged :: Storage -> Signal Int
storageUtilisationCountChanged Storage
r =
  SignalSource Int -> Signal Int
forall a. SignalSource a -> Signal a
publishSignal (SignalSource Int -> Signal Int) -> SignalSource Int -> Signal Int
forall a b. (a -> b) -> a -> b
$ Storage -> SignalSource Int
storageUtilisationCountSource Storage
r

-- | Signal triggered when the 'storageUtilisationCount' property changes.
storageUtilisationCountChanged_ :: Storage -> Signal ()
storageUtilisationCountChanged_ :: Storage -> Signal ()
storageUtilisationCountChanged_ Storage
r =
  (Int -> ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> Int -> ()
forall a b. a -> b -> a
const ()) (Signal Int -> Signal ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> a -> b
$ Storage -> Signal Int
storageUtilisationCountChanged Storage
r

-- | Return the current queue length of the storage.
storageQueueCount :: Storage -> Event Int
storageQueueCount :: Storage -> Event Int
storageQueueCount Storage
r =
  (Point -> IO Int) -> Event Int
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Int) -> Event Int) -> (Point -> IO Int) -> Event Int
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageQueueCountRef Storage
r)

-- | Return the statistics for the queue length of the storage.
storageQueueCountStats :: Storage -> Event (TimingStats Int)
storageQueueCountStats :: Storage -> Event (TimingStats Int)
storageQueueCountStats Storage
r =
  (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (TimingStats Int)) -> Event (TimingStats Int))
-> (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (TimingStats Int) -> IO (TimingStats Int)
forall a. IORef a -> IO a
readIORef (Storage -> IORef (TimingStats Int)
storageQueueCountStatsRef Storage
r)

-- | Signal triggered when the 'storageQueueCount' property changes.
storageQueueCountChanged :: Storage -> Signal Int
storageQueueCountChanged :: Storage -> Signal Int
storageQueueCountChanged Storage
r =
  SignalSource Int -> Signal Int
forall a. SignalSource a -> Signal a
publishSignal (SignalSource Int -> Signal Int) -> SignalSource Int -> Signal Int
forall a b. (a -> b) -> a -> b
$ Storage -> SignalSource Int
storageQueueCountSource Storage
r

-- | Signal triggered when the 'storageQueueCount' property changes.
storageQueueCountChanged_ :: Storage -> Signal ()
storageQueueCountChanged_ :: Storage -> Signal ()
storageQueueCountChanged_ Storage
r =
  (Int -> ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> Int -> ()
forall a b. a -> b -> a
const ()) (Signal Int -> Signal ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> a -> b
$ Storage -> Signal Int
storageQueueCountChanged Storage
r

-- | Return the total wait time of the storage.
storageTotalWaitTime :: Storage -> Event Double
storageTotalWaitTime :: Storage -> Event Double
storageTotalWaitTime Storage
r =
  (Point -> IO Double) -> Event Double
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Double) -> Event Double)
-> (Point -> IO Double) -> Event Double
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Storage -> IORef Double
storageTotalWaitTimeRef Storage
r)

-- | Return the statistics for the wait time of the storage.
storageWaitTime :: Storage -> Event (SamplingStats Double)
storageWaitTime :: Storage -> Event (SamplingStats Double)
storageWaitTime Storage
r =
  (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (SamplingStats Double))
 -> Event (SamplingStats Double))
-> (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Storage -> IORef (SamplingStats Double)
storageWaitTimeRef Storage
r)

-- | Signal triggered when the 'storageTotalWaitTime' and 'storageWaitTime' properties change.
storageWaitTimeChanged :: Storage -> Signal (SamplingStats Double)
storageWaitTimeChanged :: Storage -> Signal (SamplingStats Double)
storageWaitTimeChanged Storage
r =
  (() -> Event (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (\() -> Storage -> Event (SamplingStats Double)
storageWaitTime Storage
r) (Signal () -> Signal (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ Storage -> Signal ()
storageWaitTimeChanged_ Storage
r

-- | Signal triggered when the 'storageTotalWaitTime' and 'storageWaitTime' properties change.
storageWaitTimeChanged_ :: Storage -> Signal ()
storageWaitTimeChanged_ :: Storage -> Signal ()
storageWaitTimeChanged_ Storage
r =
  SignalSource () -> Signal ()
forall a. SignalSource a -> Signal a
publishSignal (SignalSource () -> Signal ()) -> SignalSource () -> Signal ()
forall a b. (a -> b) -> a -> b
$ Storage -> SignalSource ()
storageWaitTimeSource Storage
r

-- | Return the average holding time per unit.
storageAverageHoldingTime :: Storage -> Event Double
storageAverageHoldingTime :: Storage -> Event Double
storageAverageHoldingTime Storage
r =
  (Point -> IO Double) -> Event Double
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Double) -> Event Double)
-> (Point -> IO Double) -> Event Double
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do TimingStats Int
s <- IORef (TimingStats Int) -> IO (TimingStats Int)
forall a. IORef a -> IO a
readIORef (Storage -> IORef (TimingStats Int)
storageUtilisationCountStatsRef Storage
r)
     Int
n <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUtilisationCountRef Storage
r)
     Int
m <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUsedContentRef Storage
r)
     let t :: Double
t  = Point -> Double
pointTime Point
p
         s' :: TimingStats Int
s' = Double -> Int -> TimingStats Int -> TimingStats Int
forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats Double
t Int
n TimingStats Int
s
         k :: Double
k  = TimingStats Int -> Double
forall a. TimingStats a -> Double
timingStatsSum TimingStats Int
s' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Int -> Rational
forall a. Real a => a -> Rational
toRational Int
m)
     Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
k

-- | Enter the storage.
enterStorage :: Storage
                -- ^ the requested storage
                -> Transact a
                -- ^ a transact that makes the request
                -> Int
                -- ^ the content decrement
                -> Process ()
enterStorage :: Storage -> Transact a -> Int -> Process ()
enterStorage Storage
r Transact a
transact Int
decrement =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  (ContParams () -> Event ()) -> Cont ()
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams () -> Event ()) -> Cont ())
-> (ContParams () -> Event ()) -> Cont ()
forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Bool
f <- Point -> Event Bool -> IO Bool
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event Bool -> IO Bool) -> Event Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
-> Event Bool
forall s i. QueueStrategy s => StrategyQueue s i -> Event Bool
strategyQueueNull (Storage
-> StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
storageDelayChain Storage
r)
     if Bool
f
       then Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
            ContParams () -> Cont () -> Event ()
forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c (Cont () -> Event ()) -> Cont () -> Event ()
forall a b. (a -> b) -> a -> b
$
            ProcessId -> Process () -> Cont ()
forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid (Process () -> Cont ()) -> Process () -> Cont ()
forall a b. (a -> b) -> a -> b
$
            Storage -> Transact a -> Int -> Process ()
forall a. Storage -> Transact a -> Int -> Process ()
enterStorage' Storage
r Transact a
transact Int
decrement
       else do FrozenCont ()
c <- Point -> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (FrozenCont ()) -> IO (FrozenCont ()))
-> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                    ContParams () -> () -> Event () -> Event (FrozenCont ())
forall a. ContParams a -> a -> Event () -> Event (FrozenCont a)
freezeContReentering ContParams ()
c () (Event () -> Event (FrozenCont ()))
-> Event () -> Event (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                    ContParams () -> Cont () -> Event ()
forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c (Cont () -> Event ()) -> Cont () -> Event ()
forall a b. (a -> b) -> a -> b
$
                    ProcessId -> Process () -> Cont ()
forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid (Process () -> Cont ()) -> Process () -> Cont ()
forall a b. (a -> b) -> a -> b
$
                    Storage -> Transact a -> Int -> Process ()
forall a. Storage -> Transact a -> Int -> Process ()
enterStorage Storage
r Transact a
transact Int
decrement
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
                 StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
-> Int -> StorageDelayedItem -> Event ()
forall s p i.
PriorityQueueStrategy s p =>
StrategyQueue s i -> p -> i -> Event ()
strategyEnqueueWithPriority
                 (Storage
-> StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
storageDelayChain Storage
r)
                 (Transact a -> Int
forall a. Transact a -> Int
transactPriority Transact a
transact)
                 (Double -> Int -> FrozenCont () -> StorageDelayedItem
StorageDelayedItem Double
t Int
decrement FrozenCont ()
c)
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageQueueCount Storage
r Int
1
               
-- | Enter the storage.
enterStorage' :: Storage
                 -- ^ the requested storage
                 -> Transact a
                 -- ^ a transact that makes the request
                 -> Int
                 -- ^ the content decrement
                 -> Process ()
enterStorage' :: Storage -> Transact a -> Int -> Process ()
enterStorage' Storage
r Transact a
transact Int
decrement =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  (ContParams () -> Event ()) -> Cont ()
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams () -> Event ()) -> Cont ())
-> (ContParams () -> Event ()) -> Cont ()
forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     if Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
decrement
       then do FrozenCont ()
c <- Point -> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (FrozenCont ()) -> IO (FrozenCont ()))
-> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                    ContParams () -> () -> Event () -> Event (FrozenCont ())
forall a. ContParams a -> a -> Event () -> Event (FrozenCont a)
freezeContReentering ContParams ()
c () (Event () -> Event (FrozenCont ()))
-> Event () -> Event (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                    ContParams () -> Cont () -> Event ()
forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c (Cont () -> Event ()) -> Cont () -> Event ()
forall a b. (a -> b) -> a -> b
$
                    ProcessId -> Process () -> Cont ()
forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid (Process () -> Cont ()) -> Process () -> Cont ()
forall a b. (a -> b) -> a -> b
$
                    Storage -> Transact a -> Int -> Process ()
forall a. Storage -> Transact a -> Int -> Process ()
enterStorage Storage
r Transact a
transact Int
decrement
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
                 StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
-> Int -> StorageDelayedItem -> Event ()
forall s p i.
PriorityQueueStrategy s p =>
StrategyQueue s i -> p -> i -> Event ()
strategyEnqueueWithPriority
                 (Storage
-> StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
storageDelayChain Storage
r)
                 (Transact a -> Int
forall a. Transact a -> Int
transactPriority Transact a
transact)
                 (Double -> Int -> FrozenCont () -> StorageDelayedItem
StorageDelayedItem Double
t Int
decrement FrozenCont ()
c)
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageQueueCount Storage
r Int
1
       else do Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Double -> Event ()
updateStorageWaitTime Storage
r Double
0
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageContent Storage
r (- Int
decrement)
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUseCount Storage
r Int
1
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUsedContent Storage
r Int
decrement
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUtilisationCount Storage
r Int
decrement
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()

-- | Leave the storage.
leaveStorage :: Storage
                -- ^ the storage to leave
                -> Int
                -- ^ the content increment
                -> Process ()
leaveStorage :: Storage -> Int -> Process ()
leaveStorage Storage
r Int
increment =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
_ ->
  (ContParams () -> Event ()) -> Cont ()
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams () -> Event ()) -> Cont ())
-> (ContParams () -> Event ()) -> Cont ()
forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
leaveStorageWithinEvent Storage
r Int
increment
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()

-- | Leave the storage.
leaveStorageWithinEvent :: Storage
                           -- ^ the storage to leave
                           -> Int
                           -- ^ the content increment
                           -> Event ()
leaveStorageWithinEvent :: Storage -> Int -> Event ()
leaveStorageWithinEvent Storage
r Int
increment =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUtilisationCount Storage
r (- Int
increment)
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageContent Storage
r Int
increment
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Event () -> Event ()
enqueueEvent Double
t (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ Storage -> Event ()
tryEnterStorage Storage
r

-- | Try to enter the storage.
tryEnterStorage :: Storage -> Event ()
tryEnterStorage :: Storage -> Event ()
tryEnterStorage Storage
r =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     if Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
       then Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Event ()
letEnterStorage Storage
r
       else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Let enter the storage.
letEnterStorage :: Storage -> Event ()
letEnterStorage :: Storage -> Event ()
letEnterStorage Storage
r =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Storage -> Int
storageCapacity Storage
r) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SimulationRetry -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
forall a b. (a -> b) -> a -> b
$
       String -> SimulationRetry
SimulationRetry (String -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
       String
"The storage content cannot exceed the limited capacity: leaveStorage'"
     Maybe StorageDelayedItem
x <- Point
-> Event (Maybe StorageDelayedItem)
-> IO (Maybe StorageDelayedItem)
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (Maybe StorageDelayedItem) -> IO (Maybe StorageDelayedItem))
-> Event (Maybe StorageDelayedItem)
-> IO (Maybe StorageDelayedItem)
forall a b. (a -> b) -> a -> b
$
          StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
-> (StorageDelayedItem -> Bool) -> Event (Maybe StorageDelayedItem)
forall s i.
DeletingQueueStrategy s =>
StrategyQueue s i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy
          (Storage
-> StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
storageDelayChain Storage
r)
          (\StorageDelayedItem
i -> StorageDelayedItem -> Int
delayedItemDecrement StorageDelayedItem
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
a)
     case Maybe StorageDelayedItem
x of
       Maybe StorageDelayedItem
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just (StorageDelayedItem Double
t0 Int
decrement0 FrozenCont ()
c0) ->
         do Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageQueueCount Storage
r (-Int
1)
            Maybe (ContParams ())
c <- Point
-> Event (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (Maybe (ContParams ())) -> IO (Maybe (ContParams ())))
-> Event (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a b. (a -> b) -> a -> b
$ FrozenCont () -> Event (Maybe (ContParams ()))
forall a. FrozenCont a -> Event (Maybe (ContParams a))
unfreezeCont FrozenCont ()
c0
            case Maybe (ContParams ())
c of
              Maybe (ContParams ())
Nothing ->
                Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Event ()
letEnterStorage Storage
r
              Just ContParams ()
c ->
                do Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageContent Storage
r (- Int
decrement0)
                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Double -> Event ()
updateStorageWaitTime Storage
r (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0)
                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUtilisationCount Storage
r Int
decrement0
                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUseCount Storage
r Int
1
                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUsedContent Storage
r Int
decrement0
                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Event () -> Event ()
enqueueEvent Double
t (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
reenterCont ContParams ()
c ()

-- | Signal triggered when one of the storage counters changes.
storageChanged_ :: Storage -> Signal ()
storageChanged_ :: Storage -> Signal ()
storageChanged_ Storage
r =
  Storage -> Signal ()
storageContentChanged_ Storage
r Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  Storage -> Signal ()
storageUsedContentChanged_ Storage
r Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  Storage -> Signal ()
storageUtilisationCountChanged_ Storage
r Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  Storage -> Signal ()
storageQueueCountChanged_ Storage
r

-- | Update the storage content and its statistics.
updateStorageContent :: Storage -> Int -> Event ()
updateStorageContent :: Storage -> Int -> Event ()
updateStorageContent Storage
r Int
delta =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' Int -> IO () -> IO ()
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageContentRef Storage
r) Int
a'
     IORef (TimingStats Int)
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Storage -> IORef (TimingStats Int)
storageContentStatsRef Storage
r) ((TimingStats Int -> TimingStats Int) -> IO ())
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a b. (a -> b) -> a -> b
$
       Double -> Int -> TimingStats Int -> TimingStats Int
forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (Point -> Double
pointTime Point
p) Int
a'
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Storage -> SignalSource Int
storageContentSource Storage
r) Int
a'

-- | Update the storage use count.
updateStorageUseCount :: Storage -> Int -> Event ()
updateStorageUseCount :: Storage -> Int -> Event ()
updateStorageUseCount Storage
r Int
delta =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUseCountRef Storage
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' Int -> IO () -> IO ()
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageUseCountRef Storage
r) Int
a'
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Storage -> SignalSource Int
storageUseCountSource Storage
r) Int
a'

-- | Update the storage used content.
updateStorageUsedContent :: Storage -> Int -> Event ()
updateStorageUsedContent :: Storage -> Int -> Event ()
updateStorageUsedContent Storage
r Int
delta =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUsedContentRef Storage
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' Int -> IO () -> IO ()
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageUsedContentRef Storage
r) Int
a'
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Storage -> SignalSource Int
storageUsedContentSource Storage
r) Int
a'

-- | Update the storage queue length and its statistics.
updateStorageQueueCount :: Storage -> Int -> Event ()
updateStorageQueueCount :: Storage -> Int -> Event ()
updateStorageQueueCount Storage
r Int
delta =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageQueueCountRef Storage
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' Int -> IO () -> IO ()
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageQueueCountRef Storage
r) Int
a'
     IORef (TimingStats Int)
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Storage -> IORef (TimingStats Int)
storageQueueCountStatsRef Storage
r) ((TimingStats Int -> TimingStats Int) -> IO ())
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a b. (a -> b) -> a -> b
$
       Double -> Int -> TimingStats Int -> TimingStats Int
forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (Point -> Double
pointTime Point
p) Int
a'
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Storage -> SignalSource Int
storageQueueCountSource Storage
r) Int
a'

-- | Update the storage utilisation count and its statistics.
updateStorageUtilisationCount :: Storage -> Int -> Event ()
updateStorageUtilisationCount :: Storage -> Int -> Event ()
updateStorageUtilisationCount Storage
r Int
delta =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUtilisationCountRef Storage
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' Int -> IO () -> IO ()
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageUtilisationCountRef Storage
r) Int
a'
     IORef (TimingStats Int)
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Storage -> IORef (TimingStats Int)
storageUtilisationCountStatsRef Storage
r) ((TimingStats Int -> TimingStats Int) -> IO ())
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a b. (a -> b) -> a -> b
$
       Double -> Int -> TimingStats Int -> TimingStats Int
forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (Point -> Double
pointTime Point
p) Int
a'
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Storage -> SignalSource Int
storageUtilisationCountSource Storage
r) Int
a'

-- | Update the storage wait time and its statistics.
updateStorageWaitTime :: Storage -> Double -> Event ()
updateStorageWaitTime :: Storage -> Double -> Event ()
updateStorageWaitTime Storage
r Double
delta =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Double
a <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Storage -> IORef Double
storageTotalWaitTimeRef Storage
r)
     let a' :: Double
a' = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
delta
     Double
a' Double -> IO () -> IO ()
`seq` IORef Double -> Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Double
storageTotalWaitTimeRef Storage
r) Double
a'
     IORef (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Storage -> IORef (SamplingStats Double)
storageWaitTimeRef Storage
r) ((SamplingStats Double -> SamplingStats Double) -> IO ())
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a b. (a -> b) -> a -> b
$
       Double -> SamplingStats Double -> SamplingStats Double
forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats Double
delta
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource () -> () -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Storage -> SignalSource ()
storageWaitTimeSource Storage
r) ()

-- | Reset the statistics.
resetStorage :: Storage -> Event ()
resetStorage :: Storage -> Event ()
resetStorage Storage
r =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Int
content <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     IORef (TimingStats Int) -> TimingStats Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef (TimingStats Int)
storageContentStatsRef Storage
r) (TimingStats Int -> IO ()) -> TimingStats Int -> IO ()
forall a b. (a -> b) -> a -> b
$
       Double -> Int -> TimingStats Int
forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
content
     IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageUseCountRef Storage
r) Int
0
     let usedContent :: Int
usedContent = Storage -> Int
storageCapacity Storage
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
content
     IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageUsedContentRef Storage
r) Int
usedContent
     Int
utilCount <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUtilisationCountRef Storage
r)
     IORef (TimingStats Int) -> TimingStats Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef (TimingStats Int)
storageUtilisationCountStatsRef Storage
r) (TimingStats Int -> IO ()) -> TimingStats Int -> IO ()
forall a b. (a -> b) -> a -> b
$
       Double -> Int -> TimingStats Int
forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
utilCount
     Int
queueCount <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageQueueCountRef Storage
r)
     IORef (TimingStats Int) -> TimingStats Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef (TimingStats Int)
storageQueueCountStatsRef Storage
r) (TimingStats Int -> IO ()) -> TimingStats Int -> IO ()
forall a b. (a -> b) -> a -> b
$
       Double -> Int -> TimingStats Int
forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
queueCount
     IORef Double -> Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Double
storageTotalWaitTimeRef Storage
r) Double
0
     IORef (SamplingStats Double) -> SamplingStats Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef (SamplingStats Double)
storageWaitTimeRef Storage
r) SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Storage -> SignalSource Int
storageUseCountSource Storage
r) Int
0
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Storage -> SignalSource Int
storageUsedContentSource Storage
r) Int
usedContent
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Storage -> SignalSource Int
storageUtilisationCountSource Storage
r) Int
utilCount
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource () -> () -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Storage -> SignalSource ()
storageWaitTimeSource Storage
r) ()