-- |
-- Module     : Simulation.Aivika.GPSS.Block.Test
-- 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 TEST.
--
module Simulation.Aivika.GPSS.Block.Test
       (awaitingTestBlock,
        awaitingTestBlockM,
        transferringTestBlock,
        transferringTestBlockM) where

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

-- | This is the GPSS construct
--
-- @TEST O A,B@
awaitingTestBlock :: (a -> Signalable Bool)
                     -- ^ by the specified transact return
                     -- a test condition and signal that notifies
                     -- about changing the condition
                     -> Block a a
awaitingTestBlock :: (a -> Signalable Bool) -> Block a a
awaitingTestBlock a -> Signalable Bool
f =
  Block :: forall a b. (a -> Process b) -> Block a b
Block { blockProcess :: a -> Process a
blockProcess = \a
a ->
           do let s :: Signalable Bool
s = a -> Signalable Bool
f a
a
                  loop :: Process ()
loop =
                    do Bool
f <- Event Bool -> Process Bool
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event Bool -> Process Bool) -> Event Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ Signalable Bool -> Event Bool
forall a. Signalable a -> Event a
readSignalable Signalable Bool
s
                       if Bool
f
                         then () -> Process ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                         else do Signal () -> Process ()
forall a. Signal a -> Process a
processAwait (Signal () -> Process ()) -> Signal () -> Process ()
forall a b. (a -> b) -> a -> b
$ Signalable Bool -> Signal ()
forall a. Signalable a -> Signal ()
signalableChanged_ Signalable Bool
s
                                 Process ()
loop
              Process ()
loop
              a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        }

-- | This is the GPSS construct
--
-- @TEST O A,B@
awaitingTestBlockM :: (a -> Process (Signalable Bool))
                      -- ^ by the specified transact return
                      -- a test condition and signal that notifies
                      -- about changing the condition
                      -> Block a a
awaitingTestBlockM :: (a -> Process (Signalable Bool)) -> Block a a
awaitingTestBlockM a -> Process (Signalable Bool)
f =
  Block :: forall a b. (a -> Process b) -> Block a b
Block { blockProcess :: a -> Process a
blockProcess = \a
a ->
           do Signalable Bool
s <- a -> Process (Signalable Bool)
f a
a
              let loop :: Process ()
loop =
                    do Bool
f <- Event Bool -> Process Bool
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event Bool -> Process Bool) -> Event Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ Signalable Bool -> Event Bool
forall a. Signalable a -> Event a
readSignalable Signalable Bool
s
                       if Bool
f
                         then () -> Process ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                         else do Signal () -> Process ()
forall a. Signal a -> Process a
processAwait (Signal () -> Process ()) -> Signal () -> Process ()
forall a b. (a -> b) -> a -> b
$ Signalable Bool -> Signal ()
forall a. Signalable a -> Signal ()
signalableChanged_ Signalable Bool
s
                                 Process ()
loop
              Process ()
loop
              a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        }

-- | This is the GPSS construct
--
-- @TEST O A,B,C@
transferringTestBlock :: (a -> Bool)
                         -- ^ the predicate
                         -> Block a ()
                         -- ^ the block to transfer in when the condition fails
                         -> Block a a
transferringTestBlock :: (a -> Bool) -> Block a () -> Block a a
transferringTestBlock a -> Bool
pred Block a ()
block =
  Block :: forall a b. (a -> Process b) -> Block a b
Block { blockProcess :: a -> Process a
blockProcess = \a
a ->
           do let f :: Bool
f = a -> Bool
pred a
a
              if Bool
f
                then a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
                else Process () -> Process a
forall a. Process () -> Process a
transferProcess (Block a () -> a -> Process ()
forall a b. Block a b -> a -> Process b
blockProcess Block a ()
block a
a)
        }

-- | This is the GPSS construct
--
-- @TEST O A,B,C@
transferringTestBlockM :: (a -> Process Bool)
                          -- ^ the predicate
                          -> Block a ()
                          -- ^ the block to transfer in when the condition fails
                          -> Block a a
transferringTestBlockM :: (a -> Process Bool) -> Block a () -> Block a a
transferringTestBlockM a -> Process Bool
pred Block a ()
block =
  Block :: forall a b. (a -> Process b) -> Block a b
Block { blockProcess :: a -> Process a
blockProcess = \a
a ->
           do Bool
f <- a -> Process Bool
pred a
a
              if Bool
f
                then a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
                else Process () -> Process a
forall a. Process () -> Process a
transferProcess (Block a () -> a -> Process ()
forall a b. Block a b -> a -> Process b
blockProcess Block a ()
block a
a)
        }