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

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