-- |
-- Module     : Simulation.Aivika.GPSS.Block
-- 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 a GPSS block.
--
module Simulation.Aivika.GPSS.Block
       (Block(..),
        GeneratorBlock(..),
        withinBlock,
        processBlock,
        traceBlock) where

import Control.Monad
import Control.Monad.Trans
import qualified Control.Category as C

import Simulation.Aivika

-- | Represents a GPSS block.
newtype Block a b =
  Block { Block a b -> a -> Process b
blockProcess :: a -> Process b
          -- ^ Process the item.
        }

-- | Represents a GPSS generator block.
newtype GeneratorBlock a =
  GeneratorBlock { GeneratorBlock a -> Block a () -> Process ()
runGeneratorBlock :: Block a () -> Process ()
                   -- ^ Run the generator block.
                 }

instance C.Category Block where

  id :: Block a a
id = Block :: forall a b. (a -> Process b) -> Block a b
Block { blockProcess :: a -> Process a
blockProcess = a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return }

  Block b c
x . :: Block b c -> Block a b -> Block a c
. Block a b
y = Block :: forall a b. (a -> Process b) -> Block a b
Block { blockProcess :: a -> Process c
blockProcess = \a
a -> do { b
b <- Block a b -> a -> Process b
forall a b. Block a b -> a -> Process b
blockProcess Block a b
y a
a; Block b c -> b -> Process c
forall a b. Block a b -> a -> Process b
blockProcess Block b c
x b
b } }

-- | Perform some action within the block, for example,
-- opening or inverting the 'Gate' to emulate the LOGIC block.
withinBlock :: Process ()
               -- ^ the action to be executed for each transact
               -> Block a a
withinBlock :: Process () -> Block a a
withinBlock Process ()
m =
  Block :: forall a b. (a -> Process b) -> Block a b
Block { blockProcess :: a -> Process a
blockProcess = \a
a -> Process ()
m Process () -> Process a -> Process a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a }

-- | Process every transact within the block.
processBlock :: (a -> Process b)
                -- ^ process the transact
                -> Block a b
processBlock :: (a -> Process b) -> Block a b
processBlock = (a -> Process b) -> Block a b
forall a b. (a -> Process b) -> Block a b
Block

-- | Trace the specified block.
traceBlock :: String -> Block a b -> Block a b
traceBlock :: String -> Block a b -> Block a b
traceBlock String
message Block a b
x =
  Block :: forall a b. (a -> Process b) -> Block a b
Block { blockProcess :: a -> Process b
blockProcess = \a
a -> String -> Process b -> Process b
forall a. String -> Process a -> Process a
traceProcess String
message (Block a b -> a -> Process b
forall a b. Block a b -> a -> Process b
blockProcess Block a b
x a
a) }