-- |
-- 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 = (a -> Process (a, Net a a)) -> Net a a
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (a, Net a a)) -> Net a a)
-> (a -> Process (a, Net a a)) -> Net a a
forall a b. (a -> b) -> a -> b
$ \a
a -> (a, Net a a) -> Process (a, Net a a)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Net a a
forall a. Net 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
(.) = 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) =
        (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (b, Net a b)) -> Net a b)
-> (a -> Process (b, Net a b)) -> Net a b
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
           (b, Net a b) -> Process (b, Net a b)
forall a. a -> Process a
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 = (b -> Process (c, Net b c)) -> Net b c
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((b -> Process (c, Net b c)) -> Net b c)
-> (b -> Process (c, Net b c)) -> Net b c
forall a b. (a -> b) -> a -> b
$ \b
a -> (c, Net b c) -> Process (c, Net b c)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> c
f b
a, (b -> c) -> Net b c
forall b c. (b -> c) -> Net b c
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) =
    ((b, d) -> Process ((c, d), Net (b, d) (c, d)))
-> Net (b, d) (c, d)
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net (((b, d) -> Process ((c, d), Net (b, d) (c, d)))
 -> Net (b, d) (c, d))
-> ((b, d) -> Process ((c, d), Net (b, d) (c, d)))
-> Net (b, d) (c, d)
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
       ((c, d), Net (b, d) (c, d)) -> Process ((c, d), Net (b, d) (c, d))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ((c
c, d
d), Net b c -> Net (b, d) (c, d)
forall b c d. Net b c -> Net (b, d) (c, 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) =
    ((d, b) -> Process ((d, c), Net (d, b) (d, c)))
-> Net (d, b) (d, c)
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net (((d, b) -> Process ((d, c), Net (d, b) (d, c)))
 -> Net (d, b) (d, c))
-> ((d, b) -> Process ((d, c), Net (d, b) (d, c)))
-> Net (d, b) (d, c)
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
       ((d, c), Net (d, b) (d, c)) -> Process ((d, c), Net (d, b) (d, c))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ((d
d, c
c), Net b c -> Net (d, b) (d, c)
forall b c d. Net b c -> Net (d, b) (d, 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) =
    ((b, b') -> Process ((c, c'), Net (b, b') (c, c')))
-> Net (b, b') (c, c')
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net (((b, b') -> Process ((c, c'), Net (b, b') (c, c')))
 -> Net (b, b') (c, c'))
-> ((b, b') -> Process ((c, c'), Net (b, b') (c, c')))
-> Net (b, b') (c, c')
forall a b. (a -> b) -> a -> b
$ \(b
b, b'
b') ->
    do ((c
c, Net b c
p1), (c'
c', Net b' c'
p2)) <- Process (c, Net b c)
-> Process (c', Net b' c')
-> Process ((c, Net b c), (c', Net b' c'))
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')
       ((c, c'), Net (b, b') (c, c'))
-> Process ((c, c'), Net (b, b') (c, c'))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ((c
c, c'
c'), Net b c
p1 Net b c -> Net b' c' -> Net (b, b') (c, c')
forall b c b' c'. Net b c -> Net b' c' -> Net (b, b') (c, c')
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) =
    (b -> Process ((c, c'), Net b (c, c'))) -> Net b (c, c')
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((b -> Process ((c, c'), Net b (c, c'))) -> Net b (c, c'))
-> (b -> Process ((c, c'), Net b (c, c'))) -> Net b (c, c')
forall a b. (a -> b) -> a -> b
$ \b
b ->
    do ((c
c, Net b c
p1), (c'
c', Net b c'
p2)) <- Process (c, Net b c)
-> Process (c', Net b c') -> Process ((c, Net b c), (c', Net b c'))
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)
       ((c, c'), Net b (c, c')) -> Process ((c, c'), Net b (c, c'))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ((c
c, c'
c'), Net b c
p1 Net b c -> Net b c' -> Net b (c, c')
forall b c c'. Net b c -> Net b c' -> Net b (c, c')
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) =
    (Either b d -> Process (Either c d, Net (Either b d) (Either c d)))
-> Net (Either b d) (Either c d)
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((Either b d
  -> Process (Either c d, Net (Either b d) (Either c d)))
 -> Net (Either b d) (Either c d))
-> (Either b d
    -> Process (Either c d, Net (Either b d) (Either c d)))
-> Net (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 b c
p) <- b -> Process (c, Net b c)
f b
b
           (Either c d, Net (Either b d) (Either c d))
-> Process (Either c d, Net (Either b d) (Either c d))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Either c d
forall a b. a -> Either a b
Left c
c, Net b c -> Net (Either b d) (Either c d)
forall b c d. Net b c -> Net (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 b c
p)
      Right d
d ->
        (Either c d, Net (Either b d) (Either c d))
-> Process (Either c d, Net (Either b d) (Either c d))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> Either c d
forall a b. b -> Either a b
Right d
d, Net b c -> Net (Either b d) (Either c d)
forall b c d. Net b c -> Net (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 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) =
    (Either d b -> Process (Either d c, Net (Either d b) (Either d c)))
-> Net (Either d b) (Either d c)
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((Either d b
  -> Process (Either d c, Net (Either d b) (Either d c)))
 -> Net (Either d b) (Either d c))
-> (Either d b
    -> Process (Either d c, Net (Either d b) (Either d c)))
-> Net (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 b c
p) <- b -> Process (c, Net b c)
f b
b
           (Either d c, Net (Either d b) (Either d c))
-> Process (Either d c, Net (Either d b) (Either d c))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Either d c
forall a b. b -> Either a b
Right c
c, Net b c -> Net (Either d b) (Either d c)
forall b c d. Net b c -> Net (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 b c
p)
      Left d
d ->
        (Either d c, Net (Either d b) (Either d c))
-> Process (Either d c, Net (Either d b) (Either d c))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> Either d c
forall a b. a -> Either a b
Left d
d, Net b c -> Net (Either d b) (Either d c)
forall b c d. Net b c -> Net (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 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) =
    (Either b b'
 -> Process (Either c c', Net (Either b b') (Either c c')))
-> Net (Either b b') (Either c c')
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((Either b b'
  -> Process (Either c c', Net (Either b b') (Either c c')))
 -> Net (Either b b') (Either c c'))
-> (Either b b'
    -> Process (Either c c', Net (Either b b') (Either c c')))
-> Net (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 b c
p1) <- b -> Process (c, Net b c)
f b
b
           (Either c c', Net (Either b b') (Either c c'))
-> Process (Either c c', Net (Either b b') (Either c c'))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Either c c'
forall a b. a -> Either a b
Left c
c, Net b c
p1 Net b c -> Net b' c' -> Net (Either b b') (Either c c')
forall b c b' c'.
Net b c -> Net b' c' -> Net (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 b' c'
y)
      Right b'
b' ->
        do (c'
c', Net b' c'
p2) <- b' -> Process (c', Net b' c')
g b'
b'
           (Either c c', Net (Either b b') (Either c c'))
-> Process (Either c c', Net (Either b b') (Either c c'))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (c' -> Either c c'
forall a b. b -> Either a b
Right c'
c', Net b c
x Net b c -> Net b' c' -> Net (Either b b') (Either c c')
forall b c b' c'.
Net b c -> Net b' c' -> Net (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 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) =
    (Either b c -> Process (d, Net (Either b c) d))
-> Net (Either b c) d
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((Either b c -> Process (d, Net (Either b c) d))
 -> Net (Either b c) d)
-> (Either b c -> Process (d, Net (Either b c) d))
-> Net (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 b d
p1) <- b -> Process (d, Net b d)
f b
b
           (d, Net (Either b c) d) -> Process (d, Net (Either b c) d)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (d
d, Net b d
p1 Net b d -> Net c d -> Net (Either b c) d
forall b d c. Net b d -> Net c d -> Net (Either b c) d
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'
           (d, Net (Either b c) d) -> Process (d, Net (Either b c) d)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (d
d, Net b d
x Net b d -> Net c d -> Net (Either b c) d
forall b d c. Net b d -> Net c d -> Net (Either b c) d
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 = (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (b, Net a b)) -> Net a b)
-> (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> b) -> a -> b
$ Process (b, Net a b) -> a -> Process (b, Net a b)
forall a b. a -> b -> a
const Process (b, Net a b)
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 =
        (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (b, Net a b)) -> Net a b)
-> (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> b) -> a -> b
$ \a
a ->
        do b
b <- a -> Process b
f a
a
           (b, Net a b) -> Process (b, Net a b)
forall a. a -> Process 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 =
  (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (b, Net a b)) -> Net a b)
-> (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> b) -> a -> b
$ \a
a ->
  do (acc
acc', b
b) <- acc -> a -> Process (acc, b)
f acc
acc a
a
     (b, Net a b) -> Process (b, Net a b)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (acc -> a -> Process (acc, b)) -> acc -> Net a 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 =
  (a -> Process (a, Net a a)) -> Net a a
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (a, Net a a)) -> Net a a)
-> (a -> Process (a, Net a a)) -> Net a a
forall a b. (a -> b) -> a -> b
$ \a
a ->
  do { Process ()
m; (a, Net a a) -> Process (a, Net a a)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Process () -> Net 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) =
  (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (b, Net a b)) -> Net a b)
-> (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> b) -> a -> b
$ ProcessId -> Process (b, Net a b) -> Process (b, Net a b)
forall a. ProcessId -> Process a -> Process a
processUsingId ProcessId
pid (Process (b, Net a b) -> Process (b, Net a b))
-> (a -> Process (b, Net a b)) -> a -> Process (b, Net a b)
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 = (Stream a -> Stream b) -> Processor a b
forall a b. (Stream a -> Stream b) -> Processor a b
Processor ((Stream a -> Stream b) -> Processor a b)
-> (Net a b -> Stream a -> Stream b) -> Net a b -> Processor a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Net a b -> Stream a -> Stream b
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 =
          Process (a, Stream a) -> Stream a
forall a. Process (a, Stream a) -> Stream a
Cons (Process (a, Stream a) -> Stream a)
-> Process (a, Stream a) -> Stream a
forall a b. (a -> b) -> a -> b
$
          do (a
a, Stream a
as') <- Stream a -> Process (a, Stream a)
forall a. Stream a -> Process (a, Stream a)
runStream Stream a
as
             (a
b, Net a a
x') <- Net a a -> a -> Process (a, Net a a)
forall a b. Net a b -> a -> Process (b, Net a b)
runNet Net a a
x a
a
             (a, Stream a) -> Process (a, Stream a)
forall a. a -> Process 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 =
  (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (b, Net a b)) -> Net a b)
-> (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> b) -> a -> b
$ \a
a ->
  do Resource FCFS
readingA <- Simulation (Resource FCFS) -> Process (Resource FCFS)
forall a. Simulation a -> Process a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (Simulation (Resource FCFS) -> Process (Resource FCFS))
-> Simulation (Resource FCFS) -> Process (Resource FCFS)
forall a b. (a -> b) -> a -> b
$ FCFS -> Int -> Maybe Int -> Simulation (Resource FCFS)
forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
     Resource FCFS
writingA <- Simulation (Resource FCFS) -> Process (Resource FCFS)
forall a. Simulation a -> Process a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (Simulation (Resource FCFS) -> Process (Resource FCFS))
-> Simulation (Resource FCFS) -> Process (Resource FCFS)
forall a b. (a -> b) -> a -> b
$ FCFS -> Int -> Maybe Int -> Simulation (Resource FCFS)
forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS Int
1 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
     Resource FCFS
readingB <- Simulation (Resource FCFS) -> Process (Resource FCFS)
forall a. Simulation a -> Process a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (Simulation (Resource FCFS) -> Process (Resource FCFS))
-> Simulation (Resource FCFS) -> Process (Resource FCFS)
forall a b. (a -> b) -> a -> b
$ FCFS -> Int -> Maybe Int -> Simulation (Resource FCFS)
forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
     Resource FCFS
writingB <- Simulation (Resource FCFS) -> Process (Resource FCFS)
forall a. Simulation a -> Process a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (Simulation (Resource FCFS) -> Process (Resource FCFS))
-> Simulation (Resource FCFS) -> Process (Resource FCFS)
forall a b. (a -> b) -> a -> b
$ FCFS -> Int -> Maybe Int -> Simulation (Resource FCFS)
forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS Int
1 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
     Resource FCFS
conting  <- Simulation (Resource FCFS) -> Process (Resource FCFS)
forall a. Simulation a -> Process a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (Simulation (Resource FCFS) -> Process (Resource FCFS))
-> Simulation (Resource FCFS) -> Process (Resource FCFS)
forall a b. (a -> b) -> a -> b
$ FCFS -> Int -> Maybe Int -> Simulation (Resource FCFS)
forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
     IORef (Maybe a)
refA <- IO (IORef (Maybe a)) -> Process (IORef (Maybe a))
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe a)) -> Process (IORef (Maybe a)))
-> IO (IORef (Maybe a)) -> Process (IORef (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> IO (IORef (Maybe a))
forall a. a -> IO (IORef a)
newIORef Maybe a
forall a. Maybe a
Nothing
     IORef (Maybe b)
refB <- IO (IORef (Maybe b)) -> Process (IORef (Maybe b))
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe b)) -> Process (IORef (Maybe b)))
-> IO (IORef (Maybe b)) -> Process (IORef (Maybe b))
forall a b. (a -> b) -> a -> b
$ Maybe b -> IO (IORef (Maybe b))
forall a. a -> IO (IORef a)
newIORef Maybe b
forall a. Maybe a
Nothing
     let input :: Process (a, Stream a)
input =
           do Resource FCFS -> Process ()
forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource FCFS
readingA
              Just a
a <- IO (Maybe a) -> Process (Maybe a)
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Process (Maybe a))
-> IO (Maybe a) -> Process (Maybe a)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> IO (Maybe a)
forall a. IORef a -> IO a
readIORef IORef (Maybe a)
refA
              IO () -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
refA Maybe a
forall a. Maybe a
Nothing
              Resource FCFS -> Process ()
forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource FCFS
writingA
              (a, Stream a) -> Process (a, Stream a)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Process (a, Stream a) -> Stream 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') <- Stream b -> Process (b, Stream b)
forall a. Stream a -> Process (a, Stream a)
runStream Stream b
bs
              Resource FCFS -> Process ()
forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource FCFS
writingB
              IO () -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe b) -> Maybe b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe b)
refB (b -> Maybe b
forall a. a -> Maybe a
Just b
b)
              Resource FCFS -> Process ()
forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource FCFS
readingB
              Resource FCFS -> Process ()
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 Resource FCFS -> Process ()
forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource FCFS
writingA
              IO () -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
refA (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
              Resource FCFS -> Process ()
forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource FCFS
readingA
              Resource FCFS -> Process ()
forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource FCFS
readingB
              Just b
b <- IO (Maybe b) -> Process (Maybe b)
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe b) -> Process (Maybe b))
-> IO (Maybe b) -> Process (Maybe b)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe b) -> IO (Maybe b)
forall a. IORef a -> IO a
readIORef IORef (Maybe b)
refB
              IO () -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe b) -> Maybe b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe b)
refB Maybe b
forall a. Maybe a
Nothing
              Resource FCFS -> Process ()
forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource FCFS
writingB
              (b, Net a b) -> Process (b, Net a b)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (b, Net a b)) -> Net a b)
-> (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> b) -> a -> b
$ \a
a -> Resource FCFS -> Process ()
forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource FCFS
conting Process () -> Process (b, Net a b) -> Process (b, Net a b)
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Process (b, Net a b)
loop a
a)
     Process () -> Process ()
spawnProcess (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$
       Stream b -> Process ()
forall {b}. Stream b -> Process b
consume (Stream b -> Process ()) -> Stream b -> Process ()
forall a b. (a -> b) -> a -> b
$ Processor a b -> Stream a -> Stream b
forall a b. Processor a b -> Stream a -> Stream b
runProcessor Processor a b
x (Process (a, Stream a) -> Stream a
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 =
        (a -> Process (Arrival a, Net a (Arrival a))) -> Net a (Arrival a)
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (Arrival a, Net a (Arrival a)))
 -> Net a (Arrival a))
-> (a -> Process (Arrival a, Net a (Arrival a)))
-> Net a (Arrival a)
forall a b. (a -> b) -> a -> b
$ \a
a ->
        do Double
t <- Dynamics Double -> Process Double
forall a. Dynamics a -> Process a
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 -> Maybe Double
forall a. Maybe a
Nothing
                                 Just Double
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 a (Arrival a))
-> Process (Arrival a, Net a (Arrival a))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Arrival a
b, Maybe Double -> Net a (Arrival a)
loop (Maybe Double -> Net a (Arrival a))
-> Maybe Double -> Net 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 a (Arrival a)
forall {a}. Maybe Double -> Net a (Arrival a)
loop Maybe Double
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 =
  (a -> Process (a, Net a a)) -> Net a a
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (a, Net a a)) -> Net a a)
-> (a -> Process (a, Net a a)) -> Net a a
forall a b. (a -> b) -> a -> b
$ \a
a ->
  (a, Net a a) -> Process (a, Net a a)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a0, a -> Net a a
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
     Net a a -> a -> Process ()
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 -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just a
a' -> Net a (Maybe a) -> a -> Process ()
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'  -> b -> Process b
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b'
       Right a
a' -> Net a (Either b a) -> a -> Process b
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 = (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (b, Net a b)) -> Net a b)
-> (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> b) -> a -> b
$ Net a b -> a -> Process (b, Net 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 -> Net a b -> a -> Process (b, Net a b)
forall a b. Net a b -> a -> Process (b, Net a b)
runNet Net a b
x a
a
           Just String
message -> 
             String -> Process (b, Net a b) -> Process (b, Net a b)
forall a. String -> Process a -> Process a
traceProcess String
message (Process (b, Net a b) -> Process (b, Net a b))
-> Process (b, Net a b) -> Process (b, Net a b)
forall a b. (a -> b) -> a -> b
$
             Net a b -> a -> Process (b, Net 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 -> (b, Net a b) -> Process (b, Net a b)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (b, Net a b)) -> Net a b)
-> (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> b) -> a -> b
$ Net a b -> a -> Process (b, Net a b)
loop Net a b
x')
         Just String
message ->
           String -> Process (b, Net a b) -> Process (b, Net a b)
forall a. String -> Process a -> Process a
traceProcess String
message (Process (b, Net a b) -> Process (b, Net a b))
-> Process (b, Net a b) -> Process (b, Net a b)
forall a b. (a -> b) -> a -> b
$
           (b, Net a b) -> Process (b, Net a b)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> Process (b, Net a b)) -> Net a b
Net ((a -> Process (b, Net a b)) -> Net a b)
-> (a -> Process (b, Net a b)) -> Net a b
forall a b. (a -> b) -> a -> b
$ Net a b -> a -> Process (b, Net a b)
loop Net a b
x')