{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}

-- |
-- Module     : Simulation.Aivika.Trans.GPSS.TransactQueueStrategy
-- 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 transact queue strategy.
--
module Simulation.Aivika.Trans.GPSS.TransactQueueStrategy
       (TransactQueueStrategy(..),
        transactStrategyQueueDeleteBy,
        transactStrategyQueueContainsBy) where

import Control.Monad
import Control.Monad.Trans

import Data.IORef
import qualified Data.IntMap as M

import Simulation.Aivika.Trans
import qualified Simulation.Aivika.Trans.DoubleLinkedList as DLL

-- | The transact queue strategy.
data TransactQueueStrategy s = TransactQueueStrategy s

-- | An implementation of the 'QueueStrategy' class.
instance MonadDES m => QueueStrategy m (TransactQueueStrategy s) where

  -- | A queue used by the 'TransactQueueStrategy' strategy.
  data StrategyQueue m (TransactQueueStrategy s) a =
    TransactStrategyQueue { StrategyQueue m (TransactQueueStrategy s) a
-> TransactQueueStrategy s
transactStrategy :: TransactQueueStrategy s,
                            -- ^ the strategy itself
                            StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue :: Ref m (M.IntMap (DLL.DoubleLinkedList m a))
                            -- ^ the transact queue
                          }

  {-# INLINABLE newStrategyQueue #-}
  newStrategyQueue :: TransactQueueStrategy s
-> Simulation m (StrategyQueue m (TransactQueueStrategy s) a)
newStrategyQueue TransactQueueStrategy s
s =
    do Ref m (IntMap (DoubleLinkedList m a))
r <- IntMap (DoubleLinkedList m a)
-> Simulation m (Ref m (IntMap (DoubleLinkedList m a)))
forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef IntMap (DoubleLinkedList m a)
forall a. IntMap a
M.empty
       StrategyQueue m (TransactQueueStrategy s) a
-> Simulation m (StrategyQueue m (TransactQueueStrategy s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (StrategyQueue m (TransactQueueStrategy s) a
 -> Simulation m (StrategyQueue m (TransactQueueStrategy s) a))
-> StrategyQueue m (TransactQueueStrategy s) a
-> Simulation m (StrategyQueue m (TransactQueueStrategy s) a)
forall a b. (a -> b) -> a -> b
$ TransactQueueStrategy s
-> Ref m (IntMap (DoubleLinkedList m a))
-> StrategyQueue m (TransactQueueStrategy s) a
forall (m :: * -> *) s a.
TransactQueueStrategy s
-> Ref m (IntMap (DoubleLinkedList m a))
-> StrategyQueue m (TransactQueueStrategy s) a
TransactStrategyQueue TransactQueueStrategy s
s Ref m (IntMap (DoubleLinkedList m a))
r

  {-# INLINABLE strategyQueueNull #-}
  strategyQueueNull :: StrategyQueue m (TransactQueueStrategy s) a -> Event m Bool
strategyQueueNull StrategyQueue m (TransactQueueStrategy s) a
q =
    do IntMap (DoubleLinkedList m a)
m <- Ref m (IntMap (DoubleLinkedList m a))
-> Event m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy s) a
q)
       Bool -> Event m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Event m Bool) -> Bool -> Event m Bool
forall a b. (a -> b) -> a -> b
$ IntMap (DoubleLinkedList m a) -> Bool
forall a. IntMap a -> Bool
M.null IntMap (DoubleLinkedList m a)
m

instance MonadDES m => DequeueStrategy m (TransactQueueStrategy FCFS) where

  {-# INLINABLE strategyDequeue #-}
  strategyDequeue :: StrategyQueue m (TransactQueueStrategy FCFS) a -> Event m a
strategyDequeue StrategyQueue m (TransactQueueStrategy FCFS) a
q =
    do IntMap (DoubleLinkedList m a)
m <- Ref m (IntMap (DoubleLinkedList m a))
-> Event m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (StrategyQueue m (TransactQueueStrategy FCFS) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy FCFS) a
q)
       let (Key
k, DoubleLinkedList m a
xs) = IntMap (DoubleLinkedList m a) -> (Key, DoubleLinkedList m a)
forall a. IntMap a -> (Key, a)
M.findMin IntMap (DoubleLinkedList m a)
m
       a
i <- DoubleLinkedList m a -> Event m a
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m a
DLL.listFirst DoubleLinkedList m a
xs
       DoubleLinkedList m a -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m ()
DLL.listRemoveFirst DoubleLinkedList m a
xs
       Bool
empty <- DoubleLinkedList m a -> Event m Bool
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m Bool
DLL.listNull DoubleLinkedList m a
xs
       Bool -> Event m () -> Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
empty (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
         Ref m (IntMap (DoubleLinkedList m a))
-> (IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (StrategyQueue m (TransactQueueStrategy FCFS) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy FCFS) a
q) ((IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
 -> Event m ())
-> (IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
-> Event m ()
forall a b. (a -> b) -> a -> b
$
         Key
-> IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a)
forall a. Key -> IntMap a -> IntMap a
M.delete Key
k
       a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
i

instance MonadDES m => DequeueStrategy m (TransactQueueStrategy LCFS) where

  {-# INLINABLE strategyDequeue #-}
  strategyDequeue :: StrategyQueue m (TransactQueueStrategy LCFS) a -> Event m a
strategyDequeue StrategyQueue m (TransactQueueStrategy LCFS) a
q =
    do IntMap (DoubleLinkedList m a)
m <- Ref m (IntMap (DoubleLinkedList m a))
-> Event m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (StrategyQueue m (TransactQueueStrategy LCFS) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy LCFS) a
q)
       let (Key
k, DoubleLinkedList m a
xs) = IntMap (DoubleLinkedList m a) -> (Key, DoubleLinkedList m a)
forall a. IntMap a -> (Key, a)
M.findMin IntMap (DoubleLinkedList m a)
m
       a
i <- DoubleLinkedList m a -> Event m a
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m a
DLL.listLast DoubleLinkedList m a
xs
       DoubleLinkedList m a -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m ()
DLL.listRemoveLast DoubleLinkedList m a
xs
       Bool
empty <- DoubleLinkedList m a -> Event m Bool
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m Bool
DLL.listNull DoubleLinkedList m a
xs
       Bool -> Event m () -> Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
empty (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
         Ref m (IntMap (DoubleLinkedList m a))
-> (IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (StrategyQueue m (TransactQueueStrategy LCFS) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy LCFS) a
q) ((IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
 -> Event m ())
-> (IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
-> Event m ()
forall a b. (a -> b) -> a -> b
$
         Key
-> IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a)
forall a. Key -> IntMap a -> IntMap a
M.delete Key
k
       a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
i

instance (MonadDES m, DequeueStrategy m (TransactQueueStrategy s)) => PriorityQueueStrategy m (TransactQueueStrategy s) Int where

  {-# INLINABLE strategyEnqueueWithPriority #-}
  strategyEnqueueWithPriority :: StrategyQueue m (TransactQueueStrategy s) a
-> Key -> a -> Event m ()
strategyEnqueueWithPriority StrategyQueue m (TransactQueueStrategy s) a
q Key
priority a
i =
    do IntMap (DoubleLinkedList m a)
m <- Ref m (IntMap (DoubleLinkedList m a))
-> Event m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy s) a
q)
       let k :: Key
k  = - Key
priority
           xs :: Maybe (DoubleLinkedList m a)
xs = Key
-> IntMap (DoubleLinkedList m a) -> Maybe (DoubleLinkedList m a)
forall a. Key -> IntMap a -> Maybe a
M.lookup Key
k IntMap (DoubleLinkedList m a)
m
       case Maybe (DoubleLinkedList m a)
xs of
         Maybe (DoubleLinkedList m a)
Nothing ->
           do DoubleLinkedList m a
xs <- Simulation m (DoubleLinkedList m a)
-> Event m (DoubleLinkedList m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation Simulation m (DoubleLinkedList m a)
forall (m :: * -> *) a.
MonadRef m =>
Simulation m (DoubleLinkedList m a)
DLL.newList
              DoubleLinkedList m a -> a -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> a -> Event m ()
DLL.listAddLast DoubleLinkedList m a
xs a
i
              Ref m (IntMap (DoubleLinkedList m a))
-> (IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy s) a
q) ((IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
 -> Event m ())
-> (IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
-> Event m ()
forall a b. (a -> b) -> a -> b
$
                Key
-> DoubleLinkedList m a
-> IntMap (DoubleLinkedList m a)
-> IntMap (DoubleLinkedList m a)
forall a. Key -> a -> IntMap a -> IntMap a
M.insert Key
k DoubleLinkedList m a
xs
         Just DoubleLinkedList m a
xs ->
           DoubleLinkedList m a -> a -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> a -> Event m ()
DLL.listAddLast DoubleLinkedList m a
xs a
i

instance MonadDES m => DeletingQueueStrategy m (TransactQueueStrategy FCFS) where

  {-# INLINABLE strategyQueueDeleteBy #-}
  strategyQueueDeleteBy :: StrategyQueue m (TransactQueueStrategy FCFS) a
-> (a -> Bool) -> Event m (Maybe a)
strategyQueueDeleteBy StrategyQueue m (TransactQueueStrategy FCFS) a
q a -> Bool
pred =
    do IntMap (DoubleLinkedList m a)
m <- Ref m (IntMap (DoubleLinkedList m a))
-> Event m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (StrategyQueue m (TransactQueueStrategy FCFS) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy FCFS) a
q)
       let loop :: [(Key, DoubleLinkedList m a)] -> Event m (Maybe a)
loop [] = Maybe a -> Event m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
           loop ((Key
k, DoubleLinkedList m a
xs): [(Key, DoubleLinkedList m a)]
tail) =
             do Maybe a
a <- DoubleLinkedList m a -> (a -> Bool) -> Event m (Maybe a)
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> (a -> Bool) -> Event m (Maybe a)
DLL.listRemoveBy DoubleLinkedList m a
xs a -> Bool
pred
                case Maybe a
a of
                  Maybe a
Nothing -> [(Key, DoubleLinkedList m a)] -> Event m (Maybe a)
loop [(Key, DoubleLinkedList m a)]
tail
                  Just a
_  ->
                    do Bool
empty <- DoubleLinkedList m a -> Event m Bool
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m Bool
DLL.listNull DoubleLinkedList m a
xs
                       Bool -> Event m () -> Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
empty (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
                         Ref m (IntMap (DoubleLinkedList m a))
-> (IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (StrategyQueue m (TransactQueueStrategy FCFS) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy FCFS) a
q) ((IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
 -> Event m ())
-> (IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
-> Event m ()
forall a b. (a -> b) -> a -> b
$
                         Key
-> IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a)
forall a. Key -> IntMap a -> IntMap a
M.delete Key
k
                       Maybe a -> Event m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
a
       [(Key, DoubleLinkedList m a)] -> Event m (Maybe a)
loop (IntMap (DoubleLinkedList m a) -> [(Key, DoubleLinkedList m a)]
forall a. IntMap a -> [(Key, a)]
M.assocs IntMap (DoubleLinkedList m a)
m)

  {-# INLINABLE strategyQueueContainsBy #-}
  strategyQueueContainsBy :: StrategyQueue m (TransactQueueStrategy FCFS) a
-> (a -> Bool) -> Event m (Maybe a)
strategyQueueContainsBy StrategyQueue m (TransactQueueStrategy FCFS) a
q a -> Bool
pred =
    do IntMap (DoubleLinkedList m a)
m <- Ref m (IntMap (DoubleLinkedList m a))
-> Event m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (StrategyQueue m (TransactQueueStrategy FCFS) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy FCFS) a
q)
       let loop :: [(Key, DoubleLinkedList m a)] -> Event m (Maybe a)
loop [] = Maybe a -> Event m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
           loop ((Key
k, DoubleLinkedList m a
xs): [(Key, DoubleLinkedList m a)]
tail) =
             do Maybe a
a <- DoubleLinkedList m a -> (a -> Bool) -> Event m (Maybe a)
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> (a -> Bool) -> Event m (Maybe a)
DLL.listContainsBy DoubleLinkedList m a
xs a -> Bool
pred
                case Maybe a
a of
                  Maybe a
Nothing -> [(Key, DoubleLinkedList m a)] -> Event m (Maybe a)
loop [(Key, DoubleLinkedList m a)]
tail
                  Just a
_  -> Maybe a -> Event m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
a
       [(Key, DoubleLinkedList m a)] -> Event m (Maybe a)
loop (IntMap (DoubleLinkedList m a) -> [(Key, DoubleLinkedList m a)]
forall a. IntMap a -> [(Key, a)]
M.assocs IntMap (DoubleLinkedList m a)
m)

-- | Try to delete the transact by the specified priority and satisfying to the provided predicate.
transactStrategyQueueDeleteBy :: MonadDES m
                                 => StrategyQueue m (TransactQueueStrategy s) a
                                 -- ^ the queue
                                 -> Int
                                 -- ^ the transact priority
                                 -> (a -> Bool)
                                 -- ^ the predicate
                                 -> Event m (Maybe a)
{-# INLINABLE transactStrategyQueueDeleteBy #-}
transactStrategyQueueDeleteBy :: StrategyQueue m (TransactQueueStrategy s) a
-> Key -> (a -> Bool) -> Event m (Maybe a)
transactStrategyQueueDeleteBy StrategyQueue m (TransactQueueStrategy s) a
q Key
priority a -> Bool
pred =
  do IntMap (DoubleLinkedList m a)
m <- Ref m (IntMap (DoubleLinkedList m a))
-> Event m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy s) a
q)
     let k :: Key
k  = - Key
priority
         xs :: Maybe (DoubleLinkedList m a)
xs = Key
-> IntMap (DoubleLinkedList m a) -> Maybe (DoubleLinkedList m a)
forall a. Key -> IntMap a -> Maybe a
M.lookup Key
k IntMap (DoubleLinkedList m a)
m
     case Maybe (DoubleLinkedList m a)
xs of
       Maybe (DoubleLinkedList m a)
Nothing -> Maybe a -> Event m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
       Just DoubleLinkedList m a
xs ->
         do Maybe a
a <- DoubleLinkedList m a -> (a -> Bool) -> Event m (Maybe a)
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> (a -> Bool) -> Event m (Maybe a)
DLL.listRemoveBy DoubleLinkedList m a
xs a -> Bool
pred
            Bool
empty <- DoubleLinkedList m a -> Event m Bool
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m Bool
DLL.listNull DoubleLinkedList m a
xs
            Bool -> Event m () -> Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
empty (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
              Ref m (IntMap (DoubleLinkedList m a))
-> (IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy s) a
q) ((IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
 -> Event m ())
-> (IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a))
-> Event m ()
forall a b. (a -> b) -> a -> b
$
              Key
-> IntMap (DoubleLinkedList m a) -> IntMap (DoubleLinkedList m a)
forall a. Key -> IntMap a -> IntMap a
M.delete Key
k
            Maybe a -> Event m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
a

-- | Test whether the queue contains a transact with the specified priority satisfying the provided predicate.
transactStrategyQueueContainsBy :: MonadDES m
                                   => StrategyQueue m (TransactQueueStrategy s) a
                                   -- ^ the queue
                                   -> Int
                                   -- ^ the transact priority
                                   -> (a -> Bool)
                                   -- ^ the predicate
                                   -> Event m (Maybe a)
{-# INLINABLE transactStrategyQueueContainsBy #-}
transactStrategyQueueContainsBy :: StrategyQueue m (TransactQueueStrategy s) a
-> Key -> (a -> Bool) -> Event m (Maybe a)
transactStrategyQueueContainsBy StrategyQueue m (TransactQueueStrategy s) a
q Key
priority a -> Bool
pred =
  do IntMap (DoubleLinkedList m a)
m <- Ref m (IntMap (DoubleLinkedList m a))
-> Event m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
forall (m :: * -> *) s a.
StrategyQueue m (TransactQueueStrategy s) a
-> Ref m (IntMap (DoubleLinkedList m a))
transactStrategyQueue StrategyQueue m (TransactQueueStrategy s) a
q)
     let k :: Key
k  = - Key
priority
         xs :: Maybe (DoubleLinkedList m a)
xs = Key
-> IntMap (DoubleLinkedList m a) -> Maybe (DoubleLinkedList m a)
forall a. Key -> IntMap a -> Maybe a
M.lookup Key
k IntMap (DoubleLinkedList m a)
m
     case Maybe (DoubleLinkedList m a)
xs of
       Maybe (DoubleLinkedList m a)
Nothing -> Maybe a -> Event m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
       Just DoubleLinkedList m a
xs -> DoubleLinkedList m a -> (a -> Bool) -> Event m (Maybe a)
forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> (a -> Bool) -> Event m (Maybe a)
DLL.listContainsBy DoubleLinkedList m a
xs a -> Bool
pred