module Simulation.Aivika.Queue.Infinite.Base
(
FCFSQueue,
LCFSQueue,
SIROQueue,
PriorityQueue,
Queue,
newFCFSQueue,
newLCFSQueue,
newSIROQueue,
newPriorityQueue,
newQueue,
enqueueStoringStrategy,
dequeueStrategy,
queueNull,
queueCount,
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
type FCFSQueue a = Queue FCFS FCFS a
type LCFSQueue a = Queue LCFS FCFS a
type SIROQueue a = Queue SIRO FCFS a
type PriorityQueue a = Queue StaticPriorities FCFS a
data Queue sm so a =
Queue { forall sm so a. Queue sm so a -> sm
enqueueStoringStrategy :: sm,
forall sm so a. Queue sm so a -> so
dequeueStrategy :: so,
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 }
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
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
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
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
newQueue :: (QueueStrategy sm,
QueueStrategy so) =>
sm
-> so
-> 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 }
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)
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 :: (DequeueStrategy sm,
EnqueueStrategy so)
=> Queue sm so a
-> Process a
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
dequeueWithOutputPriority :: (DequeueStrategy sm,
PriorityQueueStrategy so po)
=> Queue sm so a
-> po
-> Process a
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
tryDequeue :: DequeueStrategy sm
=> Queue sm so a
-> Event (Maybe a)
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
queueDelete :: (Eq a,
DeletingQueueStrategy sm,
DequeueStrategy so)
=> Queue sm so a
-> a
-> Event Bool
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)
queueDelete_ :: (Eq a,
DeletingQueueStrategy sm,
DequeueStrategy so)
=> Queue sm so a
-> a
-> 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)
queueDeleteBy :: (DeletingQueueStrategy sm,
DequeueStrategy so)
=> Queue sm so a
-> (a -> Bool)
-> 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
queueDeleteBy_ :: (DeletingQueueStrategy sm,
DequeueStrategy so)
=> Queue sm so a
-> (a -> Bool)
-> 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
queueContains :: (Eq a,
DeletingQueueStrategy sm)
=> Queue sm so a
-> a
-> Event Bool
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)
queueContainsBy :: DeletingQueueStrategy sm
=> Queue sm so a
-> (a -> Bool)
-> Event (Maybe a)
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
clearQueue :: DequeueStrategy sm
=> Queue sm so a
-> 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 :: (EnqueueStrategy sm,
DequeueStrategy so)
=> Queue sm so a
-> a
-> 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
enqueueWithStoringPriority :: (PriorityQueueStrategy sm pm,
DequeueStrategy so)
=> Queue sm so a
-> pm
-> a
-> 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
enqueueStore :: (EnqueueStrategy sm,
DequeueStrategy so)
=> Queue sm so a
-> a
-> 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)
enqueueStoreWithPriority :: (PriorityQueueStrategy sm pm,
DequeueStrategy so)
=> Queue sm so a
-> pm
-> a
-> 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)
dequeueExtract :: DequeueStrategy sm
=> Queue sm so a
-> Event a
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
dequeuePostExtract :: DequeueStrategy sm
=> Queue sm so a
-> a
-> Event a
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