module Simulation.Aivika.Resource
(Resource,
newResource,
newResourceWithCount,
resourceMaxCount,
resourceCount,
requestResource,
requestResourceWithPriority,
requestResourceWithDynamicPriority,
tryRequestResourceWithinEvent,
releaseResource,
releaseResourceWithinEvent,
usingResource,
usingResourceWithPriority,
usingResourceWithDynamicPriority) where
import Data.IORef
import Control.Monad
import Control.Monad.Trans
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
data Resource s q =
Resource { resourceStrategy :: s,
resourceMaxCount :: Int,
resourceCountRef :: IORef Int,
resourceWaitList :: q (ContParams ())}
instance Eq (Resource s q) where
x == y = resourceCountRef x == resourceCountRef y
newResource :: QueueStrategy s q
=> s
-> Int
-> Simulation (Resource s q)
newResource s maxCount =
Simulation $ \r ->
do countRef <- newIORef maxCount
waitList <- invokeSimulation r $ newStrategyQueue s
return Resource { resourceStrategy = s,
resourceMaxCount = maxCount,
resourceCountRef = countRef,
resourceWaitList = waitList }
newResourceWithCount :: QueueStrategy s q
=> s
-> Int
-> Int
-> Simulation (Resource s q)
newResourceWithCount s maxCount count = do
when (count < 0) $
error $
"The resource count cannot be negative: " ++
"newResourceWithCount."
when (count > maxCount) $
error $
"The resource count cannot be greater than " ++
"its maximum value: newResourceWithCount."
Simulation $ \r ->
do countRef <- newIORef count
waitList <- invokeSimulation r $ newStrategyQueue s
return Resource { resourceStrategy = s,
resourceMaxCount = maxCount,
resourceCountRef = countRef,
resourceWaitList = waitList }
resourceCount :: Resource s q -> Event Int
resourceCount r =
Event $ \p -> readIORef (resourceCountRef r)
requestResource :: EnqueueStrategy s q
=> Resource s q
-> Process ()
requestResource r =
Process $ \pid ->
Cont $ \c ->
Event $ \p ->
do a <- readIORef (resourceCountRef r)
if a == 0
then invokeEvent p $
strategyEnqueue (resourceStrategy r) (resourceWaitList r) c
else do let a' = a 1
a' `seq` writeIORef (resourceCountRef r) a'
invokeEvent p $ resumeCont c ()
requestResourceWithPriority :: PriorityQueueStrategy s q
=> Resource s q
-> Double
-> Process ()
requestResourceWithPriority r priority =
Process $ \pid ->
Cont $ \c ->
Event $ \p ->
do a <- readIORef (resourceCountRef r)
if a == 0
then invokeEvent p $
strategyEnqueueWithPriority (resourceStrategy r) (resourceWaitList r) priority c
else do let a' = a 1
a' `seq` writeIORef (resourceCountRef r) a'
invokeEvent p $ resumeCont c ()
requestResourceWithDynamicPriority :: DynamicPriorityQueueStrategy s q
=> Resource s q
-> Event Double
-> Process ()
requestResourceWithDynamicPriority r priority =
Process $ \pid ->
Cont $ \c ->
Event $ \p ->
do a <- readIORef (resourceCountRef r)
if a == 0
then invokeEvent p $
strategyEnqueueWithDynamicPriority (resourceStrategy r) (resourceWaitList r) priority c
else do let a' = a 1
a' `seq` writeIORef (resourceCountRef r) a'
invokeEvent p $ resumeCont c ()
releaseResource :: DequeueStrategy s q
=> Resource s q
-> Process ()
releaseResource r =
Process $ \_ ->
Cont $ \c ->
Event $ \p ->
do invokeEvent p $ releaseResourceWithinEvent r
invokeEvent p $ resumeCont c ()
releaseResourceWithinEvent :: DequeueStrategy s q
=> Resource s q
-> Event ()
releaseResourceWithinEvent r =
Event $ \p ->
do a <- readIORef (resourceCountRef r)
let a' = a + 1
when (a' > resourceMaxCount r) $
error $
"The resource count cannot be greater than " ++
"its maximum value: releaseResourceWithinEvent."
f <- invokeEvent p $
strategyQueueNull (resourceStrategy r) (resourceWaitList r)
if f
then a' `seq` writeIORef (resourceCountRef r) a'
else do c <- invokeEvent p $
strategyDequeue (resourceStrategy r) (resourceWaitList r)
invokeEvent p $ enqueueEvent (pointTime p) $
Event $ \p ->
do z <- contCanceled c
if z
then do invokeEvent p $ releaseResourceWithinEvent r
invokeEvent p $ resumeCont c ()
else invokeEvent p $ resumeCont c ()
tryRequestResourceWithinEvent :: Resource s q
-> Event Bool
tryRequestResourceWithinEvent r =
Event $ \p ->
do a <- readIORef (resourceCountRef r)
if a == 0
then return False
else do let a' = a 1
a' `seq` writeIORef (resourceCountRef r) a'
return True
usingResource :: EnqueueStrategy s q
=> Resource s q
-> Process a
-> Process a
usingResource r m =
do requestResource r
finallyProcess m $ releaseResource r
usingResourceWithPriority :: PriorityQueueStrategy s q
=> Resource s q
-> Double
-> Process a
-> Process a
usingResourceWithPriority r priority m =
do requestResourceWithPriority r priority
finallyProcess m $ releaseResource r
usingResourceWithDynamicPriority :: DynamicPriorityQueueStrategy s q
=> Resource s q
-> Event Double
-> Process a
-> Process a
usingResourceWithDynamicPriority r priority m =
do requestResourceWithDynamicPriority r priority
finallyProcess m $ releaseResource r