module Simulation.Aivika.Queue
(Queue,
queueNull,
queueFull,
queueMaxCount,
queueCount,
queueLostCount,
enqueued,
dequeued,
enqueuedButLost,
newQueue,
dequeue,
dequeueWithPriority,
dequeueWithDynamicPriority,
tryDequeue,
enqueue,
enqueueWithPriority,
enqueueWithDynamicPriority,
tryEnqueue,
enqueueOrLost,
enqueueOrLost_) where
import Data.IORef
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Process
import Simulation.Aivika.Internal.Signal
import Simulation.Aivika.Signal
import Simulation.Aivika.Resource
import Simulation.Aivika.QueueStrategy
data Queue si qi sm qm so qo a =
Queue { queueMaxCount :: Int,
queueInputStrategy :: si,
queueMemoryStrategy :: sm,
queueOutputStrategy :: so,
queueInputRes :: Resource si qi,
queueMemory :: qm a,
queueOutputRes :: Resource so qo,
queueCountRef :: IORef Int,
queueLostCountRef :: IORef Int,
enqueuedSource :: SignalSource a,
enqueuedButLostSource :: SignalSource a,
dequeuedSource :: SignalSource a }
newQueue :: (QueueStrategy si qi,
QueueStrategy sm qm,
QueueStrategy so qo) =>
si
-> sm
-> so
-> Int
-> Simulation (Queue si qi sm qm so qo a)
newQueue si sm so count =
do i <- liftIO $ newIORef 0
l <- liftIO $ newIORef 0
ri <- newResourceWithCount si count count
qm <- newStrategyQueue sm
ro <- newResourceWithCount so count 0
s1 <- newSignalSource
s2 <- newSignalSource
s3 <- newSignalSource
return Queue { queueMaxCount = count,
queueInputStrategy = si,
queueMemoryStrategy = sm,
queueOutputStrategy = so,
queueInputRes = ri,
queueMemory = qm,
queueOutputRes = ro,
queueCountRef = i,
queueLostCountRef = l,
enqueuedSource = s1,
enqueuedButLostSource = s2,
dequeuedSource = s3 }
queueNull :: Queue si qi sm qm so qo a -> Event Bool
queueNull q =
Event $ \p ->
do n <- readIORef (queueCountRef q)
return (n == 0)
queueFull :: Queue si qi sm qm so qo a -> Event Bool
queueFull q =
Event $ \p ->
do n <- readIORef (queueCountRef q)
return (n == queueMaxCount q)
queueCount :: Queue si qi sm qm so qo a -> Event Int
queueCount q =
Event $ \p -> readIORef (queueCountRef q)
queueLostCount :: Queue si qi sm qm so qo a -> Event Int
queueLostCount q =
Event $ \p -> readIORef (queueLostCountRef q)
dequeue :: (DequeueStrategy si qi,
DequeueStrategy sm qm,
EnqueueStrategy so qo)
=> Queue si qi sm qm so qo a
-> Process a
dequeue q =
do requestResource (queueOutputRes q)
a <- liftEvent $
strategyDequeue (queueMemoryStrategy q) (queueMemory q)
releaseResource (queueInputRes q)
liftEvent $
triggerSignal (dequeuedSource q) a
return a
dequeueWithPriority :: (DequeueStrategy si qi,
DequeueStrategy sm qm,
PriorityQueueStrategy so qo)
=> Queue si qi sm qm so qo a
-> Double
-> Process a
dequeueWithPriority q priority =
do requestResourceWithPriority (queueOutputRes q) priority
a <- liftEvent $
strategyDequeue (queueMemoryStrategy q) (queueMemory q)
releaseResource (queueInputRes q)
liftEvent $
triggerSignal (dequeuedSource q) a
return a
dequeueWithDynamicPriority :: (DequeueStrategy si qi,
DequeueStrategy sm qm,
DynamicPriorityQueueStrategy so qo)
=> Queue si qi sm qm so qo a
-> Event Double
-> Process a
dequeueWithDynamicPriority q priority =
do requestResourceWithDynamicPriority (queueOutputRes q) priority
a <- liftEvent $
strategyDequeue (queueMemoryStrategy q) (queueMemory q)
releaseResource (queueInputRes q)
liftEvent $
triggerSignal (dequeuedSource q) a
return a
tryDequeue :: (DequeueStrategy si qi,
DequeueStrategy sm qm)
=> Queue si qi sm qm so qo a
-> Event (Maybe a)
tryDequeue q =
do x <- tryRequestResourceWithinEvent (queueOutputRes q)
if x
then do a <- strategyDequeue (queueMemoryStrategy q) (queueMemory q)
releaseResourceWithinEvent (queueInputRes q)
triggerSignal (dequeuedSource q) a
return $ Just a
else return Nothing
enqueue :: (EnqueueStrategy si qi,
EnqueueStrategy sm qm,
DequeueStrategy so qo)
=> Queue si qi sm qm so qo a
-> a
-> Process ()
enqueue q a =
do requestResource (queueInputRes q)
liftEvent $
strategyEnqueue (queueMemoryStrategy q) (queueMemory q) a
releaseResource (queueOutputRes q)
liftEvent $
triggerSignal (enqueuedSource q) a
enqueueWithPriority :: (PriorityQueueStrategy si qi,
EnqueueStrategy sm qm,
DequeueStrategy so qo)
=> Queue si qi sm qm so qo a
-> Double
-> a
-> Process ()
enqueueWithPriority q priority a =
do requestResourceWithPriority (queueInputRes q) priority
liftEvent $
strategyEnqueue (queueMemoryStrategy q) (queueMemory q) a
releaseResource (queueOutputRes q)
liftEvent $
triggerSignal (enqueuedSource q) a
enqueueWithDynamicPriority :: (DynamicPriorityQueueStrategy si qi,
EnqueueStrategy sm qm,
DequeueStrategy so qo)
=> Queue si qi sm qm so qo a
-> Event Double
-> a
-> Process ()
enqueueWithDynamicPriority q priority a =
do requestResourceWithDynamicPriority (queueInputRes q) priority
liftEvent $
strategyEnqueue (queueMemoryStrategy q) (queueMemory q) a
releaseResource (queueOutputRes q)
liftEvent $
triggerSignal (enqueuedSource q) a
tryEnqueue :: (EnqueueStrategy sm qm,
DequeueStrategy so qo)
=> Queue si qi sm qm so qo a
-> a
-> Event Bool
tryEnqueue q a =
do x <- tryRequestResourceWithinEvent (queueInputRes q)
if x
then do strategyEnqueue (queueMemoryStrategy q) (queueMemory q) a
releaseResourceWithinEvent (queueOutputRes q)
triggerSignal (enqueuedSource q) a
return True
else return False
enqueueOrLost :: (EnqueueStrategy sm qm,
DequeueStrategy so qo)
=> Queue si qi sm qm so qo a
-> a
-> Event Bool
enqueueOrLost q a =
do x <- tryRequestResourceWithinEvent (queueInputRes q)
if x
then do strategyEnqueue (queueMemoryStrategy q) (queueMemory q) a
releaseResourceWithinEvent (queueOutputRes q)
triggerSignal (enqueuedSource q) a
return True
else do liftIO $ modifyIORef (queueLostCountRef q) $ (+) 1
triggerSignal (enqueuedButLostSource q) a
return False
enqueueOrLost_ :: (EnqueueStrategy sm qm,
DequeueStrategy so qo)
=> Queue si qi sm qm so qo a
-> a
-> Event ()
enqueueOrLost_ q a =
do x <- enqueueOrLost q a
return ()
enqueued :: Queue si qi sm qm so qo a -> Signal a
enqueued q = publishSignal (enqueuedSource q)
enqueuedButLost :: Queue si qi sm qm so qo a -> Signal a
enqueuedButLost q = publishSignal (enqueuedButLostSource q)
dequeued :: Queue si qi sm qm so qo a -> Signal a
dequeued q = publishSignal (dequeuedSource q)