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

-- |
-- Module     : Simulation.Aivika.RealTime.QueueStrategy
-- Copyright  : Copyright (c) 2016-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 some queue strategy instances
-- for the 'RT' computations.
--
module Simulation.Aivika.RealTime.QueueStrategy () where

import Control.Monad.Trans

import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.Parameter
import Simulation.Aivika.Trans.Parameter.Random
import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Event
import Simulation.Aivika.Trans.QueueStrategy

import Simulation.Aivika.RealTime.Internal.RT
import Simulation.Aivika.RealTime.Comp

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

-- | An implementation of the 'FCFS' queue strategy.
instance (Monad m, MonadComp m, MonadIO m)
         => QueueStrategy (RT m) FCFS where

  {-# SPECIALISE instance QueueStrategy (RT IO) FCFS #-}

  -- | A queue used by the 'FCFS' strategy.
  newtype StrategyQueue (RT m) FCFS a = FCFSQueue (LL.DoubleLinkedList a)

  {-# INLINABLE newStrategyQueue #-}
  newStrategyQueue :: FCFS -> Simulation (RT m) (StrategyQueue (RT m) FCFS a)
newStrategyQueue FCFS
s =
    (DoubleLinkedList a -> StrategyQueue (RT m) FCFS a)
-> Simulation (RT m) (DoubleLinkedList a)
-> Simulation (RT m) (StrategyQueue (RT m) FCFS a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoubleLinkedList a -> StrategyQueue (RT m) FCFS a
forall (m :: * -> *) a.
DoubleLinkedList a -> StrategyQueue (RT m) FCFS a
FCFSQueue (Simulation (RT m) (DoubleLinkedList a)
 -> Simulation (RT m) (StrategyQueue (RT m) FCFS a))
-> Simulation (RT m) (DoubleLinkedList a)
-> Simulation (RT m) (StrategyQueue (RT m) FCFS a)
forall a b. (a -> b) -> a -> b
$
    IO (DoubleLinkedList a) -> Simulation (RT m) (DoubleLinkedList a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (DoubleLinkedList a)
forall a. IO (DoubleLinkedList a)
LL.newList

  {-# INLINABLE strategyQueueNull #-}
  strategyQueueNull :: StrategyQueue (RT m) FCFS a -> Event (RT m) Bool
strategyQueueNull (FCFSQueue q) =
    IO Bool -> Event (RT m) Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Event (RT m) Bool) -> IO Bool -> Event (RT m) Bool
forall a b. (a -> b) -> a -> b
$ DoubleLinkedList a -> IO Bool
forall a. DoubleLinkedList a -> IO Bool
LL.listNull DoubleLinkedList a
q

-- | An implementation of the 'FCFS' queue strategy.
instance (QueueStrategy (RT m) FCFS, MonadComp m, MonadIO m)
         => DequeueStrategy (RT m) FCFS where

  {-# SPECIALISE instance DequeueStrategy (RT IO) FCFS #-}

  {-# INLINABLE strategyDequeue #-}
  strategyDequeue :: StrategyQueue (RT m) FCFS a -> Event (RT m) a
strategyDequeue (FCFSQueue q) =
    IO a -> Event (RT m) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Event (RT m) a) -> IO a -> Event (RT m) a
forall a b. (a -> b) -> a -> b
$
    do a
i <- DoubleLinkedList a -> IO a
forall a. DoubleLinkedList a -> IO a
LL.listFirst DoubleLinkedList a
q
       DoubleLinkedList a -> IO ()
forall a. DoubleLinkedList a -> IO ()
LL.listRemoveFirst DoubleLinkedList a
q
       a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
i

-- | An implementation of the 'FCFS' queue strategy.
instance (DequeueStrategy (RT m) FCFS, MonadComp m, MonadIO m)
         => EnqueueStrategy (RT m) FCFS where

  {-# SPECIALISE instance EnqueueStrategy (RT IO) FCFS #-}

  {-# INLINABLE strategyEnqueue #-}
  strategyEnqueue :: StrategyQueue (RT m) FCFS a -> a -> Event (RT m) ()
strategyEnqueue (FCFSQueue q) a
i =
    IO () -> Event (RT m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event (RT m) ()) -> IO () -> Event (RT m) ()
forall a b. (a -> b) -> a -> b
$ DoubleLinkedList a -> a -> IO ()
forall a. DoubleLinkedList a -> a -> IO ()
LL.listAddLast DoubleLinkedList a
q a
i

-- | An implementation of the 'FCFS' queue strategy.
instance (DequeueStrategy (RT m) FCFS, MonadComp m, MonadIO m)
         => DeletingQueueStrategy (RT m) FCFS where

  {-# SPECIALISE instance DeletingQueueStrategy (RT IO) FCFS #-}

  {-# INLINABLE strategyQueueDeleteBy #-}
  strategyQueueDeleteBy :: StrategyQueue (RT m) FCFS a
-> (a -> Bool) -> Event (RT m) (Maybe a)
strategyQueueDeleteBy (FCFSQueue q) a -> Bool
p =
    IO (Maybe a) -> Event (RT m) (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event (RT m) (Maybe a))
-> IO (Maybe a) -> Event (RT m) (Maybe a)
forall a b. (a -> b) -> a -> b
$ DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
LL.listRemoveBy DoubleLinkedList a
q a -> Bool
p

  {-# INLINABLE strategyQueueContainsBy #-}
  strategyQueueContainsBy :: StrategyQueue (RT m) FCFS a
-> (a -> Bool) -> Event (RT m) (Maybe a)
strategyQueueContainsBy (FCFSQueue q) a -> Bool
p =
    IO (Maybe a) -> Event (RT m) (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event (RT m) (Maybe a))
-> IO (Maybe a) -> Event (RT m) (Maybe a)
forall a b. (a -> b) -> a -> b
$ DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
LL.listContainsBy DoubleLinkedList a
q a -> Bool
p

-- | An implementation of the 'LCFS' queue strategy.
instance (MonadComp m, MonadIO m)
         => QueueStrategy (RT m) LCFS where

  {-# SPECIALISE instance QueueStrategy (RT IO) LCFS #-}

  -- | A queue used by the 'LCFS' strategy.
  newtype StrategyQueue (RT m) LCFS a = LCFSQueue (LL.DoubleLinkedList a)

  {-# INLINABLE newStrategyQueue #-}
  newStrategyQueue :: LCFS -> Simulation (RT m) (StrategyQueue (RT m) LCFS a)
newStrategyQueue LCFS
s =
    (DoubleLinkedList a -> StrategyQueue (RT m) LCFS a)
-> Simulation (RT m) (DoubleLinkedList a)
-> Simulation (RT m) (StrategyQueue (RT m) LCFS a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoubleLinkedList a -> StrategyQueue (RT m) LCFS a
forall (m :: * -> *) a.
DoubleLinkedList a -> StrategyQueue (RT m) LCFS a
LCFSQueue (Simulation (RT m) (DoubleLinkedList a)
 -> Simulation (RT m) (StrategyQueue (RT m) LCFS a))
-> Simulation (RT m) (DoubleLinkedList a)
-> Simulation (RT m) (StrategyQueue (RT m) LCFS a)
forall a b. (a -> b) -> a -> b
$
    IO (DoubleLinkedList a) -> Simulation (RT m) (DoubleLinkedList a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (DoubleLinkedList a)
forall a. IO (DoubleLinkedList a)
LL.newList
       
  {-# INLINABLE strategyQueueNull #-}
  strategyQueueNull :: StrategyQueue (RT m) LCFS a -> Event (RT m) Bool
strategyQueueNull (LCFSQueue q) =
    IO Bool -> Event (RT m) Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Event (RT m) Bool) -> IO Bool -> Event (RT m) Bool
forall a b. (a -> b) -> a -> b
$ DoubleLinkedList a -> IO Bool
forall a. DoubleLinkedList a -> IO Bool
LL.listNull DoubleLinkedList a
q

-- | An implementation of the 'LCFS' queue strategy.
instance (QueueStrategy (RT m) LCFS, MonadComp m, MonadIO m)
         => DequeueStrategy (RT m) LCFS where

  {-# SPECIALISE instance DequeueStrategy (RT IO) LCFS #-}

  {-# INLINABLE strategyDequeue #-}
  strategyDequeue :: StrategyQueue (RT m) LCFS a -> Event (RT m) a
strategyDequeue (LCFSQueue q) =
    IO a -> Event (RT m) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Event (RT m) a) -> IO a -> Event (RT m) a
forall a b. (a -> b) -> a -> b
$
    do a
i <- DoubleLinkedList a -> IO a
forall a. DoubleLinkedList a -> IO a
LL.listFirst DoubleLinkedList a
q
       DoubleLinkedList a -> IO ()
forall a. DoubleLinkedList a -> IO ()
LL.listRemoveFirst DoubleLinkedList a
q
       a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
i

-- | An implementation of the 'LCFS' queue strategy.
instance (DequeueStrategy (RT m) LCFS, MonadComp m, MonadIO m)
         => EnqueueStrategy (RT m) LCFS where

  {-# SPECIALISE instance EnqueueStrategy (RT IO) LCFS #-}

  {-# INLINABLE strategyEnqueue #-}
  strategyEnqueue :: StrategyQueue (RT m) LCFS a -> a -> Event (RT m) ()
strategyEnqueue (LCFSQueue q) a
i =
    IO () -> Event (RT m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event (RT m) ()) -> IO () -> Event (RT m) ()
forall a b. (a -> b) -> a -> b
$ DoubleLinkedList a -> a -> IO ()
forall a. DoubleLinkedList a -> a -> IO ()
LL.listInsertFirst DoubleLinkedList a
q a
i

-- | An implementation of the 'LCFS' queue strategy.
instance (DequeueStrategy (RT m) LCFS, MonadComp m, MonadIO m)
         => DeletingQueueStrategy (RT m) LCFS where

  {-# SPECIALISE instance DeletingQueueStrategy (RT IO) LCFS #-}

  {-# INLINABLE strategyQueueDeleteBy #-}
  strategyQueueDeleteBy :: StrategyQueue (RT m) LCFS a
-> (a -> Bool) -> Event (RT m) (Maybe a)
strategyQueueDeleteBy (LCFSQueue q) a -> Bool
p =
    IO (Maybe a) -> Event (RT m) (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event (RT m) (Maybe a))
-> IO (Maybe a) -> Event (RT m) (Maybe a)
forall a b. (a -> b) -> a -> b
$ DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
LL.listRemoveBy DoubleLinkedList a
q a -> Bool
p

  {-# INLINABLE strategyQueueContainsBy #-}
  strategyQueueContainsBy :: StrategyQueue (RT m) LCFS a
-> (a -> Bool) -> Event (RT m) (Maybe a)
strategyQueueContainsBy (LCFSQueue q) a -> Bool
p =
    IO (Maybe a) -> Event (RT m) (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event (RT m) (Maybe a))
-> IO (Maybe a) -> Event (RT m) (Maybe a)
forall a b. (a -> b) -> a -> b
$ DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
LL.listContainsBy DoubleLinkedList a
q a -> Bool
p

-- | An implementation of the 'StaticPriorities' queue strategy.
instance (MonadComp m, MonadIO m)
         => QueueStrategy (RT m) StaticPriorities where

  {-# SPECIALISE instance QueueStrategy (RT IO) StaticPriorities #-}

  -- | A queue used by the 'StaticPriorities' strategy.
  newtype StrategyQueue (RT m) StaticPriorities a = StaticPriorityQueue (PQ.PriorityQueue a)

  {-# INLINABLE newStrategyQueue #-}
  newStrategyQueue :: StaticPriorities
-> Simulation (RT m) (StrategyQueue (RT m) StaticPriorities a)
newStrategyQueue StaticPriorities
s =
    (PriorityQueue a -> StrategyQueue (RT m) StaticPriorities a)
-> Simulation (RT m) (PriorityQueue a)
-> Simulation (RT m) (StrategyQueue (RT m) StaticPriorities a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PriorityQueue a -> StrategyQueue (RT m) StaticPriorities a
forall (m :: * -> *) a.
PriorityQueue a -> StrategyQueue (RT m) StaticPriorities a
StaticPriorityQueue (Simulation (RT m) (PriorityQueue a)
 -> Simulation (RT m) (StrategyQueue (RT m) StaticPriorities a))
-> Simulation (RT m) (PriorityQueue a)
-> Simulation (RT m) (StrategyQueue (RT m) StaticPriorities a)
forall a b. (a -> b) -> a -> b
$
    IO (PriorityQueue a) -> Simulation (RT m) (PriorityQueue a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PriorityQueue a) -> Simulation (RT m) (PriorityQueue a))
-> IO (PriorityQueue a) -> Simulation (RT m) (PriorityQueue a)
forall a b. (a -> b) -> a -> b
$ IO (PriorityQueue a)
forall a. IO (PriorityQueue a)
PQ.newQueue

  {-# INLINABLE strategyQueueNull #-}
  strategyQueueNull :: StrategyQueue (RT m) StaticPriorities a -> Event (RT m) Bool
strategyQueueNull (StaticPriorityQueue q) =
    IO Bool -> Event (RT m) Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Event (RT m) Bool) -> IO Bool -> Event (RT m) Bool
forall a b. (a -> b) -> a -> b
$ PriorityQueue a -> IO Bool
forall a. PriorityQueue a -> IO Bool
PQ.queueNull PriorityQueue a
q

-- | An implementation of the 'StaticPriorities' queue strategy.
instance (QueueStrategy (RT m) StaticPriorities, MonadComp m, MonadIO m)
         => DequeueStrategy (RT m) StaticPriorities where

  {-# SPECIALISE instance DequeueStrategy (RT IO) StaticPriorities #-}

  {-# INLINABLE strategyDequeue #-}
  strategyDequeue :: StrategyQueue (RT m) StaticPriorities a -> Event (RT m) a
strategyDequeue (StaticPriorityQueue q) =
    IO a -> Event (RT m) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Event (RT m) a) -> IO a -> Event (RT m) a
forall a b. (a -> b) -> a -> b
$
    do (Double
_, a
i) <- PriorityQueue a -> IO (Double, a)
forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront PriorityQueue a
q
       PriorityQueue a -> IO ()
forall a. PriorityQueue a -> IO ()
PQ.dequeue PriorityQueue a
q
       a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
i

-- | An implementation of the 'StaticPriorities' queue strategy.
instance (DequeueStrategy (RT m) StaticPriorities, MonadComp m, MonadIO m)
         => PriorityQueueStrategy (RT m) StaticPriorities Double where

  {-# SPECIALISE instance PriorityQueueStrategy (RT IO) StaticPriorities Double #-}

  {-# INLINABLE strategyEnqueueWithPriority #-}
  strategyEnqueueWithPriority :: StrategyQueue (RT m) StaticPriorities a
-> Double -> a -> Event (RT m) ()
strategyEnqueueWithPriority (StaticPriorityQueue q) Double
p a
i =
    IO () -> Event (RT m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event (RT m) ()) -> IO () -> Event (RT m) ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue a -> Double -> a -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue PriorityQueue a
q Double
p a
i

-- | An implementation of the 'StaticPriorities' queue strategy.
instance (DequeueStrategy (RT m) StaticPriorities, MonadComp m, MonadIO m)
         => DeletingQueueStrategy (RT m) StaticPriorities where

  {-# SPECIALISE instance DeletingQueueStrategy (RT IO) StaticPriorities #-}

  {-# INLINABLE strategyQueueDeleteBy #-}
  strategyQueueDeleteBy :: StrategyQueue (RT m) StaticPriorities a
-> (a -> Bool) -> Event (RT m) (Maybe a)
strategyQueueDeleteBy (StaticPriorityQueue q) a -> Bool
p =
    IO (Maybe a) -> Event (RT m) (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event (RT m) (Maybe a))
-> IO (Maybe a) -> Event (RT m) (Maybe a)
forall a b. (a -> b) -> a -> b
$ PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
PQ.queueDeleteBy PriorityQueue a
q a -> Bool
p

  {-# INLINABLE strategyQueueContainsBy #-}
  strategyQueueContainsBy :: StrategyQueue (RT m) StaticPriorities a
-> (a -> Bool) -> Event (RT m) (Maybe a)
strategyQueueContainsBy (StaticPriorityQueue q) a -> Bool
p =
    IO (Maybe a) -> Event (RT m) (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event (RT m) (Maybe a))
-> IO (Maybe a) -> Event (RT m) (Maybe a)
forall a b. (a -> b) -> a -> b
$ PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
PQ.queueContainsBy PriorityQueue a
q a -> Bool
p

-- | An implementation of the 'SIRO' queue strategy.
instance (MonadComp m, MonadIO m)
         => QueueStrategy (RT m) SIRO where

  {-# SPECIALISE instance QueueStrategy (RT IO) SIRO #-}

  -- | A queue used by the 'SIRO' strategy.
  newtype StrategyQueue (RT m) SIRO a = SIROQueue (V.Vector a)
  
  {-# INLINABLE newStrategyQueue #-}
  newStrategyQueue :: SIRO -> Simulation (RT m) (StrategyQueue (RT m) SIRO a)
newStrategyQueue SIRO
s =
    (Vector a -> StrategyQueue (RT m) SIRO a)
-> Simulation (RT m) (Vector a)
-> Simulation (RT m) (StrategyQueue (RT m) SIRO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> StrategyQueue (RT m) SIRO a
forall (m :: * -> *) a. Vector a -> StrategyQueue (RT m) SIRO a
SIROQueue (Simulation (RT m) (Vector a)
 -> Simulation (RT m) (StrategyQueue (RT m) SIRO a))
-> Simulation (RT m) (Vector a)
-> Simulation (RT m) (StrategyQueue (RT m) SIRO a)
forall a b. (a -> b) -> a -> b
$
    IO (Vector a) -> Simulation (RT m) (Vector a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Vector a) -> Simulation (RT m) (Vector a))
-> IO (Vector a) -> Simulation (RT m) (Vector a)
forall a b. (a -> b) -> a -> b
$ IO (Vector a)
forall a. IO (Vector a)
V.newVector

  {-# INLINABLE strategyQueueNull #-}
  strategyQueueNull :: StrategyQueue (RT m) SIRO a -> Event (RT m) Bool
strategyQueueNull (SIROQueue q) =
    IO Bool -> Event (RT m) Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Event (RT m) Bool) -> IO Bool -> Event (RT m) Bool
forall a b. (a -> b) -> a -> b
$
    do Int
n <- Vector a -> IO Int
forall a. Vector a -> IO Int
V.vectorCount Vector a
q
       Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)

-- | An implementation of the 'SIRO' queue strategy.
instance (QueueStrategy (RT m) SIRO, MonadComp m, MonadIO m)
         => DequeueStrategy (RT m) SIRO where

  {-# SPECIALISE instance DequeueStrategy (RT IO) SIRO #-}

  {-# INLINABLE strategyDequeue #-}
  strategyDequeue :: StrategyQueue (RT m) SIRO a -> Event (RT m) a
strategyDequeue (SIROQueue q) =
    do Int
n <- IO Int -> Event (RT m) Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Event (RT m) Int) -> IO Int -> Event (RT m) Int
forall a b. (a -> b) -> a -> b
$ Vector a -> IO Int
forall a. Vector a -> IO Int
V.vectorCount Vector a
q
       Int
i <- Parameter (RT m) Int -> Event (RT m) Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
ParameterLift t m =>
Parameter m a -> t m a
liftParameter (Parameter (RT m) Int -> Event (RT m) Int)
-> Parameter (RT m) Int -> Event (RT m) Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Parameter (RT m) Int
forall (m :: * -> *). MonadComp m => Int -> Int -> Parameter m Int
randomUniformInt Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
       a
x <- IO a -> Event (RT m) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Event (RT m) a) -> IO a -> Event (RT m) a
forall a b. (a -> b) -> a -> b
$ Vector a -> Int -> IO a
forall a. Vector a -> Int -> IO a
V.readVector Vector a
q Int
i
       IO () -> Event (RT m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event (RT m) ()) -> IO () -> Event (RT m) ()
forall a b. (a -> b) -> a -> b
$ Vector a -> Int -> IO ()
forall a. Vector a -> Int -> IO ()
V.vectorDeleteAt Vector a
q Int
i
       a -> Event (RT m) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | A template-based implementation of the 'SIRO' queue strategy.
instance (DequeueStrategy (RT m) SIRO, MonadComp m, MonadIO m)
         => EnqueueStrategy (RT m) SIRO where

  {-# SPECIALISE instance EnqueueStrategy (RT IO) SIRO #-}

  {-# INLINABLE strategyEnqueue #-}
  strategyEnqueue :: StrategyQueue (RT m) SIRO a -> a -> Event (RT m) ()
strategyEnqueue (SIROQueue q) a
i =
    IO () -> Event (RT m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event (RT m) ()) -> IO () -> Event (RT m) ()
forall a b. (a -> b) -> a -> b
$ Vector a -> a -> IO ()
forall a. Vector a -> a -> IO ()
V.appendVector Vector a
q a
i

-- | An implementation of the 'SIRO' queue strategy.
instance (DequeueStrategy (RT m) SIRO, MonadComp m, MonadIO m)
         => DeletingQueueStrategy (RT m) SIRO where

  {-# SPECIALISE instance DeletingQueueStrategy (RT IO) SIRO #-}

  {-# INLINABLE strategyQueueDeleteBy #-}
  strategyQueueDeleteBy :: StrategyQueue (RT m) SIRO a
-> (a -> Bool) -> Event (RT m) (Maybe a)
strategyQueueDeleteBy (SIROQueue q) a -> Bool
p =
    IO (Maybe a) -> Event (RT m) (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event (RT m) (Maybe a))
-> IO (Maybe a) -> Event (RT m) (Maybe a)
forall a b. (a -> b) -> a -> b
$ Vector a -> (a -> Bool) -> IO (Maybe a)
forall a. Vector a -> (a -> Bool) -> IO (Maybe a)
V.vectorDeleteBy Vector a
q a -> Bool
p

  {-# INLINABLE strategyQueueContainsBy #-}
  strategyQueueContainsBy :: StrategyQueue (RT m) SIRO a
-> (a -> Bool) -> Event (RT m) (Maybe a)
strategyQueueContainsBy (SIROQueue q) a -> Bool
p =
    IO (Maybe a) -> Event (RT m) (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event (RT m) (Maybe a))
-> IO (Maybe a) -> Event (RT m) (Maybe a)
forall a b. (a -> b) -> a -> b
$ Vector a -> (a -> Bool) -> IO (Maybe a)
forall a. Vector a -> (a -> Bool) -> IO (Maybe a)
V.vectorContainsBy Vector a
q a -> Bool
p