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

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

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

-- | Return a generator block by the specified stream and priority.
streamGeneratorBlock :: MonadDES m
                        => Stream m (Arrival a)
                        -- ^ the input stream of data
                        -> Int
                        -- ^ the transact priority
                        -> GeneratorBlock m (Transact m a)
{-# INLINABLE streamGeneratorBlock #-}
streamGeneratorBlock :: Stream m (Arrival a) -> Int -> GeneratorBlock m (Transact m a)
streamGeneratorBlock Stream m (Arrival a)
s = Stream m (Arrival a)
-> Event m Int -> GeneratorBlock m (Transact m a)
forall (m :: * -> *) a.
MonadDES m =>
Stream m (Arrival a)
-> Event m Int -> GeneratorBlock m (Transact m a)
streamGeneratorBlockM Stream m (Arrival a)
s (Event m Int -> GeneratorBlock m (Transact m a))
-> (Int -> Event m Int) -> Int -> GeneratorBlock m (Transact m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Event m Int
forall (m :: * -> *) a. Monad m => a -> m a
return

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

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

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

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