{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}

-- |
-- Module     : Simulation.Aivika.IO.QueueStrategy
-- 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 some queue strategy instances
-- for the 'IO' computation.
--
module Simulation.Aivika.IO.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.IO.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 QueueStrategy IO FCFS where
-- instance (Monad m, MonadComp m, MonadIO m, MonadTemplate m)
--          => QueueStrategy m FCFS where

  {-# SPECIALISE instance QueueStrategy IO FCFS #-}

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

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

  {-# INLINABLE strategyQueueNull #-}
  strategyQueueNull :: forall a. StrategyQueue IO FCFS a -> Event IO Bool
strategyQueueNull (FCFSQueue DoubleLinkedList a
q) =
    IO Bool -> Event IO Bool
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Event IO Bool) -> IO Bool -> Event IO 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 DequeueStrategy IO FCFS where
-- instance (QueueStrategy m FCFS, MonadComp m, MonadIO m, MonadTemplate m)
--          => DequeueStrategy m FCFS where

  {-# SPECIALISE instance DequeueStrategy IO FCFS #-}

  {-# INLINABLE strategyDequeue #-}
  strategyDequeue :: forall a. StrategyQueue IO FCFS a -> Event IO a
strategyDequeue (FCFSQueue DoubleLinkedList a
q) =
    IO a -> Event IO a
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Event IO a) -> IO a -> Event IO 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
i

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

  {-# SPECIALISE instance EnqueueStrategy IO FCFS #-}

  {-# INLINABLE strategyEnqueue #-}
  strategyEnqueue :: forall a. StrategyQueue IO FCFS a -> a -> Event IO ()
strategyEnqueue (FCFSQueue DoubleLinkedList a
q) a
i =
    IO () -> Event IO ()
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event IO ()) -> IO () -> Event IO ()
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 DeletingQueueStrategy IO FCFS where
-- instance (DequeueStrategy m FCFS, MonadComp m, MonadIO m, MonadTemplate m)
--          => DeletingQueueStrategy m FCFS where

  {-# SPECIALISE instance DeletingQueueStrategy IO FCFS #-}

  {-# INLINABLE strategyQueueDeleteBy #-}
  strategyQueueDeleteBy :: forall a.
StrategyQueue IO FCFS a -> (a -> Bool) -> Event IO (Maybe a)
strategyQueueDeleteBy (FCFSQueue DoubleLinkedList a
q) a -> Bool
p =
    IO (Maybe a) -> Event IO (Maybe a)
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event IO (Maybe a))
-> IO (Maybe a) -> Event IO (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 :: forall a.
StrategyQueue IO FCFS a -> (a -> Bool) -> Event IO (Maybe a)
strategyQueueContainsBy (FCFSQueue DoubleLinkedList a
q) a -> Bool
p =
    IO (Maybe a) -> Event IO (Maybe a)
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event IO (Maybe a))
-> IO (Maybe a) -> Event IO (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 QueueStrategy IO LCFS where
-- instance (MonadComp m, MonadIO m, MonadTemplate m)
--          => QueueStrategy m LCFS where

  {-# SPECIALISE instance QueueStrategy IO LCFS #-}

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

  {-# INLINABLE newStrategyQueue #-}
  newStrategyQueue :: forall a. LCFS -> Simulation IO (StrategyQueue IO LCFS a)
newStrategyQueue LCFS
s =
    (DoubleLinkedList a -> StrategyQueue IO LCFS a)
-> Simulation IO (DoubleLinkedList a)
-> Simulation IO (StrategyQueue IO LCFS a)
forall a b. (a -> b) -> Simulation IO a -> Simulation IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoubleLinkedList a -> StrategyQueue IO LCFS a
forall a. DoubleLinkedList a -> StrategyQueue IO LCFS a
LCFSQueue (Simulation IO (DoubleLinkedList a)
 -> Simulation IO (StrategyQueue IO LCFS a))
-> Simulation IO (DoubleLinkedList a)
-> Simulation IO (StrategyQueue IO LCFS a)
forall a b. (a -> b) -> a -> b
$
    IO (DoubleLinkedList a) -> Simulation IO (DoubleLinkedList a)
forall a. IO a -> Simulation IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (DoubleLinkedList a)
forall a. IO (DoubleLinkedList a)
LL.newList
       
  {-# INLINABLE strategyQueueNull #-}
  strategyQueueNull :: forall a. StrategyQueue IO LCFS a -> Event IO Bool
strategyQueueNull (LCFSQueue DoubleLinkedList a
q) =
    IO Bool -> Event IO Bool
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Event IO Bool) -> IO Bool -> Event IO 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 DequeueStrategy IO LCFS where
-- instance (QueueStrategy m LCFS, MonadComp m, MonadIO m, MonadTemplate m)
--          => DequeueStrategy m LCFS where

  {-# SPECIALISE instance DequeueStrategy IO LCFS #-}

  {-# INLINABLE strategyDequeue #-}
  strategyDequeue :: forall a. StrategyQueue IO LCFS a -> Event IO a
strategyDequeue (LCFSQueue DoubleLinkedList a
q) =
    IO a -> Event IO a
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Event IO a) -> IO a -> Event IO 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
i

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

  {-# SPECIALISE instance EnqueueStrategy IO LCFS #-}

  {-# INLINABLE strategyEnqueue #-}
  strategyEnqueue :: forall a. StrategyQueue IO LCFS a -> a -> Event IO ()
strategyEnqueue (LCFSQueue DoubleLinkedList a
q) a
i =
    IO () -> Event IO ()
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event IO ()) -> IO () -> Event IO ()
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 DeletingQueueStrategy IO LCFS where
-- instance (DequeueStrategy m LCFS, MonadComp m, MonadIO m, MonadTemplate m)
--          => DeletingQueueStrategy m LCFS where

  {-# SPECIALISE instance DeletingQueueStrategy IO LCFS #-}

  {-# INLINABLE strategyQueueDeleteBy #-}
  strategyQueueDeleteBy :: forall a.
StrategyQueue IO LCFS a -> (a -> Bool) -> Event IO (Maybe a)
strategyQueueDeleteBy (LCFSQueue DoubleLinkedList a
q) a -> Bool
p =
    IO (Maybe a) -> Event IO (Maybe a)
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event IO (Maybe a))
-> IO (Maybe a) -> Event IO (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 :: forall a.
StrategyQueue IO LCFS a -> (a -> Bool) -> Event IO (Maybe a)
strategyQueueContainsBy (LCFSQueue DoubleLinkedList a
q) a -> Bool
p =
    IO (Maybe a) -> Event IO (Maybe a)
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event IO (Maybe a))
-> IO (Maybe a) -> Event IO (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 QueueStrategy IO StaticPriorities where
-- instance (MonadComp m, MonadIO m, MonadTemplate m)
--          => QueueStrategy m StaticPriorities where

  {-# SPECIALISE instance QueueStrategy IO StaticPriorities #-}

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

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

  {-# INLINABLE strategyQueueNull #-}
  strategyQueueNull :: forall a. StrategyQueue IO StaticPriorities a -> Event IO Bool
strategyQueueNull (StaticPriorityQueue PriorityQueue a
q) =
    IO Bool -> Event IO Bool
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Event IO Bool) -> IO Bool -> Event IO 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 DequeueStrategy IO StaticPriorities where
-- instance (QueueStrategy m StaticPriorities, MonadComp m, MonadIO m, MonadTemplate m)
--          => DequeueStrategy m StaticPriorities where

  {-# SPECIALISE instance DequeueStrategy IO StaticPriorities #-}

  {-# INLINABLE strategyDequeue #-}
  strategyDequeue :: forall a. StrategyQueue IO StaticPriorities a -> Event IO a
strategyDequeue (StaticPriorityQueue PriorityQueue a
q) =
    IO a -> Event IO a
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Event IO a) -> IO a -> Event IO 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
i

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

  {-# SPECIALISE instance PriorityQueueStrategy IO StaticPriorities Double #-}

  {-# INLINABLE strategyEnqueueWithPriority #-}
  strategyEnqueueWithPriority :: forall a.
StrategyQueue IO StaticPriorities a -> Double -> a -> Event IO ()
strategyEnqueueWithPriority (StaticPriorityQueue PriorityQueue a
q) Double
p a
i =
    IO () -> Event IO ()
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event IO ()) -> IO () -> Event IO ()
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 DeletingQueueStrategy IO StaticPriorities where
-- instance (DequeueStrategy m StaticPriorities, MonadComp m, MonadIO m, MonadTemplate m)
--          => DeletingQueueStrategy m StaticPriorities where

  {-# SPECIALISE instance DeletingQueueStrategy IO StaticPriorities #-}

  {-# INLINABLE strategyQueueDeleteBy #-}
  strategyQueueDeleteBy :: forall a.
StrategyQueue IO StaticPriorities a
-> (a -> Bool) -> Event IO (Maybe a)
strategyQueueDeleteBy (StaticPriorityQueue PriorityQueue a
q) a -> Bool
p =
    IO (Maybe a) -> Event IO (Maybe a)
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event IO (Maybe a))
-> IO (Maybe a) -> Event IO (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 :: forall a.
StrategyQueue IO StaticPriorities a
-> (a -> Bool) -> Event IO (Maybe a)
strategyQueueContainsBy (StaticPriorityQueue PriorityQueue a
q) a -> Bool
p =
    IO (Maybe a) -> Event IO (Maybe a)
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event IO (Maybe a))
-> IO (Maybe a) -> Event IO (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 QueueStrategy IO SIRO where
-- instance (MonadComp m, MonadIO m, MonadTemplate m)
--          => QueueStrategy m SIRO where

  {-# SPECIALISE instance QueueStrategy IO SIRO #-}

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

  {-# INLINABLE strategyQueueNull #-}
  strategyQueueNull :: forall a. StrategyQueue IO SIRO a -> Event IO Bool
strategyQueueNull (SIROQueue Vector a
q) =
    IO Bool -> Event IO Bool
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Event IO Bool) -> IO Bool -> Event IO 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 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)

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

  {-# SPECIALISE instance DequeueStrategy IO SIRO #-}

  {-# INLINABLE strategyDequeue #-}
  strategyDequeue :: forall a. StrategyQueue IO SIRO a -> Event IO a
strategyDequeue (SIROQueue Vector a
q) =
    do Int
n <- IO Int -> Event IO Int
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Event IO Int) -> IO Int -> Event IO 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 IO Int -> Event IO Int
forall a. Parameter IO a -> Event IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
ParameterLift t m =>
Parameter m a -> t m a
liftParameter (Parameter IO Int -> Event IO Int)
-> Parameter IO Int -> Event IO Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Parameter IO 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 IO a
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Event IO a) -> IO a -> Event IO 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 IO ()
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event IO ()) -> IO () -> Event IO ()
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 IO a
forall a. a -> Event IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

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

  {-# SPECIALISE instance EnqueueStrategy IO SIRO #-}

  {-# INLINABLE strategyEnqueue #-}
  strategyEnqueue :: forall a. StrategyQueue IO SIRO a -> a -> Event IO ()
strategyEnqueue (SIROQueue Vector a
q) a
i =
    IO () -> Event IO ()
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event IO ()) -> IO () -> Event IO ()
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 DeletingQueueStrategy IO SIRO where
-- instance (DequeueStrategy m SIRO, MonadComp m, MonadIO m, MonadTemplate m)
--          => DeletingQueueStrategy m SIRO where

  {-# SPECIALISE instance DeletingQueueStrategy IO SIRO #-}

  {-# INLINABLE strategyQueueDeleteBy #-}
  strategyQueueDeleteBy :: forall a.
StrategyQueue IO SIRO a -> (a -> Bool) -> Event IO (Maybe a)
strategyQueueDeleteBy (SIROQueue Vector a
q) a -> Bool
p =
    IO (Maybe a) -> Event IO (Maybe a)
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event IO (Maybe a))
-> IO (Maybe a) -> Event IO (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 :: forall a.
StrategyQueue IO SIRO a -> (a -> Bool) -> Event IO (Maybe a)
strategyQueueContainsBy (SIROQueue Vector a
q) a -> Bool
p =
    IO (Maybe a) -> Event IO (Maybe a)
forall a. IO a -> Event IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Event IO (Maybe a))
-> IO (Maybe a) -> Event IO (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