-- |
-- Module     : Simulation.Aivika.GPSS.Queue
-- 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.2
--
-- This module defines a GPSS queue entity.
--
module Simulation.Aivika.GPSS.Queue
       (-- * Queue Types
        Queue,
        QueueEntry(..),
        -- * Creating Queue
        newQueue,
        -- * Queue Properties and Activities
        queueNull,
        queueContent,
        queueContentStats,
        enqueueCount,
        enqueueZeroEntryCount,
        queueWaitTime,
        queueNonZeroEntryWaitTime,
        queueRate,
        -- * Dequeuing and Enqueuing
        enqueue,
        dequeue,
        -- * Statistics Reset
        resetQueue,
        -- * Derived Signals for Properties
        queueNullChanged,
        queueNullChanged_,
        queueContentChanged,
        queueContentChanged_,
        enqueueCountChanged,
        enqueueCountChanged_,
        enqueueZeroEntryCountChanged,
        enqueueZeroEntryCountChanged_,
        queueWaitTimeChanged,
        queueWaitTimeChanged_,
        queueNonZeroEntryWaitTimeChanged,
        queueNonZeroEntryWaitTimeChanged_,
        queueRateChanged,
        queueRateChanged_,
        -- * Basic Signals
        enqueued,
        dequeued,
        -- * Overall Signal
        queueChanged_) where

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

import Control.Monad
import Control.Monad.Trans

import Simulation.Aivika
import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Dynamics
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Process
import Simulation.Aivika.Signal
import Simulation.Aivika.Statistics

import Simulation.Aivika.GPSS.Transact

-- | Represents the queue entity.
data Queue =
  Queue { Queue -> Int
queueSequenceNo :: Int,
          Queue -> IORef Int
queueContentRef :: IORef Int,
          Queue -> IORef (TimingStats Int)
queueContentStatsRef :: IORef (TimingStats Int),
          Queue -> IORef Int
enqueueCountRef :: IORef Int,
          Queue -> IORef Int
enqueueZeroEntryCountRef :: IORef Int,
          Queue -> IORef (SamplingStats Double)
queueWaitTimeRef :: IORef (SamplingStats Double),
          Queue -> IORef (SamplingStats Double)
queueNonZeroEntryWaitTimeRef :: IORef (SamplingStats Double),
          Queue -> SignalSource ()
enqueuedSource :: SignalSource (),
          Queue -> SignalSource ()
dequeuedSource :: SignalSource ()
        }

-- | The information about queue entry.
data QueueEntry =
  QueueEntry { QueueEntry -> Queue
entryQueue :: Queue,
               -- ^ the entry queue
               QueueEntry -> Double
entryEnqueueTime :: Double
               -- ^ the time of registering the queue entry
             } deriving QueueEntry -> QueueEntry -> Bool
(QueueEntry -> QueueEntry -> Bool)
-> (QueueEntry -> QueueEntry -> Bool) -> Eq QueueEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueueEntry -> QueueEntry -> Bool
$c/= :: QueueEntry -> QueueEntry -> Bool
== :: QueueEntry -> QueueEntry -> Bool
$c== :: QueueEntry -> QueueEntry -> Bool
Eq

instance Eq Queue where
  Queue
x == :: Queue -> Queue -> Bool
== Queue
y = (Queue -> IORef Int
queueContentRef Queue
x) IORef Int -> IORef Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Queue -> IORef Int
queueContentRef Queue
y)

instance Hashable Queue where
  hashWithSalt :: Int -> Queue -> Int
hashWithSalt Int
salt Queue
x = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Queue -> Int
queueSequenceNo Queue
x)

-- | Create a new queue.
newQueue :: Event Queue  
newQueue :: Event Queue
newQueue =
  do Double
t  <- Dynamics Double -> Event Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
     Generator
g  <- Parameter Generator -> Event Generator
forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Generator
generatorParameter
     Int
no <- IO Int -> Event Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Event Int) -> IO Int -> Event Int
forall a b. (a -> b) -> a -> b
$ Generator -> IO Int
generateSequenceNo Generator
g
     IORef Int
i  <- IO (IORef Int) -> Event (IORef Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> Event (IORef Int))
-> IO (IORef Int) -> Event (IORef Int)
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     IORef (TimingStats Int)
is <- IO (IORef (TimingStats Int)) -> Event (IORef (TimingStats Int))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (TimingStats Int)) -> Event (IORef (TimingStats Int)))
-> IO (IORef (TimingStats Int)) -> Event (IORef (TimingStats Int))
forall a b. (a -> b) -> a -> b
$ 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
     IORef Int
e  <- IO (IORef Int) -> Event (IORef Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> Event (IORef Int))
-> IO (IORef Int) -> Event (IORef Int)
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     IORef Int
z  <- IO (IORef Int) -> Event (IORef Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> Event (IORef Int))
-> IO (IORef Int) -> Event (IORef Int)
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0 
     IORef (SamplingStats Double)
w  <- IO (IORef (SamplingStats Double))
-> Event (IORef (SamplingStats Double))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (SamplingStats Double))
 -> Event (IORef (SamplingStats Double)))
-> IO (IORef (SamplingStats Double))
-> Event (IORef (SamplingStats Double))
forall a b. (a -> b) -> a -> b
$ SamplingStats Double -> IO (IORef (SamplingStats Double))
forall a. a -> IO (IORef a)
newIORef SamplingStats Double
forall a. Monoid a => a
mempty
     IORef (SamplingStats Double)
w2 <- IO (IORef (SamplingStats Double))
-> Event (IORef (SamplingStats Double))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (SamplingStats Double))
 -> Event (IORef (SamplingStats Double)))
-> IO (IORef (SamplingStats Double))
-> Event (IORef (SamplingStats Double))
forall a b. (a -> b) -> a -> b
$ SamplingStats Double -> IO (IORef (SamplingStats Double))
forall a. a -> IO (IORef a)
newIORef SamplingStats Double
forall a. Monoid a => a
mempty
     SignalSource ()
s1 <- Simulation (SignalSource ()) -> Event (SignalSource ())
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (Simulation (SignalSource ()) -> Event (SignalSource ()))
-> Simulation (SignalSource ()) -> Event (SignalSource ())
forall a b. (a -> b) -> a -> b
$ Simulation (SignalSource ())
forall a. Simulation (SignalSource a)
newSignalSource
     SignalSource ()
s2 <- Simulation (SignalSource ()) -> Event (SignalSource ())
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (Simulation (SignalSource ()) -> Event (SignalSource ()))
-> Simulation (SignalSource ()) -> Event (SignalSource ())
forall a b. (a -> b) -> a -> b
$ Simulation (SignalSource ())
forall a. Simulation (SignalSource a)
newSignalSource
     Queue -> Event Queue
forall (m :: * -> *) a. Monad m => a -> m a
return Queue :: Int
-> IORef Int
-> IORef (TimingStats Int)
-> IORef Int
-> IORef Int
-> IORef (SamplingStats Double)
-> IORef (SamplingStats Double)
-> SignalSource ()
-> SignalSource ()
-> Queue
Queue { queueSequenceNo :: Int
queueSequenceNo = Int
no,
                    queueContentRef :: IORef Int
queueContentRef = IORef Int
i,
                    queueContentStatsRef :: IORef (TimingStats Int)
queueContentStatsRef = IORef (TimingStats Int)
is,
                    enqueueCountRef :: IORef Int
enqueueCountRef = IORef Int
e,
                    enqueueZeroEntryCountRef :: IORef Int
enqueueZeroEntryCountRef = IORef Int
z,
                    queueWaitTimeRef :: IORef (SamplingStats Double)
queueWaitTimeRef = IORef (SamplingStats Double)
w,
                    queueNonZeroEntryWaitTimeRef :: IORef (SamplingStats Double)
queueNonZeroEntryWaitTimeRef = IORef (SamplingStats Double)
w2,
                    enqueuedSource :: SignalSource ()
enqueuedSource = SignalSource ()
s1,
                    dequeuedSource :: SignalSource ()
dequeuedSource = SignalSource ()
s2 }
  
-- | Test whether the queue is empty.
--
-- See also 'queueNullChanged' and 'queueNullChanged_'.
queueNull :: Queue -> Event Bool
queueNull :: Queue -> Event Bool
queueNull Queue
q =
  (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 (Queue -> IORef Int
queueContentRef Queue
q)
     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)
  
-- | Signal when the 'queueNull' property value has changed.
queueNullChanged :: Queue -> Signal Bool
queueNullChanged :: Queue -> Signal Bool
queueNullChanged Queue
q =
  (() -> Event Bool) -> Signal () -> Signal Bool
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Bool -> () -> Event Bool
forall a b. a -> b -> a
const (Event Bool -> () -> Event Bool) -> Event Bool -> () -> Event Bool
forall a b. (a -> b) -> a -> b
$ Queue -> Event Bool
queueNull Queue
q) (Queue -> Signal ()
queueNullChanged_ Queue
q)
  
-- | Signal when the 'queueNull' property value has changed.
queueNullChanged_ :: Queue -> Signal ()
queueNullChanged_ :: Queue -> Signal ()
queueNullChanged_ = Queue -> Signal ()
queueContentChanged_

-- | Return the current queue content.
--
-- See also 'queueContentStats', 'queueContentChanged' and 'queueContentChanged_'.
queueContent :: Queue -> Event Int
queueContent :: Queue -> Event Int
queueContent Queue
q =
  (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 (Queue -> IORef Int
queueContentRef Queue
q)

-- | Return the queue content statistics.
queueContentStats :: Queue -> Event (TimingStats Int)
queueContentStats :: Queue -> Event (TimingStats Int)
queueContentStats Queue
q =
  (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 (Queue -> IORef (TimingStats Int)
queueContentStatsRef Queue
q)
  
-- | Signal when the 'queueContent' property value has changed.
queueContentChanged :: Queue -> Signal Int
queueContentChanged :: Queue -> Signal Int
queueContentChanged Queue
q =
  (() -> Event Int) -> Signal () -> Signal Int
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Int -> () -> Event Int
forall a b. a -> b -> a
const (Event Int -> () -> Event Int) -> Event Int -> () -> Event Int
forall a b. (a -> b) -> a -> b
$ Queue -> Event Int
queueContent Queue
q) (Queue -> Signal ()
queueContentChanged_ Queue
q)
  
-- | Signal when the 'queueContent' property value has changed.
queueContentChanged_ :: Queue -> Signal ()
queueContentChanged_ :: Queue -> Signal ()
queueContentChanged_ Queue
q =
  (() -> ()) -> Signal () -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> () -> ()
forall a b. a -> b -> a
const ()) (Queue -> Signal ()
enqueued Queue
q) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  (() -> ()) -> Signal () -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> () -> ()
forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)

-- | Return the total number of input items that were enqueued.
--
-- See also 'enqueueCountChanged' and 'enqueueCountChanged_'.
enqueueCount :: Queue -> Event Int
enqueueCount :: Queue -> Event Int
enqueueCount Queue
q =
  (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 (Queue -> IORef Int
enqueueCountRef Queue
q)
  
-- | Signal when the 'enqueueCount' property value has changed.
enqueueCountChanged :: Queue -> Signal Int
enqueueCountChanged :: Queue -> Signal Int
enqueueCountChanged Queue
q =
  (() -> Event Int) -> Signal () -> Signal Int
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Int -> () -> Event Int
forall a b. a -> b -> a
const (Event Int -> () -> Event Int) -> Event Int -> () -> Event Int
forall a b. (a -> b) -> a -> b
$ Queue -> Event Int
enqueueCount Queue
q) (Queue -> Signal ()
enqueueCountChanged_ Queue
q)
  
-- | Signal when the 'enqueueCount' property value has changed.
enqueueCountChanged_ :: Queue -> Signal ()
enqueueCountChanged_ :: Queue -> Signal ()
enqueueCountChanged_ Queue
q =
  (() -> ()) -> Signal () -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> () -> ()
forall a b. a -> b -> a
const ()) (Queue -> Signal ()
enqueued Queue
q)

-- | Return the total number of zero entry items.
--
-- See also 'enqueueZeroEntryCountChanged' and 'enqueueZeroEntryCountChanged_'.
enqueueZeroEntryCount :: Queue -> Event Int
enqueueZeroEntryCount :: Queue -> Event Int
enqueueZeroEntryCount Queue
q =
  (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 (Queue -> IORef Int
enqueueZeroEntryCountRef Queue
q)
  
-- | Signal when the 'enqueueZeroEntryCount' property value has changed.
enqueueZeroEntryCountChanged :: Queue -> Signal Int
enqueueZeroEntryCountChanged :: Queue -> Signal Int
enqueueZeroEntryCountChanged Queue
q =
  (() -> Event Int) -> Signal () -> Signal Int
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Int -> () -> Event Int
forall a b. a -> b -> a
const (Event Int -> () -> Event Int) -> Event Int -> () -> Event Int
forall a b. (a -> b) -> a -> b
$ Queue -> Event Int
enqueueZeroEntryCount Queue
q) (Queue -> Signal ()
enqueueZeroEntryCountChanged_ Queue
q)
  
-- | Signal when the 'enqueueZeroEntryCount' property value has changed.
enqueueZeroEntryCountChanged_ :: Queue -> Signal ()
enqueueZeroEntryCountChanged_ :: Queue -> Signal ()
enqueueZeroEntryCountChanged_ Queue
q =
  (() -> ()) -> Signal () -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> () -> ()
forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)

-- | Return the wait (or residence) time.
--
-- See also 'queueWaitTimeChanged' and 'queueWaitTimeChanged_'.
queueWaitTime :: Queue -> Event (SamplingStats Double)
queueWaitTime :: Queue -> Event (SamplingStats Double)
queueWaitTime Queue
q =
  (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 (Queue -> IORef (SamplingStats Double)
queueWaitTimeRef Queue
q)
      
-- | Signal when the 'queueWaitTime' property value has changed.
queueWaitTimeChanged :: Queue -> Signal (SamplingStats Double)
queueWaitTimeChanged :: Queue -> Signal (SamplingStats Double)
queueWaitTimeChanged Queue
q =
  (() -> Event (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event (SamplingStats Double) -> () -> Event (SamplingStats Double)
forall a b. a -> b -> a
const (Event (SamplingStats Double)
 -> () -> Event (SamplingStats Double))
-> Event (SamplingStats Double)
-> ()
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ Queue -> Event (SamplingStats Double)
queueWaitTime Queue
q) (Queue -> Signal ()
queueWaitTimeChanged_ Queue
q)
  
-- | Signal when the 'queueWaitTime' property value has changed.
queueWaitTimeChanged_ :: Queue -> Signal ()
queueWaitTimeChanged_ :: Queue -> Signal ()
queueWaitTimeChanged_ Queue
q =
  (() -> ()) -> Signal () -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> () -> ()
forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)
      
-- | Return the wait (or residence) time excluding zero entries.
--
-- See also 'queueNonZeroEntryWaitTimeChanged' and 'queueNonZeroEntryWaitTimeChanged_'.
queueNonZeroEntryWaitTime :: Queue -> Event (SamplingStats Double)
queueNonZeroEntryWaitTime :: Queue -> Event (SamplingStats Double)
queueNonZeroEntryWaitTime Queue
q =
  (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 (Queue -> IORef (SamplingStats Double)
queueNonZeroEntryWaitTimeRef Queue
q)
      
-- | Signal when the 'queueNonZeroEntryWaitTime' property value has changed.
queueNonZeroEntryWaitTimeChanged :: Queue -> Signal (SamplingStats Double)
queueNonZeroEntryWaitTimeChanged :: Queue -> Signal (SamplingStats Double)
queueNonZeroEntryWaitTimeChanged Queue
q =
  (() -> Event (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event (SamplingStats Double) -> () -> Event (SamplingStats Double)
forall a b. a -> b -> a
const (Event (SamplingStats Double)
 -> () -> Event (SamplingStats Double))
-> Event (SamplingStats Double)
-> ()
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ Queue -> Event (SamplingStats Double)
queueNonZeroEntryWaitTime Queue
q) (Queue -> Signal ()
queueNonZeroEntryWaitTimeChanged_ Queue
q)
  
-- | Signal when the 'queueNonZeroEntryWaitTime' property value has changed.
queueNonZeroEntryWaitTimeChanged_ :: Queue -> Signal ()
queueNonZeroEntryWaitTimeChanged_ :: Queue -> Signal ()
queueNonZeroEntryWaitTimeChanged_ Queue
q =
  (() -> ()) -> Signal () -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> () -> ()
forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)

-- | Return a long-term average queue rate calculated as
-- the average queue content divided by the average wait time.
--
-- See also 'queueRateChanged' and 'queueRateChanged_'.
queueRate :: Queue -> Event Double
queueRate :: Queue -> Event Double
queueRate Queue
q =
  (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
x <- IORef (TimingStats Int) -> IO (TimingStats Int)
forall a. IORef a -> IO a
readIORef (Queue -> IORef (TimingStats Int)
queueContentStatsRef Queue
q)
     SamplingStats Double
y <- IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Queue -> IORef (SamplingStats Double)
queueWaitTimeRef Queue
q)
     Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (TimingStats Int -> Double
forall a. TimingData a => TimingStats a -> Double
timingStatsMean TimingStats Int
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ SamplingStats Double -> Double
forall a. SamplingStats a -> Double
samplingStatsMean SamplingStats Double
y) 
      
-- | Signal when the 'queueRate' property value has changed.
queueRateChanged :: Queue -> Signal Double
queueRateChanged :: Queue -> Signal Double
queueRateChanged Queue
q =
  (() -> Event Double) -> Signal () -> Signal Double
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Double -> () -> Event Double
forall a b. a -> b -> a
const (Event Double -> () -> Event Double)
-> Event Double -> () -> Event Double
forall a b. (a -> b) -> a -> b
$ Queue -> Event Double
queueRate Queue
q) (Queue -> Signal ()
queueRateChanged_ Queue
q)
      
-- | Signal when the 'queueRate' property value has changed.
queueRateChanged_ :: Queue -> Signal ()
queueRateChanged_ :: Queue -> Signal ()
queueRateChanged_ Queue
q =
  (() -> ()) -> Signal () -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> () -> ()
forall a b. a -> b -> a
const ()) (Queue -> Signal ()
enqueued Queue
q) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  (() -> ()) -> Signal () -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> () -> ()
forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)

-- | Return a signal that notifies when enqueuing an item.
enqueued:: Queue -> Signal ()
enqueued :: Queue -> Signal ()
enqueued Queue
q = SignalSource () -> Signal ()
forall a. SignalSource a -> Signal a
publishSignal (Queue -> SignalSource ()
enqueuedSource Queue
q)

-- | Return a signal that notifies when the dequeuing the item.
dequeued :: Queue -> Signal ()
dequeued :: Queue -> Signal ()
dequeued Queue
q = SignalSource () -> Signal ()
forall a. SignalSource a -> Signal a
publishSignal (Queue -> SignalSource ()
dequeuedSource Queue
q)

-- | Enqueue the item.
enqueue :: Queue
           -- ^ the queue
           -> Transact a
           -- ^ the item to be enqueued
           -> Int
           -- ^ the content increment
           -> Event ()
enqueue :: Queue -> Transact a -> Int -> Event ()
enqueue Queue
q Transact a
transact 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
         e :: QueueEntry
e = QueueEntry :: Queue -> Double -> QueueEntry
QueueEntry { entryQueue :: Queue
entryQueue = Queue
q,
                          entryEnqueueTime :: Double
entryEnqueueTime = Double
t }
     Int
n <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
enqueueCountRef Queue
q)
     let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     Int
n' Int -> IO () -> IO ()
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef Int
enqueueCountRef Queue
q) Int
n'
     Int
c <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
queueContentRef Queue
q)
     let c' :: Int
c' = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
increment
     Int
c' Int -> IO () -> IO ()
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef Int
queueContentRef Queue
q) Int
c'
     IORef (TimingStats Int)
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Queue -> IORef (TimingStats Int)
queueContentStatsRef Queue
q) (Double -> Int -> TimingStats Int -> TimingStats Int
forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats Double
t Int
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
$
       Transact a -> QueueEntry -> Event ()
forall a. Transact a -> QueueEntry -> Event ()
registerTransactQueueEntry Transact a
transact QueueEntry
e
     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 (Queue -> SignalSource ()
enqueuedSource Queue
q) ()

-- | Dequeue the item.
dequeue :: Queue
           -- ^ the queue
           -> Transact a
           -- ^ the item to be dequeued
           -> Int
           -- ^ the content decrement
           -> Event ()
dequeue :: Queue -> Transact a -> Int -> Event ()
dequeue Queue
q Transact a
transact Int
decrement =
  (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 QueueEntry
e <- Point -> Event QueueEntry -> IO QueueEntry
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event QueueEntry -> IO QueueEntry)
-> Event QueueEntry -> IO QueueEntry
forall a b. (a -> b) -> a -> b
$
          Transact a -> Queue -> Event QueueEntry
forall a. Transact a -> Queue -> Event QueueEntry
unregisterTransactQueueEntry Transact a
transact Queue
q
     let t :: Double
t  = Point -> Double
pointTime Point
p
         t0 :: Double
t0 = QueueEntry -> Double
entryEnqueueTime QueueEntry
e
         dt :: Double
dt = Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0
     Int
c <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
queueContentRef Queue
q)
     let c' :: Int
c' = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
decrement
     Int
c' Int -> IO () -> IO ()
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef Int
queueContentRef Queue
q) Int
c'
     IORef (TimingStats Int)
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Queue -> IORef (TimingStats Int)
queueContentStatsRef Queue
q) (Double -> Int -> TimingStats Int -> TimingStats Int
forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats Double
t Int
c')
     IORef (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Queue -> IORef (SamplingStats Double)
queueWaitTimeRef Queue
q) ((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
dt
     if Double
t Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
t0
       then IORef Int -> (Int -> Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Queue -> IORef Int
enqueueZeroEntryCountRef Queue
q) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
       else IORef (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Queue -> IORef (SamplingStats Double)
queueNonZeroEntryWaitTimeRef Queue
q) ((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
dt
     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 (Queue -> SignalSource ()
dequeuedSource Queue
q) ()

-- | Signal whenever any property of the queue changes.
--
-- The property must have the corresponded signal. There are also characteristics
-- similar to the properties but that have no signals. As a rule, such characteristics
-- already depend on the simulation time and therefore they may change at any
-- time point.
queueChanged_ :: Queue -> Signal ()
queueChanged_ :: Queue -> Signal ()
queueChanged_ Queue
q =
  (() -> ()) -> Signal () -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> () -> ()
forall a b. a -> b -> a
const ()) (Queue -> Signal ()
enqueued Queue
q) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  (() -> ()) -> Signal () -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> () -> ()
forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)

-- | Reset the statistics.
resetQueue :: Queue -> Event () 
resetQueue :: Queue -> Event ()
resetQueue Queue
q =
  do Double
t  <- Dynamics Double -> Event Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
     Int
content <- IO Int -> Event Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Event Int) -> IO Int -> Event Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
queueContentRef Queue
q)
     IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$ IORef (TimingStats Int) -> TimingStats Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef (TimingStats Int)
queueContentStatsRef Queue
q) (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
     IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$ IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef Int
enqueueCountRef Queue
q) Int
0
     IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$ IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef Int
enqueueZeroEntryCountRef Queue
q) Int
0
     IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$ IORef (SamplingStats Double) -> SamplingStats Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef (SamplingStats Double)
queueWaitTimeRef Queue
q) SamplingStats Double
forall a. Monoid a => a
mempty
     IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$ IORef (SamplingStats Double) -> SamplingStats Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef (SamplingStats Double)
queueNonZeroEntryWaitTimeRef Queue
q) SamplingStats Double
forall a. Monoid a => a
mempty