-- |
-- 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 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 =
  forall a. (Point -> IO a) -> Event a
Event 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 <- forall a. a -> IO (IORef a)
newIORef Int
capacity
     IORef (TimingStats Int)
contentStatsRef <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
capacity
     SignalSource Int
contentSource <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r forall a. Simulation (SignalSource a)
newSignalSource
     IORef Int
useCountRef <- forall a. a -> IO (IORef a)
newIORef Int
0
     SignalSource Int
useCountSource <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r forall a. Simulation (SignalSource a)
newSignalSource
     IORef Int
usedContentRef <- forall a. a -> IO (IORef a)
newIORef Int
0
     SignalSource Int
usedContentSource <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r forall a. Simulation (SignalSource a)
newSignalSource
     IORef Int
utilCountRef <- forall a. a -> IO (IORef a)
newIORef Int
0
     IORef (TimingStats Int)
utilCountStatsRef <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
0
     SignalSource Int
utilCountSource <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r forall a. Simulation (SignalSource a)
newSignalSource
     IORef Int
queueCountRef <- forall a. a -> IO (IORef a)
newIORef Int
0
     IORef (TimingStats Int)
queueCountStatsRef <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
0
     SignalSource Int
queueCountSource <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r forall a. Simulation (SignalSource a)
newSignalSource
     IORef Double
totalWaitTimeRef <- forall a. a -> IO (IORef a)
newIORef Double
0
     IORef (SamplingStats Double)
waitTimeRef <- forall a. a -> IO (IORef a)
newIORef forall a. SamplingData a => SamplingStats a
emptySamplingStats
     SignalSource ()
waitTimeSource <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r forall a. Simulation (SignalSource a)
newSignalSource
     StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
delayChain <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r forall a b. (a -> b) -> a -> b
$ forall s i. QueueStrategy s => s -> Simulation (StrategyQueue s i)
newStrategyQueue (forall s. s -> TransactQueueStrategy s
TransactQueueStrategy FCFS
FCFS)
     forall (m :: * -> *) a. Monad m => a -> m a
return 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
n <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
n <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> 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 =
  forall a. SignalSource a -> Signal a
publishSignal 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 =
  forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> 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 =
  forall a. SignalSource a -> Signal a
publishSignal 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 =
  forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> 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 =
  forall a. SignalSource a -> Signal a
publishSignal 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 =
  forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> 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 =
  forall a. SignalSource a -> Signal a
publishSignal 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 =
  forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> 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 =
  forall a. SignalSource a -> Signal a
publishSignal 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 =
  forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> 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 =
  forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (\() -> Storage -> Event (SamplingStats Double)
storageWaitTime Storage
r) 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 =
  forall a. SignalSource a -> Signal a
publishSignal 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do TimingStats Int
s <- forall a. IORef a -> IO a
readIORef (Storage -> IORef (TimingStats Int)
storageUtilisationCountStatsRef Storage
r)
     Int
n <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUtilisationCountRef Storage
r)
     Int
m <- 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' = forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats Double
t Int
n TimingStats Int
s
         k :: Double
k  = forall a. TimingStats a -> Double
timingStatsSum TimingStats Int
s' forall a. Fractional a => a -> a -> a
/ (forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Int
m)
     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 :: forall a. Storage -> Transact a -> Int -> Process ()
enterStorage Storage
r Transact a
transact Int
decrement =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Bool
f <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall s i. QueueStrategy s => StrategyQueue s i -> Event Bool
strategyQueueNull (Storage
-> StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
storageDelayChain Storage
r)
     if Bool
f
       then forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
            forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c forall a b. (a -> b) -> a -> b
$
            forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid forall a b. (a -> b) -> a -> b
$
            forall a. Storage -> Transact a -> Int -> Process ()
enterStorage' Storage
r Transact a
transact Int
decrement
       else do FrozenCont ()
c <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                    forall a. ContParams a -> a -> Event () -> Event (FrozenCont a)
freezeContReentering ContParams ()
c () forall a b. (a -> b) -> a -> b
$
                    forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c forall a b. (a -> b) -> a -> b
$
                    forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid forall a b. (a -> b) -> a -> b
$
                    forall a. Storage -> Transact a -> Int -> Process ()
enterStorage Storage
r Transact a
transact Int
decrement
               forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                 forall s p i.
PriorityQueueStrategy s p =>
StrategyQueue s i -> p -> i -> Event ()
strategyEnqueueWithPriority
                 (Storage
-> StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
storageDelayChain Storage
r)
                 (forall a. Transact a -> Int
transactPriority Transact a
transact)
                 (Double -> Int -> FrozenCont () -> StorageDelayedItem
StorageDelayedItem Double
t Int
decrement FrozenCont ()
c)
               forall a. Point -> Event a -> IO a
invokeEvent Point
p 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' :: forall a. Storage -> Transact a -> Int -> Process ()
enterStorage' Storage
r Transact a
transact Int
decrement =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Int
a <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     if Int
a forall a. Ord a => a -> a -> Bool
< Int
decrement
       then do FrozenCont ()
c <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                    forall a. ContParams a -> a -> Event () -> Event (FrozenCont a)
freezeContReentering ContParams ()
c () forall a b. (a -> b) -> a -> b
$
                    forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c forall a b. (a -> b) -> a -> b
$
                    forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid forall a b. (a -> b) -> a -> b
$
                    forall a. Storage -> Transact a -> Int -> Process ()
enterStorage Storage
r Transact a
transact Int
decrement
               forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                 forall s p i.
PriorityQueueStrategy s p =>
StrategyQueue s i -> p -> i -> Event ()
strategyEnqueueWithPriority
                 (Storage
-> StrategyQueue (TransactQueueStrategy FCFS) StorageDelayedItem
storageDelayChain Storage
r)
                 (forall a. Transact a -> Int
transactPriority Transact a
transact)
                 (Double -> Int -> FrozenCont () -> StorageDelayedItem
StorageDelayedItem Double
t Int
decrement FrozenCont ()
c)
               forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageQueueCount Storage
r Int
1
       else do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Double -> Event ()
updateStorageWaitTime Storage
r Double
0
               forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageContent Storage
r (- Int
decrement)
               forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUseCount Storage
r Int
1
               forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUsedContent Storage
r Int
decrement
               forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUtilisationCount Storage
r Int
decrement
               forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ 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 =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
_ ->
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
leaveStorageWithinEvent Storage
r Int
increment
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUtilisationCount Storage
r (- Int
increment)
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageContent Storage
r Int
increment
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Double -> Event () -> Event ()
enqueueEvent Double
t 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Int
a <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     if Int
a forall a. Ord a => a -> a -> Bool
> Int
0
       then forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Event ()
letEnterStorage Storage
r
       else forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Let enter the storage.
letEnterStorage :: Storage -> Event ()
letEnterStorage :: Storage -> Event ()
letEnterStorage Storage
r =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Int
a <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
a forall a. Ord a => a -> a -> Bool
> Storage -> Int
storageCapacity Storage
r) forall a b. (a -> b) -> a -> b
$
       forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
       String -> SimulationRetry
SimulationRetry forall a b. (a -> b) -> a -> b
$
       String
"The storage content cannot exceed the limited capacity: leaveStorage'"
     Maybe StorageDelayedItem
x <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
          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 forall a. Ord a => a -> a -> Bool
<= Int
a)
     case Maybe StorageDelayedItem
x of
       Maybe StorageDelayedItem
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just (StorageDelayedItem Double
t0 Int
decrement0 FrozenCont ()
c0) ->
         do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageQueueCount Storage
r (-Int
1)
            Maybe (ContParams ())
c <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. FrozenCont a -> Event (Maybe (ContParams a))
unfreezeCont FrozenCont ()
c0
            case Maybe (ContParams ())
c of
              Maybe (ContParams ())
Nothing ->
                forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Event ()
letEnterStorage Storage
r
              Just ContParams ()
c ->
                do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageContent Storage
r (- Int
decrement0)
                   forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Double -> Event ()
updateStorageWaitTime Storage
r (Double
t forall a. Num a => a -> a -> a
- Double
t0)
                   forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUtilisationCount Storage
r Int
decrement0
                   forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUseCount Storage
r Int
1
                   forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Storage -> Int -> Event ()
updateStorageUsedContent Storage
r Int
decrement0
                   forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Double -> Event () -> Event ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$ 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 forall a. Semigroup a => a -> a -> a
<>
  Storage -> Signal ()
storageUsedContentChanged_ Storage
r forall a. Semigroup a => a -> a -> a
<>
  Storage -> Signal ()
storageUtilisationCountChanged_ Storage
r 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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageContentRef Storage
r)
     let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageContentRef Storage
r) Int
a'
     forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Storage -> IORef (TimingStats Int)
storageContentStatsRef Storage
r) forall a b. (a -> b) -> a -> b
$
       forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (Point -> Double
pointTime Point
p) Int
a'
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
       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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUseCountRef Storage
r)
     let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageUseCountRef Storage
r) Int
a'
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
       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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUsedContentRef Storage
r)
     let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageUsedContentRef Storage
r) Int
a'
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
       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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageQueueCountRef Storage
r)
     let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageQueueCountRef Storage
r) Int
a'
     forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Storage -> IORef (TimingStats Int)
storageQueueCountStatsRef Storage
r) forall a b. (a -> b) -> a -> b
$
       forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (Point -> Double
pointTime Point
p) Int
a'
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
       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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Int
storageUtilisationCountRef Storage
r)
     let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Int
storageUtilisationCountRef Storage
r) Int
a'
     forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Storage -> IORef (TimingStats Int)
storageUtilisationCountStatsRef Storage
r) forall a b. (a -> b) -> a -> b
$
       forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (Point -> Double
pointTime Point
p) Int
a'
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
       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 =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Double
a <- forall a. IORef a -> IO a
readIORef (Storage -> IORef Double
storageTotalWaitTimeRef Storage
r)
     let a' :: Double
a' = Double
a forall a. Num a => a -> a -> a
+ Double
delta
     Double
a' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (Storage -> IORef Double
storageTotalWaitTimeRef Storage
r) Double
a'
     forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Storage -> IORef (SamplingStats Double)
storageWaitTimeRef Storage
r) forall a b. (a -> b) -> a -> b
$
       forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats Double
delta
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
       forall a. SignalSource a -> a -> Event ()
triggerSignal (Storage -> SignalSource ()
storageWaitTimeSource Storage
r) ()

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