{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FunctionalDependencies #-}

-- |
-- Module     : Simulation.Aivika.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 the queue strategies.
--
module Simulation.Aivika.QueueStrategy where

import Control.Monad.Trans
import Data.Maybe

import Simulation.Aivika.Parameter
import Simulation.Aivika.Parameter.Random
import Simulation.Aivika.Simulation
import Simulation.Aivika.Event
import Simulation.Aivika.DoubleLinkedList
import qualified Simulation.Aivika.PriorityQueue as PQ
import qualified Simulation.Aivika.Vector as V

-- | Defines the basic queue strategy.
class QueueStrategy s where

  -- | A queue used by the strategy.
  data StrategyQueue s :: * -> *

  -- | Create a new queue by the specified strategy.
  newStrategyQueue :: s
                      -- ^ the strategy
                      -> Simulation (StrategyQueue s i)
                      -- ^ a new queue

  -- | Test whether the queue is empty.
  strategyQueueNull :: StrategyQueue s i
                       -- ^ the queue
                       -> Event Bool
                       -- ^ the result of the test

-- | Defines a strategy with support of the dequeuing operation.
class QueueStrategy s => DequeueStrategy s where

  -- | Dequeue the front element and return it.
  strategyDequeue :: StrategyQueue s i
                     -- ^ the queue
                     -> Event i
                     -- ^ the dequeued element

-- | It defines a strategy when we can enqueue a single element.
class DequeueStrategy s => EnqueueStrategy s where

  -- | Enqueue an element.
  strategyEnqueue :: StrategyQueue s i
                     -- ^ the queue
                     -> i
                     -- ^ the element to be enqueued
                     -> Event ()
                     -- ^ the action of enqueuing

-- | It defines a strategy when we can enqueue an element with the specified priority.
class DequeueStrategy s => PriorityQueueStrategy s p | s -> p where

  -- | Enqueue an element with the specified priority.
  strategyEnqueueWithPriority :: StrategyQueue s i
                                 -- ^ the queue
                                 -> p
                                 -- ^ the priority
                                 -> i
                                 -- ^ the element to be enqueued
                                 -> Event ()
                                 -- ^ the action of enqueuing

-- | Defines a strategy with support of the deleting operation.
class DequeueStrategy s => DeletingQueueStrategy s where

  -- | Remove the element and return a flag indicating whether
  -- the element was found and removed.
  strategyQueueDelete :: Eq i
                         => StrategyQueue s i
                         -- ^ the queue
                         -> i
                         -- ^ the element
                         -> Event Bool
                         -- ^ whether the element was found and removed
  strategyQueueDelete StrategyQueue s i
s i
i = (Maybe i -> Bool) -> Event (Maybe i) -> Event Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe i -> Bool
forall a. Maybe a -> Bool
isJust (Event (Maybe i) -> Event Bool) -> Event (Maybe i) -> Event Bool
forall a b. (a -> b) -> a -> b
$ StrategyQueue s i -> (i -> Bool) -> Event (Maybe i)
forall s i.
DeletingQueueStrategy s =>
StrategyQueue s i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy StrategyQueue s i
s (i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
i)

  -- | Remove an element satisfying the predicate and return the element if found.
  strategyQueueDeleteBy :: StrategyQueue s i
                           -- ^ the queue
                           -> (i -> Bool)
                           -- ^ the predicate
                           -> Event (Maybe i)
                           -- ^ the element if it was found and removed

  -- | Detect whether the specified element is contained in the queue.
  strategyQueueContains :: Eq i
                           => StrategyQueue s i
                           -- ^ the queue
                           -> i
                           -- ^ the element to find
                           -> Event Bool
                           -- ^ whether the element is contained in the queue
  strategyQueueContains StrategyQueue s i
s i
i = (Maybe i -> Bool) -> Event (Maybe i) -> Event Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe i -> Bool
forall a. Maybe a -> Bool
isJust (Event (Maybe i) -> Event Bool) -> Event (Maybe i) -> Event Bool
forall a b. (a -> b) -> a -> b
$ StrategyQueue s i -> (i -> Bool) -> Event (Maybe i)
forall s i.
DeletingQueueStrategy s =>
StrategyQueue s i -> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy StrategyQueue s i
s (i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
i)

  -- | Detect whether an element satifying the specified predicate is contained in the queue.
  strategyQueueContainsBy :: StrategyQueue s i
                             -- ^ the queue
                             -> (i -> Bool)
                             -- ^ the predicate
                             -> Event (Maybe i)
                             -- ^ the element if it was found

-- | Strategy: First Come - First Served (FCFS).
data FCFS = FCFS deriving (FCFS -> FCFS -> Bool
(FCFS -> FCFS -> Bool) -> (FCFS -> FCFS -> Bool) -> Eq FCFS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FCFS -> FCFS -> Bool
$c/= :: FCFS -> FCFS -> Bool
== :: FCFS -> FCFS -> Bool
$c== :: FCFS -> FCFS -> Bool
Eq, Eq FCFS
Eq FCFS
-> (FCFS -> FCFS -> Ordering)
-> (FCFS -> FCFS -> Bool)
-> (FCFS -> FCFS -> Bool)
-> (FCFS -> FCFS -> Bool)
-> (FCFS -> FCFS -> Bool)
-> (FCFS -> FCFS -> FCFS)
-> (FCFS -> FCFS -> FCFS)
-> Ord FCFS
FCFS -> FCFS -> Bool
FCFS -> FCFS -> Ordering
FCFS -> FCFS -> FCFS
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FCFS -> FCFS -> FCFS
$cmin :: FCFS -> FCFS -> FCFS
max :: FCFS -> FCFS -> FCFS
$cmax :: FCFS -> FCFS -> FCFS
>= :: FCFS -> FCFS -> Bool
$c>= :: FCFS -> FCFS -> Bool
> :: FCFS -> FCFS -> Bool
$c> :: FCFS -> FCFS -> Bool
<= :: FCFS -> FCFS -> Bool
$c<= :: FCFS -> FCFS -> Bool
< :: FCFS -> FCFS -> Bool
$c< :: FCFS -> FCFS -> Bool
compare :: FCFS -> FCFS -> Ordering
$ccompare :: FCFS -> FCFS -> Ordering
$cp1Ord :: Eq FCFS
Ord, Int -> FCFS -> ShowS
[FCFS] -> ShowS
FCFS -> String
(Int -> FCFS -> ShowS)
-> (FCFS -> String) -> ([FCFS] -> ShowS) -> Show FCFS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FCFS] -> ShowS
$cshowList :: [FCFS] -> ShowS
show :: FCFS -> String
$cshow :: FCFS -> String
showsPrec :: Int -> FCFS -> ShowS
$cshowsPrec :: Int -> FCFS -> ShowS
Show)

-- | Strategy: Last Come - First Served (LCFS)
data LCFS = LCFS deriving (LCFS -> LCFS -> Bool
(LCFS -> LCFS -> Bool) -> (LCFS -> LCFS -> Bool) -> Eq LCFS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LCFS -> LCFS -> Bool
$c/= :: LCFS -> LCFS -> Bool
== :: LCFS -> LCFS -> Bool
$c== :: LCFS -> LCFS -> Bool
Eq, Eq LCFS
Eq LCFS
-> (LCFS -> LCFS -> Ordering)
-> (LCFS -> LCFS -> Bool)
-> (LCFS -> LCFS -> Bool)
-> (LCFS -> LCFS -> Bool)
-> (LCFS -> LCFS -> Bool)
-> (LCFS -> LCFS -> LCFS)
-> (LCFS -> LCFS -> LCFS)
-> Ord LCFS
LCFS -> LCFS -> Bool
LCFS -> LCFS -> Ordering
LCFS -> LCFS -> LCFS
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LCFS -> LCFS -> LCFS
$cmin :: LCFS -> LCFS -> LCFS
max :: LCFS -> LCFS -> LCFS
$cmax :: LCFS -> LCFS -> LCFS
>= :: LCFS -> LCFS -> Bool
$c>= :: LCFS -> LCFS -> Bool
> :: LCFS -> LCFS -> Bool
$c> :: LCFS -> LCFS -> Bool
<= :: LCFS -> LCFS -> Bool
$c<= :: LCFS -> LCFS -> Bool
< :: LCFS -> LCFS -> Bool
$c< :: LCFS -> LCFS -> Bool
compare :: LCFS -> LCFS -> Ordering
$ccompare :: LCFS -> LCFS -> Ordering
$cp1Ord :: Eq LCFS
Ord, Int -> LCFS -> ShowS
[LCFS] -> ShowS
LCFS -> String
(Int -> LCFS -> ShowS)
-> (LCFS -> String) -> ([LCFS] -> ShowS) -> Show LCFS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LCFS] -> ShowS
$cshowList :: [LCFS] -> ShowS
show :: LCFS -> String
$cshow :: LCFS -> String
showsPrec :: Int -> LCFS -> ShowS
$cshowsPrec :: Int -> LCFS -> ShowS
Show)

-- | Strategy: Service in Random Order (SIRO).
data SIRO = SIRO deriving (SIRO -> SIRO -> Bool
(SIRO -> SIRO -> Bool) -> (SIRO -> SIRO -> Bool) -> Eq SIRO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SIRO -> SIRO -> Bool
$c/= :: SIRO -> SIRO -> Bool
== :: SIRO -> SIRO -> Bool
$c== :: SIRO -> SIRO -> Bool
Eq, Eq SIRO
Eq SIRO
-> (SIRO -> SIRO -> Ordering)
-> (SIRO -> SIRO -> Bool)
-> (SIRO -> SIRO -> Bool)
-> (SIRO -> SIRO -> Bool)
-> (SIRO -> SIRO -> Bool)
-> (SIRO -> SIRO -> SIRO)
-> (SIRO -> SIRO -> SIRO)
-> Ord SIRO
SIRO -> SIRO -> Bool
SIRO -> SIRO -> Ordering
SIRO -> SIRO -> SIRO
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SIRO -> SIRO -> SIRO
$cmin :: SIRO -> SIRO -> SIRO
max :: SIRO -> SIRO -> SIRO
$cmax :: SIRO -> SIRO -> SIRO
>= :: SIRO -> SIRO -> Bool
$c>= :: SIRO -> SIRO -> Bool
> :: SIRO -> SIRO -> Bool
$c> :: SIRO -> SIRO -> Bool
<= :: SIRO -> SIRO -> Bool
$c<= :: SIRO -> SIRO -> Bool
< :: SIRO -> SIRO -> Bool
$c< :: SIRO -> SIRO -> Bool
compare :: SIRO -> SIRO -> Ordering
$ccompare :: SIRO -> SIRO -> Ordering
$cp1Ord :: Eq SIRO
Ord, Int -> SIRO -> ShowS
[SIRO] -> ShowS
SIRO -> String
(Int -> SIRO -> ShowS)
-> (SIRO -> String) -> ([SIRO] -> ShowS) -> Show SIRO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SIRO] -> ShowS
$cshowList :: [SIRO] -> ShowS
show :: SIRO -> String
$cshow :: SIRO -> String
showsPrec :: Int -> SIRO -> ShowS
$cshowsPrec :: Int -> SIRO -> ShowS
Show)

-- | Strategy: Static Priorities. It uses the priority queue.
data StaticPriorities = StaticPriorities deriving (StaticPriorities -> StaticPriorities -> Bool
(StaticPriorities -> StaticPriorities -> Bool)
-> (StaticPriorities -> StaticPriorities -> Bool)
-> Eq StaticPriorities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaticPriorities -> StaticPriorities -> Bool
$c/= :: StaticPriorities -> StaticPriorities -> Bool
== :: StaticPriorities -> StaticPriorities -> Bool
$c== :: StaticPriorities -> StaticPriorities -> Bool
Eq, Eq StaticPriorities
Eq StaticPriorities
-> (StaticPriorities -> StaticPriorities -> Ordering)
-> (StaticPriorities -> StaticPriorities -> Bool)
-> (StaticPriorities -> StaticPriorities -> Bool)
-> (StaticPriorities -> StaticPriorities -> Bool)
-> (StaticPriorities -> StaticPriorities -> Bool)
-> (StaticPriorities -> StaticPriorities -> StaticPriorities)
-> (StaticPriorities -> StaticPriorities -> StaticPriorities)
-> Ord StaticPriorities
StaticPriorities -> StaticPriorities -> Bool
StaticPriorities -> StaticPriorities -> Ordering
StaticPriorities -> StaticPriorities -> StaticPriorities
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StaticPriorities -> StaticPriorities -> StaticPriorities
$cmin :: StaticPriorities -> StaticPriorities -> StaticPriorities
max :: StaticPriorities -> StaticPriorities -> StaticPriorities
$cmax :: StaticPriorities -> StaticPriorities -> StaticPriorities
>= :: StaticPriorities -> StaticPriorities -> Bool
$c>= :: StaticPriorities -> StaticPriorities -> Bool
> :: StaticPriorities -> StaticPriorities -> Bool
$c> :: StaticPriorities -> StaticPriorities -> Bool
<= :: StaticPriorities -> StaticPriorities -> Bool
$c<= :: StaticPriorities -> StaticPriorities -> Bool
< :: StaticPriorities -> StaticPriorities -> Bool
$c< :: StaticPriorities -> StaticPriorities -> Bool
compare :: StaticPriorities -> StaticPriorities -> Ordering
$ccompare :: StaticPriorities -> StaticPriorities -> Ordering
$cp1Ord :: Eq StaticPriorities
Ord, Int -> StaticPriorities -> ShowS
[StaticPriorities] -> ShowS
StaticPriorities -> String
(Int -> StaticPriorities -> ShowS)
-> (StaticPriorities -> String)
-> ([StaticPriorities] -> ShowS)
-> Show StaticPriorities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticPriorities] -> ShowS
$cshowList :: [StaticPriorities] -> ShowS
show :: StaticPriorities -> String
$cshow :: StaticPriorities -> String
showsPrec :: Int -> StaticPriorities -> ShowS
$cshowsPrec :: Int -> StaticPriorities -> ShowS
Show)

-- | An implementation of the 'FCFS' queue strategy.
instance QueueStrategy FCFS where

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

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

  strategyQueueNull :: StrategyQueue FCFS i -> Event Bool
strategyQueueNull (FCFSQueue 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
$ DoubleLinkedList i -> IO Bool
forall a. DoubleLinkedList a -> IO Bool
listNull DoubleLinkedList i
q

-- | An implementation of the 'FCFS' queue strategy.
instance DequeueStrategy FCFS where

  strategyDequeue :: StrategyQueue FCFS i -> Event i
strategyDequeue (FCFSQueue 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 i
i <- DoubleLinkedList i -> IO i
forall a. DoubleLinkedList a -> IO a
listFirst DoubleLinkedList i
q
       DoubleLinkedList i -> IO ()
forall a. DoubleLinkedList a -> IO ()
listRemoveFirst DoubleLinkedList i
q
       i -> IO i
forall (m :: * -> *) a. Monad m => a -> m a
return i
i

-- | An implementation of the 'FCFS' queue strategy.
instance EnqueueStrategy FCFS where

  strategyEnqueue :: StrategyQueue FCFS i -> i -> Event ()
strategyEnqueue (FCFSQueue q) 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
$ DoubleLinkedList i -> i -> IO ()
forall a. DoubleLinkedList a -> a -> IO ()
listAddLast DoubleLinkedList i
q i
i

-- | An implementation of the 'FCFS' queue strategy.
instance DeletingQueueStrategy FCFS where

  strategyQueueDeleteBy :: StrategyQueue FCFS i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy (FCFSQueue q) i -> Bool
p = 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
$ DoubleLinkedList i -> (i -> Bool) -> IO (Maybe i)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
listRemoveBy DoubleLinkedList i
q i -> Bool
p

  strategyQueueContainsBy :: StrategyQueue FCFS i -> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy (FCFSQueue q) i -> Bool
p = 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
$ DoubleLinkedList i -> (i -> Bool) -> IO (Maybe i)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
listContainsBy DoubleLinkedList i
q i -> Bool
p

-- | An implementation of the 'LCFS' queue strategy.
instance QueueStrategy LCFS where

  -- | A queue used by the 'LCFS' strategy.
  newtype StrategyQueue LCFS i = LCFSQueue (DoubleLinkedList i)
  
  newStrategyQueue :: LCFS -> Simulation (StrategyQueue LCFS i)
newStrategyQueue LCFS
s = (DoubleLinkedList i -> StrategyQueue LCFS i)
-> Simulation (DoubleLinkedList i)
-> Simulation (StrategyQueue LCFS i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoubleLinkedList i -> StrategyQueue LCFS i
forall i. DoubleLinkedList i -> StrategyQueue LCFS i
LCFSQueue (Simulation (DoubleLinkedList i)
 -> Simulation (StrategyQueue LCFS i))
-> Simulation (DoubleLinkedList i)
-> Simulation (StrategyQueue LCFS i)
forall a b. (a -> b) -> a -> b
$ IO (DoubleLinkedList i) -> Simulation (DoubleLinkedList i)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (DoubleLinkedList i)
forall a. IO (DoubleLinkedList a)
newList
       
  strategyQueueNull :: StrategyQueue LCFS i -> Event Bool
strategyQueueNull (LCFSQueue 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
$ DoubleLinkedList i -> IO Bool
forall a. DoubleLinkedList a -> IO Bool
listNull DoubleLinkedList i
q

-- | An implementation of the 'LCFS' queue strategy.
instance DequeueStrategy LCFS where

  strategyDequeue :: StrategyQueue LCFS i -> Event i
strategyDequeue (LCFSQueue 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 i
i <- DoubleLinkedList i -> IO i
forall a. DoubleLinkedList a -> IO a
listFirst DoubleLinkedList i
q
       DoubleLinkedList i -> IO ()
forall a. DoubleLinkedList a -> IO ()
listRemoveFirst DoubleLinkedList i
q
       i -> IO i
forall (m :: * -> *) a. Monad m => a -> m a
return i
i

-- | An implementation of the 'LCFS' queue strategy.
instance EnqueueStrategy LCFS where

  strategyEnqueue :: StrategyQueue LCFS i -> i -> Event ()
strategyEnqueue (LCFSQueue q) 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
$ DoubleLinkedList i -> i -> IO ()
forall a. DoubleLinkedList a -> a -> IO ()
listInsertFirst DoubleLinkedList i
q i
i

-- | An implementation of the 'LCFS' queue strategy.
instance DeletingQueueStrategy LCFS where

  strategyQueueDeleteBy :: StrategyQueue LCFS i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy (LCFSQueue q) i -> Bool
p = 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
$ DoubleLinkedList i -> (i -> Bool) -> IO (Maybe i)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
listRemoveBy DoubleLinkedList i
q i -> Bool
p

  strategyQueueContainsBy :: StrategyQueue LCFS i -> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy (LCFSQueue q) i -> Bool
p = 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
$ DoubleLinkedList i -> (i -> Bool) -> IO (Maybe i)
forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
listContainsBy DoubleLinkedList i
q i -> Bool
p

-- | An implementation of the 'StaticPriorities' queue strategy.
instance QueueStrategy StaticPriorities where

  -- | A queue used by the 'StaticPriorities' strategy.
  newtype StrategyQueue StaticPriorities i = StaticPriorityQueue (PQ.PriorityQueue i)
  
  newStrategyQueue :: StaticPriorities -> Simulation (StrategyQueue StaticPriorities i)
newStrategyQueue StaticPriorities
s = (PriorityQueue i -> StrategyQueue StaticPriorities i)
-> Simulation (PriorityQueue i)
-> Simulation (StrategyQueue StaticPriorities i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PriorityQueue i -> StrategyQueue StaticPriorities i
forall i. PriorityQueue i -> StrategyQueue StaticPriorities i
StaticPriorityQueue (Simulation (PriorityQueue i)
 -> Simulation (StrategyQueue StaticPriorities i))
-> Simulation (PriorityQueue i)
-> Simulation (StrategyQueue StaticPriorities i)
forall a b. (a -> b) -> a -> b
$ IO (PriorityQueue i) -> Simulation (PriorityQueue i)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (PriorityQueue i)
forall a. IO (PriorityQueue a)
PQ.newQueue

  strategyQueueNull :: StrategyQueue StaticPriorities i -> Event Bool
strategyQueueNull (StaticPriorityQueue 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
$ PriorityQueue i -> IO Bool
forall a. PriorityQueue a -> IO Bool
PQ.queueNull PriorityQueue i
q

-- | An implementation of the 'StaticPriorities' queue strategy.
instance DequeueStrategy StaticPriorities where

  strategyDequeue :: StrategyQueue StaticPriorities i -> Event i
strategyDequeue (StaticPriorityQueue 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 (Double
_, i
i) <- PriorityQueue i -> IO (Double, i)
forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront PriorityQueue i
q
       PriorityQueue i -> IO ()
forall a. PriorityQueue a -> IO ()
PQ.dequeue PriorityQueue i
q
       i -> IO i
forall (m :: * -> *) a. Monad m => a -> m a
return i
i

-- | An implementation of the 'StaticPriorities' queue strategy.
instance PriorityQueueStrategy StaticPriorities Double where

  strategyEnqueueWithPriority :: StrategyQueue StaticPriorities i -> Double -> i -> Event ()
strategyEnqueueWithPriority (StaticPriorityQueue q) Double
p 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
$ PriorityQueue i -> Double -> i -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue PriorityQueue i
q Double
p i
i

-- | An implementation of the 'StaticPriorities' queue strategy.
instance DeletingQueueStrategy StaticPriorities where

  strategyQueueDeleteBy :: StrategyQueue StaticPriorities i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy (StaticPriorityQueue q) i -> Bool
p = 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
$ PriorityQueue i -> (i -> Bool) -> IO (Maybe i)
forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
PQ.queueDeleteBy PriorityQueue i
q i -> Bool
p

  strategyQueueContainsBy :: StrategyQueue StaticPriorities i -> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy (StaticPriorityQueue q) i -> Bool
p = 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
$ PriorityQueue i -> (i -> Bool) -> IO (Maybe i)
forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
PQ.queueContainsBy PriorityQueue i
q i -> Bool
p

-- | An implementation of the 'SIRO' queue strategy.
instance QueueStrategy SIRO where

  -- | A queue used by the 'SIRO' strategy.
  newtype StrategyQueue SIRO i = SIROQueue (V.Vector i)

  newStrategyQueue :: SIRO -> Simulation (StrategyQueue SIRO i)
newStrategyQueue SIRO
s = (Vector i -> StrategyQueue SIRO i)
-> Simulation (Vector i) -> Simulation (StrategyQueue SIRO i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector i -> StrategyQueue SIRO i
forall i. Vector i -> StrategyQueue SIRO i
SIROQueue (Simulation (Vector i) -> Simulation (StrategyQueue SIRO i))
-> Simulation (Vector i) -> Simulation (StrategyQueue SIRO i)
forall a b. (a -> b) -> a -> b
$ IO (Vector i) -> Simulation (Vector i)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Vector i)
forall a. IO (Vector a)
V.newVector

  strategyQueueNull :: StrategyQueue SIRO i -> Event Bool
strategyQueueNull (SIROQueue 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 Int
n <- Vector i -> IO Int
forall a. Vector a -> IO Int
V.vectorCount Vector i
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 DequeueStrategy SIRO where

  strategyDequeue :: StrategyQueue SIRO i -> Event i
strategyDequeue (SIROQueue q) =
    do Int
n <- IO Int -> Event Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Event Int) -> IO Int -> Event Int
forall a b. (a -> b) -> a -> b
$ Vector i -> IO Int
forall a. Vector a -> IO Int
V.vectorCount Vector i
q
       Int
i <- Parameter Int -> Event Int
forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter (Parameter Int -> Event Int) -> Parameter Int -> Event Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Parameter Int
randomUniformInt Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
       i
x <- 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
$ Vector i -> Int -> IO i
forall a. Vector a -> Int -> IO a
V.readVector Vector i
q Int
i
       IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$ Vector i -> Int -> IO ()
forall a. Vector a -> Int -> IO ()
V.vectorDeleteAt Vector i
q Int
i
       i -> Event i
forall (m :: * -> *) a. Monad m => a -> m a
return i
x

-- | An implementation of the 'SIRO' queue strategy.
instance EnqueueStrategy SIRO where

  strategyEnqueue :: StrategyQueue SIRO i -> i -> Event ()
strategyEnqueue (SIROQueue q) 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
$ Vector i -> i -> IO ()
forall a. Vector a -> a -> IO ()
V.appendVector Vector i
q i
i

-- | An implementation of the 'SIRO' queue strategy.
instance DeletingQueueStrategy SIRO where

  strategyQueueDeleteBy :: StrategyQueue SIRO i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy (SIROQueue q) i -> Bool
p = 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
$ Vector i -> (i -> Bool) -> IO (Maybe i)
forall a. Vector a -> (a -> Bool) -> IO (Maybe a)
V.vectorDeleteBy Vector i
q i -> Bool
p

  strategyQueueContainsBy :: StrategyQueue SIRO i -> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy (SIROQueue q) i -> Bool
p = 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
$ Vector i -> (i -> Bool) -> IO (Maybe i)
forall a. Vector a -> (a -> Bool) -> IO (Maybe a)
V.vectorContainsBy Vector i
q i -> Bool
p