-- |
-- Module     : Simulation.Aivika.GPSS.Block.Split
-- 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 SPLIT.
--
module Simulation.Aivika.GPSS.Block.Split
       (splitBlock) where

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

-- | This is an analog of the GPSS construct
--
-- @SPLIT A,B,C@
--
-- Parameter @A@ is a length of the list parameter passed in to the function.
-- Parameter @B@ is the list itself. If you need to define parameter @C@ then
-- you can create the blocks dynamically that could depend on the index and
-- where we could assign a new value for each new transcact after splitting.
--
-- An example is
--
-- @
-- let blocks :: [Block (Transact (a, Int)) ()]
--     blocks = ...
--     f :: (Int, Block (Transact (a, Int)) ()) -> Block (Transact a) ()
--     f (n, block) = assignBlock (\a -> (a, n)) >>> block
--     blocks' :: [Block (Transact a) ()]
--     blocks' = map f $ zip [0..] blocks
-- in splitBlock blocks'
-- @
splitBlock :: [Block (Transact a) ()]
              -- ^ split and transfer new transacts to the specified blocks
              -> Block (Transact a) (Transact a)
splitBlock :: forall a.
[Block (Transact a) ()] -> Block (Transact a) (Transact a)
splitBlock [Block (Transact a) ()]
blocks =
  Block { blockProcess :: Transact a -> Process (Transact a)
blockProcess = \Transact a
a ->
           do let loop :: [Block (Transact a) ()] -> Event ()
loop [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  loop (Block (Transact a) ()
transfer: [Block (Transact a) ()]
transfers) =
                    do Transact a
a' <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall a. Transact a -> Simulation (Transact a)
splitTransact Transact a
a
                       forall a. Transact a -> Process () -> Event ()
transferTransact Transact a
a' forall a b. (a -> b) -> a -> b
$
                         forall a b. Block a b -> a -> Process b
blockProcess Block (Transact a) ()
transfer Transact a
a'
                       [Block (Transact a) ()] -> Event ()
loop [Block (Transact a) ()]
transfers
              forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ [Block (Transact a) ()] -> Event ()
loop [Block (Transact a) ()]
blocks
              forall (m :: * -> *) a. Monad m => a -> m a
return Transact a
a
        }