-- |
-- Module     : Simulation.Aivika.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.GPSS.Block.Terminate
       (terminateBlock,
        terminateBlockByCount,
        terminateBlockByCountM) where

import Control.Monad
import Control.Monad.Trans

import Simulation.Aivika
import Simulation.Aivika.GPSS.Block

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

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

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