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

-- |
-- Module     : Simulation.Aivika.Trans.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.Trans.QueueStrategy where

import Control.Monad

import Data.Maybe

import Simulation.Aivika.Trans.Internal.Types

-- | Defines the basic queue strategy.
class Monad m => QueueStrategy m s where

  -- | The strategy queue.
  data StrategyQueue m s :: * -> *

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

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

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

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

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

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

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

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

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

  -- | Remove the element and return a flag indicating whether
  -- the element was found and removed.
  strategyQueueDelete :: Eq a
                         => StrategyQueue m s a
                         -- ^ the queue
                         -> a
                         -- ^ the element
                         -> Event m Bool
                         -- ^ whether the element was found and removed
  strategyQueueDelete StrategyQueue m s a
s a
a =
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    do Maybe a
x <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a.
DeletingQueueStrategy m s =>
StrategyQueue m s a -> (a -> Bool) -> Event m (Maybe a)
strategyQueueDeleteBy StrategyQueue m s a
s (forall a. Eq a => a -> a -> Bool
== a
a)
       forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a -> Bool
isJust Maybe a
x)

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

  -- | Detect whether the specified element is contained in the queue.
  strategyQueueContains :: Eq a
                           => StrategyQueue m s a
                           -- ^ the queue
                           -> a
                           -- ^ the element to find
                           -> Event m Bool
                           -- ^ whether the element is contained in the queue
  strategyQueueContains StrategyQueue m s a
s a
a =
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    do Maybe a
x <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a.
DeletingQueueStrategy m s =>
StrategyQueue m s a -> (a -> Bool) -> Event m (Maybe a)
strategyQueueContainsBy StrategyQueue m s a
s (forall a. Eq a => a -> a -> Bool
== a
a)
       forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a -> Bool
isJust Maybe a
x)

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

-- | Strategy: First Come - First Served (FCFS).
data FCFS = FCFS deriving (FCFS -> FCFS -> Bool
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
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
Ord, Int -> FCFS -> ShowS
[FCFS] -> ShowS
FCFS -> String
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
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
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
Ord, Int -> LCFS -> ShowS
[LCFS] -> ShowS
LCFS -> String
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
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
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
Ord, Int -> SIRO -> ShowS
[SIRO] -> ShowS
SIRO -> String
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
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
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
Ord, Int -> StaticPriorities -> ShowS
[StaticPriorities] -> ShowS
StaticPriorities -> String
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)