-- |
-- Module     : Simulation.Aivika.Trans.Net
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The module defines a 'Net' arrow that can be applied to modeling the queue networks
-- like the 'Processor' arrow from another module. Only the former has a more efficient
-- implementation of the 'Arrow' interface than the latter, although at the cost of
-- some decreasing in generality.
--
-- While the @Processor@ type is just a function that transforms the input 'Stream' into another,
-- the @Net@ type is actually an automaton that has an implementation very similar to that one
-- which the 'Circuit' type has, only the computations occur in the 'Process' monad. But unlike
-- the @Circuit@ type, the @Net@ type doesn't allow declaring recursive definitions, being based on
-- continuations.
--
-- In a nutshell, the @Net@ type is an interchangeable alternative to the @Processor@ type
-- with its weaknesses and strengths. The @Net@ arrow is useful for constructing computations
-- with help of the proc-notation to be transformed then to the @Processor@ computations that
-- are more general in nature and more easy-to-use but which computations created with help of
-- the proc-notation are not so efficient.
--
module Simulation.Aivika.Trans.Net
       (-- * Net Arrow
        Net(..),
        iterateNet,
        iterateNetMaybe,
        iterateNetEither,
        -- * Net Primitives
        emptyNet,
        arrNet,
        accumNet,
        withinNet,
        -- * Specifying Identifier
        netUsingId,
        -- * Arrival Net
        arrivalNet,
        -- * Delaying Net
        delayNet,
        -- * Interchanging Nets with Processors
        netProcessor,
        processorNet,
        -- * Debugging
        traceNet) where

import qualified Control.Category as C
import Control.Arrow
import Control.Monad.Trans

import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Parameter
import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Dynamics
import Simulation.Aivika.Trans.Event
import Simulation.Aivika.Trans.Cont
import Simulation.Aivika.Trans.Process
import Simulation.Aivika.Trans.Stream
import Simulation.Aivika.Trans.QueueStrategy
import Simulation.Aivika.Trans.Resource.Base
import Simulation.Aivika.Trans.Processor
import Simulation.Aivika.Trans.Circuit
import Simulation.Aivika.Arrival (Arrival(..))

-- | Represents the net as an automaton working within the 'Process' computation.
newtype Net m a b =
  Net { forall (m :: * -> *) a b.
Net m a b -> a -> Process m (b, Net m a b)
runNet :: a -> Process m (b, Net m a b)
        -- ^ Run the net.
      }

instance MonadDES m => C.Category (Net m) where

  {-# INLINABLE id #-}
  id :: forall a. Net m a a
id = forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
C.id)

  {-# INLINABLE (.) #-}
  . :: forall b c a. Net m b c -> Net m a b -> Net m a c
(.) = forall {m :: * -> *} {a} {b} {a}.
MonadDES m =>
Net m a b -> Net m a a -> Net m a b
dot
    where 
      (Net a -> Process m (b, Net m a b)
g) dot :: Net m a b -> Net m a a -> Net m a b
`dot` (Net a -> Process m (a, Net m a a)
f) =
        forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \a
a ->
        do (a
b, Net m a a
p1) <- a -> Process m (a, Net m a a)
f a
a
           (b
c, Net m a b
p2) <- a -> Process m (b, Net m a b)
g a
b
           forall (m :: * -> *) a. Monad m => a -> m a
return (b
c, Net m a b
p2 Net m a b -> Net m a a -> Net m a b
`dot` Net m a a
p1)

instance MonadDES m => Arrow (Net m) where

  {-# INLINABLE arr #-}
  arr :: forall b c. (b -> c) -> Net m b c
arr b -> c
f = forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \b
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (b -> c
f b
a, forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f)

  {-# INLINABLE first #-}
  first :: forall b c d. Net m b c -> Net m (b, d) (c, d)
first (Net b -> Process m (c, Net m b c)
f) =
    forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \(b
b, d
d) ->
    do (c
c, Net m b c
p) <- b -> Process m (c, Net m b c)
f b
b
       forall (m :: * -> *) a. Monad m => a -> m a
return ((c
c, d
d), forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Net m b c
p)

  {-# INLINABLE second #-}
  second :: forall b c d. Net m b c -> Net m (d, b) (d, c)
second (Net b -> Process m (c, Net m b c)
f) =
    forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \(d
d, b
b) ->
    do (c
c, Net m b c
p) <- b -> Process m (c, Net m b c)
f b
b
       forall (m :: * -> *) a. Monad m => a -> m a
return ((d
d, c
c), forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Net m b c
p)

  {-# INLINABLE (***) #-}
  (Net b -> Process m (c, Net m b c)
f) *** :: forall b c b' c'. Net m b c -> Net m b' c' -> Net m (b, b') (c, c')
*** (Net b' -> Process m (c', Net m b' c')
g) =
    forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \(b
b, b'
b') ->
    do ((c
c, Net m b c
p1), (c'
c', Net m b' c'
p2)) <- forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m (a, b)
zipProcessParallel (b -> Process m (c, Net m b c)
f b
b) (b' -> Process m (c', Net m b' c')
g b'
b')
       forall (m :: * -> *) a. Monad m => a -> m a
return ((c
c, c'
c'), Net m b c
p1 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Net m b' c'
p2)
       
  {-# INLINABLE (&&&) #-}
  (Net b -> Process m (c, Net m b c)
f) &&& :: forall b c c'. Net m b c -> Net m b c' -> Net m b (c, c')
&&& (Net b -> Process m (c', Net m b c')
g) =
    forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \b
b ->
    do ((c
c, Net m b c
p1), (c'
c', Net m b c'
p2)) <- forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m (a, b)
zipProcessParallel (b -> Process m (c, Net m b c)
f b
b) (b -> Process m (c', Net m b c')
g b
b)
       forall (m :: * -> *) a. Monad m => a -> m a
return ((c
c, c'
c'), Net m b c
p1 forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Net m b c'
p2)

instance MonadDES m => ArrowChoice (Net m) where

  {-# INLINABLE left #-}
  left :: forall b c d. Net m b c -> Net m (Either b d) (Either c d)
left x :: Net m b c
x@(Net b -> Process m (c, Net m b c)
f) =
    forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \Either b d
ebd ->
    case Either b d
ebd of
      Left b
b ->
        do (c
c, Net m b c
p) <- b -> Process m (c, Net m b c)
f b
b
           forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left c
c, forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Net m b c
p)
      Right d
d ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right d
d, forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Net m b c
x)

  {-# INLINABLE right #-}
  right :: forall b c d. Net m b c -> Net m (Either d b) (Either d c)
right x :: Net m b c
x@(Net b -> Process m (c, Net m b c)
f) =
    forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \Either d b
edb ->
    case Either d b
edb of
      Right b
b ->
        do (c
c, Net m b c
p) <- b -> Process m (c, Net m b c)
f b
b
           forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right c
c, forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right Net m b c
p)
      Left d
d ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left d
d, forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right Net m b c
x)

  {-# INLINABLE (+++) #-}
  x :: Net m b c
x@(Net b -> Process m (c, Net m b c)
f) +++ :: forall b c b' c'.
Net m b c -> Net m b' c' -> Net m (Either b b') (Either c c')
+++ y :: Net m b' c'
y@(Net b' -> Process m (c', Net m b' c')
g) =
    forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \Either b b'
ebb' ->
    case Either b b'
ebb' of
      Left b
b ->
        do (c
c, Net m b c
p1) <- b -> Process m (c, Net m b c)
f b
b
           forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left c
c, Net m b c
p1 forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ Net m b' c'
y)
      Right b'
b' ->
        do (c'
c', Net m b' c'
p2) <- b' -> Process m (c', Net m b' c')
g b'
b'
           forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right c'
c', Net m b c
x forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ Net m b' c'
p2)

  {-# INLINABLE (|||) #-}
  x :: Net m b d
x@(Net b -> Process m (d, Net m b d)
f) ||| :: forall b d c. Net m b d -> Net m c d -> Net m (Either b c) d
||| y :: Net m c d
y@(Net c -> Process m (d, Net m c d)
g) =
    forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \Either b c
ebc ->
    case Either b c
ebc of
      Left b
b ->
        do (d
d, Net m b d
p1) <- b -> Process m (d, Net m b d)
f b
b
           forall (m :: * -> *) a. Monad m => a -> m a
return (d
d, Net m b d
p1 forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Net m c d
y)
      Right c
b' ->
        do (d
d, Net m c d
p2) <- c -> Process m (d, Net m c d)
g c
b'
           forall (m :: * -> *) a. Monad m => a -> m a
return (d
d, Net m b d
x forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Net m c d
p2)

-- | A net that never finishes its work.
emptyNet :: MonadDES m => Net m a b
{-# INLINABLE emptyNet #-}
emptyNet :: forall (m :: * -> *) a b. MonadDES m => Net m a b
emptyNet = forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadDES m => Process m a
neverProcess

-- | Create a simple net by the specified handling function
-- that runs the discontinuous process for each input value to get an output.
arrNet :: MonadDES m => (a -> Process m b) -> Net m a b
{-# INLINABLE arrNet #-}
arrNet :: forall (m :: * -> *) a b.
MonadDES m =>
(a -> Process m b) -> Net m a b
arrNet a -> Process m b
f =
  let x :: Net m a b
x =
        forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \a
a ->
        do b
b <- a -> Process m b
f a
a
           forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Net m a b
x)
  in Net m a b
x

-- | Accumulator that outputs a value determined by the supplied function.
accumNet :: MonadDES m => (acc -> a -> Process m (acc, b)) -> acc -> Net m a b
{-# INLINABLE accumNet #-}
accumNet :: forall (m :: * -> *) acc a b.
MonadDES m =>
(acc -> a -> Process m (acc, b)) -> acc -> Net m a b
accumNet acc -> a -> Process m (acc, b)
f acc
acc =
  forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \a
a ->
  do (acc
acc', b
b) <- acc -> a -> Process m (acc, b)
f acc
acc a
a
     forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, forall (m :: * -> *) acc a b.
MonadDES m =>
(acc -> a -> Process m (acc, b)) -> acc -> Net m a b
accumNet acc -> a -> Process m (acc, b)
f acc
acc') 

-- | Involve the computation with side effect when processing the input.
withinNet :: MonadDES m => Process m () -> Net m a a
{-# INLINABLE withinNet #-}
withinNet :: forall (m :: * -> *) a. MonadDES m => Process m () -> Net m a a
withinNet Process m ()
m =
  forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \a
a ->
  do { Process m ()
m; forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, forall (m :: * -> *) a. MonadDES m => Process m () -> Net m a a
withinNet Process m ()
m) }

-- | Create a net that will use the specified process identifier.
-- It can be useful to refer to the underlying 'Process' computation which
-- can be passivated, interrupted, canceled and so on. See also the
-- 'processUsingId' function for more details.
netUsingId :: MonadDES m => ProcessId m -> Net m a b -> Net m a b
{-# INLINABLE netUsingId #-}
netUsingId :: forall (m :: * -> *) a b.
MonadDES m =>
ProcessId m -> Net m a b -> Net m a b
netUsingId ProcessId m
pid (Net a -> Process m (b, Net m a b)
f) =
  forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ProcessId m -> Process m a -> Process m a
processUsingId ProcessId m
pid forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Process m (b, Net m a b)
f

-- | Transform the net to an equivalent processor (a rather cheap transformation).
netProcessor :: MonadDES m => Net m a b -> Processor m a b
{-# INLINABLE netProcessor #-}
netProcessor :: forall (m :: * -> *) a b.
MonadDES m =>
Net m a b -> Processor m a b
netProcessor = forall (m :: * -> *) a b.
(Stream m a -> Stream m b) -> Processor m a b
Processor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *} {a} {a}.
MonadDES m =>
Net m a a -> Stream m a -> Stream m a
loop
  where loop :: Net m a a -> Stream m a -> Stream m a
loop Net m a a
x Stream m a
as =
          forall (m :: * -> *) a. Process m (a, Stream m a) -> Stream m a
Cons forall a b. (a -> b) -> a -> b
$
          do (a
a, Stream m a
as') <- forall (m :: * -> *) a. Stream m a -> Process m (a, Stream m a)
runStream Stream m a
as
             (a
b, Net m a a
x') <- forall (m :: * -> *) a b.
Net m a b -> a -> Process m (b, Net m a b)
runNet Net m a a
x a
a
             forall (m :: * -> *) a. Monad m => a -> m a
return (a
b, Net m a a -> Stream m a -> Stream m a
loop Net m a a
x' Stream m a
as')

-- | Transform the processor to a similar net (a more costly transformation).
processorNet :: MonadDES m => Processor m a b -> Net m a b
{-# INLINABLE processorNet #-}
processorNet :: forall (m :: * -> *) a b.
MonadDES m =>
Processor m a b -> Net m a b
processorNet Processor m a b
x =
  forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \a
a ->
  do Resource m FCFS
readingA <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS Int
0 (forall a. a -> Maybe a
Just Int
1)
     Resource m FCFS
writingA <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS Int
1 (forall a. a -> Maybe a
Just Int
1)
     Resource m FCFS
readingB <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS Int
0 (forall a. a -> Maybe a
Just Int
1)
     Resource m FCFS
writingB <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS Int
1 (forall a. a -> Maybe a
Just Int
1)
     Resource m FCFS
conting  <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS Int
0 (forall a. a -> Maybe a
Just Int
1)
     Ref m (Maybe a)
refA <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
     Ref m (Maybe b)
refB <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
     let input :: Process m (a, Stream m a)
input =
           do forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m FCFS
readingA
              Just a
a <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe a)
refA
              forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe a)
refA forall a. Maybe a
Nothing
              forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m FCFS
writingA
              forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, forall (m :: * -> *) a. Process m (a, Stream m a) -> Stream m a
Cons Process m (a, Stream m a)
input)
         consume :: Stream m b -> Process m b
consume Stream m b
bs =
           do (b
b, Stream m b
bs') <- forall (m :: * -> *) a. Stream m a -> Process m (a, Stream m a)
runStream Stream m b
bs
              forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m FCFS
writingB
              forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe b)
refB (forall a. a -> Maybe a
Just b
b)
              forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m FCFS
readingB
              forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m FCFS
conting
              Stream m b -> Process m b
consume Stream m b
bs'
         loop :: a -> Process m (b, Net m a b)
loop a
a =
           do forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m FCFS
writingA
              forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe a)
refA (forall a. a -> Maybe a
Just a
a)
              forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m FCFS
readingA
              forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m FCFS
readingB
              Just b
b <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe b)
refB
              forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe b)
refB forall a. Maybe a
Nothing
              forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m FCFS
writingB
              forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \a
a -> forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m FCFS
conting forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Process m (b, Net m a b)
loop a
a)
     forall (m :: * -> *). MonadDES m => Process m () -> Process m ()
spawnProcess forall a b. (a -> b) -> a -> b
$
       forall {b}. Stream m b -> Process m b
consume forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Processor m a b -> Stream m a -> Stream m b
runProcessor Processor m a b
x (forall (m :: * -> *) a. Process m (a, Stream m a) -> Stream m a
Cons Process m (a, Stream m a)
input)
     a -> Process m (b, Net m a b)
loop a
a

-- | A net that adds the information about the time points at which 
-- the values were received.
arrivalNet :: MonadDES m => Net m a (Arrival a)
{-# INLINABLE arrivalNet #-}
arrivalNet :: forall (m :: * -> *) a. MonadDES m => Net m a (Arrival a)
arrivalNet =
  let loop :: Maybe Double -> Net m a (Arrival a)
loop Maybe Double
t0 =
        forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \a
a ->
        do Double
t <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
DynamicsLift t m =>
Dynamics m a -> t m a
liftDynamics forall (m :: * -> *). Monad m => Dynamics m Double
time
           let b :: Arrival a
b = Arrival { arrivalValue :: a
arrivalValue = a
a,
                             arrivalTime :: Double
arrivalTime  = Double
t,
                             arrivalDelay :: Maybe Double
arrivalDelay = 
                               case Maybe Double
t0 of
                                 Maybe Double
Nothing -> forall a. Maybe a
Nothing
                                 Just Double
t0 -> forall a. a -> Maybe a
Just (Double
t forall a. Num a => a -> a -> a
- Double
t0) }
           forall (m :: * -> *) a. Monad m => a -> m a
return (Arrival a
b, Maybe Double -> Net m a (Arrival a)
loop forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Double
t)
  in forall {m :: * -> *} {a}.
MonadDES m =>
Maybe Double -> Net m a (Arrival a)
loop forall a. Maybe a
Nothing

-- | Delay the input by one step using the specified initial value.
delayNet :: MonadDES m => a -> Net m a a
{-# INLINABLE delayNet #-}
delayNet :: forall (m :: * -> *) a. MonadDES m => a -> Net m a a
delayNet a
a0 =
  forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ \a
a ->
  forall (m :: * -> *) a. Monad m => a -> m a
return (a
a0, forall (m :: * -> *) a. MonadDES m => a -> Net m a a
delayNet a
a)

-- | Iterate infinitely using the specified initial value.
iterateNet :: MonadDES m => Net m a a -> a -> Process m ()
{-# INLINABLE iterateNet #-}
iterateNet :: forall (m :: * -> *) a.
MonadDES m =>
Net m a a -> a -> Process m ()
iterateNet (Net a -> Process m (a, Net m a a)
f) a
a =
  do (a
a', Net m a a
x) <- a -> Process m (a, Net m a a)
f a
a
     forall (m :: * -> *) a.
MonadDES m =>
Net m a a -> a -> Process m ()
iterateNet Net m a a
x a
a'

-- | Iterate the net using the specified initial value
-- until 'Nothing' is returned within the 'Net' computation.
iterateNetMaybe :: MonadDES m => Net m a (Maybe a) -> a -> Process m ()
{-# INLINABLE iterateNetMaybe #-}
iterateNetMaybe :: forall (m :: * -> *) a.
MonadDES m =>
Net m a (Maybe a) -> a -> Process m ()
iterateNetMaybe (Net a -> Process m (Maybe a, Net m a (Maybe a))
f) a
a =
  do (Maybe a
a', Net m a (Maybe a)
x) <- a -> Process m (Maybe a, Net m a (Maybe a))
f a
a
     case Maybe a
a' of
       Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just a
a' -> forall (m :: * -> *) a.
MonadDES m =>
Net m a (Maybe a) -> a -> Process m ()
iterateNetMaybe Net m a (Maybe a)
x a
a'

-- | Iterate the net using the specified initial value
-- until the 'Left' result is returned within the 'Net' computation.
iterateNetEither :: MonadDES m => Net m a (Either b a) -> a -> Process m b
{-# INLINABLE iterateNetEither #-}
iterateNetEither :: forall (m :: * -> *) a b.
MonadDES m =>
Net m a (Either b a) -> a -> Process m b
iterateNetEither (Net a -> Process m (Either b a, Net m a (Either b a))
f) a
a =
  do (Either b a
ba', Net m a (Either b a)
x) <- a -> Process m (Either b a, Net m a (Either b a))
f a
a
     case Either b a
ba' of
       Left b
b'  -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b'
       Right a
a' -> forall (m :: * -> *) a b.
MonadDES m =>
Net m a (Either b a) -> a -> Process m b
iterateNetEither Net m a (Either b a)
x a
a'

-- | Show the debug messages with the current simulation time.
traceNet :: MonadDES m
            => Maybe String
            -- ^ the request message
            -> Maybe String
            -- ^ the response message
            -> Net m a b
            -- ^ a net
            -> Net m a b
{-# INLINABLE traceNet #-}
traceNet :: forall (m :: * -> *) a b.
MonadDES m =>
Maybe String -> Maybe String -> Net m a b -> Net m a b
traceNet Maybe String
request Maybe String
response Net m a b
x = forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {b}.
MonadDES m =>
Net m a b -> a -> Process m (b, Net m a b)
loop Net m a b
x where
  loop :: Net m a b -> a -> Process m (b, Net m a b)
loop Net m a b
x a
a =
    do (b
b, Net m a b
x') <-
         case Maybe String
request of
           Maybe String
Nothing -> forall (m :: * -> *) a b.
Net m a b -> a -> Process m (b, Net m a b)
runNet Net m a b
x a
a
           Just String
message -> 
             forall (m :: * -> *) a.
MonadDES m =>
String -> Process m a -> Process m a
traceProcess String
message forall a b. (a -> b) -> a -> b
$
             forall (m :: * -> *) a b.
Net m a b -> a -> Process m (b, Net m a b)
runNet Net m a b
x a
a
       case Maybe String
response of
         Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ Net m a b -> a -> Process m (b, Net m a b)
loop Net m a b
x')
         Just String
message ->
           forall (m :: * -> *) a.
MonadDES m =>
String -> Process m a -> Process m a
traceProcess String
message forall a b. (a -> b) -> a -> b
$
           forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net forall a b. (a -> b) -> a -> b
$ Net m a b -> a -> Process m (b, Net m a b)
loop Net m a b
x')