-- |
-- Module     : Simulation.Aivika.Trans.GPSS.Block.Terminate
-- Copyright  : Copyright (c) 2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.2
--
-- This module defines the GPSS block TERMINATE.
--
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

-- | This is the GPSS construct
--
-- @TERMINATE@
terminateBlock :: MonadDES m => Block m a ()
{-# INLINABLE terminateBlock #-}
terminateBlock :: Block m a ()
terminateBlock =
  Block :: forall (m :: * -> *) a b. (a -> Process m b) -> Block m a b
Block { blockProcess :: a -> Process m ()
blockProcess = \a
a -> () -> Process m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () }

-- | This is the GPSS construct
--
-- @TERMINATE Count@
terminateBlockByCountM :: MonadDES m
                          => Ref m Int
                          -- ^ the counter
                          -> Event m Int
                          -- ^ the computation of decrement
                          -> Block m a ()
{-# INLINABLE terminateBlockByCountM #-}
terminateBlockByCountM :: Ref m Int -> Event m Int -> Block m a ()
terminateBlockByCountM Ref m Int
counter Event m Int
decrement =
  Block :: forall (m :: * -> *) a b. (a -> Process m b) -> Block m a b
Block { blockProcess :: a -> Process m ()
blockProcess = \a
a -> Process m ()
action }
    where
      action :: Process m ()
action = 
        Event m () -> Process m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Process m ()) -> Event m () -> Process m ()
forall a b. (a -> b) -> a -> b
$
        do Int
i <- Event m Int
decrement
           Int
n <- Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef Ref m Int
counter
           let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
           Int
n' Int -> Event m () -> Event m ()
`seq` Ref m Int -> Int -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef Ref m Int
counter Int
n'
           Bool -> Event m () -> Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
             SimulationAbort -> Event m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent (SimulationAbort -> Event m ()) -> SimulationAbort -> Event m ()
forall a b. (a -> b) -> a -> b
$
             String -> SimulationAbort
SimulationAbort String
"Terminated by exceeding the counter"

-- | This is the GPSS construct
--
-- @TERMINATE Count@
terminateBlockByCount :: MonadDES m
                         => Ref m Int
                         -- ^ the counter
                         -> Int
                         -- ^ the decrement
                         -> Block m a ()
{-# INLINABLE terminateBlockByCount #-}
terminateBlockByCount :: Ref m Int -> Int -> Block m a ()
terminateBlockByCount Ref m Int
counter Int
i =
  Block :: forall (m :: * -> *) a b. (a -> Process m b) -> Block m a b
Block { blockProcess :: a -> Process m ()
blockProcess = \a
a -> Process m ()
action }
    where
      action :: Process m ()
action = 
        Event m () -> Process m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Process m ()) -> Event m () -> Process m ()
forall a b. (a -> b) -> a -> b
$
        do Int
n <- Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef Ref m Int
counter
           let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
           Int
n' Int -> Event m () -> Event m ()
`seq` Ref m Int -> Int -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef Ref m Int
counter Int
n'
           Bool -> Event m () -> Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
             SimulationAbort -> Event m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent (SimulationAbort -> Event m ()) -> SimulationAbort -> Event m ()
forall a b. (a -> b) -> a -> b
$
             String -> SimulationAbort
SimulationAbort String
"Terminated by exceeding the counter"