-- |
-- Module     : Simulation.Aivika.GPSS.Block.Unlink
-- 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 an analog of the GPSS block UNLINK.
--
module Simulation.Aivika.GPSS.Block.Unlink
       (unlinkBlock) where

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

-- | This is an analog of the GPSS construct
--
-- @UNLINK O A,B,C,D,E,F@
unlinkBlock :: Process [(Transact a, Maybe (Block (Transact a) ()))]
               -- ^ a computation of the list of transacts to reactivate,
               -- transfering them to the specified blocks if required
               -> Block b b
unlinkBlock :: forall a b.
Process [(Transact a, Maybe (Block (Transact a) ()))] -> Block b b
unlinkBlock Process [(Transact a, Maybe (Block (Transact a) ()))]
m =
  Block { blockProcess :: b -> Process b
blockProcess = \b
b ->
           do let f :: (a, Maybe (Block a b)) -> (a, Maybe (Process b))
f (a
a, Maybe (Block a b)
Nothing)       = (a
a, forall a. Maybe a
Nothing)
                  f (a
a, Just Block a b
transfer) = (a
a, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. Block a b -> a -> Process b
blockProcess Block a b
transfer a
a)
              [(Transact a, Maybe (Block (Transact a) ()))]
xs <- Process [(Transact a, Maybe (Block (Transact a) ()))]
m
              forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
                forall a. [(Transact a, Maybe (Process ()))] -> Event ()
reactivateTransacts forall a b. (a -> b) -> a -> b
$
                forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. (a, Maybe (Block a b)) -> (a, Maybe (Process b))
f [(Transact a, Maybe (Block (Transact a) ()))]
xs
              forall (m :: * -> *) a. Monad m => a -> m a
return b
b
        }