module Simulation.Aivika.Trans.Net
(
Net(..),
iterateNet,
iterateNetMaybe,
iterateNetEither,
emptyNet,
arrNet,
accumNet,
withinNet,
netUsingId,
arrivalNet,
delayNet,
netProcessor,
processorNet,
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(..))
newtype Net m a b =
Net { forall (m :: * -> *) a b.
Net m a b -> a -> Process m (b, Net m a b)
runNet :: a -> Process m (b, Net m a b)
}
instance MonadDES m => C.Category (Net m) where
{-# INLINABLE id #-}
id :: forall a. 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 a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Net m a a
forall a. Net m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
C.id)
{-# INLINABLE (.) #-}
. :: forall b c a. Net m b c -> Net m a b -> Net m a c
(.) = 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 a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
c, Net m a b
p2 Net m a b -> Net m a a -> Net m a b
`dot` Net m a a
p1)
instance MonadDES m => Arrow (Net m) where
{-# INLINABLE arr #-}
arr :: forall b c. (b -> c) -> Net m b c
arr b -> c
f = (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 a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> c
f b
a, (b -> c) -> Net m b c
forall b c. (b -> c) -> Net m b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f)
{-# INLINABLE first #-}
first :: forall b c d. Net m b c -> Net m (b, d) (c, d)
first (Net b -> Process m (c, Net m b c)
f) =
((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 a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((c
c, d
d), Net m b c -> Net m (b, d) (c, d)
forall b c 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 :: forall b c d. Net m b c -> Net m (d, b) (d, c)
second (Net b -> Process m (c, Net m b c)
f) =
((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 a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((d
d, c
c), Net m b c -> Net m (d, b) (d, c)
forall b c d. 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) *** :: forall b c b' c'. Net m b c -> Net m b' c' -> Net m (b, b') (c, c')
*** (Net b' -> Process m (c', Net m b' c')
g) =
((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 a. a -> Process m a
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 b c b' c'. 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) &&& :: forall b c c'. Net m b c -> Net m b c' -> Net m b (c, c')
&&& (Net b -> Process m (c', Net m b c')
g) =
(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 a. a -> Process m a
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 b c c'. 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 :: forall b c d. Net m b c -> Net m (Either b d) (Either c d)
left x :: Net m b c
x@(Net b -> Process m (c, Net m b c)
f) =
(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 a. a -> Process m 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 m b c -> Net m (Either b d) (Either c d)
forall b c 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
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 a. a -> Process m 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 m b c -> Net m (Either b d) (Either c d)
forall b c 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 :: forall b c d. Net m b c -> Net m (Either d b) (Either d c)
right x :: Net m b c
x@(Net b -> Process m (c, Net m b c)
f) =
(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 a. a -> Process m 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 m b c -> Net m (Either d b) (Either d c)
forall b c 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
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 a. a -> Process m 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 m b c -> Net m (Either d b) (Either d c)
forall b c 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) +++ :: forall b c b' c'.
Net m b c -> Net m b' c' -> Net m (Either b b') (Either c c')
+++ y :: Net m b' c'
y@(Net b' -> Process m (c', Net m b' c')
g) =
(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 a. a -> Process m 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 m b c
p1 Net m b c -> Net m b' c' -> Net m (Either b b') (Either c c')
forall b c b' c'.
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 a. a -> Process m 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 m b c
x Net m b c -> Net m b' c' -> Net m (Either b b') (Either c c')
forall b c b' c'.
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) ||| :: forall b d c. Net m b d -> Net m c d -> Net m (Either b c) d
||| y :: Net m c d
y@(Net c -> Process m (d, Net m c d)
g) =
(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 a. a -> Process m a
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 b d c. 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 a. a -> Process m a
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 b d c. 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)
emptyNet :: MonadDES m => Net m a b
{-# INLINABLE emptyNet #-}
emptyNet :: forall (m :: * -> *) a b. MonadDES m => 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
arrNet :: MonadDES m => (a -> Process m b) -> Net m a b
{-# INLINABLE arrNet #-}
arrNet :: forall (m :: * -> *) a b.
MonadDES m =>
(a -> Process m b) -> Net m a b
arrNet a -> Process m b
f =
let x :: Net m a b
x =
(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 a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Net m a b
x)
in Net m a b
x
accumNet :: MonadDES m => (acc -> a -> Process m (acc, b)) -> acc -> Net m a b
{-# INLINABLE accumNet #-}
accumNet :: forall (m :: * -> *) acc a b.
MonadDES m =>
(acc -> a -> Process m (acc, b)) -> acc -> Net m a b
accumNet acc -> a -> Process m (acc, b)
f acc
acc =
(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 a. a -> Process m a
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')
withinNet :: MonadDES m => Process m () -> Net m a a
{-# INLINABLE withinNet #-}
withinNet :: forall (m :: * -> *) a. MonadDES m => Process m () -> Net m a a
withinNet Process m ()
m =
(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 a. a -> Process m 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) }
netUsingId :: MonadDES m => ProcessId m -> Net m a b -> Net m a b
{-# INLINABLE netUsingId #-}
netUsingId :: forall (m :: * -> *) a b.
MonadDES m =>
ProcessId m -> Net m a b -> Net m a b
netUsingId ProcessId m
pid (Net a -> Process m (b, Net m a b)
f) =
(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
netProcessor :: MonadDES m => Net m a b -> Processor m a b
{-# INLINABLE netProcessor #-}
netProcessor :: forall (m :: * -> *) a b.
MonadDES m =>
Net m a b -> Processor m a b
netProcessor = (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 a. a -> Process 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')
processorNet :: MonadDES m => Processor m a b -> Net m a b
{-# INLINABLE processorNet #-}
processorNet :: forall (m :: * -> *) a b.
MonadDES m =>
Processor m a b -> Net m a b
processorNet Processor m a b
x =
(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 a. Simulation m a -> Process m a
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 a. Simulation m a -> Process m a
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 a. Simulation m a -> Process m a
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 a. Simulation m a -> Process m a
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 a. Simulation m a -> Process m a
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 a. Simulation m a -> Process m 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 a. a -> Simulation m (Ref m 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 a. Simulation m a -> Process m a
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 a. a -> Simulation m (Ref m a)
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 a. Event m a -> Process m 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 a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe a)
refA
Event m () -> Process m ()
forall a. Event m a -> Process m a
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 a. Ref m a -> 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 a. a -> Process 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 a. Event m a -> Process m a
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 a. Ref m a -> a -> 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 a. Event m a -> Process m a
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 a. Ref m a -> 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 a. Event m a -> Process m a
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 a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe b)
refB
Event m () -> Process m ()
forall a. Event m a -> Process m a
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 a. Ref m a -> a -> 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 a. a -> Process m a
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 a b. Process m a -> Process m b -> Process m 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
arrivalNet :: MonadDES m => Net m a (Arrival a)
{-# INLINABLE arrivalNet #-}
arrivalNet :: forall (m :: * -> *) a. MonadDES m => Net m a (Arrival a)
arrivalNet =
let loop :: Maybe Double -> Net m a (Arrival a)
loop Maybe Double
t0 =
(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 a. Dynamics m a -> Process m a
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 { 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 m a (Arrival a))
-> Process m (Arrival a, Net m a (Arrival a))
forall a. a -> Process m 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
delayNet :: MonadDES m => a -> Net m a a
{-# INLINABLE delayNet #-}
delayNet :: forall (m :: * -> *) a. MonadDES m => 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 a. a -> Process m 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)
iterateNet :: MonadDES m => Net m a a -> a -> Process m ()
{-# INLINABLE iterateNet #-}
iterateNet :: forall (m :: * -> *) a.
MonadDES m =>
Net m a a -> a -> Process m ()
iterateNet (Net a -> Process m (a, Net m a a)
f) a
a =
do (a
a', Net m a a
x) <- a -> Process m (a, Net m a a)
f a
a
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'
iterateNetMaybe :: MonadDES m => Net m a (Maybe a) -> a -> Process m ()
{-# INLINABLE iterateNetMaybe #-}
iterateNetMaybe :: forall (m :: * -> *) a.
MonadDES m =>
Net m a (Maybe a) -> a -> Process m ()
iterateNetMaybe (Net a -> Process m (Maybe a, Net m a (Maybe a))
f) a
a =
do (Maybe a
a', Net m a (Maybe a)
x) <- a -> Process m (Maybe a, Net m a (Maybe a))
f a
a
case Maybe a
a' of
Maybe a
Nothing -> () -> Process m ()
forall a. a -> Process m a
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'
iterateNetEither :: MonadDES m => Net m a (Either b a) -> a -> Process m b
{-# INLINABLE iterateNetEither #-}
iterateNetEither :: forall (m :: * -> *) a b.
MonadDES m =>
Net m a (Either b a) -> a -> Process m b
iterateNetEither (Net a -> Process m (Either b a, Net m a (Either b a))
f) a
a =
do (Either b a
ba', Net m a (Either b a)
x) <- a -> Process m (Either b a, Net m a (Either b a))
f a
a
case Either b a
ba' of
Left b
b' -> b -> Process m b
forall a. a -> Process m a
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'
traceNet :: MonadDES m
=> Maybe String
-> Maybe String
-> Net m a b
-> Net m a b
{-# INLINABLE traceNet #-}
traceNet :: forall (m :: * -> *) a b.
MonadDES m =>
Maybe String -> Maybe String -> Net m a b -> Net m a b
traceNet Maybe String
request Maybe String
response Net m a b
x = (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 a. a -> Process m a
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 a. a -> Process m a
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')