-- |
-- Module     : Simulation.Aivika.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.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 Data.IORef

import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Event
import Simulation.Aivika.Cont
import Simulation.Aivika.Process
import Simulation.Aivika.Stream
import Simulation.Aivika.QueueStrategy
import Simulation.Aivika.Resource.Base
import Simulation.Aivika.Processor
import Simulation.Aivika.Ref
import Simulation.Aivika.Circuit
import Simulation.Aivika.Internal.Arrival

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

instance C.Category Net where

  id :: forall a. Net a a
id = forall a b. (a -> Process (b, Net a b)) -> Net 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)

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

instance Arrow Net where

  arr :: forall b c. (b -> c) -> Net b c
arr b -> c
f = forall a b. (a -> Process (b, Net a b)) -> Net 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)

  first :: forall b c d. Net b c -> Net (b, d) (c, d)
first (Net b -> Process (c, Net b c)
f) =
    forall a b. (a -> Process (b, Net a b)) -> Net a b
Net forall a b. (a -> b) -> a -> b
$ \(b
b, d
d) ->
    do (c
c, Net b c
p) <- b -> Process (c, Net 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 b c
p)

  second :: forall b c d. Net b c -> Net (d, b) (d, c)
second (Net b -> Process (c, Net b c)
f) =
    forall a b. (a -> Process (b, Net a b)) -> Net a b
Net forall a b. (a -> b) -> a -> b
$ \(d
d, b
b) ->
    do (c
c, Net b c
p) <- b -> Process (c, Net 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 b c
p)

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

instance ArrowChoice Net where

  left :: forall b c d. Net b c -> Net (Either b d) (Either c d)
left x :: Net b c
x@(Net b -> Process (c, Net b c)
f) =
    forall a b. (a -> Process (b, Net a b)) -> Net 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 b c
p) <- b -> Process (c, Net 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 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 b c
x)

  right :: forall b c d. Net b c -> Net (Either d b) (Either d c)
right x :: Net b c
x@(Net b -> Process (c, Net b c)
f) =
    forall a b. (a -> Process (b, Net a b)) -> Net 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 b c
p) <- b -> Process (c, Net 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 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 b c
x)

  x :: Net b c
x@(Net b -> Process (c, Net b c)
f) +++ :: forall b c b' c'.
Net b c -> Net b' c' -> Net (Either b b') (Either c c')
+++ y :: Net b' c'
y@(Net b' -> Process (c', Net b' c')
g) =
    forall a b. (a -> Process (b, Net a b)) -> Net 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 b c
p1) <- b -> Process (c, Net 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 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 b' c'
y)
      Right b'
b' ->
        do (c'
c', Net b' c'
p2) <- b' -> Process (c', Net 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 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 b' c'
p2)

  x :: Net b d
x@(Net b -> Process (d, Net b d)
f) ||| :: forall b d c. Net b d -> Net c d -> Net (Either b c) d
||| y :: Net c d
y@(Net c -> Process (d, Net c d)
g) =
    forall a b. (a -> Process (b, Net a b)) -> Net 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 b d
p1) <- b -> Process (d, Net b d)
f b
b
           forall (m :: * -> *) a. Monad m => a -> m a
return (d
d, Net b d
p1 forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Net c d
y)
      Right c
b' ->
        do (d
d, Net c d
p2) <- c -> Process (d, Net c d)
g c
b'
           forall (m :: * -> *) a. Monad m => a -> m a
return (d
d, Net b d
x forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Net c d
p2)

-- | A net that never finishes its work.
emptyNet :: Net a b
emptyNet :: forall a b. Net a b
emptyNet = forall a b. (a -> Process (b, Net a b)) -> Net a b
Net forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. Process 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 :: (a -> Process b) -> Net a b
arrNet :: forall a b. (a -> Process b) -> Net a b
arrNet a -> Process b
f =
  let x :: Net a b
x =
        forall a b. (a -> Process (b, Net a b)) -> Net a b
Net forall a b. (a -> b) -> a -> b
$ \a
a ->
        do b
b <- a -> Process b
f a
a
           forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Net a b
x)
  in Net a b
x

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

-- | Involve the computation with side effect when processing the input.
withinNet :: Process () -> Net a a
withinNet :: forall a. Process () -> Net a a
withinNet Process ()
m =
  forall a b. (a -> Process (b, Net a b)) -> Net a b
Net forall a b. (a -> b) -> a -> b
$ \a
a ->
  do { Process ()
m; forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, forall a. Process () -> Net a a
withinNet Process ()
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 :: ProcessId -> Net a b -> Net a b
netUsingId :: forall a b. ProcessId -> Net a b -> Net a b
netUsingId ProcessId
pid (Net a -> Process (b, Net a b)
f) =
  forall a b. (a -> Process (b, Net a b)) -> Net a b
Net forall a b. (a -> b) -> a -> b
$ forall a. ProcessId -> Process a -> Process a
processUsingId ProcessId
pid forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Process (b, Net a b)
f

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

-- | Transform the processor to a similar net (a more costly transformation).
processorNet :: Processor a b -> Net a b
processorNet :: forall a b. Processor a b -> Net a b
processorNet Processor a b
x =
  forall a b. (a -> Process (b, Net a b)) -> Net a b
Net forall a b. (a -> b) -> a -> b
$ \a
a ->
  do Resource FCFS
readingA <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS Int
0 (forall a. a -> Maybe a
Just Int
1)
     Resource FCFS
writingA <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS Int
1 (forall a. a -> Maybe a
Just Int
1)
     Resource FCFS
readingB <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS Int
0 (forall a. a -> Maybe a
Just Int
1)
     Resource FCFS
writingB <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS Int
1 (forall a. a -> Maybe a
Just Int
1)
     Resource FCFS
conting  <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS Int
0 (forall a. a -> Maybe a
Just Int
1)
     IORef (Maybe a)
refA <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     IORef (Maybe b)
refB <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     let input :: Process (a, Stream a)
input =
           do forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource FCFS
readingA
              Just a
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (Maybe a)
refA
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
refA forall a. Maybe a
Nothing
              forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource FCFS
writingA
              forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, forall a. Process (a, Stream a) -> Stream a
Cons Process (a, Stream a)
input)
         consume :: Stream b -> Process b
consume Stream b
bs =
           do (b
b, Stream b
bs') <- forall a. Stream a -> Process (a, Stream a)
runStream Stream b
bs
              forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource FCFS
writingB
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe b)
refB (forall a. a -> Maybe a
Just b
b)
              forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource FCFS
readingB
              forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource FCFS
conting
              Stream b -> Process b
consume Stream b
bs'
         loop :: a -> Process (b, Net a b)
loop a
a =
           do forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource FCFS
writingA
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
refA (forall a. a -> Maybe a
Just a
a)
              forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource FCFS
readingA
              forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource FCFS
readingB
              Just b
b <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (Maybe b)
refB
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe b)
refB forall a. Maybe a
Nothing
              forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource FCFS
writingB
              forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, forall a b. (a -> Process (b, Net a b)) -> Net a b
Net forall a b. (a -> b) -> a -> b
$ \a
a -> forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource FCFS
conting forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Process (b, Net a b)
loop a
a)
     Process () -> Process ()
spawnProcess forall a b. (a -> b) -> a -> b
$
       forall {b}. Stream b -> Process b
consume forall a b. (a -> b) -> a -> b
$ forall a b. Processor a b -> Stream a -> Stream b
runProcessor Processor a b
x (forall a. Process (a, Stream a) -> Stream a
Cons Process (a, Stream a)
input)
     a -> Process (b, Net a b)
loop a
a

-- | A net that adds the information about the time points at which 
-- the values were received.
arrivalNet :: Net a (Arrival a)
arrivalNet :: forall a. Net a (Arrival a)
arrivalNet =
  let loop :: Maybe Double -> Net a (Arrival a)
loop Maybe Double
t0 =
        forall a b. (a -> Process (b, Net a b)) -> Net a b
Net forall a b. (a -> b) -> a -> b
$ \a
a ->
        do Double
t <- forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics 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 a (Arrival a)
loop forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Double
t)
  in forall {a}. Maybe Double -> Net a (Arrival a)
loop forall a. Maybe a
Nothing

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

-- | Iterate infinitely using the specified initial value.
iterateNet :: Net a a -> a -> Process ()
iterateNet :: forall a. Net a a -> a -> Process ()
iterateNet (Net a -> Process (a, Net a a)
f) a
a =
  do (a
a', Net a a
x) <- a -> Process (a, Net a a)
f a
a
     forall a. Net a a -> a -> Process ()
iterateNet Net a a
x a
a'

-- | Iterate the net using the specified initial value
-- until 'Nothing' is returned within the 'Net' computation.
iterateNetMaybe :: Net a (Maybe a) -> a -> Process ()
iterateNetMaybe :: forall a. Net a (Maybe a) -> a -> Process ()
iterateNetMaybe (Net a -> Process (Maybe a, Net a (Maybe a))
f) a
a =
  do (Maybe a
a', Net a (Maybe a)
x) <- a -> Process (Maybe a, Net 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 a. Net a (Maybe a) -> a -> Process ()
iterateNetMaybe Net 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 :: Net a (Either b a) -> a -> Process b
iterateNetEither :: forall a b. Net a (Either b a) -> a -> Process b
iterateNetEither (Net a -> Process (Either b a, Net a (Either b a))
f) a
a =
  do (Either b a
ba', Net a (Either b a)
x) <- a -> Process (Either b a, Net 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 a b. Net a (Either b a) -> a -> Process b
iterateNetEither Net a (Either b a)
x a
a'

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