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

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

import Simulation.Aivika.Trans

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

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

instance MonadDES m => C.Category (Block m) where

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

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

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

-- | Process every transact within the block.
processBlock :: MonadDES m
                => (a -> Process m b)
                -- ^ process the transact
                -> Block m a b
{-# INLINABLE processBlock #-}
processBlock :: (a -> Process m b) -> Block m a b
processBlock = (a -> Process m b) -> Block m a b
forall (m :: * -> *) a b. (a -> Process m b) -> Block m a b
Block

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