-- |
-- 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 :: Process [(Transact a, Maybe (Block (Transact a) ()))] -> Block b b
unlinkBlock Process [(Transact a, Maybe (Block (Transact a) ()))]
m =
  Block :: forall a b. (a -> Process b) -> Block a b
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, Maybe (Process b)
forall a. Maybe a
Nothing)
                  f (a
a, Just Block a b
transfer) = (a
a, Process b -> Maybe (Process b)
forall a. a -> Maybe a
Just (Process b -> Maybe (Process b)) -> Process b -> Maybe (Process b)
forall a b. (a -> b) -> a -> b
$ Block a b -> a -> Process 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
              Event () -> Process ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$
                [(Transact a, Maybe (Process ()))] -> Event ()
forall a. [(Transact a, Maybe (Process ()))] -> Event ()
reactivateTransacts ([(Transact a, Maybe (Process ()))] -> Event ())
-> [(Transact a, Maybe (Process ()))] -> Event ()
forall a b. (a -> b) -> a -> b
$
                ((Transact a, Maybe (Block (Transact a) ()))
 -> (Transact a, Maybe (Process ())))
-> [(Transact a, Maybe (Block (Transact a) ()))]
-> [(Transact a, Maybe (Process ()))]
forall a b. (a -> b) -> [a] -> [b]
map (Transact a, Maybe (Block (Transact a) ()))
-> (Transact a, Maybe (Process ()))
forall a b. (a, Maybe (Block a b)) -> (a, Maybe (Process b))
f [(Transact a, Maybe (Block (Transact a) ()))]
xs
              b -> Process b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
        }