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