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

-- |
-- Module     : Simulation.Aivika.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.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
import qualified Simulation.Aivika.DoubleLinkedList as DLL

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

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

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

  newStrategyQueue :: TransactQueueStrategy s
-> Simulation (StrategyQueue (TransactQueueStrategy s) i)
newStrategyQueue TransactQueueStrategy s
s =
    IO (StrategyQueue (TransactQueueStrategy s) i)
-> Simulation (StrategyQueue (TransactQueueStrategy s) i)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (StrategyQueue (TransactQueueStrategy s) i)
 -> Simulation (StrategyQueue (TransactQueueStrategy s) i))
-> IO (StrategyQueue (TransactQueueStrategy s) i)
-> Simulation (StrategyQueue (TransactQueueStrategy s) i)
forall a b. (a -> b) -> a -> b
$
    do IORef (IntMap (DoubleLinkedList i))
r <- IntMap (DoubleLinkedList i)
-> IO (IORef (IntMap (DoubleLinkedList i)))
forall a. a -> IO (IORef a)
newIORef IntMap (DoubleLinkedList i)
forall a. IntMap a
M.empty
       StrategyQueue (TransactQueueStrategy s) i
-> IO (StrategyQueue (TransactQueueStrategy s) i)
forall (m :: * -> *) a. Monad m => a -> m a
return (StrategyQueue (TransactQueueStrategy s) i
 -> IO (StrategyQueue (TransactQueueStrategy s) i))
-> StrategyQueue (TransactQueueStrategy s) i
-> IO (StrategyQueue (TransactQueueStrategy s) i)
forall a b. (a -> b) -> a -> b
$ TransactQueueStrategy s
-> IORef (IntMap (DoubleLinkedList i))
-> StrategyQueue (TransactQueueStrategy s) i
forall s a.
TransactQueueStrategy s
-> IORef (IntMap (DoubleLinkedList a))
-> StrategyQueue (TransactQueueStrategy s) a
TransactStrategyQueue TransactQueueStrategy s
s IORef (IntMap (DoubleLinkedList i))
r

  strategyQueueNull :: StrategyQueue (TransactQueueStrategy s) i -> Event Bool
strategyQueueNull StrategyQueue (TransactQueueStrategy s) i
q =
    IO Bool -> Event Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Event Bool) -> IO Bool -> Event Bool
forall a b. (a -> b) -> a -> b
$
    do IntMap (DoubleLinkedList i)
m <- IORef (IntMap (DoubleLinkedList i))
-> IO (IntMap (DoubleLinkedList i))
forall a. IORef a -> IO a
readIORef (StrategyQueue (TransactQueueStrategy s) i
-> IORef (IntMap (DoubleLinkedList i))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy s) i
q)
       Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ IntMap (DoubleLinkedList i) -> Bool
forall a. IntMap a -> Bool
M.null IntMap (DoubleLinkedList i)
m

instance DequeueStrategy (TransactQueueStrategy FCFS) where

  strategyDequeue :: StrategyQueue (TransactQueueStrategy FCFS) i -> Event i
strategyDequeue StrategyQueue (TransactQueueStrategy FCFS) i
q =
    IO i -> Event i
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO i -> Event i) -> IO i -> Event i
forall a b. (a -> b) -> a -> b
$ 
    do IntMap (DoubleLinkedList i)
m <- IORef (IntMap (DoubleLinkedList i))
-> IO (IntMap (DoubleLinkedList i))
forall a. IORef a -> IO a
readIORef (StrategyQueue (TransactQueueStrategy FCFS) i
-> IORef (IntMap (DoubleLinkedList i))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy FCFS) i
q)
       let (Key
k, DoubleLinkedList i
xs) = IntMap (DoubleLinkedList i) -> (Key, DoubleLinkedList i)
forall a. IntMap a -> (Key, a)
M.findMin IntMap (DoubleLinkedList i)
m
       i
i <- DoubleLinkedList i -> IO i
forall a. DoubleLinkedList a -> IO a
DLL.listFirst DoubleLinkedList i
xs
       DoubleLinkedList i -> IO ()
forall a. DoubleLinkedList a -> IO ()
DLL.listRemoveFirst DoubleLinkedList i
xs
       Bool
empty <- DoubleLinkedList i -> IO Bool
forall a. DoubleLinkedList a -> IO Bool
DLL.listNull DoubleLinkedList i
xs
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
empty (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         IORef (IntMap (DoubleLinkedList i))
-> (IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (StrategyQueue (TransactQueueStrategy FCFS) i
-> IORef (IntMap (DoubleLinkedList i))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy FCFS) i
q) ((IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
 -> IO ())
-> (IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
-> IO ()
forall a b. (a -> b) -> a -> b
$
         Key -> IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i)
forall a. Key -> IntMap a -> IntMap a
M.delete Key
k
       i -> IO i
forall (m :: * -> *) a. Monad m => a -> m a
return i
i

instance DequeueStrategy (TransactQueueStrategy LCFS) where

  strategyDequeue :: StrategyQueue (TransactQueueStrategy LCFS) i -> Event i
strategyDequeue StrategyQueue (TransactQueueStrategy LCFS) i
q =
    IO i -> Event i
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO i -> Event i) -> IO i -> Event i
forall a b. (a -> b) -> a -> b
$ 
    do IntMap (DoubleLinkedList i)
m <- IORef (IntMap (DoubleLinkedList i))
-> IO (IntMap (DoubleLinkedList i))
forall a. IORef a -> IO a
readIORef (StrategyQueue (TransactQueueStrategy LCFS) i
-> IORef (IntMap (DoubleLinkedList i))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy LCFS) i
q)
       let (Key
k, DoubleLinkedList i
xs) = IntMap (DoubleLinkedList i) -> (Key, DoubleLinkedList i)
forall a. IntMap a -> (Key, a)
M.findMin IntMap (DoubleLinkedList i)
m
       i
i <- DoubleLinkedList i -> IO i
forall a. DoubleLinkedList a -> IO a
DLL.listLast DoubleLinkedList i
xs
       DoubleLinkedList i -> IO ()
forall a. DoubleLinkedList a -> IO ()
DLL.listRemoveLast DoubleLinkedList i
xs
       Bool
empty <- DoubleLinkedList i -> IO Bool
forall a. DoubleLinkedList a -> IO Bool
DLL.listNull DoubleLinkedList i
xs
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
empty (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         IORef (IntMap (DoubleLinkedList i))
-> (IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (StrategyQueue (TransactQueueStrategy LCFS) i
-> IORef (IntMap (DoubleLinkedList i))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy LCFS) i
q) ((IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
 -> IO ())
-> (IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
-> IO ()
forall a b. (a -> b) -> a -> b
$
         Key -> IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i)
forall a. Key -> IntMap a -> IntMap a
M.delete Key
k
       i -> IO i
forall (m :: * -> *) a. Monad m => a -> m a
return i
i

instance DequeueStrategy (TransactQueueStrategy s) => PriorityQueueStrategy (TransactQueueStrategy s) Int where

  {-# SPECIALISE instance PriorityQueueStrategy (TransactQueueStrategy FCFS) Int #-}
  {-# SPECIALISE instance PriorityQueueStrategy (TransactQueueStrategy LCFS) Int #-}
  
  strategyEnqueueWithPriority :: StrategyQueue (TransactQueueStrategy s) i -> Key -> i -> Event ()
strategyEnqueueWithPriority StrategyQueue (TransactQueueStrategy s) i
q Key
priority i
i =
    IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$
    do IntMap (DoubleLinkedList i)
m <- IORef (IntMap (DoubleLinkedList i))
-> IO (IntMap (DoubleLinkedList i))
forall a. IORef a -> IO a
readIORef (StrategyQueue (TransactQueueStrategy s) i
-> IORef (IntMap (DoubleLinkedList i))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy s) i
q)
       let k :: Key
k  = - Key
priority
           xs :: Maybe (DoubleLinkedList i)
xs = Key -> IntMap (DoubleLinkedList i) -> Maybe (DoubleLinkedList i)
forall a. Key -> IntMap a -> Maybe a
M.lookup Key
k IntMap (DoubleLinkedList i)
m
       case Maybe (DoubleLinkedList i)
xs of
         Maybe (DoubleLinkedList i)
Nothing ->
           do DoubleLinkedList i
xs <- IO (DoubleLinkedList i)
forall a. IO (DoubleLinkedList a)
DLL.newList
              DoubleLinkedList i -> i -> IO ()
forall a. DoubleLinkedList a -> a -> IO ()
DLL.listAddLast DoubleLinkedList i
xs i
i
              IORef (IntMap (DoubleLinkedList i))
-> (IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (StrategyQueue (TransactQueueStrategy s) i
-> IORef (IntMap (DoubleLinkedList i))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy s) i
q) ((IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
 -> IO ())
-> (IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
-> IO ()
forall a b. (a -> b) -> a -> b
$
                Key
-> DoubleLinkedList i
-> IntMap (DoubleLinkedList i)
-> IntMap (DoubleLinkedList i)
forall a. Key -> a -> IntMap a -> IntMap a
M.insert Key
k DoubleLinkedList i
xs
         Just DoubleLinkedList i
xs ->
           DoubleLinkedList i -> i -> IO ()
forall a. DoubleLinkedList a -> a -> IO ()
DLL.listAddLast DoubleLinkedList i
xs i
i

instance DeletingQueueStrategy (TransactQueueStrategy FCFS) where

  strategyQueueDeleteBy :: StrategyQueue (TransactQueueStrategy FCFS) i
-> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy StrategyQueue (TransactQueueStrategy FCFS) i
q i -> Bool
pred =
    IO (Maybe i) -> Event (Maybe i)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe i) -> Event (Maybe i))
-> IO (Maybe i) -> Event (Maybe i)
forall a b. (a -> b) -> a -> b
$
    do IntMap (DoubleLinkedList i)
m <- IORef (IntMap (DoubleLinkedList i))
-> IO (IntMap (DoubleLinkedList i))
forall a. IORef a -> IO a
readIORef (StrategyQueue (TransactQueueStrategy FCFS) i
-> IORef (IntMap (DoubleLinkedList i))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy FCFS) i
q)
       let loop :: [(Key, DoubleLinkedList i)] -> IO (Maybe i)
loop [] = Maybe i -> IO (Maybe i)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe i
forall a. Maybe a
Nothing
           loop ((Key
k, DoubleLinkedList i
xs): [(Key, DoubleLinkedList i)]
tail) =
             do Maybe i
a <- DoubleLinkedList i -> (i -> Bool) -> IO (Maybe i)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
DLL.listRemoveBy DoubleLinkedList i
xs i -> Bool
pred
                case Maybe i
a of
                  Maybe i
Nothing -> [(Key, DoubleLinkedList i)] -> IO (Maybe i)
loop [(Key, DoubleLinkedList i)]
tail
                  Just i
_  ->
                    do Bool
empty <- DoubleLinkedList i -> IO Bool
forall a. DoubleLinkedList a -> IO Bool
DLL.listNull DoubleLinkedList i
xs
                       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
empty (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                         IORef (IntMap (DoubleLinkedList i))
-> (IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (StrategyQueue (TransactQueueStrategy FCFS) i
-> IORef (IntMap (DoubleLinkedList i))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy FCFS) i
q) ((IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
 -> IO ())
-> (IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i))
-> IO ()
forall a b. (a -> b) -> a -> b
$
                         Key -> IntMap (DoubleLinkedList i) -> IntMap (DoubleLinkedList i)
forall a. Key -> IntMap a -> IntMap a
M.delete Key
k
                       Maybe i -> IO (Maybe i)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe i
a
       [(Key, DoubleLinkedList i)] -> IO (Maybe i)
loop (IntMap (DoubleLinkedList i) -> [(Key, DoubleLinkedList i)]
forall a. IntMap a -> [(Key, a)]
M.assocs IntMap (DoubleLinkedList i)
m)

  strategyQueueContainsBy :: StrategyQueue (TransactQueueStrategy FCFS) i
-> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy StrategyQueue (TransactQueueStrategy FCFS) i
q i -> Bool
pred =
    IO (Maybe i) -> Event (Maybe i)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe i) -> Event (Maybe i))
-> IO (Maybe i) -> Event (Maybe i)
forall a b. (a -> b) -> a -> b
$
    do IntMap (DoubleLinkedList i)
m <- IORef (IntMap (DoubleLinkedList i))
-> IO (IntMap (DoubleLinkedList i))
forall a. IORef a -> IO a
readIORef (StrategyQueue (TransactQueueStrategy FCFS) i
-> IORef (IntMap (DoubleLinkedList i))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy FCFS) i
q)
       let loop :: [(Key, DoubleLinkedList i)] -> IO (Maybe i)
loop [] = Maybe i -> IO (Maybe i)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe i
forall a. Maybe a
Nothing
           loop ((Key
k, DoubleLinkedList i
xs): [(Key, DoubleLinkedList i)]
tail) =
             do Maybe i
a <- DoubleLinkedList i -> (i -> Bool) -> IO (Maybe i)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
DLL.listContainsBy DoubleLinkedList i
xs i -> Bool
pred
                case Maybe i
a of
                  Maybe i
Nothing -> [(Key, DoubleLinkedList i)] -> IO (Maybe i)
loop [(Key, DoubleLinkedList i)]
tail
                  Just i
_  -> Maybe i -> IO (Maybe i)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe i
a
       [(Key, DoubleLinkedList i)] -> IO (Maybe i)
loop (IntMap (DoubleLinkedList i) -> [(Key, DoubleLinkedList i)]
forall a. IntMap a -> [(Key, a)]
M.assocs IntMap (DoubleLinkedList i)
m)

-- | Try to delete the transact by the specified priority and satisfying to the provided predicate.
transactStrategyQueueDeleteBy :: StrategyQueue (TransactQueueStrategy s) a
                                 -- ^ the queue
                                 -> Int
                                 -- ^ the transact priority
                                 -> (a -> Bool)
                                 -- ^ the predicate
                                 -> Event (Maybe a)
transactStrategyQueueDeleteBy :: StrategyQueue (TransactQueueStrategy s) a
-> Key -> (a -> Bool) -> Event (Maybe a)
transactStrategyQueueDeleteBy StrategyQueue (TransactQueueStrategy s) a
q Key
priority a -> Bool
pred =
  IO (Maybe a) -> Event (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event (Maybe a))
-> IO (Maybe a) -> Event (Maybe a)
forall a b. (a -> b) -> a -> b
$
  do IntMap (DoubleLinkedList a)
m <- IORef (IntMap (DoubleLinkedList a))
-> IO (IntMap (DoubleLinkedList a))
forall a. IORef a -> IO a
readIORef (StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy s) a
q)
     let k :: Key
k  = - Key
priority
         xs :: Maybe (DoubleLinkedList a)
xs = Key -> IntMap (DoubleLinkedList a) -> Maybe (DoubleLinkedList a)
forall a. Key -> IntMap a -> Maybe a
M.lookup Key
k IntMap (DoubleLinkedList a)
m
     case Maybe (DoubleLinkedList a)
xs of
       Maybe (DoubleLinkedList a)
Nothing -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
       Just DoubleLinkedList a
xs ->
         do Maybe a
a <- DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
DLL.listRemoveBy DoubleLinkedList a
xs a -> Bool
pred
            Bool
empty <- DoubleLinkedList a -> IO Bool
forall a. DoubleLinkedList a -> IO Bool
DLL.listNull DoubleLinkedList a
xs
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
empty (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              IORef (IntMap (DoubleLinkedList a))
-> (IntMap (DoubleLinkedList a) -> IntMap (DoubleLinkedList a))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy s) a
q) ((IntMap (DoubleLinkedList a) -> IntMap (DoubleLinkedList a))
 -> IO ())
-> (IntMap (DoubleLinkedList a) -> IntMap (DoubleLinkedList a))
-> IO ()
forall a b. (a -> b) -> a -> b
$
              Key -> IntMap (DoubleLinkedList a) -> IntMap (DoubleLinkedList a)
forall a. Key -> IntMap a -> IntMap a
M.delete Key
k
            Maybe a -> IO (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 :: StrategyQueue (TransactQueueStrategy s) a
                                   -- ^ the queue
                                   -> Int
                                   -- ^ the transact priority
                                   -> (a -> Bool)
                                   -- ^ the predicate
                                   -> Event (Maybe a)
transactStrategyQueueContainsBy :: StrategyQueue (TransactQueueStrategy s) a
-> Key -> (a -> Bool) -> Event (Maybe a)
transactStrategyQueueContainsBy StrategyQueue (TransactQueueStrategy s) a
q Key
priority a -> Bool
pred =
  IO (Maybe a) -> Event (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event (Maybe a))
-> IO (Maybe a) -> Event (Maybe a)
forall a b. (a -> b) -> a -> b
$
  do IntMap (DoubleLinkedList a)
m <- IORef (IntMap (DoubleLinkedList a))
-> IO (IntMap (DoubleLinkedList a))
forall a. IORef a -> IO a
readIORef (StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
forall s a.
StrategyQueue (TransactQueueStrategy s) a
-> IORef (IntMap (DoubleLinkedList a))
transactStrategyQueue StrategyQueue (TransactQueueStrategy s) a
q)
     let k :: Key
k  = - Key
priority
         xs :: Maybe (DoubleLinkedList a)
xs = Key -> IntMap (DoubleLinkedList a) -> Maybe (DoubleLinkedList a)
forall a. Key -> IntMap a -> Maybe a
M.lookup Key
k IntMap (DoubleLinkedList a)
m
     case Maybe (DoubleLinkedList a)
xs of
       Maybe (DoubleLinkedList a)
Nothing -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
       Just DoubleLinkedList a
xs -> DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
DLL.listContainsBy DoubleLinkedList a
xs a -> Bool
pred