-- |
-- Module     : Simulation.Aivika.Queue.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 optimised finite queue, which has no counters nor signals.
--
module Simulation.Aivika.Queue.Base
       (-- * Queue Types
        FCFSQueue,
        LCFSQueue,
        SIROQueue,
        PriorityQueue,
        Queue,
        -- * Creating Queue
        newFCFSQueue,
        newLCFSQueue,
        newSIROQueue,
        newPriorityQueue,
        newQueue,
        -- * Queue Properties and Activities
        enqueueStrategy,
        enqueueStoringStrategy,
        dequeueStrategy,
        queueNull,
        queueFull,
        queueMaxCount,
        queueCount,
        -- * Dequeuing and Enqueuing
        dequeue,
        dequeueWithOutputPriority,
        tryDequeue,
        enqueue,
        enqueueWithInputPriority,
        enqueueWithStoringPriority,
        enqueueWithInputStoringPriorities,
        tryEnqueue,
        tryEnqueueWithStoringPriority,
        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 FCFS a

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

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

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

-- | Represents a queue using the specified strategies for enqueueing (input), @si@,
-- internal storing (in memory), @sm@, and dequeueing (output), @so@, where @a@ denotes
-- the type of items stored in the queue.
data Queue si sm so a =
  Queue { forall si sm so a. Queue si sm so a -> Int
queueMaxCount :: Int,
          -- ^ The queue capacity.
          forall si sm so a. Queue si sm so a -> si
enqueueStrategy :: si,
          -- ^ The strategy applied to the enqueueing (input) processes when the queue is full.
          forall si sm so a. Queue si sm so a -> sm
enqueueStoringStrategy :: sm,
          -- ^ The strategy applied when storing (in memory) items in the queue.
          forall si sm so a. Queue si sm so a -> so
dequeueStrategy :: so,
          -- ^ The strategy applied to the dequeueing (output) processes when the queue is empty.
          forall si sm so a. Queue si sm so a -> Resource si
enqueueRes :: Resource si,
          forall si sm so a. Queue si sm so a -> StrategyQueue sm a
queueStore :: StrategyQueue sm a,
          forall si sm so a. Queue si sm so a -> Resource so
dequeueRes :: Resource so,
          forall si sm so a. Queue si sm so a -> IORef Int
queueCountRef :: IORef Int
        }

-- | Create a new FCFS queue with the specified capacity.  
newFCFSQueue :: Int -> Simulation (FCFSQueue a)  
newFCFSQueue :: forall a. Int -> Simulation (FCFSQueue a)
newFCFSQueue = FCFS -> FCFS -> FCFS -> Int -> Simulation (Queue FCFS FCFS FCFS a)
forall si sm so a.
(QueueStrategy si, QueueStrategy sm, QueueStrategy so) =>
si -> sm -> so -> Int -> Simulation (Queue si sm so a)
newQueue FCFS
FCFS FCFS
FCFS FCFS
FCFS
  
-- | Create a new LCFS queue with the specified capacity.  
newLCFSQueue :: Int -> Simulation (LCFSQueue a)  
newLCFSQueue :: forall a. Int -> Simulation (LCFSQueue a)
newLCFSQueue = FCFS -> LCFS -> FCFS -> Int -> Simulation (Queue FCFS LCFS FCFS a)
forall si sm so a.
(QueueStrategy si, QueueStrategy sm, QueueStrategy so) =>
si -> sm -> so -> Int -> Simulation (Queue si sm so a)
newQueue FCFS
FCFS LCFS
LCFS FCFS
FCFS
  
-- | Create a new SIRO queue with the specified capacity.  
newSIROQueue :: Int -> Simulation (SIROQueue a)  
newSIROQueue :: forall a. Int -> Simulation (SIROQueue a)
newSIROQueue = FCFS -> SIRO -> FCFS -> Int -> Simulation (Queue FCFS SIRO FCFS a)
forall si sm so a.
(QueueStrategy si, QueueStrategy sm, QueueStrategy so) =>
si -> sm -> so -> Int -> Simulation (Queue si sm so a)
newQueue FCFS
FCFS SIRO
SIRO FCFS
FCFS
  
-- | Create a new priority queue with the specified capacity.  
newPriorityQueue :: Int -> Simulation (PriorityQueue a)  
newPriorityQueue :: forall a. Int -> Simulation (PriorityQueue a)
newPriorityQueue = FCFS
-> StaticPriorities
-> FCFS
-> Int
-> Simulation (Queue FCFS StaticPriorities FCFS a)
forall si sm so a.
(QueueStrategy si, QueueStrategy sm, QueueStrategy so) =>
si -> sm -> so -> Int -> Simulation (Queue si sm so a)
newQueue FCFS
FCFS StaticPriorities
StaticPriorities FCFS
FCFS
  
-- | Create a new queue with the specified strategies and capacity.  
newQueue :: (QueueStrategy si,
             QueueStrategy sm,
             QueueStrategy so) =>
            si
            -- ^ the strategy applied to the enqueueing (input) processes when the queue is full
            -> sm
            -- ^ the strategy applied when storing items in the queue
            -> so
            -- ^ the strategy applied to the dequeueing (output) processes when the queue is empty
            -> Int
            -- ^ the queue capacity
            -> Simulation (Queue si sm so a)  
newQueue :: forall si sm so a.
(QueueStrategy si, QueueStrategy sm, QueueStrategy so) =>
si -> sm -> so -> Int -> Simulation (Queue si sm so a)
newQueue si
si sm
sm so
so Int
count =
  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
     Resource si
ri <- si -> Int -> Maybe Int -> Simulation (Resource si)
forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount si
si Int
count (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count)
     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 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count)
     Queue si sm so a -> Simulation (Queue si sm so a)
forall a. a -> Simulation a
forall (m :: * -> *) a. Monad m => a -> m a
return Queue { queueMaxCount :: Int
queueMaxCount = Int
count,
                    enqueueStrategy :: si
enqueueStrategy = si
si,
                    enqueueStoringStrategy :: sm
enqueueStoringStrategy = sm
sm,
                    dequeueStrategy :: so
dequeueStrategy = so
so,
                    enqueueRes :: Resource si
enqueueRes = Resource si
ri,
                    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 si sm so a -> Event Bool
queueNull :: forall si sm so a. Queue si sm so a -> Event Bool
queueNull Queue si 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 si sm so a -> IORef Int
forall si sm so a. Queue si sm so a -> IORef Int
queueCountRef Queue si 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)
  
-- | Test whether the queue is full.
--
-- See also 'queueFullChanged' and 'queueFullChanged_'.
queueFull :: Queue si sm so a -> Event Bool
queueFull :: forall si sm so a. Queue si sm so a -> Event Bool
queueFull Queue si 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 si sm so a -> IORef Int
forall si sm so a. Queue si sm so a -> IORef Int
queueCountRef Queue si 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
== Queue si sm so a -> Int
forall si sm so a. Queue si sm so a -> Int
queueMaxCount Queue si sm so a
q)
  
-- | Return the current queue size.
--
-- See also 'queueCountStats', 'queueCountChanged' and 'queueCountChanged_'.
queueCount :: Queue si sm so a -> Event Int
queueCount :: forall si sm so a. Queue si sm so a -> Event Int
queueCount Queue si 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 si sm so a -> IORef Int
forall si sm so a. Queue si sm so a -> IORef Int
queueCountRef Queue si sm so a
q)

-- | Dequeue suspending the process if the queue is empty.
dequeue :: (DequeueStrategy si,
            DequeueStrategy sm,
            EnqueueStrategy so)
           => Queue si sm so a
           -- ^ the queue
           -> Process a
           -- ^ the dequeued value
dequeue :: forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm, EnqueueStrategy so) =>
Queue si sm so a -> Process a
dequeue Queue si sm so a
q =
  do Resource so -> Process ()
forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource (Queue si sm so a -> Resource so
forall si sm so a. Queue si sm so a -> Resource so
dequeueRes Queue si 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 si sm so a -> Event a
forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm) =>
Queue si sm so a -> Event a
dequeueExtract Queue si sm so a
q
  
-- | Dequeue with the output priority suspending the process if the queue is empty.
dequeueWithOutputPriority :: (DequeueStrategy si,
                              DequeueStrategy sm,
                              PriorityQueueStrategy so po)
                             => Queue si sm so a
                             -- ^ the queue
                             -> po
                             -- ^ the priority for output
                             -> Process a
                             -- ^ the dequeued value
dequeueWithOutputPriority :: forall si sm so po a.
(DequeueStrategy si, DequeueStrategy sm,
 PriorityQueueStrategy so po) =>
Queue si sm so a -> po -> Process a
dequeueWithOutputPriority Queue si sm so a
q po
po =
  do Resource so -> po -> Process ()
forall s p.
PriorityQueueStrategy s p =>
Resource s -> p -> Process ()
requestResourceWithPriority (Queue si sm so a -> Resource so
forall si sm so a. Queue si sm so a -> Resource so
dequeueRes Queue si 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 si sm so a -> Event a
forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm) =>
Queue si sm so a -> Event a
dequeueExtract Queue si sm so a
q
  
-- | Try to dequeue immediately.
tryDequeue :: (DequeueStrategy si,
               DequeueStrategy sm)
              => Queue si sm so a
              -- ^ the queue
              -> Event (Maybe a)
              -- ^ the dequeued value of 'Nothing'
tryDequeue :: forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm) =>
Queue si sm so a -> Event (Maybe a)
tryDequeue Queue si sm so a
q =
  do Bool
x <- Resource so -> Event Bool
forall s. Resource s -> Event Bool
tryRequestResourceWithinEvent (Queue si sm so a -> Resource so
forall si sm so a. Queue si sm so a -> Resource so
dequeueRes Queue si 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 si sm so a -> Event a
forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm) =>
Queue si sm so a -> Event a
dequeueExtract Queue si 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,
                DequeueStrategy si,
                DeletingQueueStrategy sm,
                DequeueStrategy so)
               => Queue si 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 si sm so.
(Eq a, DequeueStrategy si, DeletingQueueStrategy sm,
 DequeueStrategy so) =>
Queue si sm so a -> a -> Event Bool
queueDelete Queue si 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 si sm so a -> (a -> Bool) -> Event (Maybe a)
forall si sm so a.
(DequeueStrategy si, DeletingQueueStrategy sm,
 DequeueStrategy so) =>
Queue si sm so a -> (a -> Bool) -> Event (Maybe a)
queueDeleteBy Queue si 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,
                 DequeueStrategy si,
                 DeletingQueueStrategy sm,
                 DequeueStrategy so)
                => Queue si sm so a
                -- ^ the queue
                -> a
                -- ^ the item to remove from the queue
                -> Event ()
queueDelete_ :: forall a si sm so.
(Eq a, DequeueStrategy si, DeletingQueueStrategy sm,
 DequeueStrategy so) =>
Queue si sm so a -> a -> Event ()
queueDelete_ Queue si 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 si sm so a -> (a -> Bool) -> Event (Maybe a)
forall si sm so a.
(DequeueStrategy si, DeletingQueueStrategy sm,
 DequeueStrategy so) =>
Queue si sm so a -> (a -> Bool) -> Event (Maybe a)
queueDeleteBy Queue si 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 :: (DequeueStrategy si,
                  DeletingQueueStrategy sm,
                  DequeueStrategy so)
                 => Queue si sm so a
                 -- ^ the queue
                 -> (a -> Bool)
                 -- ^ the predicate
                 -> Event (Maybe a)
queueDeleteBy :: forall si sm so a.
(DequeueStrategy si, DeletingQueueStrategy sm,
 DequeueStrategy so) =>
Queue si sm so a -> (a -> Bool) -> Event (Maybe a)
queueDeleteBy Queue si sm so a
q a -> Bool
pred =
  do Bool
x <- Resource so -> Event Bool
forall s. Resource s -> Event Bool
tryRequestResourceWithinEvent (Queue si sm so a -> Resource so
forall si sm so a. Queue si sm so a -> Resource so
dequeueRes Queue si 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 si sm so a -> StrategyQueue sm a
forall si sm so a. Queue si sm so a -> StrategyQueue sm a
queueStore Queue si 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 si sm so a -> Resource so
forall si sm so a. Queue si sm so a -> Resource so
dequeueRes Queue si 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 si sm so a -> a -> Event a
forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm) =>
Queue si sm so a -> a -> Event a
dequeuePostExtract Queue si 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_ :: (DequeueStrategy si,
                   DeletingQueueStrategy sm,
                   DequeueStrategy so)
                  => Queue si sm so a
                  -- ^ the queue
                  -> (a -> Bool)
                  -- ^ the predicate
                  -> Event ()
queueDeleteBy_ :: forall si sm so a.
(DequeueStrategy si, DeletingQueueStrategy sm,
 DequeueStrategy so) =>
Queue si sm so a -> (a -> Bool) -> Event ()
queueDeleteBy_ Queue si 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 si sm so a -> (a -> Bool) -> Event (Maybe a)
forall si sm so a.
(DequeueStrategy si, DeletingQueueStrategy sm,
 DequeueStrategy so) =>
Queue si sm so a -> (a -> Bool) -> Event (Maybe a)
queueDeleteBy Queue si sm so a
q a -> Bool
pred

-- | Detect whether the item is contained in the queue.
queueContains :: (Eq a,
                  DeletingQueueStrategy sm)
                 => Queue si sm so a
                 -- ^ the queue
                 -> a
                 -- ^ the item to search the queue for
                 -> Event Bool
                 -- ^ whether the item was found
queueContains :: forall a sm si so.
(Eq a, DeletingQueueStrategy sm) =>
Queue si sm so a -> a -> Event Bool
queueContains Queue si 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 si sm so a -> (a -> Bool) -> Event (Maybe a)
forall sm si so a.
DeletingQueueStrategy sm =>
Queue si sm so a -> (a -> Bool) -> Event (Maybe a)
queueContainsBy Queue si 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 si sm so a
                   -- ^ the queue
                   -> (a -> Bool)
                   -- ^ the predicate
                   -> Event (Maybe a)
                   -- ^ the item if it was found
queueContainsBy :: forall sm si so a.
DeletingQueueStrategy sm =>
Queue si sm so a -> (a -> Bool) -> Event (Maybe a)
queueContainsBy Queue si 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 si sm so a -> StrategyQueue sm a
forall si sm so a. Queue si sm so a -> StrategyQueue sm a
queueStore Queue si sm so a
q) a -> Bool
pred

-- | Clear the queue immediately.
clearQueue :: (DequeueStrategy si,
               DequeueStrategy sm)
              => Queue si sm so a
              -- ^ the queue
              -> Event ()
clearQueue :: forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm) =>
Queue si sm so a -> Event ()
clearQueue Queue si sm so a
q =
  do Maybe a
x <- Queue si sm so a -> Event (Maybe a)
forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm) =>
Queue si sm so a -> Event (Maybe a)
tryDequeue Queue si 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 si sm so a -> Event ()
forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm) =>
Queue si sm so a -> Event ()
clearQueue Queue si sm so a
q
              
-- | Enqueue the item suspending the process if the queue is full.  
enqueue :: (EnqueueStrategy si,
            EnqueueStrategy sm,
            DequeueStrategy so)
           => Queue si sm so a
           -- ^ the queue
           -> a
           -- ^ the item to enqueue
           -> Process ()
enqueue :: forall si sm so a.
(EnqueueStrategy si, EnqueueStrategy sm, DequeueStrategy so) =>
Queue si sm so a -> a -> Process ()
enqueue Queue si sm so a
q a
a =
  do Resource si -> Process ()
forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource (Queue si sm so a -> Resource si
forall si sm so a. Queue si sm so a -> Resource si
enqueueRes Queue si sm so a
q)
     Event () -> Process ()
forall a. Event a -> Process a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$ Queue si sm so a -> a -> Event ()
forall sm so si a.
(EnqueueStrategy sm, DequeueStrategy so) =>
Queue si sm so a -> a -> Event ()
enqueueStore Queue si sm so a
q a
a
     
-- | Enqueue with the input priority the item suspending the process if the queue is full.  
enqueueWithInputPriority :: (PriorityQueueStrategy si pi,
                             EnqueueStrategy sm,
                             DequeueStrategy so)
                            => Queue si sm so a
                            -- ^ the queue
                            -> pi
                            -- ^ the priority for input
                            -> a
                            -- ^ the item to enqueue
                            -> Process ()
enqueueWithInputPriority :: forall si pi sm so a.
(PriorityQueueStrategy si pi, EnqueueStrategy sm,
 DequeueStrategy so) =>
Queue si sm so a -> pi -> a -> Process ()
enqueueWithInputPriority Queue si sm so a
q pi
pi a
a =
  do Resource si -> pi -> Process ()
forall s p.
PriorityQueueStrategy s p =>
Resource s -> p -> Process ()
requestResourceWithPriority (Queue si sm so a -> Resource si
forall si sm so a. Queue si sm so a -> Resource si
enqueueRes Queue si sm so a
q) pi
pi
     Event () -> Process ()
forall a. Event a -> Process a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$ Queue si sm so a -> a -> Event ()
forall sm so si a.
(EnqueueStrategy sm, DequeueStrategy so) =>
Queue si sm so a -> a -> Event ()
enqueueStore Queue si sm so a
q a
a
     
-- | Enqueue with the storing priority the item suspending the process if the queue is full.  
enqueueWithStoringPriority :: (EnqueueStrategy si,
                               PriorityQueueStrategy sm pm,
                               DequeueStrategy so)
                              => Queue si sm so a
                              -- ^ the queue
                              -> pm
                              -- ^ the priority for storing
                              -> a
                              -- ^ the item to enqueue
                              -> Process ()
enqueueWithStoringPriority :: forall si sm pm so a.
(EnqueueStrategy si, PriorityQueueStrategy sm pm,
 DequeueStrategy so) =>
Queue si sm so a -> pm -> a -> Process ()
enqueueWithStoringPriority Queue si sm so a
q pm
pm a
a =
  do Resource si -> Process ()
forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource (Queue si sm so a -> Resource si
forall si sm so a. Queue si sm so a -> Resource si
enqueueRes Queue si sm so a
q)
     Event () -> Process ()
forall a. Event a -> Process a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$ Queue si sm so a -> pm -> a -> Event ()
forall sm pm so si a.
(PriorityQueueStrategy sm pm, DequeueStrategy so) =>
Queue si sm so a -> pm -> a -> Event ()
enqueueStoreWithPriority Queue si sm so a
q pm
pm a
a
     
-- | Enqueue with the input and storing priorities the item suspending the process if the queue is full.  
enqueueWithInputStoringPriorities :: (PriorityQueueStrategy si pi,
                                      PriorityQueueStrategy sm pm,
                                      DequeueStrategy so)
                                     => Queue si sm so a
                                     -- ^ the queue
                                     -> pi
                                     -- ^ the priority for input
                                     -> pm
                                     -- ^ the priority for storing
                                     -> a
                                     -- ^ the item to enqueue
                                     -> Process ()
enqueueWithInputStoringPriorities :: forall si pi sm pm so a.
(PriorityQueueStrategy si pi, PriorityQueueStrategy sm pm,
 DequeueStrategy so) =>
Queue si sm so a -> pi -> pm -> a -> Process ()
enqueueWithInputStoringPriorities Queue si sm so a
q pi
pi pm
pm a
a =
  do Resource si -> pi -> Process ()
forall s p.
PriorityQueueStrategy s p =>
Resource s -> p -> Process ()
requestResourceWithPriority (Queue si sm so a -> Resource si
forall si sm so a. Queue si sm so a -> Resource si
enqueueRes Queue si sm so a
q) pi
pi
     Event () -> Process ()
forall a. Event a -> Process a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$ Queue si sm so a -> pm -> a -> Event ()
forall sm pm so si a.
(PriorityQueueStrategy sm pm, DequeueStrategy so) =>
Queue si sm so a -> pm -> a -> Event ()
enqueueStoreWithPriority Queue si sm so a
q pm
pm a
a
     
-- | Try to enqueue the item. Return 'False' in the monad if the queue is full.
tryEnqueue :: (EnqueueStrategy sm,
               DequeueStrategy so)
              => Queue si sm so a
              -- ^ the queue
              -> a
              -- ^ the item which we try to enqueue
              -> Event Bool
tryEnqueue :: forall sm so si a.
(EnqueueStrategy sm, DequeueStrategy so) =>
Queue si sm so a -> a -> Event Bool
tryEnqueue Queue si sm so a
q a
a =
  do Bool
x <- Resource si -> Event Bool
forall s. Resource s -> Event Bool
tryRequestResourceWithinEvent (Queue si sm so a -> Resource si
forall si sm so a. Queue si sm so a -> Resource si
enqueueRes Queue si sm so a
q)
     if Bool
x 
       then do Queue si sm so a -> a -> Event ()
forall sm so si a.
(EnqueueStrategy sm, DequeueStrategy so) =>
Queue si sm so a -> a -> Event ()
enqueueStore Queue si sm so a
q a
a
               Bool -> Event Bool
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       else Bool -> Event Bool
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Try to enqueue with the storing priority the item. Return 'False' in
-- the monad if the queue is full.
tryEnqueueWithStoringPriority :: (PriorityQueueStrategy sm pm,
                                  DequeueStrategy so)
                                 => Queue si sm so a
                                 -- ^ the queue
                                 -> pm
                                 -- ^ the priority for storing
                                 -> a
                                 -- ^ the item which we try to enqueue
                                 -> Event Bool
tryEnqueueWithStoringPriority :: forall sm pm so si a.
(PriorityQueueStrategy sm pm, DequeueStrategy so) =>
Queue si sm so a -> pm -> a -> Event Bool
tryEnqueueWithStoringPriority Queue si sm so a
q pm
pm a
a =
  do Bool
x <- Resource si -> Event Bool
forall s. Resource s -> Event Bool
tryRequestResourceWithinEvent (Queue si sm so a -> Resource si
forall si sm so a. Queue si sm so a -> Resource si
enqueueRes Queue si sm so a
q)
     if Bool
x 
       then do Queue si sm so a -> pm -> a -> Event ()
forall sm pm so si a.
(PriorityQueueStrategy sm pm, DequeueStrategy so) =>
Queue si sm so a -> pm -> a -> Event ()
enqueueStoreWithPriority Queue si sm so a
q pm
pm a
a
               Bool -> Event Bool
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       else Bool -> Event Bool
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Store the item.
enqueueStore :: (EnqueueStrategy sm,
                 DequeueStrategy so)
                => Queue si sm so a
                -- ^ the queue
                -> a
                -- ^ the item to be stored
                -> Event ()
enqueueStore :: forall sm so si a.
(EnqueueStrategy sm, DequeueStrategy so) =>
Queue si sm so a -> a -> Event ()
enqueueStore Queue si 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 si sm so a -> StrategyQueue sm a
forall si sm so a. Queue si sm so a -> StrategyQueue sm a
queueStore Queue si sm so a
q) a
a
     Int
c <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Queue si sm so a -> IORef Int
forall si sm so a. Queue si sm so a -> IORef Int
queueCountRef Queue si 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 si sm so a -> IORef Int
forall si sm so a. Queue si sm so a -> IORef Int
queueCountRef Queue si 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 si sm so a -> Resource so
forall si sm so a. Queue si sm so a -> Resource so
dequeueRes Queue si sm so a
q)

-- | Store with the priority the item.
enqueueStoreWithPriority :: (PriorityQueueStrategy sm pm,
                             DequeueStrategy so)
                            => Queue si sm so a
                            -- ^ the queue
                            -> pm
                            -- ^ the priority for storing
                            -> a
                            -- ^ the item to be enqueued
                            -> Event ()
enqueueStoreWithPriority :: forall sm pm so si a.
(PriorityQueueStrategy sm pm, DequeueStrategy so) =>
Queue si sm so a -> pm -> a -> Event ()
enqueueStoreWithPriority Queue si 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 si sm so a -> StrategyQueue sm a
forall si sm so a. Queue si sm so a -> StrategyQueue sm a
queueStore Queue si sm so a
q) pm
pm a
a
     Int
c <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Queue si sm so a -> IORef Int
forall si sm so a. Queue si sm so a -> IORef Int
queueCountRef Queue si 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 si sm so a -> IORef Int
forall si sm so a. Queue si sm so a -> IORef Int
queueCountRef Queue si 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 si sm so a -> Resource so
forall si sm so a. Queue si sm so a -> Resource so
dequeueRes Queue si sm so a
q)

-- | Extract an item for the dequeuing request.  
dequeueExtract :: (DequeueStrategy si,
                   DequeueStrategy sm)
                  => Queue si sm so a
                  -- ^ the queue
                  -> Event a
                  -- ^ the dequeued value
dequeueExtract :: forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm) =>
Queue si sm so a -> Event a
dequeueExtract Queue si 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 si sm so a -> StrategyQueue sm a
forall si sm so a. Queue si sm so a -> StrategyQueue sm a
queueStore Queue si 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 si sm so a -> a -> Event a
forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm) =>
Queue si sm so a -> a -> Event a
dequeuePostExtract Queue si sm so a
q a
a

-- | A post action after extracting the item by the dequeuing request.  
dequeuePostExtract :: (DequeueStrategy si,
                       DequeueStrategy sm)
                      => Queue si sm so a
                      -- ^ the queue
                      -> a
                      -- ^ the item to dequeue
                      -> Event a
                      -- ^ the dequeued value
dequeuePostExtract :: forall si sm so a.
(DequeueStrategy si, DequeueStrategy sm) =>
Queue si sm so a -> a -> Event a
dequeuePostExtract Queue si 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 si sm so a -> IORef Int
forall si sm so a. Queue si sm so a -> IORef Int
queueCountRef Queue si 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 si sm so a -> IORef Int
forall si sm so a. Queue si sm so a -> IORef Int
queueCountRef Queue si 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 si -> Event ()
forall s. DequeueStrategy s => Resource s -> Event ()
releaseResourceWithinEvent (Queue si sm so a -> Resource si
forall si sm so a. Queue si sm so a -> Resource si
enqueueRes Queue si sm so a
q)
     a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a