aivika-transformers 4.3.3 → 4.3.4
raw patch · 12 files changed
+82/−32 lines, 12 filesdep ~aivika
Dependency ranges changed: aivika
Files
- Simulation/Aivika/IO/Resource/Preemption.hs +13/−7
- Simulation/Aivika/IO/Resource/Preemption/Base.hs +15/−8
- Simulation/Aivika/Trans/Event.hs +2/−0
- Simulation/Aivika/Trans/Internal/Cont.hs +9/−1
- Simulation/Aivika/Trans/Internal/Event.hs +7/−0
- Simulation/Aivika/Trans/Internal/Process.hs +7/−0
- Simulation/Aivika/Trans/Internal/Simulation.hs +3/−2
- Simulation/Aivika/Trans/Process.hs +2/−0
- Simulation/Aivika/Trans/Resource.hs +9/−5
- Simulation/Aivika/Trans/Resource/Base.hs +11/−6
- Simulation/Aivika/Trans/Simulation.hs +2/−1
- aivika-transformers.cabal +2/−2
Simulation/Aivika/IO/Resource/Preemption.hs view
@@ -21,6 +21,7 @@ import Data.IORef import Data.Monoid +import Simulation.Aivika.Trans.Exception import Simulation.Aivika.Trans.Ref.Base import Simulation.Aivika.Trans.DES import Simulation.Aivika.Trans.Template@@ -72,12 +73,14 @@ do let r = pointRun p t = pointTime p when (count < 0) $- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be negative: " ++ "newResourceWithMaxCount." case maxCount of Just maxCount | count > maxCount ->- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be greater than " ++ "its maximum value: newResourceWithMaxCount." _ ->@@ -235,7 +238,8 @@ then do invokeEvent p $ updateResourceUtilisationCount r (-1) invokeEvent p $ releaseResource' r invokeEvent p $ resumeCont c ()- else error $+ else throwComp $+ SimulationRetry "The resource was not acquired by this process: releaseResource" {-# INLINABLE usingResourceWithPriority #-}@@ -245,7 +249,7 @@ {-# INLINABLE incResourceCount #-} incResourceCount r n- | n < 0 = error "The increment cannot be negative: incResourceCount"+ | n < 0 = throwEvent $ SimulationRetry "The increment cannot be negative: incResourceCount" | n == 0 = return () | otherwise = do releaseResource' r@@ -253,7 +257,7 @@ {-# INLINABLE decResourceCount #-} decResourceCount r n- | n < 0 = error "The decrement cannot be negative: decResourceCount"+ | n < 0 = throwEvent $ SimulationRetry "The decrement cannot be negative: decResourceCount" | n == 0 = return () | otherwise = do decResourceCount' r@@ -309,7 +313,8 @@ let a' = a + 1 case resourceMaxCount r of Just maxCount | a' > maxCount ->- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be greater than " ++ "its maximum value: releaseResource'." _ ->@@ -351,7 +356,8 @@ do let t = pointTime p a <- liftIO $ readIORef (resourceCountRef r) when (a == 0) $- error $+ throwComp $+ SimulationRetry "The resource exceeded and its count is zero: decResourceCount'" f <- liftIO $ PQ.queueNull (resourceActingQueue r) unless f $
Simulation/Aivika/IO/Resource/Preemption/Base.hs view
@@ -20,6 +20,7 @@ import Data.Maybe import Data.IORef +import Simulation.Aivika.Trans.Exception import Simulation.Aivika.Trans.Ref.Base import Simulation.Aivika.Trans.DES import Simulation.Aivika.Trans.Template@@ -50,7 +51,8 @@ newResource count = Simulation $ \r -> do when (count < 0) $- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be negative: " ++ "newResource." countRef <- liftIO $ newIORef count@@ -65,12 +67,14 @@ newResourceWithMaxCount count maxCount = Simulation $ \r -> do when (count < 0) $- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be negative: " ++ "newResourceWithMaxCount." case maxCount of Just maxCount | count > maxCount ->- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be greater than " ++ "its maximum value: newResourceWithMaxCount." _ ->@@ -134,7 +138,8 @@ if f then do invokeEvent p $ releaseResource' r invokeEvent p $ resumeCont c ()- else error $+ else throwComp $+ SimulationRetry "The resource was not acquired by this process: releaseResource" {-# INLINABLE usingResourceWithPriority #-}@@ -144,7 +149,7 @@ {-# INLINABLE incResourceCount #-} incResourceCount r n- | n < 0 = error "The increment cannot be negative: incResourceCount"+ | n < 0 = throwEvent $ SimulationRetry "The increment cannot be negative: incResourceCount" | n == 0 = return () | otherwise = do releaseResource' r@@ -152,7 +157,7 @@ {-# INLINABLE decResourceCount #-} decResourceCount r n- | n < 0 = error "The decrement cannot be negative: decResourceCount"+ | n < 0 = throwEvent $ SimulationRetry "The decrement cannot be negative: decResourceCount" | n == 0 = return () | otherwise = do decResourceCount' r@@ -202,7 +207,8 @@ let a' = a + 1 case resourceMaxCount r of Just maxCount | a' > maxCount ->- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be greater than " ++ "its maximum value: releaseResource'." _ ->@@ -236,7 +242,8 @@ Event $ \p -> do a <- liftIO $ readIORef (resourceCountRef r) when (a == 0) $- error $+ throwComp $+ SimulationRetry "The resource exceeded and its count is zero: decResourceCount'" f <- liftIO $ PQ.queueNull (resourceActingQueue r) unless f $
Simulation/Aivika/Trans/Event.hs view
@@ -37,6 +37,8 @@ memoEventInTime, -- * Disposable DisposableEvent(..),+ -- * Retrying Computation+ retryEvent, -- * Debugging traceEvent) where
Simulation/Aivika/Trans/Internal/Cont.hs view
@@ -830,7 +830,15 @@ if not f then invokeEvent p $ enqueueEvent (pointTime p) $- resumeCont c a+ Event $ \p ->+ do f <- invokeEvent p $+ contPreemptionBegun $+ contId $ contAux c+ if not f+ then invokeEvent p $+ resumeCont c a+ else invokeEvent p $+ sleepCont c a else invokeEvent p $ sleepCont c a
Simulation/Aivika/Trans/Internal/Event.hs view
@@ -41,6 +41,8 @@ memoEventInTime, -- * Disposable DisposableEvent(..),+ -- * Retrying Computation+ retryEvent, -- * Debugging traceEvent) where @@ -296,6 +298,11 @@ {-# INLINE mappend #-} mappend (DisposableEvent x) (DisposableEvent y) = DisposableEvent $ x >> y++-- | Retry the current computation as possible, using the specified argument+-- as a 'SimulationRetry' exception message in case of failure.+retryEvent :: MonadException m => String -> Event m a+retryEvent message = throwEvent $ SimulationRetry message -- | Show the debug message with the current simulation time. traceEvent :: MonadDES m => String -> Event m a -> Event m a
Simulation/Aivika/Trans/Internal/Process.hs view
@@ -85,6 +85,8 @@ memoProcess, -- * Never Ending Process neverProcess,+ -- * Retrying Computation+ retryProcess, -- * Debugging traceProcess) where @@ -762,6 +764,11 @@ let signal = processCancelling pid in handleSignal_ signal $ \_ -> resumeCont c $ error "It must never be computed: neverProcess"++-- | Retry the current computation as possible, using the specified argument+-- as a 'SimulationRetry' exception message in case of failure.+retryProcess :: MonadDES m => String -> Process m a+retryProcess = liftEvent . retryEvent -- | Show the debug message with the current simulation time. traceProcess :: MonadDES m => String -> Process m a -> Process m a
Simulation/Aivika/Trans/Internal/Simulation.hs view
@@ -26,7 +26,8 @@ throwSimulation, -- * Exceptions SimulationException(..),- SimulationAbort(..)) where+ SimulationAbort(..),+ SimulationRetry(..)) where import Control.Exception import Control.Monad@@ -42,7 +43,7 @@ import Simulation.Aivika.Trans.Internal.Specs import Simulation.Aivika.Trans.Internal.Parameter -import Simulation.Aivika.Simulation (SimulationException, SimulationAbort)+import Simulation.Aivika.Simulation (SimulationException(..), SimulationAbort(..), SimulationRetry(..)) instance Monad m => Monad (Simulation m) where
Simulation/Aivika/Trans/Process.hs view
@@ -83,6 +83,8 @@ memoProcess, -- * Never Ending Process neverProcess,+ -- * Retrying Computation+ retryProcess, -- * Debugging traceProcess) where
Simulation/Aivika/Trans/Resource.hs view
@@ -72,6 +72,7 @@ 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@@ -228,12 +229,14 @@ do let r = pointRun p t = pointTime p when (count < 0) $- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be negative: " ++ "newResourceWithMaxCount." case maxCount of Just maxCount | count > maxCount ->- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be greater than " ++ "its maximum value: newResourceWithMaxCount." _ ->@@ -459,7 +462,8 @@ let a' = a + 1 case resourceMaxCount r of Just maxCount | a' > maxCount ->- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be greater than " ++ "its maximum value: releaseResource'." _ ->@@ -550,7 +554,7 @@ -> Event m () {-# INLINABLE incResourceCount #-} incResourceCount r n- | n < 0 = error "The increment cannot be negative: incResourceCount"+ | n < 0 = throwEvent $ SimulationRetry "The increment cannot be negative: incResourceCount" | n == 0 = return () | otherwise = do releaseResource' r@@ -566,7 +570,7 @@ -> Process m () {-# INLINABLE decResourceCount #-} decResourceCount r n- | n < 0 = error "The decrement cannot be negative: decResourceCount"+ | n < 0 = throwProcess $ SimulationRetry "The decrement cannot be negative: decResourceCount" | n == 0 = return () | otherwise = do decResourceCount' r
Simulation/Aivika/Trans/Resource/Base.hs view
@@ -57,6 +57,7 @@ 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@@ -180,7 +181,8 @@ newResource s count = Simulation $ \r -> do when (count < 0) $- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be negative: " ++ "newResource." countRef <- invokeSimulation r $ newRef count@@ -204,12 +206,14 @@ newResourceWithMaxCount s count maxCount = Simulation $ \r -> do when (count < 0) $- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be negative: " ++ "newResourceWithMaxCount." case maxCount of Just maxCount | count > maxCount ->- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be greater than " ++ "its maximum value: newResourceWithMaxCount." _ ->@@ -306,7 +310,8 @@ let a' = a + 1 case resourceMaxCount r of Just maxCount | a' > maxCount ->- error $+ throwComp $+ SimulationRetry $ "The resource count cannot be greater than " ++ "its maximum value: releaseResourceWithinEvent." _ ->@@ -382,7 +387,7 @@ -> Event m () {-# INLINABLE incResourceCount #-} incResourceCount r n- | n < 0 = error "The increment cannot be negative: incResourceCount"+ | n < 0 = throwEvent $ SimulationRetry "The increment cannot be negative: incResourceCount" | n == 0 = return () | otherwise = do releaseResourceWithinEvent r@@ -398,7 +403,7 @@ -> Process m () {-# INLINABLE decResourceCount #-} decResourceCount r n- | n < 0 = error "The decrement cannot be negative: decResourceCount"+ | n < 0 = throwProcess $ SimulationRetry "The decrement cannot be negative: decResourceCount" | n == 0 = return () | otherwise = do requestResource r
Simulation/Aivika/Trans/Simulation.hs view
@@ -22,6 +22,7 @@ throwSimulation, -- * Exceptions SimulationException(..),- SimulationAbort(..)) where+ SimulationAbort(..),+ SimulationRetry(..)) where import Simulation.Aivika.Trans.Internal.Simulation
aivika-transformers.cabal view
@@ -1,5 +1,5 @@ name: aivika-transformers-version: 4.3.3+version: 4.3.4 synopsis: Transformers for the Aivika simulation library description: This package is a generalization of the Aivika [1] simulation library@@ -144,7 +144,7 @@ containers >= 0.4.0.0, random >= 1.0.0.3, vector >= 0.10.0.1,- aivika >= 4.3.1+ aivika >= 4.3.4 other-extensions: FlexibleContexts, FlexibleInstances,