module Simulation.Aivika.Trans.GPSS.Block.Terminate
(terminateBlock,
terminateBlockByCount,
terminateBlockByCountM) where
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika.Trans
import Simulation.Aivika.Trans.GPSS.Block
terminateBlock :: MonadDES m => Block m a ()
{-# INLINABLE terminateBlock #-}
terminateBlock :: forall (m :: * -> *) a. MonadDES m => Block m a ()
terminateBlock =
Block { blockProcess :: a -> Process m ()
blockProcess = \a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return () }
terminateBlockByCountM :: MonadDES m
=> Ref m Int
-> Event m Int
-> Block m a ()
{-# INLINABLE terminateBlockByCountM #-}
terminateBlockByCountM :: forall (m :: * -> *) a.
MonadDES m =>
Ref m Int -> Event m Int -> Block m a ()
terminateBlockByCountM Ref m Int
counter Event m Int
decrement =
Block { blockProcess :: a -> Process m ()
blockProcess = \a
a -> Process m ()
action }
where
action :: Process m ()
action =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$
do Int
i <- Event m Int
decrement
Int
n <- forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef Ref m Int
counter
let n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
- Int
i
Int
n' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef Ref m Int
counter Int
n'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' forall a. Ord a => a -> a -> Bool
<= Int
0) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent forall a b. (a -> b) -> a -> b
$
String -> SimulationAbort
SimulationAbort String
"Terminated by exceeding the counter"
terminateBlockByCount :: MonadDES m
=> Ref m Int
-> Int
-> Block m a ()
{-# INLINABLE terminateBlockByCount #-}
terminateBlockByCount :: forall (m :: * -> *) a.
MonadDES m =>
Ref m Int -> Int -> Block m a ()
terminateBlockByCount Ref m Int
counter Int
i =
Block { blockProcess :: a -> Process m ()
blockProcess = \a
a -> Process m ()
action }
where
action :: Process m ()
action =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$
do Int
n <- forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef Ref m Int
counter
let n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
- Int
i
Int
n' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef Ref m Int
counter Int
n'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' forall a. Ord a => a -> a -> Bool
<= Int
0) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent forall a b. (a -> b) -> a -> b
$
String -> SimulationAbort
SimulationAbort String
"Terminated by exceeding the counter"