-- |
-- Module     : Simulation.Aivika.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.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 Data.IORef
import Control.Monad
import Control.Monad.Trans
import Control.Exception

import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Cont
import Simulation.Aivika.Internal.Process
import Simulation.Aivika.QueueStrategy

import qualified Simulation.Aivika.DoubleLinkedList as DLL 
import qualified Simulation.Aivika.Vector as V
import qualified Simulation.Aivika.PriorityQueue as PQ

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

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

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

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

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

instance Eq (Resource s) where
  Resource s
x == :: Resource s -> Resource s -> Bool
== Resource s
y = Resource s -> IORef Int
forall s. Resource s -> IORef Int
resourceCountRef Resource s
x IORef Int -> IORef Int -> Bool
forall a. Eq a => a -> a -> Bool
== Resource s -> IORef Int
forall s. Resource s -> IORef Int
resourceCountRef Resource s
y  -- unique references

-- | Create a new FCFS resource with the specified initial count which value becomes
-- the upper bound as well.
newFCFSResource :: Int
                   -- ^ the initial count (and maximal count too) of the resource
                   -> Simulation FCFSResource
newFCFSResource :: Int -> Simulation FCFSResource
newFCFSResource = FCFS -> Int -> Simulation FCFSResource
forall s. QueueStrategy s => s -> Int -> Simulation (Resource 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 :: Int
                               -- ^ the initial count of the resource
                               -> Maybe Int
                               -- ^ the maximum count of the resource, which can be indefinite
                               -> Simulation FCFSResource
newFCFSResourceWithMaxCount :: Int -> Maybe Int -> Simulation FCFSResource
newFCFSResourceWithMaxCount = FCFS -> Int -> Maybe Int -> Simulation FCFSResource
forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS

-- | Create a new LCFS resource with the specified initial count which value becomes
-- the upper bound as well.
newLCFSResource :: Int
                   -- ^ the initial count (and maximal count too) of the resource
                   -> Simulation LCFSResource
newLCFSResource :: Int -> Simulation LCFSResource
newLCFSResource = LCFS -> Int -> Simulation LCFSResource
forall s. QueueStrategy s => s -> Int -> Simulation (Resource 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 :: Int
                               -- ^ the initial count of the resource
                               -> Maybe Int
                               -- ^ the maximum count of the resource, which can be indefinite
                               -> Simulation LCFSResource
newLCFSResourceWithMaxCount :: Int -> Maybe Int -> Simulation LCFSResource
newLCFSResourceWithMaxCount = LCFS -> Int -> Maybe Int -> Simulation LCFSResource
forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount LCFS
LCFS

-- | Create a new SIRO resource with the specified initial count which value becomes
-- the upper bound as well.
newSIROResource :: Int
                   -- ^ the initial count (and maximal count too) of the resource
                   -> Simulation SIROResource
newSIROResource :: Int -> Simulation SIROResource
newSIROResource = SIRO -> Int -> Simulation SIROResource
forall s. QueueStrategy s => s -> Int -> Simulation (Resource 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 :: Int
                               -- ^ the initial count of the resource
                               -> Maybe Int
                               -- ^ the maximum count of the resource, which can be indefinite
                               -> Simulation SIROResource
newSIROResourceWithMaxCount :: Int -> Maybe Int -> Simulation SIROResource
newSIROResourceWithMaxCount = SIRO -> Int -> Maybe Int -> Simulation SIROResource
forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount SIRO
SIRO

-- | Create a new priority resource with the specified initial count which value becomes
-- the upper bound as well.
newPriorityResource :: Int
                       -- ^ the initial count (and maximal count too) of the resource
                       -> Simulation PriorityResource
newPriorityResource :: Int -> Simulation PriorityResource
newPriorityResource = StaticPriorities -> Int -> Simulation PriorityResource
forall s. QueueStrategy s => s -> Int -> Simulation (Resource 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 :: Int
                                   -- ^ the initial count of the resource
                                   -> Maybe Int
                                   -- ^ the maximum count of the resource, which can be indefinite
                                   -> Simulation PriorityResource
newPriorityResourceWithMaxCount :: Int -> Maybe Int -> Simulation PriorityResource
newPriorityResourceWithMaxCount = StaticPriorities -> Int -> Maybe Int -> Simulation PriorityResource
forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource 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 :: QueueStrategy s
               => s
               -- ^ the strategy for managing the queuing requests
               -> Int
               -- ^ the initial count (and maximal count too) of the resource
               -> Simulation (Resource s)
newResource :: forall s. QueueStrategy s => s -> Int -> Simulation (Resource s)
newResource s
s Int
count =
  (Run -> IO (Resource s)) -> Simulation (Resource s)
forall a. (Run -> IO a) -> Simulation a
Simulation ((Run -> IO (Resource s)) -> Simulation (Resource s))
-> (Run -> IO (Resource s)) -> Simulation (Resource s)
forall a b. (a -> b) -> a -> b
$ \Run
r ->
  do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SimulationRetry -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
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."
     IORef Int
countRef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
count
     StrategyQueue s (FrozenCont ())
waitList <- Run
-> Simulation (StrategyQueue s (FrozenCont ()))
-> IO (StrategyQueue s (FrozenCont ()))
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r (Simulation (StrategyQueue s (FrozenCont ()))
 -> IO (StrategyQueue s (FrozenCont ())))
-> Simulation (StrategyQueue s (FrozenCont ()))
-> IO (StrategyQueue s (FrozenCont ()))
forall a b. (a -> b) -> a -> b
$ s -> Simulation (StrategyQueue s (FrozenCont ()))
forall i. s -> Simulation (StrategyQueue s i)
forall s i. QueueStrategy s => s -> Simulation (StrategyQueue s i)
newStrategyQueue s
s
     Resource s -> IO (Resource s)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Resource { resourceStrategy :: s
resourceStrategy = s
s,
                       resourceMaxCount :: Maybe Int
resourceMaxCount = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count,
                       resourceCountRef :: IORef Int
resourceCountRef = IORef Int
countRef,
                       resourceWaitList :: StrategyQueue s (FrozenCont ())
resourceWaitList = StrategyQueue s (FrozenCont ())
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 :: QueueStrategy 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 (Resource s)
newResourceWithMaxCount :: forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount s
s Int
count Maybe Int
maxCount =
  (Run -> IO (Resource s)) -> Simulation (Resource s)
forall a. (Run -> IO a) -> Simulation a
Simulation ((Run -> IO (Resource s)) -> Simulation (Resource s))
-> (Run -> IO (Resource s)) -> Simulation (Resource s)
forall a b. (a -> b) -> a -> b
$ \Run
r ->
  do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SimulationRetry -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
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 -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
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
_ ->
         () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     IORef Int
countRef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
count
     StrategyQueue s (FrozenCont ())
waitList <- Run
-> Simulation (StrategyQueue s (FrozenCont ()))
-> IO (StrategyQueue s (FrozenCont ()))
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r (Simulation (StrategyQueue s (FrozenCont ()))
 -> IO (StrategyQueue s (FrozenCont ())))
-> Simulation (StrategyQueue s (FrozenCont ()))
-> IO (StrategyQueue s (FrozenCont ()))
forall a b. (a -> b) -> a -> b
$ s -> Simulation (StrategyQueue s (FrozenCont ()))
forall i. s -> Simulation (StrategyQueue s i)
forall s i. QueueStrategy s => s -> Simulation (StrategyQueue s i)
newStrategyQueue s
s
     Resource s -> IO (Resource s)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Resource { resourceStrategy :: s
resourceStrategy = s
s,
                       resourceMaxCount :: Maybe Int
resourceMaxCount = Maybe Int
maxCount,
                       resourceCountRef :: IORef Int
resourceCountRef = IORef Int
countRef,
                       resourceWaitList :: StrategyQueue s (FrozenCont ())
resourceWaitList = StrategyQueue s (FrozenCont ())
waitList }

-- | Return the current count of the resource.
resourceCount :: Resource s -> Event Int
resourceCount :: forall s. Resource s -> Event Int
resourceCount Resource s
r =
  (Point -> IO Int) -> Event Int
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Int) -> Event Int) -> (Point -> IO Int) -> Event Int
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource s -> IORef Int
forall s. Resource s -> IORef Int
resourceCountRef Resource 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 :: EnqueueStrategy s
                   => Resource s
                   -- ^ the requested resource
                   -> Process ()
requestResource :: forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource s
r =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  (ContParams () -> Event ()) -> Cont ()
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams () -> Event ()) -> Cont ())
-> (ContParams () -> Event ()) -> Cont ()
forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource s -> IORef Int
forall s. Resource s -> IORef Int
resourceCountRef Resource s
r)
     if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
       then do FrozenCont ()
c <- Point -> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (FrozenCont ()) -> IO (FrozenCont ()))
-> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                    ContParams () -> () -> Event () -> Event (FrozenCont ())
forall a. ContParams a -> a -> Event () -> Event (FrozenCont a)
freezeContReentering ContParams ()
c () (Event () -> Event (FrozenCont ()))
-> Event () -> Event (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                    ContParams () -> Cont () -> Event ()
forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c (Cont () -> Event ()) -> Cont () -> Event ()
forall a b. (a -> b) -> a -> b
$
                    ProcessId -> Process () -> Cont ()
forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid (Process () -> Cont ()) -> Process () -> Cont ()
forall a b. (a -> b) -> a -> b
$
                    Resource s -> Process ()
forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource s
r
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
                 StrategyQueue s (FrozenCont ()) -> FrozenCont () -> Event ()
forall s i. EnqueueStrategy s => StrategyQueue s i -> i -> Event ()
forall i. StrategyQueue s i -> i -> Event ()
strategyEnqueue (Resource s -> StrategyQueue s (FrozenCont ())
forall s. Resource s -> StrategyQueue s (FrozenCont ())
resourceWaitList Resource s
r) FrozenCont ()
c
       else do let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
               Int
a' Int -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource s -> IORef Int
forall s. Resource s -> IORef Int
resourceCountRef Resource s
r) Int
a'
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
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 :: PriorityQueueStrategy s p
                               => Resource s
                               -- ^ the requested resource
                               -> p
                               -- ^ the priority
                               -> Process ()
requestResourceWithPriority :: forall s p.
PriorityQueueStrategy s p =>
Resource s -> p -> Process ()
requestResourceWithPriority Resource s
r p
priority =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  (ContParams () -> Event ()) -> Cont ()
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams () -> Event ()) -> Cont ())
-> (ContParams () -> Event ()) -> Cont ()
forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource s -> IORef Int
forall s. Resource s -> IORef Int
resourceCountRef Resource s
r)
     if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
       then do FrozenCont ()
c <- Point -> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (FrozenCont ()) -> IO (FrozenCont ()))
-> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                    ContParams () -> () -> Event () -> Event (FrozenCont ())
forall a. ContParams a -> a -> Event () -> Event (FrozenCont a)
freezeContReentering ContParams ()
c () (Event () -> Event (FrozenCont ()))
-> Event () -> Event (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                    ContParams () -> Cont () -> Event ()
forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c (Cont () -> Event ()) -> Cont () -> Event ()
forall a b. (a -> b) -> a -> b
$
                    ProcessId -> Process () -> Cont ()
forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid (Process () -> Cont ()) -> Process () -> Cont ()
forall a b. (a -> b) -> a -> b
$
                    Resource s -> p -> Process ()
forall s p.
PriorityQueueStrategy s p =>
Resource s -> p -> Process ()
requestResourceWithPriority Resource s
r p
priority
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
                 StrategyQueue s (FrozenCont ()) -> p -> FrozenCont () -> Event ()
forall i. StrategyQueue s i -> p -> i -> Event ()
forall s p i.
PriorityQueueStrategy s p =>
StrategyQueue s i -> p -> i -> Event ()
strategyEnqueueWithPriority (Resource s -> StrategyQueue s (FrozenCont ())
forall s. Resource s -> StrategyQueue s (FrozenCont ())
resourceWaitList Resource s
r) p
priority FrozenCont ()
c
       else do let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
               Int
a' Int -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource s -> IORef Int
forall s. Resource s -> IORef Int
resourceCountRef Resource s
r) Int
a'
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()

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

-- | Release the resource increasing its count and resuming one of the
-- previously suspended processes as possible.
releaseResourceWithinEvent :: DequeueStrategy s
                              => Resource s
                              -- ^ the resource to release
                              -> Event ()
releaseResourceWithinEvent :: forall s. DequeueStrategy s => Resource s -> Event ()
releaseResourceWithinEvent Resource s
r =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource s -> IORef Int
forall s. Resource s -> IORef Int
resourceCountRef Resource s
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     case Resource s -> Maybe Int
forall s. Resource s -> Maybe Int
resourceMaxCount Resource s
r of
       Just Int
maxCount | Int
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
         SimulationRetry -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
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
_ ->
         () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Bool
f <- Point -> Event Bool -> IO Bool
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event Bool -> IO Bool) -> Event Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
          StrategyQueue s (FrozenCont ()) -> Event Bool
forall s i. QueueStrategy s => StrategyQueue s i -> Event Bool
forall i. StrategyQueue s i -> Event Bool
strategyQueueNull (Resource s -> StrategyQueue s (FrozenCont ())
forall s. Resource s -> StrategyQueue s (FrozenCont ())
resourceWaitList Resource s
r)
     if Bool
f 
       then Int
a' Int -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource s -> IORef Int
forall s. Resource s -> IORef Int
resourceCountRef Resource s
r) Int
a'
       else do FrozenCont ()
c <- Point -> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (FrozenCont ()) -> IO (FrozenCont ()))
-> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                    StrategyQueue s (FrozenCont ()) -> Event (FrozenCont ())
forall s i. DequeueStrategy s => StrategyQueue s i -> Event i
forall i. StrategyQueue s i -> Event i
strategyDequeue (Resource s -> StrategyQueue s (FrozenCont ())
forall s. Resource s -> StrategyQueue s (FrozenCont ())
resourceWaitList Resource s
r)
               Maybe (ContParams ())
c <- Point
-> Event (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (Maybe (ContParams ())) -> IO (Maybe (ContParams ())))
-> Event (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a b. (a -> b) -> a -> b
$ FrozenCont () -> Event (Maybe (ContParams ()))
forall a. FrozenCont a -> Event (Maybe (ContParams a))
unfreezeCont FrozenCont ()
c
               case Maybe (ContParams ())
c of
                 Maybe (ContParams ())
Nothing ->
                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource s -> Event ()
forall s. DequeueStrategy s => Resource s -> Event ()
releaseResourceWithinEvent Resource s
r
                 Just ContParams ()
c  ->
                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
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 :: Resource s
                                 -- ^ the resource which we try to request for
                                 -> Event Bool
tryRequestResourceWithinEvent :: forall s. Resource s -> Event Bool
tryRequestResourceWithinEvent Resource s
r =
  (Point -> IO Bool) -> Event Bool
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Bool) -> Event Bool)
-> (Point -> IO Bool) -> Event Bool
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource s -> IORef Int
forall s. Resource s -> IORef Int
resourceCountRef Resource s
r)
     if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
       then Bool -> IO Bool
forall a. a -> IO a
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 -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource s -> IORef Int
forall s. Resource s -> IORef Int
resourceCountRef Resource s
r) Int
a'
               Bool -> IO Bool
forall a. a -> IO a
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 :: EnqueueStrategy s
                 => Resource s
                 -- ^ the resource we are going to request for and then release in the end
                 -> Process a
                 -- ^ the action we are going to apply having the resource
                 -> Process a
                 -- ^ the result of the action
usingResource :: forall s a.
EnqueueStrategy s =>
Resource s -> Process a -> Process a
usingResource Resource s
r Process a
m =
  do Resource s -> Process ()
forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource s
r
     Process a -> Process () -> Process a
forall a b. Process a -> Process b -> Process a
finallyProcess Process a
m (Process () -> Process a) -> Process () -> Process a
forall a b. (a -> b) -> a -> b
$ Resource s -> Process ()
forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource 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 :: PriorityQueueStrategy s p
                             => Resource s
                             -- ^ the resource we are going to request for and then
                             -- release in the end
                             -> p
                             -- ^ the priority
                             -> Process a
                             -- ^ the action we are going to apply having the resource
                             -> Process a
                             -- ^ the result of the action
usingResourceWithPriority :: forall s p a.
PriorityQueueStrategy s p =>
Resource s -> p -> Process a -> Process a
usingResourceWithPriority Resource s
r p
priority Process a
m =
  do Resource s -> p -> Process ()
forall s p.
PriorityQueueStrategy s p =>
Resource s -> p -> Process ()
requestResourceWithPriority Resource s
r p
priority
     Process a -> Process () -> Process a
forall a b. Process a -> Process b -> Process a
finallyProcess Process a
m (Process () -> Process a) -> Process () -> Process a
forall a b. (a -> b) -> a -> b
$ Resource s -> Process ()
forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource s
r

-- | Increase the count of available resource by the specified number,
-- invoking the awaiting processes as needed.
incResourceCount :: DequeueStrategy s
                    => Resource s
                    -- ^ the resource
                    -> Int
                    -- ^ the increment for the resource count
                    -> Event ()
incResourceCount :: forall s. DequeueStrategy s => Resource s -> Int -> Event ()
incResourceCount Resource s
r Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = SimulationRetry -> Event ()
forall e a. Exception e => e -> Event a
throwEvent (SimulationRetry -> Event ()) -> SimulationRetry -> Event ()
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 ()
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise =
    do Resource s -> Event ()
forall s. DequeueStrategy s => Resource s -> Event ()
releaseResourceWithinEvent Resource s
r
       Resource s -> Int -> Event ()
forall s. DequeueStrategy s => Resource s -> Int -> Event ()
incResourceCount Resource 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 :: EnqueueStrategy s
                    => Resource s
                    -- ^ the resource
                    -> Int
                    -- ^ the decrement for the resource count
                    -> Process ()
decResourceCount :: forall s. EnqueueStrategy s => Resource s -> Int -> Process ()
decResourceCount Resource s
r Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = SimulationRetry -> Process ()
forall e a. Exception e => e -> Process a
throwProcess (SimulationRetry -> Process ()) -> SimulationRetry -> Process ()
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 ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise =
    do Resource s -> Process ()
forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource s
r
       Resource s -> Int -> Process ()
forall s. EnqueueStrategy s => Resource s -> Int -> Process ()
decResourceCount Resource s
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)