-- |
-- Module     : Simulation.Aivika.Queue.Infinite.Base
-- Copyright  : Copyright (c) 2009-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 an infinite optimised queue, which has no counters nor signals.
--
module Simulation.Aivika.Queue.Infinite.Base
       (-- * Queue Types
        FCFSQueue,
        LCFSQueue,
        SIROQueue,
        PriorityQueue,
        Queue,
        -- * Creating Queue
        newFCFSQueue,
        newLCFSQueue,
        newSIROQueue,
        newPriorityQueue,
        newQueue,
        -- * Queue Properties and Activities
        enqueueStoringStrategy,
        dequeueStrategy,
        queueNull,
        queueCount,
        -- * Dequeuing and Enqueuing
        dequeue,
        dequeueWithOutputPriority,
        tryDequeue,
        enqueue,
        enqueueWithStoringPriority,
        queueDelete,
        queueDelete_,
        queueDeleteBy,
        queueDeleteBy_,
        queueContains,
        queueContainsBy,
        clearQueue) where

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

import Control.Monad
import Control.Monad.Trans

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.Resource.Base
import Simulation.Aivika.QueueStrategy

import qualified Simulation.Aivika.DoubleLinkedList as DLL 
import qualified Simulation.Aivika.Vector as V
import qualified Simulation.Aivika.PriorityQueue as PQ

-- | A type synonym for the ordinary FIFO queue also known as the FCFS
-- (First Come - First Serviced) queue.
type FCFSQueue a = Queue FCFS FCFS a

-- | A type synonym for the ordinary LIFO queue also known as the LCFS
-- (Last Come - First Serviced) queue.
type LCFSQueue a = Queue LCFS FCFS a

-- | A type synonym for the SIRO (Serviced in Random Order) queue.
type SIROQueue a = Queue SIRO FCFS a

-- | A type synonym for the queue with static priorities applied when
-- storing the elements in the queue.
type PriorityQueue a = Queue StaticPriorities FCFS a

-- | Represents an infinite queue using the specified strategies for
-- internal storing (in memory), @sm@, and dequeueing (output), @so@, where @a@ denotes
-- the type of items stored in the queue.
data Queue sm so a =
  Queue { forall sm so a. Queue sm so a -> sm
enqueueStoringStrategy :: sm,
          -- ^ The strategy applied when storing (in memory) items in the queue.
          forall sm so a. Queue sm so a -> so
dequeueStrategy :: so,
          -- ^ The strategy applied to the dequeueing (output) processes.
          forall sm so a. Queue sm so a -> StrategyQueue sm a
queueStore :: StrategyQueue sm a,
          forall sm so a. Queue sm so a -> Resource so
dequeueRes :: Resource so,
          forall sm so a. Queue sm so a -> IORef Int
queueCountRef :: IORef Int }
  
-- | Create a new infinite FCFS queue.  
newFCFSQueue :: Simulation (FCFSQueue a)  
newFCFSQueue :: forall a. Simulation (FCFSQueue a)
newFCFSQueue = FCFS -> FCFS -> Simulation (Queue FCFS FCFS a)
forall sm so a.
(QueueStrategy sm, QueueStrategy so) =>
sm -> so -> Simulation (Queue sm so a)
newQueue FCFS
FCFS FCFS
FCFS
  
-- | Create a new infinite LCFS queue.  
newLCFSQueue :: Simulation (LCFSQueue a)  
newLCFSQueue :: forall a. Simulation (LCFSQueue a)
newLCFSQueue = LCFS -> FCFS -> Simulation (Queue LCFS FCFS a)
forall sm so a.
(QueueStrategy sm, QueueStrategy so) =>
sm -> so -> Simulation (Queue sm so a)
newQueue LCFS
LCFS FCFS
FCFS
  
-- | Create a new infinite SIRO queue.  
newSIROQueue :: Simulation (SIROQueue a)  
newSIROQueue :: forall a. Simulation (SIROQueue a)
newSIROQueue = SIRO -> FCFS -> Simulation (Queue SIRO FCFS a)
forall sm so a.
(QueueStrategy sm, QueueStrategy so) =>
sm -> so -> Simulation (Queue sm so a)
newQueue SIRO
SIRO FCFS
FCFS
  
-- | Create a new infinite priority queue.  
newPriorityQueue :: Simulation (PriorityQueue a)  
newPriorityQueue :: forall a. Simulation (PriorityQueue a)
newPriorityQueue = StaticPriorities
-> FCFS -> Simulation (Queue StaticPriorities FCFS a)
forall sm so a.
(QueueStrategy sm, QueueStrategy so) =>
sm -> so -> Simulation (Queue sm so a)
newQueue StaticPriorities
StaticPriorities FCFS
FCFS
  
-- | Create a new infinite queue with the specified strategies.  
newQueue :: (QueueStrategy sm,
             QueueStrategy so) =>
            sm
            -- ^ the strategy applied when storing items in the queue
            -> so
            -- ^ the strategy applied to the dequeueing (output) processes when the queue is empty
            -> Simulation (Queue sm so a)  
newQueue :: forall sm so a.
(QueueStrategy sm, QueueStrategy so) =>
sm -> so -> Simulation (Queue sm so a)
newQueue sm
sm so
so =
  do IORef Int
i  <- IO (IORef Int) -> Simulation (IORef Int)
forall a. IO a -> Simulation a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> Simulation (IORef Int))
-> IO (IORef Int) -> Simulation (IORef Int)
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     StrategyQueue sm a
qm <- sm -> Simulation (StrategyQueue sm a)
forall i. sm -> Simulation (StrategyQueue sm i)
forall s i. QueueStrategy s => s -> Simulation (StrategyQueue s i)
newStrategyQueue sm
sm
     Resource so
ro <- so -> Int -> Maybe Int -> Simulation (Resource so)
forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount so
so Int
0 Maybe Int
forall a. Maybe a
Nothing
     Queue sm so a -> Simulation (Queue sm so a)
forall a. a -> Simulation a
forall (m :: * -> *) a. Monad m => a -> m a
return Queue { enqueueStoringStrategy :: sm
enqueueStoringStrategy = sm
sm,
                    dequeueStrategy :: so
dequeueStrategy = so
so,
                    queueStore :: StrategyQueue sm a
queueStore = StrategyQueue sm a
qm,
                    dequeueRes :: Resource so
dequeueRes = Resource so
ro,
                    queueCountRef :: IORef Int
queueCountRef = IORef Int
i }

-- | Test whether the queue is empty.
--
-- See also 'queueNullChanged' and 'queueNullChanged_'.
queueNull :: Queue sm so a -> Event Bool
queueNull :: forall sm so a. Queue sm so a -> Event Bool
queueNull Queue sm so a
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 sm so a -> IORef Int
forall sm so a. Queue sm so a -> IORef Int
queueCountRef Queue sm so a
q)
     Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
  
-- | Return the current queue size.
--
-- See also 'queueCountStats', 'queueCountChanged' and 'queueCountChanged_'.
queueCount :: Queue sm so a -> Event Int
queueCount :: forall sm so a. Queue sm so a -> Event Int
queueCount Queue sm so a
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 sm so a -> IORef Int
forall sm so a. Queue sm so a -> IORef Int
queueCountRef Queue sm so a
q)

-- | Dequeue suspending the process if the queue is empty.
dequeue :: (DequeueStrategy sm,
            EnqueueStrategy so)
           => Queue sm so a
           -- ^ the queue
           -> Process a
           -- ^ the dequeued value
dequeue :: forall sm so a.
(DequeueStrategy sm, EnqueueStrategy so) =>
Queue sm so a -> Process a
dequeue Queue sm so a
q =
  do Resource so -> Process ()
forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource (Queue sm so a -> Resource so
forall sm so a. Queue sm so a -> Resource so
dequeueRes Queue sm so a
q)
     Event a -> Process a
forall a. Event a -> Process a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event a -> Process a) -> Event a -> Process a
forall a b. (a -> b) -> a -> b
$ Queue sm so a -> Event a
forall sm so a. DequeueStrategy sm => Queue sm so a -> Event a
dequeueExtract Queue sm so a
q
  
-- | Dequeue with the output priority suspending the process if the queue is empty.
dequeueWithOutputPriority :: (DequeueStrategy sm,
                              PriorityQueueStrategy so po)
                             => Queue sm so a
                             -- ^ the queue
                             -> po
                             -- ^ the priority for output
                             -> Process a
                             -- ^ the dequeued value
dequeueWithOutputPriority :: forall sm so po a.
(DequeueStrategy sm, PriorityQueueStrategy so po) =>
Queue sm so a -> po -> Process a
dequeueWithOutputPriority Queue sm so a
q po
po =
  do Resource so -> po -> Process ()
forall s p.
PriorityQueueStrategy s p =>
Resource s -> p -> Process ()
requestResourceWithPriority (Queue sm so a -> Resource so
forall sm so a. Queue sm so a -> Resource so
dequeueRes Queue sm so a
q) po
po
     Event a -> Process a
forall a. Event a -> Process a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event a -> Process a) -> Event a -> Process a
forall a b. (a -> b) -> a -> b
$ Queue sm so a -> Event a
forall sm so a. DequeueStrategy sm => Queue sm so a -> Event a
dequeueExtract Queue sm so a
q
  
-- | Try to dequeue immediately.
tryDequeue :: DequeueStrategy sm
              => Queue sm so a
              -- ^ the queue
              -> Event (Maybe a)
              -- ^ the dequeued value of 'Nothing'
tryDequeue :: forall sm so a.
DequeueStrategy sm =>
Queue sm so a -> Event (Maybe a)
tryDequeue Queue sm so a
q =
  do Bool
x <- Resource so -> Event Bool
forall s. Resource s -> Event Bool
tryRequestResourceWithinEvent (Queue sm so a -> Resource so
forall sm so a. Queue sm so a -> Resource so
dequeueRes Queue sm so a
q)
     if Bool
x 
       then (a -> Maybe a) -> Event a -> Event (Maybe a)
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Event a -> Event (Maybe a)) -> Event a -> Event (Maybe a)
forall a b. (a -> b) -> a -> b
$ Queue sm so a -> Event a
forall sm so a. DequeueStrategy sm => Queue sm so a -> Event a
dequeueExtract Queue sm so a
q
       else Maybe a -> Event (Maybe a)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | Remove the item from the queue and return a flag indicating
-- whether the item was found and actually removed.
queueDelete :: (Eq a,
                DeletingQueueStrategy sm,
                DequeueStrategy so)
               => Queue sm so a
               -- ^ the queue
               -> a
               -- ^ the item to remove from the queue
               -> Event Bool
               -- ^ whether the item was found and removed
queueDelete :: forall a sm so.
(Eq a, DeletingQueueStrategy sm, DequeueStrategy so) =>
Queue sm so a -> a -> Event Bool
queueDelete Queue sm so a
q a
a = (Maybe a -> Bool) -> Event (Maybe a) -> Event Bool
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Event (Maybe a) -> Event Bool) -> Event (Maybe a) -> Event Bool
forall a b. (a -> b) -> a -> b
$ Queue sm so a -> (a -> Bool) -> Event (Maybe a)
forall sm so a.
(DeletingQueueStrategy sm, DequeueStrategy so) =>
Queue sm so a -> (a -> Bool) -> Event (Maybe a)
queueDeleteBy Queue sm so a
q (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a)

-- | Remove the specified item from the queue.
queueDelete_ :: (Eq a,
                 DeletingQueueStrategy sm,
                 DequeueStrategy so)
                => Queue sm so a
                -- ^ the queue
                -> a
                -- ^ the item to remove from the queue
                -> Event ()
queueDelete_ :: forall a sm so.
(Eq a, DeletingQueueStrategy sm, DequeueStrategy so) =>
Queue sm so a -> a -> Event ()
queueDelete_ Queue sm so a
q a
a = (Maybe a -> ()) -> Event (Maybe a) -> Event ()
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> Maybe a -> ()
forall a b. a -> b -> a
const ()) (Event (Maybe a) -> Event ()) -> Event (Maybe a) -> Event ()
forall a b. (a -> b) -> a -> b
$ Queue sm so a -> (a -> Bool) -> Event (Maybe a)
forall sm so a.
(DeletingQueueStrategy sm, DequeueStrategy so) =>
Queue sm so a -> (a -> Bool) -> Event (Maybe a)
queueDeleteBy Queue sm so a
q (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a)

-- | Remove an item satisfying the specified predicate and return the item if found.
queueDeleteBy :: (DeletingQueueStrategy sm,
                  DequeueStrategy so)
                 => Queue sm so a
                 -- ^ the queue
                 -> (a -> Bool)
                 -- ^ the predicate
                 -> Event (Maybe a)
queueDeleteBy :: forall sm so a.
(DeletingQueueStrategy sm, DequeueStrategy so) =>
Queue sm so a -> (a -> Bool) -> Event (Maybe a)
queueDeleteBy Queue sm so a
q a -> Bool
pred =
  do Bool
x <- Resource so -> Event Bool
forall s. Resource s -> Event Bool
tryRequestResourceWithinEvent (Queue sm so a -> Resource so
forall sm so a. Queue sm so a -> Resource so
dequeueRes Queue sm so a
q)
     if Bool
x
       then do Maybe a
i <- StrategyQueue sm a -> (a -> Bool) -> Event (Maybe a)
forall s i.
DeletingQueueStrategy s =>
StrategyQueue s i -> (i -> Bool) -> Event (Maybe i)
forall i. StrategyQueue sm i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy (Queue sm so a -> StrategyQueue sm a
forall sm so a. Queue sm so a -> StrategyQueue sm a
queueStore Queue sm so a
q) a -> Bool
pred
               case Maybe a
i of
                 Maybe a
Nothing ->
                   do Resource so -> Event ()
forall s. DequeueStrategy s => Resource s -> Event ()
releaseResourceWithinEvent (Queue sm so a -> Resource so
forall sm so a. Queue sm so a -> Resource so
dequeueRes Queue sm so a
q)
                      Maybe a -> Event (Maybe a)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                 Just a
i ->
                   (a -> Maybe a) -> Event a -> Event (Maybe a)
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Event a -> Event (Maybe a)) -> Event a -> Event (Maybe a)
forall a b. (a -> b) -> a -> b
$ Queue sm so a -> a -> Event a
forall sm so a. DequeueStrategy sm => Queue sm so a -> a -> Event a
dequeuePostExtract Queue sm so a
q a
i
       else Maybe a -> Event (Maybe a)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
               
-- | Remove an item satisfying the specified predicate.
queueDeleteBy_ :: (DeletingQueueStrategy sm,
                   DequeueStrategy so)
                  => Queue sm so a
                  -- ^ the queue
                  -> (a -> Bool)
                  -- ^ the predicate
                  -> Event ()
queueDeleteBy_ :: forall sm so a.
(DeletingQueueStrategy sm, DequeueStrategy so) =>
Queue sm so a -> (a -> Bool) -> Event ()
queueDeleteBy_ Queue sm so a
q a -> Bool
pred = (Maybe a -> ()) -> Event (Maybe a) -> Event ()
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> Maybe a -> ()
forall a b. a -> b -> a
const ()) (Event (Maybe a) -> Event ()) -> Event (Maybe a) -> Event ()
forall a b. (a -> b) -> a -> b
$ Queue sm so a -> (a -> Bool) -> Event (Maybe a)
forall sm so a.
(DeletingQueueStrategy sm, DequeueStrategy so) =>
Queue sm so a -> (a -> Bool) -> Event (Maybe a)
queueDeleteBy Queue sm so a
q a -> Bool
pred

-- | Detect whether the item is contained in the queue.
queueContains :: (Eq a,
                  DeletingQueueStrategy sm)
                 => Queue sm so a
                 -- ^ the queue
                 -> a
                 -- ^ the item to search the queue for
                 -> Event Bool
                 -- ^ whether the item was found
queueContains :: forall a sm so.
(Eq a, DeletingQueueStrategy sm) =>
Queue sm so a -> a -> Event Bool
queueContains Queue sm so a
q a
a = (Maybe a -> Bool) -> Event (Maybe a) -> Event Bool
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Event (Maybe a) -> Event Bool) -> Event (Maybe a) -> Event Bool
forall a b. (a -> b) -> a -> b
$ Queue sm so a -> (a -> Bool) -> Event (Maybe a)
forall sm so a.
DeletingQueueStrategy sm =>
Queue sm so a -> (a -> Bool) -> Event (Maybe a)
queueContainsBy Queue sm so a
q (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a)

-- | Detect whether an item satisfying the specified predicate is contained in the queue.
queueContainsBy :: DeletingQueueStrategy sm
                   => Queue sm so a
                   -- ^ the queue
                   -> (a -> Bool)
                   -- ^ the predicate
                   -> Event (Maybe a)
                   -- ^ the item if it was found
queueContainsBy :: forall sm so a.
DeletingQueueStrategy sm =>
Queue sm so a -> (a -> Bool) -> Event (Maybe a)
queueContainsBy Queue sm so a
q a -> Bool
pred =
  StrategyQueue sm a -> (a -> Bool) -> Event (Maybe a)
forall s i.
DeletingQueueStrategy s =>
StrategyQueue s i -> (i -> Bool) -> Event (Maybe i)
forall i. StrategyQueue sm i -> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy (Queue sm so a -> StrategyQueue sm a
forall sm so a. Queue sm so a -> StrategyQueue sm a
queueStore Queue sm so a
q) a -> Bool
pred

-- | Clear the queue immediately.
clearQueue :: DequeueStrategy sm
              => Queue sm so a
              -- ^ the queue
              -> Event ()
clearQueue :: forall sm so a. DequeueStrategy sm => Queue sm so a -> Event ()
clearQueue Queue sm so a
q =
  do Maybe a
x <- Queue sm so a -> Event (Maybe a)
forall sm so a.
DequeueStrategy sm =>
Queue sm so a -> Event (Maybe a)
tryDequeue Queue sm so a
q
     case Maybe a
x of
       Maybe a
Nothing -> () -> Event ()
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just a
a  -> Queue sm so a -> Event ()
forall sm so a. DequeueStrategy sm => Queue sm so a -> Event ()
clearQueue Queue sm so a
q

-- | Enqueue the item.  
enqueue :: (EnqueueStrategy sm,
            DequeueStrategy so)
           => Queue sm so a
           -- ^ the queue
           -> a
           -- ^ the item to enqueue
           -> Event ()
enqueue :: forall sm so a.
(EnqueueStrategy sm, DequeueStrategy so) =>
Queue sm so a -> a -> Event ()
enqueue = Queue sm so a -> a -> Event ()
forall sm so a.
(EnqueueStrategy sm, DequeueStrategy so) =>
Queue sm so a -> a -> Event ()
enqueueStore
     
-- | Enqueue with the storing priority the item.  
enqueueWithStoringPriority :: (PriorityQueueStrategy sm pm,
                               DequeueStrategy so)
                              => Queue sm so a
                              -- ^ the queue
                              -> pm
                              -- ^ the priority for storing
                              -> a
                              -- ^ the item to enqueue
                              -> Event ()
enqueueWithStoringPriority :: forall sm pm so a.
(PriorityQueueStrategy sm pm, DequeueStrategy so) =>
Queue sm so a -> pm -> a -> Event ()
enqueueWithStoringPriority = Queue sm so a -> pm -> a -> Event ()
forall sm pm so a.
(PriorityQueueStrategy sm pm, DequeueStrategy so) =>
Queue sm so a -> pm -> a -> Event ()
enqueueStoreWithPriority

-- | Store the item.
enqueueStore :: (EnqueueStrategy sm,
                 DequeueStrategy so)
                => Queue sm so a
                -- ^ the queue
                -> a
                -- ^ the item to be stored
                -> Event ()
enqueueStore :: forall sm so a.
(EnqueueStrategy sm, DequeueStrategy so) =>
Queue sm so a -> a -> Event ()
enqueueStore Queue sm so a
q a
a =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       StrategyQueue sm a -> a -> Event ()
forall s i. EnqueueStrategy s => StrategyQueue s i -> i -> Event ()
forall i. StrategyQueue sm i -> i -> Event ()
strategyEnqueue (Queue sm so a -> StrategyQueue sm a
forall sm so a. Queue sm so a -> StrategyQueue sm a
queueStore Queue sm so a
q) a
a
     Int
c <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Queue sm so a -> IORef Int
forall sm so a. Queue sm so a -> IORef Int
queueCountRef Queue sm so a
q)
     let c' :: Int
c' = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     Int
c' Int -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Queue sm so a -> IORef Int
forall sm so a. Queue sm so a -> IORef Int
queueCountRef Queue sm so a
q) 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
$
       Resource so -> Event ()
forall s. DequeueStrategy s => Resource s -> Event ()
releaseResourceWithinEvent (Queue sm so a -> Resource so
forall sm so a. Queue sm so a -> Resource so
dequeueRes Queue sm so a
q)

-- | Store with the priority the item.
enqueueStoreWithPriority :: (PriorityQueueStrategy sm pm,
                             DequeueStrategy so)
                            => Queue sm so a
                            -- ^ the queue
                            -> pm
                            -- ^ the priority for storing
                            -> a
                            -- ^ the item to be enqueued
                            -> Event ()
enqueueStoreWithPriority :: forall sm pm so a.
(PriorityQueueStrategy sm pm, DequeueStrategy so) =>
Queue sm so a -> pm -> a -> Event ()
enqueueStoreWithPriority Queue sm so a
q pm
pm a
a =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       StrategyQueue sm a -> pm -> a -> Event ()
forall i. StrategyQueue sm i -> pm -> i -> Event ()
forall s p i.
PriorityQueueStrategy s p =>
StrategyQueue s i -> p -> i -> Event ()
strategyEnqueueWithPriority (Queue sm so a -> StrategyQueue sm a
forall sm so a. Queue sm so a -> StrategyQueue sm a
queueStore Queue sm so a
q) pm
pm a
a
     Int
c <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Queue sm so a -> IORef Int
forall sm so a. Queue sm so a -> IORef Int
queueCountRef Queue sm so a
q)
     let c' :: Int
c' = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     Int
c' Int -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Queue sm so a -> IORef Int
forall sm so a. Queue sm so a -> IORef Int
queueCountRef Queue sm so a
q) 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
$
       Resource so -> Event ()
forall s. DequeueStrategy s => Resource s -> Event ()
releaseResourceWithinEvent (Queue sm so a -> Resource so
forall sm so a. Queue sm so a -> Resource so
dequeueRes Queue sm so a
q)

-- | Extract an item for the dequeuing request.  
dequeueExtract :: DequeueStrategy sm
                  => Queue sm so a
                  -- ^ the queue
                  -> Event a
                  -- ^ the dequeued value
dequeueExtract :: forall sm so a. DequeueStrategy sm => Queue sm so a -> Event a
dequeueExtract Queue sm so a
q =
  (Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do a
a <- Point -> Event a -> IO a
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event a -> IO a) -> Event a -> IO a
forall a b. (a -> b) -> a -> b
$
          StrategyQueue sm a -> Event a
forall s i. DequeueStrategy s => StrategyQueue s i -> Event i
forall i. StrategyQueue sm i -> Event i
strategyDequeue (Queue sm so a -> StrategyQueue sm a
forall sm so a. Queue sm so a -> StrategyQueue sm a
queueStore Queue sm so a
q)
     Point -> Event a -> IO a
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event a -> IO a) -> Event a -> IO a
forall a b. (a -> b) -> a -> b
$
       Queue sm so a -> a -> Event a
forall sm so a. DequeueStrategy sm => Queue sm so a -> a -> Event a
dequeuePostExtract Queue sm so a
q a
a

-- | A post action after extracting the item by the dequeuing request.  
dequeuePostExtract :: DequeueStrategy sm
                      => Queue sm so a
                      -- ^ the queue
                      -> a
                      -- ^ the item to dequeue
                      -> Event a
                      -- ^ the dequeued value
dequeuePostExtract :: forall sm so a. DequeueStrategy sm => Queue sm so a -> a -> Event a
dequeuePostExtract Queue sm so a
q a
a =
  (Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
c <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Queue sm so a -> IORef Int
forall sm so a. Queue sm so a -> IORef Int
queueCountRef Queue sm so a
q)
     let c' :: Int
c' = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
     Int
c' Int -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Queue sm so a -> IORef Int
forall sm so a. Queue sm so a -> IORef Int
queueCountRef Queue sm so a
q) Int
c'
     a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a