-- |
-- 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 :: 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) <- Stream (Arrival a) -> Process (Arrival a, Stream (Arrival a))
forall a. Stream a -> Process (a, Stream a)
runStream Stream (Arrival a)
s
           Event () -> Process ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$
             do Int
p <- Event Int
priority
                Transact a
t <- Simulation (Transact a) -> Event (Transact a)
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (Simulation (Transact a) -> Event (Transact a))
-> Simulation (Transact a) -> Event (Transact a)
forall a b. (a -> b) -> a -> b
$ Arrival a -> Int -> Simulation (Transact a)
forall a. Arrival a -> Int -> Simulation (Transact a)
newTransact Arrival a
a Int
p
                Process () -> Event ()
runProcess (Process () -> Event ()) -> Process () -> Event ()
forall a b. (a -> b) -> a -> b
$
                  do Transact a -> Process ()
forall a. Transact a -> Process ()
takeTransact Transact a
t
                     Block (Transact a) () -> Transact a -> Process ()
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 (Block (Transact a) () -> Process ())
-> GeneratorBlock (Transact a)
forall a. (Block a () -> Process ()) -> GeneratorBlock a
GeneratorBlock (Stream (Arrival a) -> Block (Transact a) () -> Process ()
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 :: Stream (Arrival a) -> Int -> GeneratorBlock (Transact a)
streamGeneratorBlock Stream (Arrival a)
s = Stream (Arrival a) -> Event Int -> GeneratorBlock (Transact a)
forall a.
Stream (Arrival a) -> Event Int -> GeneratorBlock (Transact a)
streamGeneratorBlockM Stream (Arrival a)
s (Event Int -> GeneratorBlock (Transact a))
-> (Int -> Event Int) -> Int -> GeneratorBlock (Transact a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Event Int
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Return a generator block by the specified stream using zero priority.
streamGeneratorBlock0 :: Stream (Arrival a)
                         -- ^ the input stream of data
                         -> GeneratorBlock (Transact a)
streamGeneratorBlock0 :: Stream (Arrival a) -> GeneratorBlock (Transact a)
streamGeneratorBlock0 Stream (Arrival a)
s = Stream (Arrival a) -> Int -> GeneratorBlock (Transact a)
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 :: 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 <- Simulation (Transact a) -> Event (Transact a)
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (Simulation (Transact a) -> Event (Transact a))
-> Simulation (Transact a) -> Event (Transact a)
forall a b. (a -> b) -> a -> b
$ Arrival a -> Int -> Simulation (Transact a)
forall a. Arrival a -> Int -> Simulation (Transact a)
newTransact Arrival a
a Int
p
           Process () -> Event ()
runProcess (Process () -> Event ()) -> Process () -> Event ()
forall a b. (a -> b) -> a -> b
$
             do Transact a -> Process ()
forall a. Transact a -> Process ()
takeTransact Transact a
t
                Block (Transact a) () -> Transact a -> Process ()
forall a b. Block a b -> a -> Process b
blockProcess Block (Transact a) ()
block Transact a
t
  in (Block (Transact a) () -> Process ())
-> GeneratorBlock (Transact a)
forall a. (Block a () -> Process ()) -> GeneratorBlock a
GeneratorBlock ((Block (Transact a) () -> Process ())
 -> GeneratorBlock (Transact a))
-> (Block (Transact a) () -> Process ())
-> GeneratorBlock (Transact a)
forall a b. (a -> b) -> a -> b
$ \Block (Transact a) ()
block ->
  do DisposableEvent
h <- Event DisposableEvent -> Process DisposableEvent
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event DisposableEvent -> Process DisposableEvent)
-> Event DisposableEvent -> Process DisposableEvent
forall a b. (a -> b) -> a -> b
$
          Signal (Arrival a)
-> (Arrival a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal (Arrival a)
s ((Arrival a -> Event ()) -> Event DisposableEvent)
-> (Arrival a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$
          Block (Transact a) () -> Arrival a -> Event ()
forall a. Block (Transact a) () -> Arrival a -> Event ()
handle Block (Transact a) ()
block
     Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process a
finallyProcess Process ()
forall a. Process a
neverProcess
       (Event () -> Process ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
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 :: Signal (Arrival a) -> Int -> GeneratorBlock (Transact a)
signalGeneratorBlock Signal (Arrival a)
s = Signal (Arrival a) -> Event Int -> GeneratorBlock (Transact a)
forall a.
Signal (Arrival a) -> Event Int -> GeneratorBlock (Transact a)
signalGeneratorBlockM Signal (Arrival a)
s (Event Int -> GeneratorBlock (Transact a))
-> (Int -> Event Int) -> Int -> GeneratorBlock (Transact a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Event Int
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 :: Signal (Arrival a) -> GeneratorBlock (Transact a)
signalGeneratorBlock0 Signal (Arrival a)
s = Signal (Arrival a) -> Int -> GeneratorBlock (Transact a)
forall a. Signal (Arrival a) -> Int -> GeneratorBlock (Transact a)
signalGeneratorBlock Signal (Arrival a)
s Int
0