module Simulation.Aivika.Dynamics.Resource
(Resource,
newResource,
newResourceWithCount,
resourceQueue,
resourceInitCount,
resourceCount,
requestResource,
tryRequestResourceInDynamics,
releaseResource,
releaseResourceInDynamics,
usingResource) where
import Data.IORef
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika.Dynamics.Internal.Simulation
import Simulation.Aivika.Dynamics.Internal.Dynamics
import Simulation.Aivika.Dynamics.Internal.Cont
import Simulation.Aivika.Dynamics.Internal.Process
import Simulation.Aivika.Dynamics.EventQueue
import qualified Simulation.Aivika.Queue as Q
data Resource =
Resource { resourceQueue :: EventQueue,
resourceInitCount :: Int,
resourceCountRef :: IORef Int,
resourceWaitQueue :: Q.Queue (ContParams ())}
instance Eq Resource where
x == y = resourceCountRef x == resourceCountRef y
newResource :: EventQueue -> Int -> Simulation Resource
newResource q initCount =
Simulation $ \r ->
do countRef <- newIORef initCount
waitQueue <- Q.newQueue
return Resource { resourceQueue = q,
resourceInitCount = initCount,
resourceCountRef = countRef,
resourceWaitQueue = waitQueue }
newResourceWithCount :: EventQueue -> Int -> Int -> Simulation Resource
newResourceWithCount q initCount count = do
when (count < 0) $
error $
"The resource count cannot be negative: " ++
"newResourceWithCount."
when (count > initCount) $
error $
"The resource count cannot be greater than " ++
"its initial value: newResourceWithCount."
Simulation $ \r ->
do countRef <- newIORef count
waitQueue <- Q.newQueue
return Resource { resourceQueue = q,
resourceInitCount = initCount,
resourceCountRef = countRef,
resourceWaitQueue = waitQueue }
resourceCount :: Resource -> Dynamics Int
resourceCount r =
Dynamics $ \p ->
do invokeDynamics p $ runQueueSync (resourceQueue r)
readIORef (resourceCountRef r)
requestResource :: Resource -> Process ()
requestResource r =
Process $ \pid ->
Cont $ \c ->
Dynamics $ \p ->
do a <- readIORef (resourceCountRef r)
if a == 0
then Q.enqueue (resourceWaitQueue r) c
else do let a' = a 1
a' `seq` writeIORef (resourceCountRef r) a'
invokeDynamics p $ resumeContByParams c ()
releaseResource :: Resource -> Process ()
releaseResource r =
Process $ \_ ->
Cont $ \c ->
Dynamics $ \p ->
do invokeDynamics p $ releaseResourceUnsafe r
invokeDynamics p $ resumeContByParams c ()
releaseResourceInDynamics :: Resource -> Dynamics ()
releaseResourceInDynamics r =
Dynamics $ \p ->
do invokeDynamics p $ runQueueSync (resourceQueue r)
invokeDynamics p $ releaseResourceUnsafe r
releaseResourceUnsafe :: Resource -> Dynamics ()
releaseResourceUnsafe r =
Dynamics $ \p ->
do a <- readIORef (resourceCountRef r)
let a' = a + 1
when (a' > resourceInitCount r) $
error $
"The resource count cannot be greater than " ++
"its initial value: releaseResourceUnsafe."
f <- Q.queueNull (resourceWaitQueue r)
if f
then a' `seq` writeIORef (resourceCountRef r) a'
else do c <- Q.queueFront (resourceWaitQueue r)
Q.dequeue (resourceWaitQueue r)
invokeDynamics p $ enqueue (resourceQueue r) (pointTime p) $
Dynamics $ \p ->
do z <- contParamsCanceled c
if z
then do invokeDynamics p $ releaseResourceUnsafe r
invokeDynamics p $ resumeContByParams c ()
else invokeDynamics p $ resumeContByParams c ()
tryRequestResourceInDynamics :: Resource -> Dynamics Bool
tryRequestResourceInDynamics r =
Dynamics $ \p ->
do invokeDynamics p $ runQueueSync (resourceQueue r)
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 :: Resource -> Process a -> Process a
usingResource r m =
do requestResource r
finallyProcess m $ releaseResource r
invokeDynamics :: Point -> Dynamics a -> IO a
invokeDynamics p (Dynamics m) = m p