{-# LANGUAGE FlexibleContexts #-}
module Simulation.Aivika.Trans.Queue
(
FCFSQueue,
LCFSQueue,
SIROQueue,
PriorityQueue,
Queue,
newFCFSQueue,
newLCFSQueue,
newSIROQueue,
newPriorityQueue,
newQueue,
enqueueStrategy,
enqueueStoringStrategy,
dequeueStrategy,
queueNull,
queueFull,
queueMaxCount,
queueCount,
queueCountStats,
enqueueCount,
enqueueLostCount,
enqueueStoreCount,
dequeueCount,
dequeueExtractCount,
queueLoadFactor,
enqueueRate,
enqueueStoreRate,
dequeueRate,
dequeueExtractRate,
queueWaitTime,
queueTotalWaitTime,
enqueueWaitTime,
dequeueWaitTime,
queueRate,
dequeue,
dequeueWithOutputPriority,
tryDequeue,
enqueue,
enqueueWithInputPriority,
enqueueWithStoringPriority,
enqueueWithInputStoringPriorities,
tryEnqueue,
tryEnqueueWithStoringPriority,
enqueueOrLost,
enqueueOrLost_,
enqueueWithStoringPriorityOrLost,
enqueueWithStoringPriorityOrLost_,
queueDelete,
queueDelete_,
queueDeleteBy,
queueDeleteBy_,
queueContains,
queueContainsBy,
clearQueue,
resetQueue,
waitWhileFullQueue,
queueSummary,
queueNullChanged,
queueNullChanged_,
queueFullChanged,
queueFullChanged_,
queueCountChanged,
queueCountChanged_,
enqueueCountChanged,
enqueueCountChanged_,
enqueueLostCountChanged,
enqueueLostCountChanged_,
enqueueStoreCountChanged,
enqueueStoreCountChanged_,
dequeueCountChanged,
dequeueCountChanged_,
dequeueExtractCountChanged,
dequeueExtractCountChanged_,
queueLoadFactorChanged,
queueLoadFactorChanged_,
queueWaitTimeChanged,
queueWaitTimeChanged_,
queueTotalWaitTimeChanged,
queueTotalWaitTimeChanged_,
enqueueWaitTimeChanged,
enqueueWaitTimeChanged_,
dequeueWaitTimeChanged,
dequeueWaitTimeChanged_,
queueRateChanged,
queueRateChanged_,
enqueueInitiated,
enqueueStored,
enqueueLost,
dequeueRequested,
dequeueExtracted,
queueChanged_) where
import Data.Monoid
import Data.Maybe
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Parameter
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Dynamics
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Internal.Process
import Simulation.Aivika.Trans.Signal
import Simulation.Aivika.Trans.Resource.Base
import Simulation.Aivika.Trans.QueueStrategy
import Simulation.Aivika.Trans.Statistics
type FCFSQueue m a = Queue m FCFS FCFS FCFS a
type LCFSQueue m a = Queue m FCFS LCFS FCFS a
type SIROQueue m a = Queue m FCFS SIRO FCFS a
type PriorityQueue m a = Queue m FCFS StaticPriorities FCFS a
data Queue m si sm so a =
Queue { queueMaxCount :: Int,
enqueueStrategy :: si,
enqueueStoringStrategy :: sm,
dequeueStrategy :: so,
enqueueRes :: Resource m si,
queueStore :: StrategyQueue m sm (QueueItem a),
dequeueRes :: Resource m so,
queueCountRef :: Ref m Int,
queueCountStatsRef :: Ref m (TimingStats Int),
enqueueCountRef :: Ref m Int,
enqueueLostCountRef :: Ref m Int,
enqueueStoreCountRef :: Ref m Int,
dequeueCountRef :: Ref m Int,
dequeueExtractCountRef :: Ref m Int,
queueWaitTimeRef :: Ref m (SamplingStats Double),
queueTotalWaitTimeRef :: Ref m (SamplingStats Double),
enqueueWaitTimeRef :: Ref m (SamplingStats Double),
dequeueWaitTimeRef :: Ref m (SamplingStats Double),
enqueueInitiatedSource :: SignalSource m a,
enqueueLostSource :: SignalSource m a,
enqueueStoredSource :: SignalSource m a,
dequeueRequestedSource :: SignalSource m (),
dequeueExtractedSource :: SignalSource m a }
data QueueItem a =
QueueItem { itemValue :: a,
itemInputTime :: Double,
itemStoringTime :: Double
}
newFCFSQueue :: MonadDES m => Int -> Event m (FCFSQueue m a)
{-# INLINABLE newFCFSQueue #-}
newFCFSQueue = newQueue FCFS FCFS FCFS
newLCFSQueue :: MonadDES m => Int -> Event m (LCFSQueue m a)
{-# INLINABLE newLCFSQueue #-}
newLCFSQueue = newQueue FCFS LCFS FCFS
newSIROQueue :: (MonadDES m, QueueStrategy m SIRO) => Int -> Event m (SIROQueue m a)
{-# INLINABLE newSIROQueue #-}
newSIROQueue = newQueue FCFS SIRO FCFS
newPriorityQueue :: (MonadDES m, QueueStrategy m StaticPriorities) => Int -> Event m (PriorityQueue m a)
{-# INLINABLE newPriorityQueue #-}
newPriorityQueue = newQueue FCFS StaticPriorities FCFS
newQueue :: (MonadDES m,
QueueStrategy m si,
QueueStrategy m sm,
QueueStrategy m so) =>
si
-> sm
-> so
-> Int
-> Event m (Queue m si sm so a)
{-# INLINABLE newQueue #-}
newQueue si sm so count =
do t <- liftDynamics time
i <- liftSimulation $ newRef 0
is <- liftSimulation $ newRef $ returnTimingStats t 0
ci <- liftSimulation $ newRef 0
cl <- liftSimulation $ newRef 0
cm <- liftSimulation $ newRef 0
cr <- liftSimulation $ newRef 0
co <- liftSimulation $ newRef 0
ri <- liftSimulation $ newResourceWithMaxCount si count (Just count)
qm <- liftSimulation $ newStrategyQueue sm
ro <- liftSimulation $ newResourceWithMaxCount so 0 (Just count)
w <- liftSimulation $ newRef mempty
wt <- liftSimulation $ newRef mempty
wi <- liftSimulation $ newRef mempty
wo <- liftSimulation $ newRef mempty
s1 <- liftSimulation $ newSignalSource
s2 <- liftSimulation $ newSignalSource
s3 <- liftSimulation $ newSignalSource
s4 <- liftSimulation $ newSignalSource
s5 <- liftSimulation $ newSignalSource
return Queue { queueMaxCount = count,
enqueueStrategy = si,
enqueueStoringStrategy = sm,
dequeueStrategy = so,
enqueueRes = ri,
queueStore = qm,
dequeueRes = ro,
queueCountRef = i,
queueCountStatsRef = is,
enqueueCountRef = ci,
enqueueLostCountRef = cl,
enqueueStoreCountRef = cm,
dequeueCountRef = cr,
dequeueExtractCountRef = co,
queueWaitTimeRef = w,
queueTotalWaitTimeRef = wt,
enqueueWaitTimeRef = wi,
dequeueWaitTimeRef = wo,
enqueueInitiatedSource = s1,
enqueueLostSource = s2,
enqueueStoredSource = s3,
dequeueRequestedSource = s4,
dequeueExtractedSource = s5 }
queueNull :: MonadDES m => Queue m si sm so a -> Event m Bool
{-# INLINABLE queueNull #-}
queueNull q =
Event $ \p ->
do n <- invokeEvent p $ readRef (queueCountRef q)
return (n == 0)
queueNullChanged :: MonadDES m => Queue m si sm so a -> Signal m Bool
{-# INLINABLE queueNullChanged #-}
queueNullChanged q =
mapSignalM (const $ queueNull q) (queueNullChanged_ q)
queueNullChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE queueNullChanged_ #-}
queueNullChanged_ = queueCountChanged_
queueFull :: MonadDES m => Queue m si sm so a -> Event m Bool
{-# INLINABLE queueFull #-}
queueFull q =
Event $ \p ->
do n <- invokeEvent p $ readRef (queueCountRef q)
return (n == queueMaxCount q)
queueFullChanged :: MonadDES m => Queue m si sm so a -> Signal m Bool
{-# INLINABLE queueFullChanged #-}
queueFullChanged q =
mapSignalM (const $ queueFull q) (queueFullChanged_ q)
queueFullChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE queueFullChanged_ #-}
queueFullChanged_ = queueCountChanged_
queueCount :: MonadDES m => Queue m si sm so a -> Event m Int
{-# INLINABLE queueCount #-}
queueCount q =
Event $ \p -> invokeEvent p $ readRef (queueCountRef q)
queueCountStats :: MonadDES m => Queue m si sm so a -> Event m (TimingStats Int)
{-# INLINABLE queueCountStats #-}
queueCountStats q =
Event $ \p -> invokeEvent p $ readRef (queueCountStatsRef q)
queueCountChanged :: MonadDES m => Queue m si sm so a -> Signal m Int
{-# INLINABLE queueCountChanged #-}
queueCountChanged q =
mapSignalM (const $ queueCount q) (queueCountChanged_ q)
queueCountChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE queueCountChanged_ #-}
queueCountChanged_ q =
mapSignal (const ()) (enqueueStored q) <>
mapSignal (const ()) (dequeueExtracted q)
enqueueCount :: MonadDES m => Queue m si sm so a -> Event m Int
{-# INLINABLE enqueueCount #-}
enqueueCount q =
Event $ \p -> invokeEvent p $ readRef (enqueueCountRef q)
enqueueCountChanged :: MonadDES m => Queue m si sm so a -> Signal m Int
{-# INLINABLE enqueueCountChanged #-}
enqueueCountChanged q =
mapSignalM (const $ enqueueCount q) (enqueueCountChanged_ q)
enqueueCountChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE enqueueCountChanged_ #-}
enqueueCountChanged_ q =
mapSignal (const ()) (enqueueInitiated q)
enqueueLostCount :: MonadDES m => Queue m si sm so a -> Event m Int
{-# INLINABLE enqueueLostCount #-}
enqueueLostCount q =
Event $ \p -> invokeEvent p $ readRef (enqueueLostCountRef q)
enqueueLostCountChanged :: MonadDES m => Queue m si sm so a -> Signal m Int
{-# INLINABLE enqueueLostCountChanged #-}
enqueueLostCountChanged q =
mapSignalM (const $ enqueueLostCount q) (enqueueLostCountChanged_ q)
enqueueLostCountChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE enqueueLostCountChanged_ #-}
enqueueLostCountChanged_ q =
mapSignal (const ()) (enqueueLost q)
enqueueStoreCount :: MonadDES m => Queue m si sm so a -> Event m Int
{-# INLINABLE enqueueStoreCount #-}
enqueueStoreCount q =
Event $ \p -> invokeEvent p $ readRef (enqueueStoreCountRef q)
enqueueStoreCountChanged :: MonadDES m => Queue m si sm so a -> Signal m Int
{-# INLINABLE enqueueStoreCountChanged #-}
enqueueStoreCountChanged q =
mapSignalM (const $ enqueueStoreCount q) (enqueueStoreCountChanged_ q)
enqueueStoreCountChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE enqueueStoreCountChanged_ #-}
enqueueStoreCountChanged_ q =
mapSignal (const ()) (enqueueStored q)
dequeueCount :: MonadDES m => Queue m si sm so a -> Event m Int
{-# INLINABLE dequeueCount #-}
dequeueCount q =
Event $ \p -> invokeEvent p $ readRef (dequeueCountRef q)
dequeueCountChanged :: MonadDES m => Queue m si sm so a -> Signal m Int
{-# INLINABLE dequeueCountChanged #-}
dequeueCountChanged q =
mapSignalM (const $ dequeueCount q) (dequeueCountChanged_ q)
dequeueCountChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE dequeueCountChanged_ #-}
dequeueCountChanged_ q =
mapSignal (const ()) (dequeueRequested q)
dequeueExtractCount :: MonadDES m => Queue m si sm so a -> Event m Int
{-# INLINABLE dequeueExtractCount #-}
dequeueExtractCount q =
Event $ \p -> invokeEvent p $ readRef (dequeueExtractCountRef q)
dequeueExtractCountChanged :: MonadDES m => Queue m si sm so a -> Signal m Int
{-# INLINABLE dequeueExtractCountChanged #-}
dequeueExtractCountChanged q =
mapSignalM (const $ dequeueExtractCount q) (dequeueExtractCountChanged_ q)
dequeueExtractCountChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE dequeueExtractCountChanged_ #-}
dequeueExtractCountChanged_ q =
mapSignal (const ()) (dequeueExtracted q)
queueLoadFactor :: MonadDES m => Queue m si sm so a -> Event m Double
{-# INLINABLE queueLoadFactor #-}
queueLoadFactor q =
Event $ \p ->
do x <- invokeEvent p $ readRef (queueCountRef q)
let y = queueMaxCount q
return (fromIntegral x / fromIntegral y)
queueLoadFactorChanged :: MonadDES m => Queue m si sm so a -> Signal m Double
{-# INLINABLE queueLoadFactorChanged #-}
queueLoadFactorChanged q =
mapSignalM (const $ queueLoadFactor q) (queueLoadFactorChanged_ q)
queueLoadFactorChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE queueLoadFactorChanged_ #-}
queueLoadFactorChanged_ q =
mapSignal (const ()) (enqueueStored q) <>
mapSignal (const ()) (dequeueExtracted q)
enqueueRate :: MonadDES m => Queue m si sm so a -> Event m Double
{-# INLINABLE enqueueRate #-}
enqueueRate q =
Event $ \p ->
do x <- invokeEvent p $ readRef (enqueueCountRef q)
let t0 = spcStartTime $ pointSpecs p
t = pointTime p
return (fromIntegral x / (t - t0))
enqueueStoreRate :: MonadDES m => Queue m si sm so a -> Event m Double
{-# INLINABLE enqueueStoreRate #-}
enqueueStoreRate q =
Event $ \p ->
do x <- invokeEvent p $ readRef (enqueueStoreCountRef q)
let t0 = spcStartTime $ pointSpecs p
t = pointTime p
return (fromIntegral x / (t - t0))
dequeueRate :: MonadDES m => Queue m si sm so a -> Event m Double
{-# INLINABLE dequeueRate #-}
dequeueRate q =
Event $ \p ->
do x <- invokeEvent p $ readRef (dequeueCountRef q)
let t0 = spcStartTime $ pointSpecs p
t = pointTime p
return (fromIntegral x / (t - t0))
dequeueExtractRate :: MonadDES m => Queue m si sm so a -> Event m Double
{-# INLINABLE dequeueExtractRate #-}
dequeueExtractRate q =
Event $ \p ->
do x <- invokeEvent p $ readRef (dequeueExtractCountRef q)
let t0 = spcStartTime $ pointSpecs p
t = pointTime p
return (fromIntegral x / (t - t0))
queueWaitTime :: MonadDES m => Queue m si sm so a -> Event m (SamplingStats Double)
{-# INLINABLE queueWaitTime #-}
queueWaitTime q =
Event $ \p -> invokeEvent p $ readRef (queueWaitTimeRef q)
queueWaitTimeChanged :: MonadDES m => Queue m si sm so a -> Signal m (SamplingStats Double)
{-# INLINABLE queueWaitTimeChanged #-}
queueWaitTimeChanged q =
mapSignalM (const $ queueWaitTime q) (queueWaitTimeChanged_ q)
queueWaitTimeChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE queueWaitTimeChanged_ #-}
queueWaitTimeChanged_ q =
mapSignal (const ()) (dequeueExtracted q)
queueTotalWaitTime :: MonadDES m => Queue m si sm so a -> Event m (SamplingStats Double)
{-# INLINABLE queueTotalWaitTime #-}
queueTotalWaitTime q =
Event $ \p -> invokeEvent p $ readRef (queueTotalWaitTimeRef q)
queueTotalWaitTimeChanged :: MonadDES m => Queue m si sm so a -> Signal m (SamplingStats Double)
{-# INLINABLE queueTotalWaitTimeChanged #-}
queueTotalWaitTimeChanged q =
mapSignalM (const $ queueTotalWaitTime q) (queueTotalWaitTimeChanged_ q)
queueTotalWaitTimeChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE queueTotalWaitTimeChanged_ #-}
queueTotalWaitTimeChanged_ q =
mapSignal (const ()) (dequeueExtracted q)
enqueueWaitTime :: MonadDES m => Queue m si sm so a -> Event m (SamplingStats Double)
{-# INLINABLE enqueueWaitTime #-}
enqueueWaitTime q =
Event $ \p -> invokeEvent p $ readRef (enqueueWaitTimeRef q)
enqueueWaitTimeChanged :: MonadDES m => Queue m si sm so a -> Signal m (SamplingStats Double)
{-# INLINABLE enqueueWaitTimeChanged #-}
enqueueWaitTimeChanged q =
mapSignalM (const $ enqueueWaitTime q) (enqueueWaitTimeChanged_ q)
enqueueWaitTimeChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE enqueueWaitTimeChanged_ #-}
enqueueWaitTimeChanged_ q =
mapSignal (const ()) (enqueueStored q)
dequeueWaitTime :: MonadDES m => Queue m si sm so a -> Event m (SamplingStats Double)
{-# INLINABLE dequeueWaitTime #-}
dequeueWaitTime q =
Event $ \p -> invokeEvent p $ readRef (dequeueWaitTimeRef q)
dequeueWaitTimeChanged :: MonadDES m => Queue m si sm so a -> Signal m (SamplingStats Double)
{-# INLINABLE dequeueWaitTimeChanged #-}
dequeueWaitTimeChanged q =
mapSignalM (const $ dequeueWaitTime q) (dequeueWaitTimeChanged_ q)
dequeueWaitTimeChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE dequeueWaitTimeChanged_ #-}
dequeueWaitTimeChanged_ q =
mapSignal (const ()) (dequeueExtracted q)
queueRate :: MonadDES m => Queue m si sm so a -> Event m Double
{-# INLINABLE queueRate #-}
queueRate q =
Event $ \p ->
do x <- invokeEvent p $ readRef (queueCountStatsRef q)
y <- invokeEvent p $ readRef (queueWaitTimeRef q)
return (timingStatsMean x / samplingStatsMean y)
queueRateChanged :: MonadDES m => Queue m si sm so a -> Signal m Double
{-# INLINABLE queueRateChanged #-}
queueRateChanged q =
mapSignalM (const $ queueRate q) (queueRateChanged_ q)
queueRateChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE queueRateChanged_ #-}
queueRateChanged_ q =
mapSignal (const ()) (enqueueStored q) <>
mapSignal (const ()) (dequeueExtracted q)
dequeue :: (MonadDES m,
DequeueStrategy m si,
DequeueStrategy m sm,
EnqueueStrategy m so)
=> Queue m si sm so a
-> Process m a
{-# INLINABLE dequeue #-}
dequeue q =
do t <- liftEvent $ dequeueRequest q
requestResource (dequeueRes q)
liftEvent $ dequeueExtract q t
dequeueWithOutputPriority :: (MonadDES m,
DequeueStrategy m si,
DequeueStrategy m sm,
PriorityQueueStrategy m so po)
=> Queue m si sm so a
-> po
-> Process m a
{-# INLINABLE dequeueWithOutputPriority #-}
dequeueWithOutputPriority q po =
do t <- liftEvent $ dequeueRequest q
requestResourceWithPriority (dequeueRes q) po
liftEvent $ dequeueExtract q t
tryDequeue :: (MonadDES m,
DequeueStrategy m si,
DequeueStrategy m sm)
=> Queue m si sm so a
-> Event m (Maybe a)
{-# INLINABLE tryDequeue #-}
tryDequeue q =
do x <- tryRequestResourceWithinEvent (dequeueRes q)
if x
then do t <- dequeueRequest q
fmap Just $ dequeueExtract q t
else return Nothing
queueDelete :: (MonadDES m,
Eq a,
DequeueStrategy m si,
DeletingQueueStrategy m sm,
DequeueStrategy m so)
=> Queue m si sm so a
-> a
-> Event m Bool
{-# INLINABLE queueDelete #-}
queueDelete q a = fmap isJust $ queueDeleteBy q (== a)
queueDelete_ :: (MonadDES m,
Eq a,
DequeueStrategy m si,
DeletingQueueStrategy m sm,
DequeueStrategy m so)
=> Queue m si sm so a
-> a
-> Event m ()
{-# INLINABLE queueDelete_ #-}
queueDelete_ q a = fmap (const ()) $ queueDeleteBy q (== a)
queueDeleteBy :: (MonadDES m,
DequeueStrategy m si,
DeletingQueueStrategy m sm,
DequeueStrategy m so)
=> Queue m si sm so a
-> (a -> Bool)
-> Event m (Maybe a)
{-# INLINABLE queueDeleteBy #-}
queueDeleteBy q pred =
do x <- tryRequestResourceWithinEvent (dequeueRes q)
if x
then do i <- strategyQueueDeleteBy (queueStore q) (pred . itemValue)
case i of
Nothing ->
do releaseResourceWithinEvent (dequeueRes q)
return Nothing
Just i ->
do t <- dequeueRequest q
fmap Just $ dequeuePostExtract q t i
else return Nothing
queueDeleteBy_ :: (MonadDES m,
DequeueStrategy m si,
DeletingQueueStrategy m sm,
DequeueStrategy m so)
=> Queue m si sm so a
-> (a -> Bool)
-> Event m ()
{-# INLINABLE queueDeleteBy_ #-}
queueDeleteBy_ q pred = fmap (const ()) $ queueDeleteBy q pred
queueContains :: (MonadDES m,
Eq a,
DeletingQueueStrategy m sm)
=> Queue m si sm so a
-> a
-> Event m Bool
{-# INLINABLE queueContains #-}
queueContains q a = fmap isJust $ queueContainsBy q (== a)
queueContainsBy :: (MonadDES m,
DeletingQueueStrategy m sm)
=> Queue m si sm so a
-> (a -> Bool)
-> Event m (Maybe a)
{-# INLINABLE queueContainsBy #-}
queueContainsBy q pred =
do x <- strategyQueueContainsBy (queueStore q) (pred . itemValue)
case x of
Nothing -> return Nothing
Just i -> return $ Just (itemValue i)
clearQueue :: (MonadDES m,
DequeueStrategy m si,
DequeueStrategy m sm)
=> Queue m si sm so a
-> Event m ()
{-# INLINABLE clearQueue #-}
clearQueue q =
do x <- tryDequeue q
case x of
Nothing -> return ()
Just a -> clearQueue q
enqueue :: (MonadDES m,
EnqueueStrategy m si,
EnqueueStrategy m sm,
DequeueStrategy m so)
=> Queue m si sm so a
-> a
-> Process m ()
{-# INLINABLE enqueue #-}
enqueue q a =
do i <- liftEvent $ enqueueInitiate q a
requestResource (enqueueRes q)
liftEvent $ enqueueStore q i
enqueueWithInputPriority :: (MonadDES m,
PriorityQueueStrategy m si pi,
EnqueueStrategy m sm,
DequeueStrategy m so)
=> Queue m si sm so a
-> pi
-> a
-> Process m ()
{-# INLINABLE enqueueWithInputPriority #-}
enqueueWithInputPriority q pi a =
do i <- liftEvent $ enqueueInitiate q a
requestResourceWithPriority (enqueueRes q) pi
liftEvent $ enqueueStore q i
enqueueWithStoringPriority :: (MonadDES m,
EnqueueStrategy m si,
PriorityQueueStrategy m sm pm,
DequeueStrategy m so)
=> Queue m si sm so a
-> pm
-> a
-> Process m ()
{-# INLINABLE enqueueWithStoringPriority #-}
enqueueWithStoringPriority q pm a =
do i <- liftEvent $ enqueueInitiate q a
requestResource (enqueueRes q)
liftEvent $ enqueueStoreWithPriority q pm i
enqueueWithInputStoringPriorities :: (MonadDES m,
PriorityQueueStrategy m si pi,
PriorityQueueStrategy m sm pm,
DequeueStrategy m so)
=> Queue m si sm so a
-> pi
-> pm
-> a
-> Process m ()
{-# INLINABLE enqueueWithInputStoringPriorities #-}
enqueueWithInputStoringPriorities q pi pm a =
do i <- liftEvent $ enqueueInitiate q a
requestResourceWithPriority (enqueueRes q) pi
liftEvent $ enqueueStoreWithPriority q pm i
tryEnqueue :: (MonadDES m,
EnqueueStrategy m sm,
DequeueStrategy m so)
=> Queue m si sm so a
-> a
-> Event m Bool
{-# INLINABLE tryEnqueue #-}
tryEnqueue q a =
do x <- tryRequestResourceWithinEvent (enqueueRes q)
if x
then do enqueueInitiate q a >>= enqueueStore q
return True
else return False
tryEnqueueWithStoringPriority :: (MonadDES m,
PriorityQueueStrategy m sm pm,
DequeueStrategy m so)
=> Queue m si sm so a
-> pm
-> a
-> Event m Bool
{-# INLINABLE tryEnqueueWithStoringPriority #-}
tryEnqueueWithStoringPriority q pm a =
do x <- tryRequestResourceWithinEvent (enqueueRes q)
if x
then do enqueueInitiate q a >>= enqueueStoreWithPriority q pm
return True
else return False
enqueueOrLost :: (MonadDES m,
EnqueueStrategy m sm,
DequeueStrategy m so)
=> Queue m si sm so a
-> a
-> Event m Bool
{-# INLINABLE enqueueOrLost #-}
enqueueOrLost q a =
do x <- tryRequestResourceWithinEvent (enqueueRes q)
if x
then do enqueueInitiate q a >>= enqueueStore q
return True
else do enqueueDeny q a
return False
enqueueWithStoringPriorityOrLost :: (MonadDES m,
PriorityQueueStrategy m sm pm,
DequeueStrategy m so)
=> Queue m si sm so a
-> pm
-> a
-> Event m Bool
{-# INLINABLE enqueueWithStoringPriorityOrLost #-}
enqueueWithStoringPriorityOrLost q pm a =
do x <- tryRequestResourceWithinEvent (enqueueRes q)
if x
then do enqueueInitiate q a >>= enqueueStoreWithPriority q pm
return True
else do enqueueDeny q a
return False
enqueueOrLost_ :: (MonadDES m,
EnqueueStrategy m sm,
DequeueStrategy m so)
=> Queue m si sm so a
-> a
-> Event m ()
{-# INLINABLE enqueueOrLost_ #-}
enqueueOrLost_ q a =
do x <- enqueueOrLost q a
return ()
enqueueWithStoringPriorityOrLost_ :: (MonadDES m,
PriorityQueueStrategy m sm pm,
DequeueStrategy m so)
=> Queue m si sm so a
-> pm
-> a
-> Event m ()
{-# INLINABLE enqueueWithStoringPriorityOrLost_ #-}
enqueueWithStoringPriorityOrLost_ q pm a =
do x <- enqueueWithStoringPriorityOrLost q pm a
return ()
enqueueInitiated :: MonadDES m => Queue m si sm so a -> Signal m a
{-# INLINABLE enqueueInitiated #-}
enqueueInitiated q = publishSignal (enqueueInitiatedSource q)
enqueueStored :: MonadDES m => Queue m si sm so a -> Signal m a
{-# INLINABLE enqueueStored #-}
enqueueStored q = publishSignal (enqueueStoredSource q)
enqueueLost :: MonadDES m => Queue m si sm so a -> Signal m a
{-# INLINABLE enqueueLost #-}
enqueueLost q = publishSignal (enqueueLostSource q)
dequeueRequested :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE dequeueRequested #-}
dequeueRequested q = publishSignal (dequeueRequestedSource q)
dequeueExtracted :: MonadDES m => Queue m si sm so a -> Signal m a
{-# INLINABLE dequeueExtracted #-}
dequeueExtracted q = publishSignal (dequeueExtractedSource q)
enqueueInitiate :: MonadDES m
=> Queue m si sm so a
-> a
-> Event m (QueueItem a)
{-# INLINE enqueueInitiate #-}
enqueueInitiate q a =
Event $ \p ->
do let t = pointTime p
invokeEvent p $
modifyRef (enqueueCountRef q) (+ 1)
invokeEvent p $
triggerSignal (enqueueInitiatedSource q) a
return QueueItem { itemValue = a,
itemInputTime = t,
itemStoringTime = t
}
enqueueStore :: (MonadDES m,
EnqueueStrategy m sm,
DequeueStrategy m so)
=> Queue m si sm so a
-> QueueItem a
-> Event m ()
{-# INLINE enqueueStore #-}
enqueueStore q i =
Event $ \p ->
do let i' = i { itemStoringTime = pointTime p }
invokeEvent p $
strategyEnqueue (queueStore q) i'
c <- invokeEvent p $
readRef (queueCountRef q)
let c' = c + 1
t = pointTime p
c' `seq` invokeEvent p $
writeRef (queueCountRef q) c'
invokeEvent p $
modifyRef (queueCountStatsRef q) (addTimingStats t c')
invokeEvent p $
modifyRef (enqueueStoreCountRef q) (+ 1)
invokeEvent p $
enqueueStat q i'
invokeEvent p $
releaseResourceWithinEvent (dequeueRes q)
invokeEvent p $
triggerSignal (enqueueStoredSource q) (itemValue i')
enqueueStoreWithPriority :: (MonadDES m,
PriorityQueueStrategy m sm pm,
DequeueStrategy m so)
=> Queue m si sm so a
-> pm
-> QueueItem a
-> Event m ()
{-# INLINE enqueueStoreWithPriority #-}
enqueueStoreWithPriority q pm i =
Event $ \p ->
do let i' = i { itemStoringTime = pointTime p }
invokeEvent p $
strategyEnqueueWithPriority (queueStore q) pm i'
c <- invokeEvent p $
readRef (queueCountRef q)
let c' = c + 1
t = pointTime p
c' `seq` invokeEvent p $
writeRef (queueCountRef q) c'
invokeEvent p $
modifyRef (queueCountStatsRef q) (addTimingStats t c')
invokeEvent p $
modifyRef (enqueueStoreCountRef q) (+ 1)
invokeEvent p $
enqueueStat q i'
invokeEvent p $
releaseResourceWithinEvent (dequeueRes q)
invokeEvent p $
triggerSignal (enqueueStoredSource q) (itemValue i')
enqueueDeny :: MonadDES m
=> Queue m si sm so a
-> a
-> Event m ()
{-# INLINE enqueueDeny #-}
enqueueDeny q a =
Event $ \p ->
do invokeEvent p $
modifyRef (enqueueLostCountRef q) $ (+) 1
invokeEvent p $
triggerSignal (enqueueLostSource q) a
enqueueStat :: MonadDES m
=> Queue m si sm so a
-> QueueItem a
-> Event m ()
{-# INLINE enqueueStat #-}
enqueueStat q i =
Event $ \p ->
do let t0 = itemInputTime i
t1 = itemStoringTime i
invokeEvent p $
modifyRef (enqueueWaitTimeRef q) $
addSamplingStats (t1 - t0)
dequeueRequest :: MonadDES m
=> Queue m si sm so a
-> Event m Double
{-# INLINE dequeueRequest #-}
dequeueRequest q =
Event $ \p ->
do invokeEvent p $
modifyRef (dequeueCountRef q) (+ 1)
invokeEvent p $
triggerSignal (dequeueRequestedSource q) ()
return $ pointTime p
dequeueExtract :: (MonadDES m,
DequeueStrategy m si,
DequeueStrategy m sm)
=> Queue m si sm so a
-> Double
-> Event m a
{-# INLINE dequeueExtract #-}
dequeueExtract q t' =
Event $ \p ->
do i <- invokeEvent p $
strategyDequeue (queueStore q)
invokeEvent p $
dequeuePostExtract q t' i
dequeuePostExtract :: (MonadDES m,
DequeueStrategy m si,
DequeueStrategy m sm)
=> Queue m si sm so a
-> Double
-> QueueItem a
-> Event m a
{-# INLINE dequeuePostExtract #-}
dequeuePostExtract q t' i =
Event $ \p ->
do c <- invokeEvent p $
readRef (queueCountRef q)
let c' = c - 1
t = pointTime p
c' `seq` invokeEvent p $
writeRef (queueCountRef q) c'
invokeEvent p $
modifyRef (queueCountStatsRef q) (addTimingStats t c')
invokeEvent p $
modifyRef (dequeueExtractCountRef q) (+ 1)
invokeEvent p $
dequeueStat q t' i
invokeEvent p $
releaseResourceWithinEvent (enqueueRes q)
invokeEvent p $
triggerSignal (dequeueExtractedSource q) (itemValue i)
return $ itemValue i
dequeueStat :: MonadDES m
=> Queue m si sm so a
-> Double
-> QueueItem a
-> Event m ()
{-# INLINE dequeueStat #-}
dequeueStat q t' i =
Event $ \p ->
do let t0 = itemInputTime i
t1 = itemStoringTime i
t = pointTime p
invokeEvent p $
modifyRef (dequeueWaitTimeRef q) $
addSamplingStats (t - t')
invokeEvent p $
modifyRef (queueTotalWaitTimeRef q) $
addSamplingStats (t - t0)
invokeEvent p $
modifyRef (queueWaitTimeRef q) $
addSamplingStats (t - t1)
waitWhileFullQueue :: MonadDES m => Queue m si sm so a -> Process m ()
{-# INLINABLE waitWhileFullQueue #-}
waitWhileFullQueue q =
do x <- liftEvent (queueFull q)
when x $
do processAwait (dequeueExtracted q)
waitWhileFullQueue q
queueChanged_ :: MonadDES m => Queue m si sm so a -> Signal m ()
{-# INLINABLE queueChanged_ #-}
queueChanged_ q =
mapSignal (const ()) (enqueueInitiated q) <>
mapSignal (const ()) (enqueueStored q) <>
mapSignal (const ()) (enqueueLost q) <>
dequeueRequested q <>
mapSignal (const ()) (dequeueExtracted q)
queueSummary :: (MonadDES m, Show si, Show sm, Show so) => Queue m si sm so a -> Int -> Event m ShowS
{-# INLINABLE queueSummary #-}
queueSummary q indent =
do let si = enqueueStrategy q
sm = enqueueStoringStrategy q
so = dequeueStrategy q
null <- queueNull q
full <- queueFull q
let maxCount = queueMaxCount q
count <- queueCount q
countStats <- queueCountStats q
enqueueCount <- enqueueCount q
enqueueLostCount <- enqueueLostCount q
enqueueStoreCount <- enqueueStoreCount q
dequeueCount <- dequeueCount q
dequeueExtractCount <- dequeueExtractCount q
loadFactor <- queueLoadFactor q
enqueueRate <- enqueueRate q
enqueueStoreRate <- enqueueStoreRate q
dequeueRate <- dequeueRate q
dequeueExtractRate <- dequeueExtractRate q
waitTime <- queueWaitTime q
totalWaitTime <- queueTotalWaitTime q
enqueueWaitTime <- enqueueWaitTime q
dequeueWaitTime <- dequeueWaitTime q
let tab = replicate indent ' '
return $
showString tab .
showString "the enqueueing (input) strategy = " .
shows si .
showString "\n" .
showString tab .
showString "the storing (memory) strategy = " .
shows sm .
showString "\n" .
showString tab .
showString "the dequeueing (output) strategy = " .
shows so .
showString "\n" .
showString tab .
showString "empty? = " .
shows null .
showString "\n" .
showString tab .
showString "full? = " .
shows full .
showString "\n" .
showString tab .
showString "max. capacity = " .
shows maxCount .
showString "\n" .
showString tab .
showString "size = " .
shows count .
showString "\n" .
showString tab .
showString "the size statistics = \n\n" .
timingStatsSummary countStats (2 + indent) .
showString "\n\n" .
showString tab .
showString "the enqueue count (number of the input items that were enqueued) = " .
shows enqueueCount .
showString "\n" .
showString tab .
showString "the enqueue lost count (number of the lost items) = " .
shows enqueueLostCount .
showString "\n" .
showString tab .
showString "the enqueue store count (number of the input items that were stored) = " .
shows enqueueStoreCount .
showString "\n" .
showString tab .
showString "the dequeue count (number of requests for dequeueing an item) = " .
shows dequeueCount .
showString "\n" .
showString tab .
showString "the dequeue extract count (number of the output items that were dequeued) = " .
shows dequeueExtractCount .
showString "\n" .
showString tab .
showString "the load factor (size / max. capacity) = " .
shows loadFactor .
showString "\n" .
showString tab .
showString "the enqueue rate (how many input items were enqueued per time) = " .
shows enqueueRate .
showString "\n" .
showString tab .
showString "the enqueue store rate (how many input items were stored per time) = " .
shows enqueueStoreRate .
showString "\n" .
showString tab .
showString "the dequeue rate (how many requests for dequeueing per time) = " .
shows dequeueRate .
showString "\n" .
showString tab .
showString "the dequeue extract rate (how many output items were dequeued per time) = " .
shows dequeueExtractRate .
showString "\n" .
showString tab .
showString "the wait time (when was stored -> when was dequeued) = \n\n" .
samplingStatsSummary waitTime (2 + indent) .
showString "\n\n" .
showString tab .
showString "the total wait time (when the enqueueing was initiated -> when was dequeued) = \n\n" .
samplingStatsSummary totalWaitTime (2 + indent) .
showString "\n\n" .
showString tab .
showString "the enqueue wait time (when the enqueueing was initiated -> when was stored) = \n\n" .
samplingStatsSummary enqueueWaitTime (2 + indent) .
showString "\n\n" .
showString tab .
showString "the dequeue wait time (when was requested for dequeueing -> when was dequeued) = \n\n" .
samplingStatsSummary dequeueWaitTime (2 + indent)
resetQueue :: MonadDES m => Queue m si sm so a -> Event m ()
{-# INLINABLE resetQueue #-}
resetQueue q =
Event $ \p ->
do let t = pointTime p
queueCount <- invokeEvent p $ readRef (queueCountRef q)
invokeEvent p $ writeRef (queueCountStatsRef q) $
returnTimingStats t queueCount
invokeEvent p $ writeRef (enqueueCountRef q) 0
invokeEvent p $ writeRef (enqueueLostCountRef q) 0
invokeEvent p $ writeRef (enqueueStoreCountRef q) 0
invokeEvent p $ writeRef (dequeueCountRef q) 0
invokeEvent p $ writeRef (dequeueExtractCountRef q) 0
invokeEvent p $ writeRef (queueWaitTimeRef q) mempty
invokeEvent p $ writeRef (queueTotalWaitTimeRef q) mempty
invokeEvent p $ writeRef (enqueueWaitTimeRef q) mempty
invokeEvent p $ writeRef (dequeueWaitTimeRef q) mempty