-- |
-- 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 { 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 :: Net m a a
id = (a -> Process m (a, Net m a a)) -> Net m a a
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (a, Net m a a)) -> Net m a a)
-> (a -> Process m (a, Net m a a)) -> Net m a a
forall a b. (a -> b) -> a -> b
$ \a
a -> (a, Net m a a) -> Process m (a, Net m a a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Net m a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
C.id)

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

  {-# INLINABLE first #-}
  first :: Net m b c -> Net m (b, d) (c, d)
first (Net b -> Process m (c, Net m b c)
f) =
    ((b, d) -> Process m ((c, d), Net m (b, d) (c, d)))
-> Net m (b, d) (c, d)
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net (((b, d) -> Process m ((c, d), Net m (b, d) (c, d)))
 -> Net m (b, d) (c, d))
-> ((b, d) -> Process m ((c, d), Net m (b, d) (c, d)))
-> Net m (b, d) (c, d)
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
       ((c, d), Net m (b, d) (c, d))
-> Process m ((c, d), Net m (b, d) (c, d))
forall (m :: * -> *) a. Monad m => a -> m a
return ((c
c, d
d), Net m b c -> Net m (b, d) (c, 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 :: Net m b c -> Net m (d, b) (d, c)
second (Net b -> Process m (c, Net m b c)
f) =
    ((d, b) -> Process m ((d, c), Net m (d, b) (d, c)))
-> Net m (d, b) (d, c)
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net (((d, b) -> Process m ((d, c), Net m (d, b) (d, c)))
 -> Net m (d, b) (d, c))
-> ((d, b) -> Process m ((d, c), Net m (d, b) (d, c)))
-> Net m (d, b) (d, c)
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
       ((d, c), Net m (d, b) (d, c))
-> Process m ((d, c), Net m (d, b) (d, c))
forall (m :: * -> *) a. Monad m => a -> m a
return ((d
d, c
c), Net m b c -> Net m (d, b) (d, 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) *** :: Net m b c -> Net m b' c' -> Net m (b, b') (c, c')
*** (Net b' -> Process m (c', Net m b' c')
g) =
    ((b, b') -> Process m ((c, c'), Net m (b, b') (c, c')))
-> Net m (b, b') (c, c')
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net (((b, b') -> Process m ((c, c'), Net m (b, b') (c, c')))
 -> Net m (b, b') (c, c'))
-> ((b, b') -> Process m ((c, c'), Net m (b, b') (c, c')))
-> Net m (b, b') (c, c')
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)) <- Process m (c, Net m b c)
-> Process m (c', Net m b' c')
-> Process m ((c, Net m b c), (c', Net m b' c'))
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')
       ((c, c'), Net m (b, b') (c, c'))
-> Process m ((c, c'), Net m (b, b') (c, c'))
forall (m :: * -> *) a. Monad m => a -> m a
return ((c
c, c'
c'), Net m b c
p1 Net m b c -> Net m b' c' -> Net m (b, b') (c, c')
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) &&& :: Net m b c -> Net m b c' -> Net m b (c, c')
&&& (Net b -> Process m (c', Net m b c')
g) =
    (b -> Process m ((c, c'), Net m b (c, c'))) -> Net m b (c, c')
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((b -> Process m ((c, c'), Net m b (c, c'))) -> Net m b (c, c'))
-> (b -> Process m ((c, c'), Net m b (c, c'))) -> Net m b (c, c')
forall a b. (a -> b) -> a -> b
$ \b
b ->
    do ((c
c, Net m b c
p1), (c'
c', Net m b c'
p2)) <- Process m (c, Net m b c)
-> Process m (c', Net m b c')
-> Process m ((c, Net m b c), (c', Net m b c'))
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)
       ((c, c'), Net m b (c, c')) -> Process m ((c, c'), Net m b (c, c'))
forall (m :: * -> *) a. Monad m => a -> m a
return ((c
c, c'
c'), Net m b c
p1 Net m b c -> Net m b c' -> Net m b (c, c')
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 :: 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) =
    (Either b d
 -> Process m (Either c d, Net m (Either b d) (Either c d)))
-> Net m (Either b d) (Either c d)
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((Either b d
  -> Process m (Either c d, Net m (Either b d) (Either c d)))
 -> Net m (Either b d) (Either c d))
-> (Either b d
    -> Process m (Either c d, Net m (Either b d) (Either c d)))
-> Net m (Either b d) (Either c d)
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
           (Either c d, Net m (Either b d) (Either c d))
-> Process m (Either c d, Net m (Either b d) (Either c d))
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Either c d
forall a b. a -> Either a b
Left c
c, Net m b c -> Net m (Either b d) (Either c d)
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 ->
        (Either c d, Net m (Either b d) (Either c d))
-> Process m (Either c d, Net m (Either b d) (Either c d))
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> Either c d
forall a b. b -> Either a b
Right d
d, Net m b c -> Net m (Either b d) (Either c 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 :: 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) =
    (Either d b
 -> Process m (Either d c, Net m (Either d b) (Either d c)))
-> Net m (Either d b) (Either d c)
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((Either d b
  -> Process m (Either d c, Net m (Either d b) (Either d c)))
 -> Net m (Either d b) (Either d c))
-> (Either d b
    -> Process m (Either d c, Net m (Either d b) (Either d c)))
-> Net m (Either d b) (Either d c)
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
           (Either d c, Net m (Either d b) (Either d c))
-> Process m (Either d c, Net m (Either d b) (Either d c))
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Either d c
forall a b. b -> Either a b
Right c
c, Net m b c -> Net m (Either d b) (Either d 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 ->
        (Either d c, Net m (Either d b) (Either d c))
-> Process m (Either d c, Net m (Either d b) (Either d c))
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> Either d c
forall a b. a -> Either a b
Left d
d, Net m b c -> Net m (Either d b) (Either d c)
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) +++ :: 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) =
    (Either b b'
 -> Process m (Either c c', Net m (Either b b') (Either c c')))
-> Net m (Either b b') (Either c c')
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((Either b b'
  -> Process m (Either c c', Net m (Either b b') (Either c c')))
 -> Net m (Either b b') (Either c c'))
-> (Either b b'
    -> Process m (Either c c', Net m (Either b b') (Either c c')))
-> Net m (Either b b') (Either c c')
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
           (Either c c', Net m (Either b b') (Either c c'))
-> Process m (Either c c', Net m (Either b b') (Either c c'))
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Either c c'
forall a b. a -> Either a b
Left c
c, Net m b c
p1 Net m b c -> Net m b' c' -> Net m (Either b b') (Either c c')
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'
           (Either c c', Net m (Either b b') (Either c c'))
-> Process m (Either c c', Net m (Either b b') (Either c c'))
forall (m :: * -> *) a. Monad m => a -> m a
return (c' -> Either c c'
forall a b. b -> Either a b
Right c'
c', Net m b c
x Net m b c -> Net m b' c' -> Net m (Either b b') (Either c c')
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) ||| :: 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) =
    (Either b c -> Process m (d, Net m (Either b c) d))
-> Net m (Either b c) d
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((Either b c -> Process m (d, Net m (Either b c) d))
 -> Net m (Either b c) d)
-> (Either b c -> Process m (d, Net m (Either b c) d))
-> Net m (Either b c) d
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
           (d, Net m (Either b c) d) -> Process m (d, Net m (Either b c) d)
forall (m :: * -> *) a. Monad m => a -> m a
return (d
d, Net m b d
p1 Net m b d -> Net m c d -> Net m (Either b c) d
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'
           (d, Net m (Either b c) d) -> Process m (d, Net m (Either b c) d)
forall (m :: * -> *) a. Monad m => a -> m a
return (d
d, Net m b d
x Net m b d -> Net m c d -> Net m (Either b c) d
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 :: Net m a b
emptyNet = (a -> Process m (b, Net m a b)) -> Net m a b
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (b, Net m a b)) -> Net m a b)
-> (a -> Process m (b, Net m a b)) -> Net m a b
forall a b. (a -> b) -> a -> b
$ Process m (b, Net m a b) -> a -> Process m (b, Net m a b)
forall a b. a -> b -> a
const Process m (b, Net m a b)
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 :: (a -> Process m b) -> Net m a b
arrNet a -> Process m b
f =
  let x :: Net m a b
x =
        (a -> Process m (b, Net m a b)) -> Net m a b
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (b, Net m a b)) -> Net m a b)
-> (a -> Process m (b, Net m a b)) -> Net m a b
forall a b. (a -> b) -> a -> b
$ \a
a ->
        do b
b <- a -> Process m b
f a
a
           (b, Net m a b) -> Process m (b, Net m a b)
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 :: (acc -> a -> Process m (acc, b)) -> acc -> Net m a b
accumNet acc -> a -> Process m (acc, b)
f acc
acc =
  (a -> Process m (b, Net m a b)) -> Net m a b
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (b, Net m a b)) -> Net m a b)
-> (a -> Process m (b, Net m a b)) -> Net m a b
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
     (b, Net m a b) -> Process m (b, Net m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (acc -> a -> Process m (acc, b)) -> acc -> Net m a 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 :: Process m () -> Net m a a
withinNet Process m ()
m =
  (a -> Process m (a, Net m a a)) -> Net m a a
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (a, Net m a a)) -> Net m a a)
-> (a -> Process m (a, Net m a a)) -> Net m a a
forall a b. (a -> b) -> a -> b
$ \a
a ->
  do { Process m ()
m; (a, Net m a a) -> Process m (a, Net m a a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Process m () -> Net m 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 :: ProcessId m -> Net m a b -> Net m a b
netUsingId ProcessId m
pid (Net a -> Process m (b, Net m a b)
f) =
  (a -> Process m (b, Net m a b)) -> Net m a b
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (b, Net m a b)) -> Net m a b)
-> (a -> Process m (b, Net m a b)) -> Net m a b
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Process m (b, Net m a b) -> Process m (b, Net m a b)
forall (m :: * -> *) a.
MonadDES m =>
ProcessId m -> Process m a -> Process m a
processUsingId ProcessId m
pid (Process m (b, Net m a b) -> Process m (b, Net m a b))
-> (a -> Process m (b, Net m a b)) -> a -> Process m (b, Net m a b)
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 :: Net m a b -> Processor m a b
netProcessor = (Stream m a -> Stream m b) -> Processor m a b
forall (m :: * -> *) a b.
(Stream m a -> Stream m b) -> Processor m a b
Processor ((Stream m a -> Stream m b) -> Processor m a b)
-> (Net m a b -> Stream m a -> Stream m b)
-> Net m a b
-> Processor m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Net m a b -> Stream m a -> Stream m b
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 =
          Process m (a, Stream m a) -> Stream m a
forall (m :: * -> *) a. Process m (a, Stream m a) -> Stream m a
Cons (Process m (a, Stream m a) -> Stream m a)
-> Process m (a, Stream m a) -> Stream m a
forall a b. (a -> b) -> a -> b
$
          do (a
a, Stream m a
as') <- Stream m a -> Process m (a, Stream m a)
forall (m :: * -> *) a. Stream m a -> Process m (a, Stream m a)
runStream Stream m a
as
             (a
b, Net m a a
x') <- Net m a a -> a -> Process m (a, Net m a a)
forall (m :: * -> *) a b.
Net m a b -> a -> Process m (b, Net m a b)
runNet Net m a a
x a
a
             (a, Stream m a) -> Process m (a, Stream m 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 :: Processor m a b -> Net m a b
processorNet Processor m a b
x =
  (a -> Process m (b, Net m a b)) -> Net m a b
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (b, Net m a b)) -> Net m a b)
-> (a -> Process m (b, Net m a b)) -> Net m a b
forall a b. (a -> b) -> a -> b
$ \a
a ->
  do Resource m FCFS
readingA <- Simulation m (Resource m FCFS) -> Process m (Resource m FCFS)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m (Resource m FCFS) -> Process m (Resource m FCFS))
-> Simulation m (Resource m FCFS) -> Process m (Resource m FCFS)
forall a b. (a -> b) -> a -> b
$ FCFS -> Int -> Maybe Int -> Simulation m (Resource m FCFS)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
     Resource m FCFS
writingA <- Simulation m (Resource m FCFS) -> Process m (Resource m FCFS)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m (Resource m FCFS) -> Process m (Resource m FCFS))
-> Simulation m (Resource m FCFS) -> Process m (Resource m FCFS)
forall a b. (a -> b) -> a -> b
$ FCFS -> Int -> Maybe Int -> Simulation m (Resource m FCFS)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS Int
1 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
     Resource m FCFS
readingB <- Simulation m (Resource m FCFS) -> Process m (Resource m FCFS)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m (Resource m FCFS) -> Process m (Resource m FCFS))
-> Simulation m (Resource m FCFS) -> Process m (Resource m FCFS)
forall a b. (a -> b) -> a -> b
$ FCFS -> Int -> Maybe Int -> Simulation m (Resource m FCFS)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
     Resource m FCFS
writingB <- Simulation m (Resource m FCFS) -> Process m (Resource m FCFS)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m (Resource m FCFS) -> Process m (Resource m FCFS))
-> Simulation m (Resource m FCFS) -> Process m (Resource m FCFS)
forall a b. (a -> b) -> a -> b
$ FCFS -> Int -> Maybe Int -> Simulation m (Resource m FCFS)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS Int
1 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
     Resource m FCFS
conting  <- Simulation m (Resource m FCFS) -> Process m (Resource m FCFS)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m (Resource m FCFS) -> Process m (Resource m FCFS))
-> Simulation m (Resource m FCFS) -> Process m (Resource m FCFS)
forall a b. (a -> b) -> a -> b
$ FCFS -> Int -> Maybe Int -> Simulation m (Resource m FCFS)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
     Ref m (Maybe a)
refA <- Simulation m (Ref m (Maybe a)) -> Process m (Ref m (Maybe a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m (Ref m (Maybe a)) -> Process m (Ref m (Maybe a)))
-> Simulation m (Ref m (Maybe a)) -> Process m (Ref m (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Simulation m (Ref m (Maybe a))
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe a
forall a. Maybe a
Nothing
     Ref m (Maybe b)
refB <- Simulation m (Ref m (Maybe b)) -> Process m (Ref m (Maybe b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m (Ref m (Maybe b)) -> Process m (Ref m (Maybe b)))
-> Simulation m (Ref m (Maybe b)) -> Process m (Ref m (Maybe b))
forall a b. (a -> b) -> a -> b
$ Maybe b -> Simulation m (Ref m (Maybe b))
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe b
forall a. Maybe a
Nothing
     let input :: Process m (a, Stream m a)
input =
           do Resource m FCFS -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m FCFS
readingA
              Just a
a <- Event m (Maybe a) -> Process m (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m (Maybe a) -> Process m (Maybe a))
-> Event m (Maybe a) -> Process m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe a) -> Event m (Maybe a)
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe a)
refA
              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
$ Ref m (Maybe a) -> Maybe a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe a)
refA Maybe a
forall a. Maybe a
Nothing
              Resource m FCFS -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m FCFS
writingA
              (a, Stream m a) -> Process m (a, Stream m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Process m (a, Stream m a) -> Stream m 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') <- Stream m b -> Process m (b, Stream m b)
forall (m :: * -> *) a. Stream m a -> Process m (a, Stream m a)
runStream Stream m b
bs
              Resource m FCFS -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m FCFS
writingB
              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
$ Ref m (Maybe b) -> Maybe b -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe b)
refB (b -> Maybe b
forall a. a -> Maybe a
Just b
b)
              Resource m FCFS -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m FCFS
readingB
              Resource m FCFS -> Process m ()
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 Resource m FCFS -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m FCFS
writingA
              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
$ Ref m (Maybe a) -> Maybe a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe a)
refA (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
              Resource m FCFS -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m FCFS
readingA
              Resource m FCFS -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m FCFS
readingB
              Just b
b <- Event m (Maybe b) -> Process m (Maybe b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m (Maybe b) -> Process m (Maybe b))
-> Event m (Maybe b) -> Process m (Maybe b)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe b) -> Event m (Maybe b)
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe b)
refB
              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
$ Ref m (Maybe b) -> Maybe b -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe b)
refB Maybe b
forall a. Maybe a
Nothing
              Resource m FCFS -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m FCFS
writingB
              (b, Net m a b) -> Process m (b, Net m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (a -> Process m (b, Net m a b)) -> Net m a b
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (b, Net m a b)) -> Net m a b)
-> (a -> Process m (b, Net m a b)) -> Net m a b
forall a b. (a -> b) -> a -> b
$ \a
a -> Resource m FCFS -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m FCFS
conting Process m ()
-> Process m (b, Net m a b) -> Process m (b, Net m a b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Process m (b, Net m a b)
loop a
a)
     Process m () -> Process m ()
forall (m :: * -> *). MonadDES m => Process m () -> Process m ()
spawnProcess (Process m () -> Process m ()) -> Process m () -> Process m ()
forall a b. (a -> b) -> a -> b
$
       Stream m b -> Process m ()
forall b. Stream m b -> Process m b
consume (Stream m b -> Process m ()) -> Stream m b -> Process m ()
forall a b. (a -> b) -> a -> b
$ Processor m a b -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Processor m a b -> Stream m a -> Stream m b
runProcessor Processor m a b
x (Process m (a, Stream m a) -> Stream m a
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 :: Net m a (Arrival a)
arrivalNet =
  let loop :: Maybe Double -> Net m a (Arrival a)
loop Maybe Double
t0 =
        (a -> Process m (Arrival a, Net m a (Arrival a)))
-> Net m a (Arrival a)
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (Arrival a, Net m a (Arrival a)))
 -> Net m a (Arrival a))
-> (a -> Process m (Arrival a, Net m a (Arrival a)))
-> Net m a (Arrival a)
forall a b. (a -> b) -> a -> b
$ \a
a ->
        do Double
t <- Dynamics m Double -> Process m Double
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
DynamicsLift t m =>
Dynamics m a -> t m a
liftDynamics Dynamics m Double
forall (m :: * -> *). Monad m => Dynamics m Double
time
           let b :: Arrival a
b = Arrival :: forall a. a -> Double -> Maybe Double -> Arrival a
Arrival { arrivalValue :: a
arrivalValue = a
a,
                             arrivalTime :: Double
arrivalTime  = Double
t,
                             arrivalDelay :: Maybe Double
arrivalDelay = 
                               case Maybe Double
t0 of
                                 Maybe Double
Nothing -> Maybe Double
forall a. Maybe a
Nothing
                                 Just t0 -> Double -> Maybe Double
forall a. a -> Maybe a
Just (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0) }
           (Arrival a, Net m a (Arrival a))
-> Process m (Arrival a, Net m a (Arrival a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Arrival a
b, Maybe Double -> Net m a (Arrival a)
loop (Maybe Double -> Net m a (Arrival a))
-> Maybe Double -> Net m a (Arrival a)
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t)
  in Maybe Double -> Net m a (Arrival a)
forall (m :: * -> *) a.
MonadDES m =>
Maybe Double -> Net m a (Arrival a)
loop Maybe Double
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 :: a -> Net m a a
delayNet a
a0 =
  (a -> Process m (a, Net m a a)) -> Net m a a
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (a, Net m a a)) -> Net m a a)
-> (a -> Process m (a, Net m a a)) -> Net m a a
forall a b. (a -> b) -> a -> b
$ \a
a ->
  (a, Net m a a) -> Process m (a, Net m a a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a0, a -> Net m a a
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 :: 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
     Net m a a -> a -> Process m ()
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 :: 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 -> () -> Process m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just a
a' -> Net m a (Maybe a) -> a -> Process m ()
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 :: 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'  -> b -> Process m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b'
       Right a
a' -> Net m a (Either b a) -> a -> Process m b
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 :: Maybe String -> Maybe String -> Net m a b -> Net m a b
traceNet Maybe String
request Maybe String
response Net m a b
x = (a -> Process m (b, Net m a b)) -> Net m a b
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (b, Net m a b)) -> Net m a b)
-> (a -> Process m (b, Net m a b)) -> Net m a b
forall a b. (a -> b) -> a -> b
$ Net m a b -> a -> Process m (b, Net m 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 -> Net m a b -> a -> Process m (b, Net m 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
           Just String
message -> 
             String -> Process m (b, Net m a b) -> Process m (b, Net m a b)
forall (m :: * -> *) a.
MonadDES m =>
String -> Process m a -> Process m a
traceProcess String
message (Process m (b, Net m a b) -> Process m (b, Net m a b))
-> Process m (b, Net m a b) -> Process m (b, Net m a b)
forall a b. (a -> b) -> a -> b
$
             Net m a b -> a -> Process m (b, Net m 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 -> (b, Net m a b) -> Process m (b, Net m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (a -> Process m (b, Net m a b)) -> Net m a b
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (b, Net m a b)) -> Net m a b)
-> (a -> Process m (b, Net m a b)) -> Net m a b
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 ->
           String -> Process m (b, Net m a b) -> Process m (b, Net m a b)
forall (m :: * -> *) a.
MonadDES m =>
String -> Process m a -> Process m a
traceProcess String
message (Process m (b, Net m a b) -> Process m (b, Net m a b))
-> Process m (b, Net m a b) -> Process m (b, Net m a b)
forall a b. (a -> b) -> a -> b
$
           (b, Net m a b) -> Process m (b, Net m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (a -> Process m (b, Net m a b)) -> Net m a b
forall (m :: * -> *) a b.
(a -> Process m (b, Net m a b)) -> Net m a b
Net ((a -> Process m (b, Net m a b)) -> Net m a b)
-> (a -> Process m (b, Net m a b)) -> Net m a b
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')