{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module     : Simulation.Aivika.Trans.Resource.Base
-- 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 an optimised version of the resource 
-- which can be acquired and then released by the discontinuous 
-- process 'Process'. The resource can be either limited by 
-- the upper bound (run-time check), or it can have no upper bound. 
-- The latter is useful for modeling the infinite queue, for example.
--
-- The module is optimised in the sense that this kind of the resource
-- has neither additional signals, nor counters that would may slow
-- down the simulation.
--
module Simulation.Aivika.Trans.Resource.Base
       (-- * Resource Types
        FCFSResource,
        LCFSResource,
        SIROResource,
        PriorityResource,
        Resource,
        -- * Creating Resource
        newFCFSResource,
        newFCFSResourceWithMaxCount,
        newLCFSResource,
        newLCFSResourceWithMaxCount,
        newSIROResource,
        newSIROResourceWithMaxCount,
        newPriorityResource,
        newPriorityResourceWithMaxCount,
        newResource,
        newResourceWithMaxCount,
        -- * Resource Properties
        resourceStrategy,
        resourceMaxCount,
        resourceCount,
        -- * Requesting for and Releasing Resource
        requestResource,
        requestResourceWithPriority,
        tryRequestResourceWithinEvent,
        releaseResource,
        releaseResourceWithinEvent,
        usingResource,
        usingResourceWithPriority,
        -- * Altering Resource
        incResourceCount,
        decResourceCount) where

import Control.Monad
import Control.Monad.Trans
import Control.Exception

import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Internal.Cont
import Simulation.Aivika.Trans.Internal.Process
import Simulation.Aivika.Trans.QueueStrategy

-- | The ordinary FCFS (First Come - First Serviced) resource.
type FCFSResource m = Resource m FCFS

-- | The ordinary LCFS (Last Come - First Serviced) resource.
type LCFSResource m = Resource m LCFS

-- | The SIRO (Serviced in Random Order) resource.
type SIROResource m = Resource m SIRO

-- | The resource with static priorities.
type PriorityResource m = Resource m StaticPriorities

-- | Represents the resource with strategy @s@ applied for queuing the requests.
data Resource m s = 
  Resource { Resource m s -> s
resourceStrategy :: s,
             -- ^ Return the strategy applied for queuing the requests.
             Resource m s -> Maybe Int
resourceMaxCount :: Maybe Int,
             -- ^ Return the maximum count of the resource, where 'Nothing'
             -- means that the resource has no upper bound.
             Resource m s -> Ref m Int
resourceCountRef :: Ref m Int, 
             Resource m s -> StrategyQueue m s (FrozenCont m ())
resourceWaitList :: StrategyQueue m s (FrozenCont m ()) }

-- | Create a new FCFS resource with the specified initial count which value becomes
-- the upper bound as well.
newFCFSResource :: MonadDES m
                   => Int
                   -- ^ the initial count (and maximal count too) of the resource
                   -> Simulation m (FCFSResource m)
{-# INLINABLE newFCFSResource #-}
newFCFSResource :: Int -> Simulation m (FCFSResource m)
newFCFSResource = FCFS -> Int -> Simulation m (FCFSResource m)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Simulation m (Resource m s)
newResource FCFS
FCFS

-- | Create a new FCFS resource with the specified initial and maximum counts,
-- where 'Nothing' means that the resource has no upper bound.
newFCFSResourceWithMaxCount :: MonadDES m
                               => Int
                               -- ^ the initial count of the resource
                               -> Maybe Int
                               -- ^ the maximum count of the resource, which can be indefinite
                               -> Simulation m (FCFSResource m)
{-# INLINABLE newFCFSResourceWithMaxCount #-}
newFCFSResourceWithMaxCount :: Int -> Maybe Int -> Simulation m (FCFSResource m)
newFCFSResourceWithMaxCount = FCFS -> Int -> Maybe Int -> Simulation m (FCFSResource m)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS

-- | Create a new LCFS resource with the specified initial count which value becomes
-- the upper bound as well.
newLCFSResource :: MonadDES m
                   => Int
                   -- ^ the initial count (and maximal count too) of the resource
                   -> Simulation m (LCFSResource m)
{-# INLINABLE newLCFSResource #-}
newLCFSResource :: Int -> Simulation m (LCFSResource m)
newLCFSResource = LCFS -> Int -> Simulation m (LCFSResource m)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Simulation m (Resource m s)
newResource LCFS
LCFS

-- | Create a new LCFS resource with the specified initial and maximum counts,
-- where 'Nothing' means that the resource has no upper bound.
newLCFSResourceWithMaxCount :: MonadDES m
                               => Int
                               -- ^ the initial count of the resource
                               -> Maybe Int
                               -- ^ the maximum count of the resource, which can be indefinite
                               -> Simulation m (LCFSResource m)
{-# INLINABLE newLCFSResourceWithMaxCount #-}
newLCFSResourceWithMaxCount :: Int -> Maybe Int -> Simulation m (LCFSResource m)
newLCFSResourceWithMaxCount = LCFS -> Int -> Maybe Int -> Simulation m (LCFSResource m)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount LCFS
LCFS

-- | Create a new SIRO resource with the specified initial count which value becomes
-- the upper bound as well.
newSIROResource :: (MonadDES m, QueueStrategy m SIRO)
                   => Int
                   -- ^ the initial count (and maximal count too) of the resource
                   -> Simulation m (SIROResource m)
{-# INLINABLE newSIROResource #-}
newSIROResource :: Int -> Simulation m (SIROResource m)
newSIROResource = SIRO -> Int -> Simulation m (SIROResource m)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Simulation m (Resource m s)
newResource SIRO
SIRO

-- | Create a new SIRO resource with the specified initial and maximum counts,
-- where 'Nothing' means that the resource has no upper bound.
newSIROResourceWithMaxCount :: (MonadDES m, QueueStrategy m SIRO)
                               => Int
                               -- ^ the initial count of the resource
                               -> Maybe Int
                               -- ^ the maximum count of the resource, which can be indefinite
                               -> Simulation m (SIROResource m)
{-# INLINABLE newSIROResourceWithMaxCount #-}
newSIROResourceWithMaxCount :: Int -> Maybe Int -> Simulation m (SIROResource m)
newSIROResourceWithMaxCount = SIRO -> Int -> Maybe Int -> Simulation m (SIROResource m)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount SIRO
SIRO

-- | Create a new priority resource with the specified initial count which value becomes
-- the upper bound as well.
newPriorityResource :: (MonadDES m, QueueStrategy m StaticPriorities)
                       => Int
                       -- ^ the initial count (and maximal count too) of the resource
                       -> Simulation m (PriorityResource m)
{-# INLINABLE newPriorityResource #-}
newPriorityResource :: Int -> Simulation m (PriorityResource m)
newPriorityResource = StaticPriorities -> Int -> Simulation m (PriorityResource m)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Simulation m (Resource m s)
newResource StaticPriorities
StaticPriorities

-- | Create a new priority resource with the specified initial and maximum counts,
-- where 'Nothing' means that the resource has no upper bound.
newPriorityResourceWithMaxCount :: (MonadDES m, QueueStrategy m StaticPriorities)
                                   => Int
                                   -- ^ the initial count of the resource
                                   -> Maybe Int
                                   -- ^ the maximum count of the resource, which can be indefinite
                                   -> Simulation m (PriorityResource m)
{-# INLINABLE newPriorityResourceWithMaxCount #-}
newPriorityResourceWithMaxCount :: Int -> Maybe Int -> Simulation m (PriorityResource m)
newPriorityResourceWithMaxCount = StaticPriorities
-> Int -> Maybe Int -> Simulation m (PriorityResource m)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount StaticPriorities
StaticPriorities

-- | Create a new resource with the specified queue strategy and initial count.
-- The last value becomes the upper bound as well.
newResource :: (MonadDES m, QueueStrategy m s)
               => s
               -- ^ the strategy for managing the queuing requests
               -> Int
               -- ^ the initial count (and maximal count too) of the resource
               -> Simulation m (Resource m s)
{-# INLINABLE newResource #-}
newResource :: s -> Int -> Simulation m (Resource m s)
newResource s
s Int
count =
  (Run m -> m (Resource m s)) -> Simulation m (Resource m s)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Resource m s)) -> Simulation m (Resource m s))
-> (Run m -> m (Resource m s)) -> Simulation m (Resource m s)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  do Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
       SimulationRetry -> m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> m ()) -> SimulationRetry -> m ()
forall a b. (a -> b) -> a -> b
$
       String -> SimulationRetry
SimulationRetry (String -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
       String
"The resource count cannot be negative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
       String
"newResource."
     Ref m Int
countRef <- Run m -> Simulation m (Ref m Int) -> m (Ref m Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Int) -> m (Ref m Int))
-> Simulation m (Ref m Int) -> m (Ref m Int)
forall a b. (a -> b) -> a -> b
$ Int -> Simulation m (Ref m Int)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
count
     StrategyQueue m s (FrozenCont m ())
waitList <- Run m
-> Simulation m (StrategyQueue m s (FrozenCont m ()))
-> m (StrategyQueue m s (FrozenCont m ()))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (StrategyQueue m s (FrozenCont m ()))
 -> m (StrategyQueue m s (FrozenCont m ())))
-> Simulation m (StrategyQueue m s (FrozenCont m ()))
-> m (StrategyQueue m s (FrozenCont m ()))
forall a b. (a -> b) -> a -> b
$ s -> Simulation m (StrategyQueue m s (FrozenCont m ()))
forall (m :: * -> *) s a.
QueueStrategy m s =>
s -> Simulation m (StrategyQueue m s a)
newStrategyQueue s
s
     Resource m s -> m (Resource m s)
forall (m :: * -> *) a. Monad m => a -> m a
return Resource :: forall (m :: * -> *) s.
s
-> Maybe Int
-> Ref m Int
-> StrategyQueue m s (FrozenCont m ())
-> Resource m s
Resource { resourceStrategy :: s
resourceStrategy = s
s,
                       resourceMaxCount :: Maybe Int
resourceMaxCount = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count,
                       resourceCountRef :: Ref m Int
resourceCountRef = Ref m Int
countRef,
                       resourceWaitList :: StrategyQueue m s (FrozenCont m ())
resourceWaitList = StrategyQueue m s (FrozenCont m ())
waitList }

-- | Create a new resource with the specified queue strategy, initial and maximum counts,
-- where 'Nothing' means that the resource has no upper bound.
newResourceWithMaxCount :: (MonadDES m, QueueStrategy m s)
                           => s
                           -- ^ the strategy for managing the queuing requests
                           -> Int
                           -- ^ the initial count of the resource
                           -> Maybe Int
                           -- ^ the maximum count of the resource, which can be indefinite
                           -> Simulation m (Resource m s)
{-# INLINABLE newResourceWithMaxCount #-}
newResourceWithMaxCount :: s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount s
s Int
count Maybe Int
maxCount =
  (Run m -> m (Resource m s)) -> Simulation m (Resource m s)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Resource m s)) -> Simulation m (Resource m s))
-> (Run m -> m (Resource m s)) -> Simulation m (Resource m s)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  do Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
       SimulationRetry -> m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> m ()) -> SimulationRetry -> m ()
forall a b. (a -> b) -> a -> b
$
       String -> SimulationRetry
SimulationRetry (String -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
       String
"The resource count cannot be negative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
       String
"newResourceWithMaxCount."
     case Maybe Int
maxCount of
       Just Int
maxCount | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
         SimulationRetry -> m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> m ()) -> SimulationRetry -> m ()
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry (String -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
         String
"The resource count cannot be greater than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
         String
"its maximum value: newResourceWithMaxCount."
       Maybe Int
_ ->
         () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Ref m Int
countRef <- Run m -> Simulation m (Ref m Int) -> m (Ref m Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Int) -> m (Ref m Int))
-> Simulation m (Ref m Int) -> m (Ref m Int)
forall a b. (a -> b) -> a -> b
$ Int -> Simulation m (Ref m Int)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
count
     StrategyQueue m s (FrozenCont m ())
waitList <- Run m
-> Simulation m (StrategyQueue m s (FrozenCont m ()))
-> m (StrategyQueue m s (FrozenCont m ()))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (StrategyQueue m s (FrozenCont m ()))
 -> m (StrategyQueue m s (FrozenCont m ())))
-> Simulation m (StrategyQueue m s (FrozenCont m ()))
-> m (StrategyQueue m s (FrozenCont m ()))
forall a b. (a -> b) -> a -> b
$ s -> Simulation m (StrategyQueue m s (FrozenCont m ()))
forall (m :: * -> *) s a.
QueueStrategy m s =>
s -> Simulation m (StrategyQueue m s a)
newStrategyQueue s
s
     Resource m s -> m (Resource m s)
forall (m :: * -> *) a. Monad m => a -> m a
return Resource :: forall (m :: * -> *) s.
s
-> Maybe Int
-> Ref m Int
-> StrategyQueue m s (FrozenCont m ())
-> Resource m s
Resource { resourceStrategy :: s
resourceStrategy = s
s,
                       resourceMaxCount :: Maybe Int
resourceMaxCount = Maybe Int
maxCount,
                       resourceCountRef :: Ref m Int
resourceCountRef = Ref m Int
countRef,
                       resourceWaitList :: StrategyQueue m s (FrozenCont m ())
resourceWaitList = StrategyQueue m s (FrozenCont m ())
waitList }

-- | Return the current count of the resource.
resourceCount :: MonadDES m => Resource m s -> Event m Int
{-# INLINABLE resourceCount #-}
resourceCount :: Resource m s -> Event m Int
resourceCount Resource m s
r =
  (Point m -> m Int) -> Event m Int
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m Int) -> Event m Int)
-> (Point m -> m Int) -> Event m Int
forall a b. (a -> b) -> a -> b
$ \Point m
p -> Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r)

-- | Request for the resource decreasing its count in case of success,
-- otherwise suspending the discontinuous process until some other 
-- process releases the resource.
requestResource :: (MonadDES m, EnqueueStrategy m s)
                   => Resource m s 
                   -- ^ the requested resource
                   -> Process m ()
{-# INLINABLE requestResource #-}
requestResource :: Resource m s -> Process m ()
requestResource Resource m s
r =
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  (ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Int
a <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r)
     if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
       then do FrozenCont m ()
c <- Point m -> Event m (FrozenCont m ()) -> m (FrozenCont m ())
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (FrozenCont m ()) -> m (FrozenCont m ()))
-> Event m (FrozenCont m ()) -> m (FrozenCont m ())
forall a b. (a -> b) -> a -> b
$
                    ContParams m () -> () -> Event m () -> Event m (FrozenCont m ())
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m () -> Event m (FrozenCont m a)
freezeContReentering ContParams m ()
c () (Event m () -> Event m (FrozenCont m ()))
-> Event m () -> Event m (FrozenCont m ())
forall a b. (a -> b) -> a -> b
$
                    ContParams m () -> Cont m () -> Event m ()
forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m ()
c (Cont m () -> Event m ()) -> Cont m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
                    ProcessId m -> Process m () -> Cont m ()
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid (Process m () -> Cont m ()) -> Process m () -> Cont m ()
forall a b. (a -> b) -> a -> b
$
                    Resource m s -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m s
r
               Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
                 StrategyQueue m s (FrozenCont m ())
-> FrozenCont m () -> Event m ()
forall (m :: * -> *) s a.
EnqueueStrategy m s =>
StrategyQueue m s a -> a -> Event m ()
strategyEnqueue (Resource m s -> StrategyQueue m s (FrozenCont m ())
forall (m :: * -> *) s.
Resource m s -> StrategyQueue m s (FrozenCont m ())
resourceWaitList Resource m s
r) FrozenCont m ()
c
       else do let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
               Int
a' Int -> m () -> m ()
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r) Int
a'
               Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()

-- | Request with the priority for the resource decreasing its count
-- in case of success, otherwise suspending the discontinuous process
-- until some other process releases the resource.
requestResourceWithPriority :: (MonadDES m, PriorityQueueStrategy m s p)
                               => Resource m s
                               -- ^ the requested resource
                               -> p
                               -- ^ the priority
                               -> Process m ()
{-# INLINABLE requestResourceWithPriority #-}
requestResourceWithPriority :: Resource m s -> p -> Process m ()
requestResourceWithPriority Resource m s
r p
priority =
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  (ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Int
a <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r)
     if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
       then do FrozenCont m ()
c <- Point m -> Event m (FrozenCont m ()) -> m (FrozenCont m ())
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (FrozenCont m ()) -> m (FrozenCont m ()))
-> Event m (FrozenCont m ()) -> m (FrozenCont m ())
forall a b. (a -> b) -> a -> b
$
                    ContParams m () -> () -> Event m () -> Event m (FrozenCont m ())
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m () -> Event m (FrozenCont m a)
freezeContReentering ContParams m ()
c () (Event m () -> Event m (FrozenCont m ()))
-> Event m () -> Event m (FrozenCont m ())
forall a b. (a -> b) -> a -> b
$
                    ContParams m () -> Cont m () -> Event m ()
forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m ()
c (Cont m () -> Event m ()) -> Cont m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
                    ProcessId m -> Process m () -> Cont m ()
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid (Process m () -> Cont m ()) -> Process m () -> Cont m ()
forall a b. (a -> b) -> a -> b
$
                    Resource m s -> p -> Process m ()
forall (m :: * -> *) s p.
(MonadDES m, PriorityQueueStrategy m s p) =>
Resource m s -> p -> Process m ()
requestResourceWithPriority Resource m s
r p
priority
               Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
                 StrategyQueue m s (FrozenCont m ())
-> p -> FrozenCont m () -> Event m ()
forall (m :: * -> *) s p a.
PriorityQueueStrategy m s p =>
StrategyQueue m s a -> p -> a -> Event m ()
strategyEnqueueWithPriority (Resource m s -> StrategyQueue m s (FrozenCont m ())
forall (m :: * -> *) s.
Resource m s -> StrategyQueue m s (FrozenCont m ())
resourceWaitList Resource m s
r) p
priority FrozenCont m ()
c
       else do let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
               Int
a' Int -> m () -> m ()
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r) Int
a'
               Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()

-- | Release the resource increasing its count and resuming one of the
-- previously suspended processes as possible.
releaseResource :: (MonadDES m, DequeueStrategy m s)
                   => Resource m s
                   -- ^ the resource to release
                   -> Process m ()
{-# INLINABLE releaseResource #-}
releaseResource :: Resource m s -> Process m ()
releaseResource Resource m s
r = 
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
_ ->
  (ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Resource m s -> Event m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Event m ()
releaseResourceWithinEvent Resource m s
r
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()

-- | Release the resource increasing its count and resuming one of the
-- previously suspended processes as possible.
releaseResourceWithinEvent :: (MonadDES m, DequeueStrategy m s)
                              => Resource m s
                              -- ^ the resource to release
                              -> Event m ()
{-# INLINABLE releaseResourceWithinEvent #-}
releaseResourceWithinEvent :: Resource m s -> Event m ()
releaseResourceWithinEvent Resource m s
r =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Int
a <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     case Resource m s -> Maybe Int
forall (m :: * -> *) s. Resource m s -> Maybe Int
resourceMaxCount Resource m s
r of
       Just Int
maxCount | Int
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
         SimulationRetry -> m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> m ()) -> SimulationRetry -> m ()
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry (String -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
         String
"The resource count cannot be greater than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
         String
"its maximum value: releaseResourceWithinEvent."
       Maybe Int
_ ->
         () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Bool
f <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
          StrategyQueue m s (FrozenCont m ()) -> Event m Bool
forall (m :: * -> *) s a.
QueueStrategy m s =>
StrategyQueue m s a -> Event m Bool
strategyQueueNull (Resource m s -> StrategyQueue m s (FrozenCont m ())
forall (m :: * -> *) s.
Resource m s -> StrategyQueue m s (FrozenCont m ())
resourceWaitList Resource m s
r)
     if Bool
f 
       then Int
a' Int -> m () -> m ()
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r) Int
a'
       else do FrozenCont m ()
c <- Point m -> Event m (FrozenCont m ()) -> m (FrozenCont m ())
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (FrozenCont m ()) -> m (FrozenCont m ()))
-> Event m (FrozenCont m ()) -> m (FrozenCont m ())
forall a b. (a -> b) -> a -> b
$
                    StrategyQueue m s (FrozenCont m ()) -> Event m (FrozenCont m ())
forall (m :: * -> *) s a.
DequeueStrategy m s =>
StrategyQueue m s a -> Event m a
strategyDequeue (Resource m s -> StrategyQueue m s (FrozenCont m ())
forall (m :: * -> *) s.
Resource m s -> StrategyQueue m s (FrozenCont m ())
resourceWaitList Resource m s
r)
               Maybe (ContParams m ())
c <- Point m
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ())))
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall a b. (a -> b) -> a -> b
$ FrozenCont m () -> Event m (Maybe (ContParams m ()))
forall (m :: * -> *) a.
FrozenCont m a -> Event m (Maybe (ContParams m a))
unfreezeCont FrozenCont m ()
c
               case Maybe (ContParams m ())
c of
                 Maybe (ContParams m ())
Nothing ->
                   Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Resource m s -> Event m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Event m ()
releaseResourceWithinEvent Resource m s
r
                 Just ContParams m ()
c  ->
                   Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()

-- | Try to request for the resource decreasing its count in case of success
-- and returning 'True' in the 'Event' monad; otherwise, returning 'False'.
tryRequestResourceWithinEvent :: MonadDES m
                                 => Resource m s
                                 -- ^ the resource which we try to request for
                                 -> Event m Bool
{-# INLINABLE tryRequestResourceWithinEvent #-}
tryRequestResourceWithinEvent :: Resource m s -> Event m Bool
tryRequestResourceWithinEvent Resource m s
r =
  (Point m -> m Bool) -> Event m Bool
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m Bool) -> Event m Bool)
-> (Point m -> m Bool) -> Event m Bool
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Int
a <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r)
     if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
       then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
       else do let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
               Int
a' Int -> m () -> m ()
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r) Int
a'
               Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
               
-- | Acquire the resource, perform some action and safely release the resource               
-- in the end, even if the 'IOException' was raised within the action. 
usingResource :: (MonadDES m, EnqueueStrategy m s)
                 => Resource m s
                 -- ^ the resource we are going to request for and then release in the end
                 -> Process m a
                 -- ^ the action we are going to apply having the resource
                 -> Process m a
                 -- ^ the result of the action
{-# INLINABLE usingResource #-}
usingResource :: Resource m s -> Process m a -> Process m a
usingResource Resource m s
r Process m a
m =
  do Resource m s -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m s
r
     Process m a -> Process m () -> Process m a
forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess Process m a
m (Process m () -> Process m a) -> Process m () -> Process m a
forall a b. (a -> b) -> a -> b
$ Resource m s -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m s
r

-- | Acquire the resource with the specified priority, perform some action and
-- safely release the resource in the end, even if the 'IOException' was raised
-- within the action.
usingResourceWithPriority :: (MonadDES m, PriorityQueueStrategy m s p)
                             => Resource m s
                             -- ^ the resource we are going to request for and then
                             -- release in the end
                             -> p
                             -- ^ the priority
                             -> Process m a
                             -- ^ the action we are going to apply having the resource
                             -> Process m a
                             -- ^ the result of the action
{-# INLINABLE usingResourceWithPriority #-}
usingResourceWithPriority :: Resource m s -> p -> Process m a -> Process m a
usingResourceWithPriority Resource m s
r p
priority Process m a
m =
  do Resource m s -> p -> Process m ()
forall (m :: * -> *) s p.
(MonadDES m, PriorityQueueStrategy m s p) =>
Resource m s -> p -> Process m ()
requestResourceWithPriority Resource m s
r p
priority
     Process m a -> Process m () -> Process m a
forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess Process m a
m (Process m () -> Process m a) -> Process m () -> Process m a
forall a b. (a -> b) -> a -> b
$ Resource m s -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m s
r

-- | Increase the count of available resource by the specified number,
-- invoking the awaiting processes as needed.
incResourceCount :: (MonadDES m, DequeueStrategy m s)
                    => Resource m s
                    -- ^ the resource
                    -> Int
                    -- ^ the increment for the resource count
                    -> Event m ()
{-# INLINABLE incResourceCount #-}
incResourceCount :: Resource m s -> Int -> Event m ()
incResourceCount Resource m s
r Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = SimulationRetry -> Event m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent (SimulationRetry -> Event m ()) -> SimulationRetry -> Event m ()
forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
"The increment cannot be negative: incResourceCount"
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = () -> Event m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise =
    do Resource m s -> Event m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Event m ()
releaseResourceWithinEvent Resource m s
r
       Resource m s -> Int -> Event m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Int -> Event m ()
incResourceCount Resource m s
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Decrease the count of available resource by the specified number,
-- waiting for the processes capturing the resource as needed.
decResourceCount :: (MonadDES m, EnqueueStrategy m s)
                    => Resource m s
                    -- ^ the resource
                    -> Int
                    -- ^ the decrement for the resource count
                    -> Process m ()
{-# INLINABLE decResourceCount #-}
decResourceCount :: Resource m s -> Int -> Process m ()
decResourceCount Resource m s
r Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = SimulationRetry -> Process m ()
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Process m a
throwProcess (SimulationRetry -> Process m ())
-> SimulationRetry -> Process m ()
forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
"The decrement cannot be negative: decResourceCount"
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = () -> Process m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise =
    do Resource m s -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m s
r
       Resource m s -> Int -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Int -> Process m ()
decResourceCount Resource m s
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)