{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}
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
instance QueueStrategy IO FCFS where
{-# SPECIALISE instance QueueStrategy IO FCFS #-}
newtype StrategyQueue IO FCFS a = FCFSQueue (LL.DoubleLinkedList a)
{-# INLINABLE newStrategyQueue #-}
newStrategyQueue :: forall a. FCFS -> Simulation IO (StrategyQueue IO FCFS a)
newStrategyQueue FCFS
s =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. DoubleLinkedList a -> StrategyQueue IO FCFS a
FCFSQueue forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (DoubleLinkedList a)
LL.newList
{-# INLINABLE strategyQueueNull #-}
strategyQueueNull :: forall a. StrategyQueue IO FCFS a -> Event IO Bool
strategyQueueNull (FCFSQueue DoubleLinkedList a
q) =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> IO Bool
LL.listNull DoubleLinkedList a
q
instance DequeueStrategy IO FCFS where
{-# SPECIALISE instance DequeueStrategy IO FCFS #-}
{-# INLINABLE strategyDequeue #-}
strategyDequeue :: forall a. StrategyQueue IO FCFS a -> Event IO a
strategyDequeue (FCFSQueue DoubleLinkedList a
q) =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do a
i <- forall a. DoubleLinkedList a -> IO a
LL.listFirst DoubleLinkedList a
q
forall a. DoubleLinkedList a -> IO ()
LL.listRemoveFirst DoubleLinkedList a
q
forall (m :: * -> *) a. Monad m => a -> m a
return a
i
instance EnqueueStrategy IO 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> a -> IO ()
LL.listAddLast DoubleLinkedList a
q a
i
instance DeletingQueueStrategy IO 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
LL.listContainsBy DoubleLinkedList a
q a -> Bool
p
instance QueueStrategy IO LCFS where
{-# SPECIALISE instance QueueStrategy IO LCFS #-}
newtype StrategyQueue IO LCFS a = LCFSQueue (LL.DoubleLinkedList a)
{-# INLINABLE newStrategyQueue #-}
newStrategyQueue :: forall a. LCFS -> Simulation IO (StrategyQueue IO LCFS a)
newStrategyQueue LCFS
s =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. DoubleLinkedList a -> StrategyQueue IO LCFS a
LCFSQueue forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (DoubleLinkedList a)
LL.newList
{-# INLINABLE strategyQueueNull #-}
strategyQueueNull :: forall a. StrategyQueue IO LCFS a -> Event IO Bool
strategyQueueNull (LCFSQueue DoubleLinkedList a
q) =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> IO Bool
LL.listNull DoubleLinkedList a
q
instance DequeueStrategy IO LCFS where
{-# SPECIALISE instance DequeueStrategy IO LCFS #-}
{-# INLINABLE strategyDequeue #-}
strategyDequeue :: forall a. StrategyQueue IO LCFS a -> Event IO a
strategyDequeue (LCFSQueue DoubleLinkedList a
q) =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do a
i <- forall a. DoubleLinkedList a -> IO a
LL.listFirst DoubleLinkedList a
q
forall a. DoubleLinkedList a -> IO ()
LL.listRemoveFirst DoubleLinkedList a
q
forall (m :: * -> *) a. Monad m => a -> m a
return a
i
instance EnqueueStrategy IO 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> a -> IO ()
LL.listInsertFirst DoubleLinkedList a
q a
i
instance DeletingQueueStrategy IO 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
LL.listContainsBy DoubleLinkedList a
q a -> Bool
p
instance QueueStrategy IO StaticPriorities where
{-# SPECIALISE instance QueueStrategy IO StaticPriorities #-}
newtype StrategyQueue IO StaticPriorities a = StaticPriorityQueue (PQ.PriorityQueue a)
{-# INLINABLE newStrategyQueue #-}
newStrategyQueue :: forall a.
StaticPriorities
-> Simulation IO (StrategyQueue IO StaticPriorities a)
newStrategyQueue StaticPriorities
s =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. PriorityQueue a -> StrategyQueue IO StaticPriorities a
StaticPriorityQueue forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO (PriorityQueue a)
PQ.newQueue
{-# INLINABLE strategyQueueNull #-}
strategyQueueNull :: forall a. StrategyQueue IO StaticPriorities a -> Event IO Bool
strategyQueueNull (StaticPriorityQueue PriorityQueue a
q) =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO Bool
PQ.queueNull PriorityQueue a
q
instance DequeueStrategy IO StaticPriorities where
{-# SPECIALISE instance DequeueStrategy IO StaticPriorities #-}
{-# INLINABLE strategyDequeue #-}
strategyDequeue :: forall a. StrategyQueue IO StaticPriorities a -> Event IO a
strategyDequeue (StaticPriorityQueue PriorityQueue a
q) =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do (Double
_, a
i) <- forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront PriorityQueue a
q
forall a. PriorityQueue a -> IO ()
PQ.dequeue PriorityQueue a
q
forall (m :: * -> *) a. Monad m => a -> m a
return a
i
instance PriorityQueueStrategy IO 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue PriorityQueue a
q Double
p a
i
instance DeletingQueueStrategy IO 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
PQ.queueContainsBy PriorityQueue a
q a -> Bool
p
instance QueueStrategy IO SIRO where
{-# SPECIALISE instance QueueStrategy IO SIRO #-}
newtype StrategyQueue IO SIRO a = SIROQueue (V.Vector a)
{-# INLINABLE newStrategyQueue #-}
newStrategyQueue :: forall a. SIRO -> Simulation IO (StrategyQueue IO SIRO a)
newStrategyQueue SIRO
s =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> StrategyQueue IO SIRO a
SIROQueue forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO (Vector a)
V.newVector
{-# INLINABLE strategyQueueNull #-}
strategyQueueNull :: forall a. StrategyQueue IO SIRO a -> Event IO Bool
strategyQueueNull (SIROQueue Vector a
q) =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do Int
n <- forall a. Vector a -> IO Int
V.vectorCount Vector a
q
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n forall a. Eq a => a -> a -> Bool
== Int
0)
instance DequeueStrategy IO 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> IO Int
V.vectorCount Vector a
q
Int
i <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
ParameterLift t m =>
Parameter m a -> t m a
liftParameter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadComp m => Int -> Int -> Parameter m Int
randomUniformInt Int
0 (Int
n forall a. Num a => a -> a -> a
- Int
1)
a
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int -> IO a
V.readVector Vector a
q Int
i
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int -> IO ()
V.vectorDeleteAt Vector a
q Int
i
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
instance EnqueueStrategy IO 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> a -> IO ()
V.appendVector Vector a
q a
i
instance DeletingQueueStrategy IO 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> (a -> Bool) -> IO (Maybe a)
V.vectorContainsBy Vector a
q a -> Bool
p