-- |
-- Module     : Simulation.Aivika.GPSS.Block.Generate
-- 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 the GPSS block GENERATE.
--
module Simulation.Aivika.GPSS.Block.Generate
       (streamGeneratorBlock0,
        streamGeneratorBlock,
        streamGeneratorBlockM,
        signalGeneratorBlock0,
        signalGeneratorBlock,
        signalGeneratorBlockM) where

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

-- | Return a generator block by the specified stream and priority computation.
streamGeneratorBlockM :: Stream (Arrival a)
                         -- ^ the input stream of data
                         -> Event Int
                         -- ^ the transact priority
                         -> GeneratorBlock (Transact a)
streamGeneratorBlockM :: forall a.
Stream (Arrival a) -> Event Int -> GeneratorBlock (Transact a)
streamGeneratorBlockM Stream (Arrival a)
s Event Int
priority =
  let loop :: Stream (Arrival a) -> Block (Transact a) () -> Process b
loop Stream (Arrival a)
s Block (Transact a) ()
block =
        do (Arrival a
a, Stream (Arrival a)
xs) <- forall a. Stream a -> Process (a, Stream a)
runStream Stream (Arrival a)
s
           forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
             do Int
p <- Event Int
priority
                Transact a
t <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall a. Arrival a -> Int -> Simulation (Transact a)
newTransact Arrival a
a Int
p
                Process () -> Event ()
runProcess forall a b. (a -> b) -> a -> b
$
                  do forall a. Transact a -> Process ()
takeTransact Transact a
t
                     forall a b. Block a b -> a -> Process b
blockProcess Block (Transact a) ()
block Transact a
t
           Stream (Arrival a) -> Block (Transact a) () -> Process b
loop Stream (Arrival a)
xs Block (Transact a) ()
block
  in forall a. (Block a () -> Process ()) -> GeneratorBlock a
GeneratorBlock (forall {a} {b}.
Stream (Arrival a) -> Block (Transact a) () -> Process b
loop Stream (Arrival a)
s)

-- | Return a generator block by the specified stream and priority.
streamGeneratorBlock :: Stream (Arrival a)
                        -- ^ the input stream of data
                        -> Int
                        -- ^ the transact priority
                        -> GeneratorBlock (Transact a)
streamGeneratorBlock :: forall a. Stream (Arrival a) -> Int -> GeneratorBlock (Transact a)
streamGeneratorBlock Stream (Arrival a)
s Int
priority = forall a.
Stream (Arrival a) -> Event Int -> GeneratorBlock (Transact a)
streamGeneratorBlockM Stream (Arrival a)
s' (forall (m :: * -> *) a. Monad m => a -> m a
return Int
priority)
  where s' :: Stream (Arrival a)
s' = forall a. Process (a, Stream a) -> Stream a
Cons forall a b. (a -> b) -> a -> b
$ Int -> Process ()
processWithPriority Int
priority forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Stream a -> Process (a, Stream a)
runStream Stream (Arrival a)
s

-- | Return a generator block by the specified stream using zero priority.
streamGeneratorBlock0 :: Stream (Arrival a)
                         -- ^ the input stream of data
                         -> GeneratorBlock (Transact a)
streamGeneratorBlock0 :: forall a. Stream (Arrival a) -> GeneratorBlock (Transact a)
streamGeneratorBlock0 Stream (Arrival a)
s = forall a. Stream (Arrival a) -> Int -> GeneratorBlock (Transact a)
streamGeneratorBlock Stream (Arrival a)
s Int
0

-- | Return a generator block by the specified signal and priority computation.
signalGeneratorBlockM :: Signal (Arrival a)
                         -- ^ the input signal of data
                         -> Event Int
                         -- ^ the transact priority
                         -> GeneratorBlock (Transact a)
signalGeneratorBlockM :: forall a.
Signal (Arrival a) -> Event Int -> GeneratorBlock (Transact a)
signalGeneratorBlockM Signal (Arrival a)
s Event Int
priority =
  let handle :: Block (Transact a) () -> Arrival a -> Event ()
handle Block (Transact a) ()
block Arrival a
a =
        do Int
p <- Event Int
priority
           Transact a
t <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall a. Arrival a -> Int -> Simulation (Transact a)
newTransact Arrival a
a Int
p
           Process () -> Event ()
runProcess forall a b. (a -> b) -> a -> b
$
             do forall a. Transact a -> Process ()
takeTransact Transact a
t
                forall a b. Block a b -> a -> Process b
blockProcess Block (Transact a) ()
block Transact a
t
  in forall a. (Block a () -> Process ()) -> GeneratorBlock a
GeneratorBlock forall a b. (a -> b) -> a -> b
$ \Block (Transact a) ()
block ->
  do DisposableEvent
h <- forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
          forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal (Arrival a)
s forall a b. (a -> b) -> a -> b
$
          forall {a}. Block (Transact a) () -> Arrival a -> Event ()
handle Block (Transact a) ()
block
     forall a b. Process a -> Process b -> Process a
finallyProcess forall a. Process a
neverProcess
       (forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
h)

-- | Return a generator block by the specified signal and priority.
signalGeneratorBlock :: Signal (Arrival a)
                        -- ^ the input signal of data
                        -> Int
                        -- ^ the transact priority
                        -> GeneratorBlock (Transact a)
signalGeneratorBlock :: forall a. Signal (Arrival a) -> Int -> GeneratorBlock (Transact a)
signalGeneratorBlock Signal (Arrival a)
s = forall a.
Signal (Arrival a) -> Event Int -> GeneratorBlock (Transact a)
signalGeneratorBlockM Signal (Arrival a)
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Return a generator block by the specified signal using zero priority.
signalGeneratorBlock0 :: Signal (Arrival a)
                         -- ^ the input signal of data
                         -> GeneratorBlock (Transact a)
signalGeneratorBlock0 :: forall a. Signal (Arrival a) -> GeneratorBlock (Transact a)
signalGeneratorBlock0 Signal (Arrival a)
s = forall a. Signal (Arrival a) -> Int -> GeneratorBlock (Transact a)
signalGeneratorBlock Signal (Arrival a)
s Int
0