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

-- |
-- Module     : Simulation.Aivika.Branch.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 7.10.3
--
-- This module defines queue strategies 'FCFS' and 'LCFS' for the 'BR' computation.
--
module Simulation.Aivika.Branch.QueueStrategy () where

import Control.Monad.Trans

import Simulation.Aivika.Trans
import qualified Simulation.Aivika.Trans.DoubleLinkedList as LL

import Simulation.Aivika.Branch.Internal.BR
import Simulation.Aivika.Branch.Ref.Base

-- | An implementation of the 'FCFS' queue strategy.
instance QueueStrategy (BR IO) FCFS where

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

  newStrategyQueue :: forall a. FCFS -> Simulation (BR IO) (StrategyQueue (BR IO) FCFS a)
newStrategyQueue FCFS
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a.
DoubleLinkedList (BR IO) a -> StrategyQueue (BR IO) FCFS a
FCFSQueue forall (m :: * -> *) a.
MonadRef m =>
Simulation m (DoubleLinkedList m a)
LL.newList

  strategyQueueNull :: forall a. StrategyQueue (BR IO) FCFS a -> Event (BR IO) Bool
strategyQueueNull (FCFSQueue DoubleLinkedList (BR IO) a
q) = forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m Bool
LL.listNull DoubleLinkedList (BR IO) a
q

-- | An implementation of the 'FCFS' queue strategy.
instance DequeueStrategy (BR IO) FCFS where

  strategyDequeue :: forall a. StrategyQueue (BR IO) FCFS a -> Event (BR IO) a
strategyDequeue (FCFSQueue DoubleLinkedList (BR IO) a
q) =
    do a
i <- forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m a
LL.listFirst DoubleLinkedList (BR IO) a
q
       forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m ()
LL.listRemoveFirst DoubleLinkedList (BR IO) a
q
       forall (m :: * -> *) a. Monad m => a -> m a
return a
i

-- | An implementation of the 'FCFS' queue strategy.
instance EnqueueStrategy (BR IO) FCFS where

  strategyEnqueue :: forall a. StrategyQueue (BR IO) FCFS a -> a -> Event (BR IO) ()
strategyEnqueue (FCFSQueue DoubleLinkedList (BR IO) a
q) a
i = forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> a -> Event m ()
LL.listAddLast DoubleLinkedList (BR IO) a
q a
i

-- | An implementation of the 'LCFS' queue strategy.
instance QueueStrategy (BR IO) LCFS where

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

  newStrategyQueue :: forall a. LCFS -> Simulation (BR IO) (StrategyQueue (BR IO) LCFS a)
newStrategyQueue LCFS
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a.
DoubleLinkedList (BR IO) a -> StrategyQueue (BR IO) LCFS a
LCFSQueue forall (m :: * -> *) a.
MonadRef m =>
Simulation m (DoubleLinkedList m a)
LL.newList
       
  strategyQueueNull :: forall a. StrategyQueue (BR IO) LCFS a -> Event (BR IO) Bool
strategyQueueNull (LCFSQueue DoubleLinkedList (BR IO) a
q) = forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m Bool
LL.listNull DoubleLinkedList (BR IO) a
q

-- | An implementation of the 'LCFS' queue strategy.
instance DequeueStrategy (BR IO) LCFS where

  strategyDequeue :: forall a. StrategyQueue (BR IO) LCFS a -> Event (BR IO) a
strategyDequeue (LCFSQueue DoubleLinkedList (BR IO) a
q) =
    do a
i <- forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m a
LL.listFirst DoubleLinkedList (BR IO) a
q
       forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> Event m ()
LL.listRemoveFirst DoubleLinkedList (BR IO) a
q
       forall (m :: * -> *) a. Monad m => a -> m a
return a
i

-- | An implementation of the 'LCFS' queue strategy.
instance EnqueueStrategy (BR IO) LCFS where

  strategyEnqueue :: forall a. StrategyQueue (BR IO) LCFS a -> a -> Event (BR IO) ()
strategyEnqueue (LCFSQueue DoubleLinkedList (BR IO) a
q) a
i = forall (m :: * -> *) a.
MonadRef m =>
DoubleLinkedList m a -> a -> Event m ()
LL.listInsertFirst DoubleLinkedList (BR IO) a
q a
i