-- |
-- Module     : Simulation.Aivika.Trans.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.Trans.GPSS.Block.Unlink
       (unlinkBlock) where

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

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