{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

-- |
-- Module     : Simulation.Aivika.Trans.Internal.Process
-- 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
--
-- A value in the 'Process' monad represents a discontinuous process that 
-- can suspend in any simulation time point and then resume later in the same 
-- or another time point. 
-- 
-- The process of this type can involve the 'Event', 'Dynamics' and 'Simulation'
-- computations. Moreover, a value in the @Process@ monad can be run within
-- the @Event@ computation.
--
-- A value of the 'ProcessId' type is just an identifier of such a process.
--
module Simulation.Aivika.Trans.Internal.Process
       (-- * Process Monad
        ProcessId,
        Process(..),
        ProcessLift(..),
        invokeProcess,
        -- * Running Process
        runProcess,
        runProcessUsingId,
        runProcessInStartTime,
        runProcessInStartTimeUsingId,
        runProcessInStopTime,
        runProcessInStopTimeUsingId,
        -- * Spawning Processes
        spawnProcess,
        spawnProcessUsingId,
        spawnProcessWith,
        spawnProcessUsingIdWith,
        -- * Enqueuing Process
        enqueueProcess,
        enqueueProcessUsingId,
        -- * Creating Process Identifier
        newProcessId,
        processId,
        processUsingId,
        -- * Holding, Interrupting, Passivating and Canceling Process
        holdProcess,
        interruptProcess,
        processInterrupted,
        processInterruptionTime,
        passivateProcess,
        passivateProcessBefore,
        processPassive,
        reactivateProcess,
        reactivateProcessImmediately,
        cancelProcessWithId,
        cancelProcess,
        processCancelled,
        processCancelling,
        whenCancellingProcess,
        -- * Awaiting Signal
        processAwait,
        -- * Preemption
        processPreemptionBegin,
        processPreemptionEnd,
        processPreemptionBeginning,
        processPreemptionEnding,
        -- * Yield of Process
        processYield,
        -- * Process Timeout
        timeoutProcess,
        timeoutProcessUsingId,
        -- * Parallelizing Processes
        processParallel,
        processParallelUsingIds,
        processParallel_,
        processParallelUsingIds_,
        -- * Exception Handling
        catchProcess,
        finallyProcess,
        throwProcess,
        -- * Utilities
        zipProcessParallel,
        zip3ProcessParallel,
        unzipProcess,
        -- * Memoizing Process
        memoProcess,
        -- * Never Ending Process
        neverProcess,
        -- * Retrying Computation
        retryProcess,
        -- * GoTo Statement
        transferProcess,
        -- * Debugging
        traceProcess) where

import Data.Maybe

import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Fail
import qualified Control.Monad.Catch as MC
import Control.Applicative

import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Parameter
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Dynamics
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Internal.Cont
import Simulation.Aivika.Trans.Signal

-- | Represents a process identifier.
data ProcessId m = 
  ProcessId { ProcessId m -> Ref m Bool
processStarted :: Ref m Bool,
              ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont     :: Ref m (Maybe (ContParams m ())), 
              ProcessId m -> ContId m
processContId  :: ContId m,
              ProcessId m -> Ref m Bool
processInterruptRef  :: Ref m Bool, 
              ProcessId m -> Ref m (Maybe (ContParams m ()))
processInterruptCont :: Ref m (Maybe (ContParams m ())),
              ProcessId m -> Ref m Double
processInterruptTime :: Ref m Double,
              ProcessId m -> Ref m Int
processInterruptVersion :: Ref m Int }

-- | Specifies a discontinuous process that can suspend at any time
-- and then resume later.
newtype Process m a = Process (ProcessId m -> Cont m a)

-- | A type class to lift the 'Process' computation into other computations.
class ProcessLift t m where
  
  -- | Lift the specified 'Process' computation into another computation.
  liftProcess :: Process m a -> t m a

-- | Invoke the process computation.
invokeProcess :: ProcessId m -> Process m a -> Cont m a
{-# INLINE invokeProcess #-}
invokeProcess :: ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid (Process ProcessId m -> Cont m a
m) = ProcessId m -> Cont m a
m ProcessId m
pid

-- | Hold the process for the specified time period.
holdProcess :: MonadDES m => Double -> Process m ()
{-# INLINABLE holdProcess #-}
holdProcess :: Double -> Process m ()
holdProcess Double
dt =
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  (ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
dt Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
       [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Time period dt < 0: holdProcess"
     let x :: Ref m (Maybe (ContParams m ()))
x = ProcessId m -> Ref m (Maybe (ContParams m ()))
forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processInterruptCont ProcessId m
pid
         t :: Double
t = Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dt
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Maybe (ContParams m ()) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x (Maybe (ContParams m ()) -> Event m ())
-> Maybe (ContParams m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Maybe (ContParams m ())
forall a. a -> Maybe a
Just ContParams m ()
c
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ProcessId m -> Ref m Bool
forall (m :: * -> *). ProcessId m -> Ref m Bool
processInterruptRef ProcessId m
pid) Bool
False
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Double -> Double -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ProcessId m -> Ref m Double
forall (m :: * -> *). ProcessId m -> Ref m Double
processInterruptTime ProcessId m
pid) Double
t
     Int
v <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ProcessId m -> Ref m Int
forall (m :: * -> *). ProcessId m -> Ref m Int
processInterruptVersion ProcessId m
pid)
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
       Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
       (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
       do Int
v' <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ProcessId m -> Ref m Int
forall (m :: * -> *). ProcessId m -> Ref m Int
processInterruptVersion ProcessId m
pid)
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
v') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 
            do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Maybe (ContParams m ()) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x Maybe (ContParams m ())
forall a. Maybe a
Nothing
               Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()

-- | Interrupt a process with the specified identifier if the process
-- is held by computation 'holdProcess'.
interruptProcess :: MonadDES m => ProcessId m -> Event m ()
{-# INLINABLE interruptProcess #-}
interruptProcess :: ProcessId m -> Event m ()
interruptProcess ProcessId m
pid =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let x :: Ref m (Maybe (ContParams m ()))
x = ProcessId m -> Ref m (Maybe (ContParams m ()))
forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processInterruptCont ProcessId m
pid
     Maybe (ContParams m ())
a <- Point m
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ())))
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Event m (Maybe (ContParams m ()))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m ()))
x
     case Maybe (ContParams m ())
a of
       Maybe (ContParams m ())
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ContParams m ()
c ->
         do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Maybe (ContParams m ()) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x Maybe (ContParams m ())
forall a. Maybe a
Nothing
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ProcessId m -> Ref m Bool
forall (m :: * -> *). ProcessId m -> Ref m Bool
processInterruptRef ProcessId m
pid) Bool
True
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (ProcessId m -> Ref m Int
forall (m :: * -> *). ProcessId m -> Ref m Int
processInterruptVersion ProcessId m
pid) ((Int -> Int) -> Event m ()) -> (Int -> Int) -> Event m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
1
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()
            
-- | Test whether the process with the specified identifier was interrupted.
processInterrupted :: MonadDES m => ProcessId m -> Event m Bool
{-# INLINABLE processInterrupted #-}
processInterrupted :: ProcessId m -> Event m Bool
processInterrupted ProcessId m
pid =
  (Point m -> m Bool) -> Event m Bool
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m Bool) -> Event m Bool)
-> (Point m -> m Bool) -> Event m Bool
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ProcessId m -> Ref m Bool
forall (m :: * -> *). ProcessId m -> Ref m Bool
processInterruptRef ProcessId m
pid)

-- | Return the expected interruption time after finishing the 'holdProcess' computation,
-- which value may change if the corresponding process is preempted.
processInterruptionTime :: MonadDES m => ProcessId m -> Event m (Maybe Double)
{-# INLINABLE processInterruptionTime #-}
processInterruptionTime :: ProcessId m -> Event m (Maybe Double)
processInterruptionTime ProcessId m
pid =
  (Point m -> m (Maybe Double)) -> Event m (Maybe Double)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (Maybe Double)) -> Event m (Maybe Double))
-> (Point m -> m (Maybe Double)) -> Event m (Maybe Double)
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let x :: Ref m (Maybe (ContParams m ()))
x = ProcessId m -> Ref m (Maybe (ContParams m ()))
forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processInterruptCont ProcessId m
pid
     Maybe (ContParams m ())
a <- Point m
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ())))
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Event m (Maybe (ContParams m ()))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m ()))
x
     case Maybe (ContParams m ())
a of
       Just ContParams m ()
c  ->
         do Double
t <- Point m -> Event m Double -> m Double
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Double -> m Double) -> Event m Double -> m Double
forall a b. (a -> b) -> a -> b
$ Ref m Double -> Event m Double
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ProcessId m -> Ref m Double
forall (m :: * -> *). ProcessId m -> Ref m Double
processInterruptTime ProcessId m
pid)
            Maybe Double -> m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t)
       Maybe (ContParams m ())
Nothing ->
         Maybe Double -> m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
forall a. Maybe a
Nothing

-- | Define a reaction when the process with the specified identifier is preempted.
processPreempted :: MonadDES m => ProcessId m -> Event m ()
{-# INLINABLE processPreempted #-}
processPreempted :: ProcessId m -> Event m ()
processPreempted ProcessId m
pid =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let x :: Ref m (Maybe (ContParams m ()))
x = ProcessId m -> Ref m (Maybe (ContParams m ()))
forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processInterruptCont ProcessId m
pid
     Maybe (ContParams m ())
a <- Point m
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ())))
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Event m (Maybe (ContParams m ()))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m ()))
x
     case Maybe (ContParams m ())
a of
       Just ContParams m ()
c ->
         do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Maybe (ContParams m ()) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x Maybe (ContParams m ())
forall a. Maybe a
Nothing
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ProcessId m -> Ref m Bool
forall (m :: * -> *). ProcessId m -> Ref m Bool
processInterruptRef ProcessId m
pid) Bool
True
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (ProcessId m -> Ref m Int
forall (m :: * -> *). ProcessId m -> Ref m Int
processInterruptVersion ProcessId m
pid) ((Int -> Int) -> Event m ()) -> (Int -> Int) -> Event m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
1
            Double
t <- Point m -> Event m Double -> m Double
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Double -> m Double) -> Event m Double -> m Double
forall a b. (a -> b) -> a -> b
$ Ref m Double -> Event m Double
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ProcessId m -> Ref m Double
forall (m :: * -> *). ProcessId m -> Ref m Double
processInterruptTime ProcessId m
pid)
            let dt :: Double
dt = Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p
                c' :: ContParams m ()
c' = ContParams m () -> (() -> Event m ()) -> ContParams m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> (a -> Event m ()) -> ContParams m a
substituteCont ContParams m ()
c ((() -> Event m ()) -> ContParams m ())
-> (() -> Event m ()) -> ContParams m ()
forall a b. (a -> b) -> a -> b
$ \()
a ->
                  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                  Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
                  ContParams m () -> Cont m () -> Event m ()
forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m ()
c (Cont m () -> Event m ()) -> Cont m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
                  ProcessId m -> Process m () -> Cont m ()
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid (Process m () -> Cont m ()) -> Process m () -> Cont m ()
forall a b. (a -> b) -> a -> b
$
                  Double -> Process m ()
forall (m :: * -> *). MonadDES m => Double -> Process m ()
holdProcess Double
dt
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
              ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
reenterCont ContParams m ()
c' ()
       Maybe (ContParams m ())
Nothing ->
         do let x :: Ref m (Maybe (ContParams m ()))
x = ProcessId m -> Ref m (Maybe (ContParams m ()))
forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
            Maybe (ContParams m ())
a <- Point m
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ())))
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Event m (Maybe (ContParams m ()))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m ()))
x
            case Maybe (ContParams m ())
a of
              Maybe (ContParams m ())
Nothing ->
                () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Just ContParams m ()
c ->
                do let c' :: ContParams m ()
c' = ContParams m () -> (() -> Event m ()) -> ContParams m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> (a -> Event m ()) -> ContParams m a
substituteCont ContParams m ()
c ((() -> Event m ()) -> ContParams m ())
-> (() -> Event m ()) -> ContParams m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
reenterCont ContParams m ()
c
                   Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Maybe (ContParams m ()) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x (Maybe (ContParams m ()) -> Event m ())
-> Maybe (ContParams m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Maybe (ContParams m ())
forall a. a -> Maybe a
Just ContParams m ()
c'

-- | Passivate the process.
passivateProcess :: MonadDES m => Process m ()
{-# INLINABLE passivateProcess #-}
passivateProcess :: Process m ()
passivateProcess =
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  (ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let x :: Ref m (Maybe (ContParams m ()))
x = ProcessId m -> Ref m (Maybe (ContParams m ()))
forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
     Maybe (ContParams m ())
a <- Point m
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ())))
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Event m (Maybe (ContParams m ()))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m ()))
x
     case Maybe (ContParams m ())
a of
       Maybe (ContParams m ())
Nothing -> Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Maybe (ContParams m ()) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x (Maybe (ContParams m ()) -> Event m ())
-> Maybe (ContParams m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Maybe (ContParams m ())
forall a. a -> Maybe a
Just ContParams m ()
c
       Just ContParams m ()
_  -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot passivate the process twice: passivateProcess"

-- | Passivate the process before performing some action.
passivateProcessBefore :: MonadDES m => Event m () -> Process m ()
{-# INLINABLE passivateProcessBefore #-}
passivateProcessBefore :: Event m () -> Process m ()
passivateProcessBefore Event m ()
m =
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  (ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let x :: Ref m (Maybe (ContParams m ()))
x = ProcessId m -> Ref m (Maybe (ContParams m ()))
forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
     Maybe (ContParams m ())
a <- Point m
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ())))
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Event m (Maybe (ContParams m ()))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m ()))
x
     case Maybe (ContParams m ())
a of
       Maybe (ContParams m ())
Nothing ->
         do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Maybe (ContParams m ()) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x (Maybe (ContParams m ()) -> Event m ())
-> Maybe (ContParams m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Maybe (ContParams m ())
forall a. a -> Maybe a
Just ContParams m ()
c
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
m
       Just ContParams m ()
_  -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot passivate the process twice: passivateProcessBefore"

-- | Test whether the process with the specified identifier is passivated.
processPassive :: MonadDES m => ProcessId m -> Event m Bool
{-# INLINABLE processPassive #-}
processPassive :: ProcessId m -> Event m Bool
processPassive ProcessId m
pid =
  (Point m -> m Bool) -> Event m Bool
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m Bool) -> Event m Bool)
-> (Point m -> m Bool) -> Event m Bool
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let x :: Ref m (Maybe (ContParams m ()))
x = ProcessId m -> Ref m (Maybe (ContParams m ()))
forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
     Maybe (ContParams m ())
a <- Point m
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ())))
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Event m (Maybe (ContParams m ()))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m ()))
x
     Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Maybe (ContParams m ()) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ContParams m ())
a

-- | Reactivate a process with the specified identifier.
reactivateProcess :: MonadDES m => ProcessId m -> Event m ()
{-# INLINABLE reactivateProcess #-}
reactivateProcess :: ProcessId m -> Event m ()
reactivateProcess ProcessId m
pid =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let x :: Ref m (Maybe (ContParams m ()))
x = ProcessId m -> Ref m (Maybe (ContParams m ()))
forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
     Maybe (ContParams m ())
a <- Point m
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ())))
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Event m (Maybe (ContParams m ()))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m ()))
x
     case Maybe (ContParams m ())
a of
       Maybe (ContParams m ())
Nothing -> 
         () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ContParams m ()
c ->
         do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Maybe (ContParams m ()) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x Maybe (ContParams m ())
forall a. Maybe a
Nothing
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()

-- | Reactivate a process with the specified identifier immediately.
reactivateProcessImmediately :: MonadDES m => ProcessId m -> Event m ()
{-# INLINABLE reactivateProcessImmediately #-}
reactivateProcessImmediately :: ProcessId m -> Event m ()
reactivateProcessImmediately ProcessId m
pid =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let x :: Ref m (Maybe (ContParams m ()))
x = ProcessId m -> Ref m (Maybe (ContParams m ()))
forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
     Maybe (ContParams m ())
a <- Point m
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ())))
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Event m (Maybe (ContParams m ()))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m ()))
x
     case Maybe (ContParams m ())
a of
       Maybe (ContParams m ())
Nothing -> 
         () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ContParams m ()
c ->
         do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m ()))
-> Maybe (ContParams m ()) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x Maybe (ContParams m ())
forall a. Maybe a
Nothing
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()

-- | Prepare the processes identifier for running.
processIdPrepare :: MonadDES m => ProcessId m -> Event m ()
{-# INLINABLE processIdPrepare #-}
processIdPrepare :: ProcessId m -> Event m ()
processIdPrepare ProcessId m
pid =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
y <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ProcessId m -> Ref m Bool
forall (m :: * -> *). ProcessId m -> Ref m Bool
processStarted ProcessId m
pid)
     if Bool
y
       then [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$
            [Char]
"Another process with the specified identifier " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"has been started already: processIdPrepare"
       else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ProcessId m -> Ref m Bool
forall (m :: * -> *). ProcessId m -> Ref m Bool
processStarted ProcessId m
pid) Bool
True
     let signal :: Signal m ContEvent
signal = ContId m -> Signal m ContEvent
forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal (ContId m -> Signal m ContEvent) -> ContId m -> Signal m ContEvent
forall a b. (a -> b) -> a -> b
$ ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
       Signal m ContEvent -> (ContEvent -> Event m ()) -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> (a -> Event m ()) -> Event m ()
handleSignal_ Signal m ContEvent
signal ((ContEvent -> Event m ()) -> Event m ())
-> (ContEvent -> Event m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \ContEvent
e ->
       (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
       case ContEvent
e of
         ContEvent
ContCancellationInitiating ->
           do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContId m -> Event m Bool
forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contCancellationActivated (ContId m -> Event m Bool) -> ContId m -> Event m Bool
forall a b. (a -> b) -> a -> b
$ ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
interruptProcess ProcessId m
pid
                   Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
reactivateProcess ProcessId m
pid
         ContEvent
ContPreemptionBeginning ->
           Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processPreempted ProcessId m
pid
         ContEvent
ContPreemptionEnding ->
           () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Run immediately the process. A new 'ProcessId' identifier will be
-- assigned to the process.
--            
-- To run the process at the specified time, you can use
-- the 'enqueueProcess' function.
runProcess :: MonadDES m => Process m () -> Event m ()
{-# INLINABLE runProcess #-}
runProcess :: Process m () -> Event m ()
runProcess Process m ()
p =
  do ProcessId m
pid <- Simulation m (ProcessId m) -> Event m (ProcessId m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation Simulation m (ProcessId m)
forall (m :: * -> *). MonadDES m => Simulation m (ProcessId m)
newProcessId
     ProcessId m -> Process m () -> Event m ()
forall (m :: * -> *).
MonadDES m =>
ProcessId m -> Process m () -> Event m ()
runProcessUsingId ProcessId m
pid Process m ()
p
             
-- | Run immediately the process with the specified identifier.
-- It will be more efficient than as you would specify the process identifier
-- with help of the 'processUsingId' combinator and then would call 'runProcess'.
--            
-- To run the process at the specified time, you can use
-- the 'enqueueProcessUsingId' function.
runProcessUsingId :: MonadDES m => ProcessId m -> Process m () -> Event m ()
{-# INLINABLE runProcessUsingId #-}
runProcessUsingId :: ProcessId m -> Process m () -> Event m ()
runProcessUsingId ProcessId m
pid Process m ()
p =
  do ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processIdPrepare ProcessId m
pid
     Cont m ()
-> (() -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m ()
m () -> Event m ()
forall a. a -> Event m a
cont SomeException -> Event m ()
forall a. SomeException -> Event m a
econt () -> Event m ()
forall a. a -> Event m a
ccont (ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid) Bool
False
       where cont :: a -> Event m a
cont  = a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return
             econt :: SomeException -> Event m a
econt = SomeException -> Event m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent
             ccont :: a -> Event m a
ccont = a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return
             m :: Cont m ()
m = ProcessId m -> Process m () -> Cont m ()
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid Process m ()
p

-- | Run the process in the start time immediately involving all pending
-- 'CurrentEvents' in the computation too.
runProcessInStartTime :: MonadDES m => Process m () -> Simulation m ()
{-# INLINABLE runProcessInStartTime #-}
runProcessInStartTime :: Process m () -> Simulation m ()
runProcessInStartTime = Event m () -> Simulation m ()
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStartTime (Event m () -> Simulation m ())
-> (Process m () -> Event m ()) -> Process m () -> Simulation m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process m () -> Event m ()
forall (m :: * -> *). MonadDES m => Process m () -> Event m ()
runProcess

-- | Run the process in the start time immediately using the specified identifier
-- and involving all pending 'CurrentEvents' in the computation too.
runProcessInStartTimeUsingId :: MonadDES m => ProcessId m -> Process m () -> Simulation m ()
{-# INLINABLE runProcessInStartTimeUsingId #-}
runProcessInStartTimeUsingId :: ProcessId m -> Process m () -> Simulation m ()
runProcessInStartTimeUsingId ProcessId m
pid Process m ()
p =
  Event m () -> Simulation m ()
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStartTime (Event m () -> Simulation m ()) -> Event m () -> Simulation m ()
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Process m () -> Event m ()
forall (m :: * -> *).
MonadDES m =>
ProcessId m -> Process m () -> Event m ()
runProcessUsingId ProcessId m
pid Process m ()
p

-- | Run the process in the final simulation time immediately involving all
-- pending 'CurrentEvents' in the computation too.
runProcessInStopTime :: MonadDES m => Process m () -> Simulation m ()
{-# INLINABLE runProcessInStopTime #-}
runProcessInStopTime :: Process m () -> Simulation m ()
runProcessInStopTime = Event m () -> Simulation m ()
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStopTime (Event m () -> Simulation m ())
-> (Process m () -> Event m ()) -> Process m () -> Simulation m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process m () -> Event m ()
forall (m :: * -> *). MonadDES m => Process m () -> Event m ()
runProcess

-- | Run the process in the final simulation time immediately using 
-- the specified identifier and involving all pending 'CurrentEvents'
-- in the computation too.
runProcessInStopTimeUsingId :: MonadDES m => ProcessId m -> Process m () -> Simulation m ()
{-# INLINABLE runProcessInStopTimeUsingId #-}
runProcessInStopTimeUsingId :: ProcessId m -> Process m () -> Simulation m ()
runProcessInStopTimeUsingId ProcessId m
pid Process m ()
p =
  Event m () -> Simulation m ()
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStopTime (Event m () -> Simulation m ()) -> Event m () -> Simulation m ()
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Process m () -> Event m ()
forall (m :: * -> *).
MonadDES m =>
ProcessId m -> Process m () -> Event m ()
runProcessUsingId ProcessId m
pid Process m ()
p

-- | Enqueue the process that will be then started at the specified time
-- from the event queue.
enqueueProcess :: MonadDES m => Double -> Process m () -> Event m ()
{-# INLINABLE enqueueProcess #-}
enqueueProcess :: Double -> Process m () -> Event m ()
enqueueProcess Double
t Process m ()
p =
  Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$ Process m () -> Event m ()
forall (m :: * -> *). MonadDES m => Process m () -> Event m ()
runProcess Process m ()
p

-- | Enqueue the process that will be then started at the specified time
-- from the event queue.
enqueueProcessUsingId :: MonadDES m => Double -> ProcessId m -> Process m () -> Event m ()
{-# INLINABLE enqueueProcessUsingId #-}
enqueueProcessUsingId :: Double -> ProcessId m -> Process m () -> Event m ()
enqueueProcessUsingId Double
t ProcessId m
pid Process m ()
p =
  Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Process m () -> Event m ()
forall (m :: * -> *).
MonadDES m =>
ProcessId m -> Process m () -> Event m ()
runProcessUsingId ProcessId m
pid Process m ()
p

-- | Return the current process identifier.
processId :: MonadDES m => Process m (ProcessId m)
{-# INLINABLE processId #-}
processId :: Process m (ProcessId m)
processId = (ProcessId m -> Cont m (ProcessId m)) -> Process m (ProcessId m)
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ProcessId m -> Cont m (ProcessId m)
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Create a new process identifier.
newProcessId :: MonadDES m => Simulation m (ProcessId m)
{-# INLINABLE newProcessId #-}
newProcessId :: Simulation m (ProcessId m)
newProcessId =
  (Run m -> m (ProcessId m)) -> Simulation m (ProcessId m)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (ProcessId m)) -> Simulation m (ProcessId m))
-> (Run m -> m (ProcessId m)) -> Simulation m (ProcessId m)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  do Ref m (Maybe (ContParams m ()))
x <- Run m
-> Simulation m (Ref m (Maybe (ContParams m ())))
-> m (Ref m (Maybe (ContParams m ())))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (ContParams m ())))
 -> m (Ref m (Maybe (ContParams m ()))))
-> Simulation m (Ref m (Maybe (ContParams m ())))
-> m (Ref m (Maybe (ContParams m ())))
forall a b. (a -> b) -> a -> b
$ Maybe (ContParams m ())
-> Simulation m (Ref m (Maybe (ContParams m ())))
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (ContParams m ())
forall a. Maybe a
Nothing
     Ref m Bool
y <- Run m -> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Bool) -> m (Ref m Bool))
-> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Simulation m (Ref m Bool)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
     ContId m
c <- Run m -> Simulation m (ContId m) -> m (ContId m)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (ContId m) -> m (ContId m))
-> Simulation m (ContId m) -> m (ContId m)
forall a b. (a -> b) -> a -> b
$ Simulation m (ContId m)
forall (m :: * -> *). MonadDES m => Simulation m (ContId m)
newContId
     Ref m Bool
i <- Run m -> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Bool) -> m (Ref m Bool))
-> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Simulation m (Ref m Bool)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
     Ref m (Maybe (ContParams m ()))
z <- Run m
-> Simulation m (Ref m (Maybe (ContParams m ())))
-> m (Ref m (Maybe (ContParams m ())))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (ContParams m ())))
 -> m (Ref m (Maybe (ContParams m ()))))
-> Simulation m (Ref m (Maybe (ContParams m ())))
-> m (Ref m (Maybe (ContParams m ())))
forall a b. (a -> b) -> a -> b
$ Maybe (ContParams m ())
-> Simulation m (Ref m (Maybe (ContParams m ())))
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (ContParams m ())
forall a. Maybe a
Nothing
     Ref m Double
t <- Run m -> Simulation m (Ref m Double) -> m (Ref m Double)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Double) -> m (Ref m Double))
-> Simulation m (Ref m Double) -> m (Ref m Double)
forall a b. (a -> b) -> a -> b
$ Double -> Simulation m (Ref m Double)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Double
0
     Ref m Int
v <- Run m -> Simulation m (Ref m Int) -> m (Ref m Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Int) -> m (Ref m Int))
-> Simulation m (Ref m Int) -> m (Ref m Int)
forall a b. (a -> b) -> a -> b
$ Int -> Simulation m (Ref m Int)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
     ProcessId m -> m (ProcessId m)
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessId :: forall (m :: * -> *).
Ref m Bool
-> Ref m (Maybe (ContParams m ()))
-> ContId m
-> Ref m Bool
-> Ref m (Maybe (ContParams m ()))
-> Ref m Double
-> Ref m Int
-> ProcessId m
ProcessId { processStarted :: Ref m Bool
processStarted = Ref m Bool
y,
                        processReactCont :: Ref m (Maybe (ContParams m ()))
processReactCont     = Ref m (Maybe (ContParams m ()))
x, 
                        processContId :: ContId m
processContId  = ContId m
c, 
                        processInterruptRef :: Ref m Bool
processInterruptRef  = Ref m Bool
i,
                        processInterruptCont :: Ref m (Maybe (ContParams m ()))
processInterruptCont = Ref m (Maybe (ContParams m ()))
z,
                        processInterruptTime :: Ref m Double
processInterruptTime = Ref m Double
t,
                        processInterruptVersion :: Ref m Int
processInterruptVersion = Ref m Int
v }

-- | Cancel a process with the specified identifier, interrupting it if needed.
cancelProcessWithId :: MonadDES m => ProcessId m -> Event m ()
{-# INLINABLE cancelProcessWithId #-}
cancelProcessWithId :: ProcessId m -> Event m ()
cancelProcessWithId ProcessId m
pid = ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate (ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid)

-- | The process cancels itself.
cancelProcess :: MonadDES m => Process m a
{-# INLINABLE cancelProcess #-}
cancelProcess :: Process m a
cancelProcess =
  do ProcessId m
pid <- Process m (ProcessId m)
forall (m :: * -> *). MonadDES m => Process m (ProcessId m)
processId
     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
$ ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
cancelProcessWithId ProcessId m
pid
     SomeException -> Process m a
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Process m a
throwProcess (SomeException -> Process m a) -> SomeException -> Process m a
forall a b. (a -> b) -> a -> b
$ 
       ([Char] -> SomeException
forall a. HasCallStack => [Char] -> a
error [Char]
"The process must be cancelled already: cancelProcess." :: SomeException)

-- | Test whether the process with the specified identifier was cancelled.
processCancelled :: MonadDES m => ProcessId m -> Event m Bool
{-# INLINABLE processCancelled #-}
processCancelled :: ProcessId m -> Event m Bool
processCancelled ProcessId m
pid = ContId m -> Event m Bool
forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contCancellationInitiated (ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid)

-- | Return a signal that notifies about cancelling the process with 
-- the specified identifier.
processCancelling :: MonadDES m => ProcessId m -> Signal m ()
{-# INLINABLE processCancelling #-}
processCancelling :: ProcessId m -> Signal m ()
processCancelling ProcessId m
pid = ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating (ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid)

-- | Register a handler that will be invoked in case of cancelling the current process.
whenCancellingProcess :: MonadDES m => Event m () -> Process m ()
{-# INLINABLE whenCancellingProcess #-}
whenCancellingProcess :: Event m () -> Process m ()
whenCancellingProcess Event m ()
h =
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  Event m () -> Cont m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Cont m ()) -> Event m () -> Cont m ()
forall a b. (a -> b) -> a -> b
$
  Signal m () -> (() -> Event m ()) -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> (a -> Event m ()) -> Event m ()
handleSignal_ (ProcessId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Signal m ()
processCancelling ProcessId m
pid) ((() -> Event m ()) -> Event m ())
-> (() -> Event m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \() -> Event m ()
h

-- | Preempt a process with the specified identifier.
processPreemptionBegin :: MonadDES m => ProcessId m -> Event m ()
processPreemptionBegin :: ProcessId m -> Event m ()
processPreemptionBegin ProcessId m
pid = ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contPreemptionBegin (ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid)

-- | Proceed with the process with the specified identifier after it was preempted with help of 'preemptProcessBegin'.
processPreemptionEnd :: MonadDES m => ProcessId m -> Event m ()
processPreemptionEnd :: ProcessId m -> Event m ()
processPreemptionEnd ProcessId m
pid = ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contPreemptionEnd (ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid)

-- | Return a signal when the process is preempted.
processPreemptionBeginning :: MonadDES m => ProcessId m -> Signal m ()
processPreemptionBeginning :: ProcessId m -> Signal m ()
processPreemptionBeginning ProcessId m
pid = ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contPreemptionBeginning (ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid)

-- | Return a signal when the process is proceeded after it was preempted earlier.
processPreemptionEnding :: MonadDES m => ProcessId m -> Signal m ()
processPreemptionEnding :: ProcessId m -> Signal m ()
processPreemptionEnding ProcessId m
pid = ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contPreemptionEnding (ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid)

instance MonadDES m => Eq (ProcessId m) where

  {-# INLINE (==) #-}
  ProcessId m
x == :: ProcessId m -> ProcessId m -> Bool
== ProcessId m
y = ProcessId m -> Ref m Bool
forall (m :: * -> *). ProcessId m -> Ref m Bool
processStarted ProcessId m
x Ref m Bool -> Ref m Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId m -> Ref m Bool
forall (m :: * -> *). ProcessId m -> Ref m Bool
processStarted ProcessId m
y

instance MonadDES m => Monad (Process m) where

  {-# INLINE return #-}
  return :: a -> Process m a
return a
a = (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (ProcessId m -> Cont m a) -> Process m a
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid -> a -> Cont m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

  {-# INLINE (>>=) #-}
  (Process ProcessId m -> Cont m a
m) >>= :: Process m a -> (a -> Process m b) -> Process m b
>>= a -> Process m b
k =
    (ProcessId m -> Cont m b) -> Process m b
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m b) -> Process m b)
-> (ProcessId m -> Cont m b) -> Process m b
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid -> 
    do a
a <- ProcessId m -> Cont m a
m ProcessId m
pid
       let Process ProcessId m -> Cont m b
m' = a -> Process m b
k a
a
       ProcessId m -> Cont m b
m' ProcessId m
pid

instance MonadDES m => MonadCompTrans Process m where

  {-# INLINE liftComp #-}
  liftComp :: m a -> Process m a
liftComp = (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (m a -> ProcessId m -> Cont m a) -> m a -> Process m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cont m a -> ProcessId m -> Cont m a
forall a b. a -> b -> a
const (Cont m a -> ProcessId m -> Cont m a)
-> (m a -> Cont m a) -> m a -> ProcessId m -> Cont m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Cont m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadCompTrans t m =>
m a -> t m a
liftComp

instance MonadDES m => Functor (Process m) where
  
  {-# INLINE fmap #-}
  fmap :: (a -> b) -> Process m a -> Process m b
fmap a -> b
f (Process ProcessId m -> Cont m a
x) = (ProcessId m -> Cont m b) -> Process m b
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m b) -> Process m b)
-> (ProcessId m -> Cont m b) -> Process m b
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid -> (a -> b) -> Cont m a -> Cont m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Cont m a -> Cont m b) -> Cont m a -> Cont m b
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Cont m a
x ProcessId m
pid

instance MonadDES m => Applicative (Process m) where
  
  {-# INLINE pure #-}
  pure :: a -> Process m a
pure = (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (a -> ProcessId m -> Cont m a) -> a -> Process m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cont m a -> ProcessId m -> Cont m a
forall a b. a -> b -> a
const (Cont m a -> ProcessId m -> Cont m a)
-> (a -> Cont m a) -> a -> ProcessId m -> Cont m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Cont m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  
  {-# INLINE (<*>) #-}
  (Process ProcessId m -> Cont m (a -> b)
x) <*> :: Process m (a -> b) -> Process m a -> Process m b
<*> (Process ProcessId m -> Cont m a
y) = (ProcessId m -> Cont m b) -> Process m b
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m b) -> Process m b)
-> (ProcessId m -> Cont m b) -> Process m b
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid -> ProcessId m -> Cont m (a -> b)
x ProcessId m
pid Cont m (a -> b) -> Cont m a -> Cont m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProcessId m -> Cont m a
y ProcessId m
pid

instance MonadDES m => MonadFail (Process m) where

  {-# INLINE fail #-}
  fail :: [Char] -> Process m a
fail = [Char] -> Process m a
forall a. HasCallStack => [Char] -> a
error

instance (MonadDES m, MonadIO m) => MonadIO (Process m) where
  
  {-# INLINE liftIO #-}
  liftIO :: IO a -> Process m a
liftIO = (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (IO a -> ProcessId m -> Cont m a) -> IO a -> Process m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cont m a -> ProcessId m -> Cont m a
forall a b. a -> b -> a
const (Cont m a -> ProcessId m -> Cont m a)
-> (IO a -> Cont m a) -> IO a -> ProcessId m -> Cont m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Cont m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadDES m => ParameterLift Process m where

  {-# INLINE liftParameter #-}
  liftParameter :: Parameter m a -> Process m a
liftParameter = (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (Parameter m a -> ProcessId m -> Cont m a)
-> Parameter m a
-> Process m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cont m a -> ProcessId m -> Cont m a
forall a b. a -> b -> a
const (Cont m a -> ProcessId m -> Cont m a)
-> (Parameter m a -> Cont m a)
-> Parameter m a
-> ProcessId m
-> Cont m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parameter m a -> Cont m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
ParameterLift t m =>
Parameter m a -> t m a
liftParameter

instance MonadDES m => SimulationLift Process m where

  {-# INLINE liftSimulation #-}
  liftSimulation :: Simulation m a -> Process m a
liftSimulation = (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (Simulation m a -> ProcessId m -> Cont m a)
-> Simulation m a
-> Process m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cont m a -> ProcessId m -> Cont m a
forall a b. a -> b -> a
const (Cont m a -> ProcessId m -> Cont m a)
-> (Simulation m a -> Cont m a)
-> Simulation m a
-> ProcessId m
-> Cont m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Simulation m a -> Cont m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation
  
instance MonadDES m => DynamicsLift Process m where

  {-# INLINE liftDynamics #-}
  liftDynamics :: Dynamics m a -> Process m a
liftDynamics = (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (Dynamics m a -> ProcessId m -> Cont m a)
-> Dynamics m a
-> Process m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cont m a -> ProcessId m -> Cont m a
forall a b. a -> b -> a
const (Cont m a -> ProcessId m -> Cont m a)
-> (Dynamics m a -> Cont m a)
-> Dynamics m a
-> ProcessId m
-> Cont m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamics m a -> Cont m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
DynamicsLift t m =>
Dynamics m a -> t m a
liftDynamics
  
instance MonadDES m => EventLift Process m where

  {-# INLINE liftEvent #-}
  liftEvent :: Event m a -> Process m a
liftEvent = (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (Event m a -> ProcessId m -> Cont m a)
-> Event m a
-> Process m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cont m a -> ProcessId m -> Cont m a
forall a b. a -> b -> a
const (Cont m a -> ProcessId m -> Cont m a)
-> (Event m a -> Cont m a) -> Event m a -> ProcessId m -> Cont m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event m a -> Cont m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent

instance MonadDES m => ProcessLift Process m where

  {-# INLINE liftProcess #-}
  liftProcess :: Process m a -> Process m a
liftProcess = Process m a -> Process m a
forall a. a -> a
id

instance MonadDES m => MC.MonadThrow (Process m) where

  {-# INLINE throwM #-}
  throwM :: e -> Process m a
throwM = e -> Process m a
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Process m a
throwProcess

instance MonadDES m => MC.MonadCatch (Process m) where

  {-# INLINE catch #-}
  catch :: Process m a -> (e -> Process m a) -> Process m a
catch = Process m a -> (e -> Process m a) -> Process m a
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
Process m a -> (e -> Process m a) -> Process m a
catchProcess

-- | Exception handling within 'Process' computations.
catchProcess :: (MonadDES m, Exception e) => Process m a -> (e -> Process m a) -> Process m a
{-# INLINABLE catchProcess #-}
catchProcess :: Process m a -> (e -> Process m a) -> Process m a
catchProcess (Process ProcessId m -> Cont m a
m) e -> Process m a
h =
  (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (ProcessId m -> Cont m a) -> Process m a
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  Cont m a -> (e -> Cont m a) -> Cont m a
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
Cont m a -> (e -> Cont m a) -> Cont m a
catchCont (ProcessId m -> Cont m a
m ProcessId m
pid) ((e -> Cont m a) -> Cont m a) -> (e -> Cont m a) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \e
e ->
  let Process ProcessId m -> Cont m a
m' = e -> Process m a
h e
e in ProcessId m -> Cont m a
m' ProcessId m
pid
                           
-- | A computation with finalization part.
finallyProcess :: MonadDES m => Process m a -> Process m b -> Process m a
{-# INLINABLE finallyProcess #-}
finallyProcess :: Process m a -> Process m b -> Process m a
finallyProcess (Process ProcessId m -> Cont m a
m) (Process ProcessId m -> Cont m b
m') =
  (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (ProcessId m -> Cont m a) -> Process m a
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  Cont m a -> Cont m b -> Cont m a
forall (m :: * -> *) a b.
MonadDES m =>
Cont m a -> Cont m b -> Cont m a
finallyCont (ProcessId m -> Cont m a
m ProcessId m
pid) (ProcessId m -> Cont m b
m' ProcessId m
pid)

-- | Throw the exception with the further exception handling.
-- 
-- By some reason, an exception raised with help of the standard 'throw' function
-- is not handled properly within 'Process' computation, altough it will be still handled 
-- if it will be wrapped in the 'IO' monad. Therefore, you should use specialised
-- functions like the stated one that use the 'throw' function but within the 'IO' computation,
-- which allows already handling the exception.
throwProcess :: (MonadDES m, Exception e) => e -> Process m a
{-# INLINABLE throwProcess #-}
throwProcess :: e -> Process m a
throwProcess = Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m a -> Process m a) -> (e -> Event m a) -> e -> Process m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Event m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent

-- | Execute the specified computations in parallel within
-- the current computation and return their results. The cancellation
-- of any of the nested computations affects the current computation.
-- The exception raised in any of the nested computations is propagated
-- to the current computation as well.
--
-- Here word @parallel@ literally means that the computations are
-- actually executed on a single operating system thread but
-- they are processed simultaneously by the event queue.
--
-- New 'ProcessId' identifiers will be assigned to the started processes.
processParallel :: MonadDES m => [Process m a] -> Process m [a]
{-# INLINABLE processParallel #-}
processParallel :: [Process m a] -> Process m [a]
processParallel [Process m a]
xs =
  Simulation m [(ProcessId m, Process m a)]
-> Process m [(ProcessId m, Process m a)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation ([Process m a] -> Simulation m [(ProcessId m, Process m a)]
forall (m :: * -> *) a.
MonadDES m =>
[Process m a] -> Simulation m [(ProcessId m, Process m a)]
processParallelCreateIds [Process m a]
xs) Process m [(ProcessId m, Process m a)]
-> ([(ProcessId m, Process m a)] -> Process m [a]) -> Process m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(ProcessId m, Process m a)] -> Process m [a]
forall (m :: * -> *) a.
MonadDES m =>
[(ProcessId m, Process m a)] -> Process m [a]
processParallelUsingIds 

-- | Like 'processParallel' but allows specifying the process identifiers.
-- It will be more efficient than as you would specify the process identifiers
-- with help of the 'processUsingId' combinator and then would call 'processParallel'.
processParallelUsingIds :: MonadDES m => [(ProcessId m, Process m a)] -> Process m [a]
{-# INLINABLE processParallelUsingIds #-}
processParallelUsingIds :: [(ProcessId m, Process m a)] -> Process m [a]
processParallelUsingIds [(ProcessId m, Process m a)]
xs =
  (ProcessId m -> Cont m [a]) -> Process m [a]
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m [a]) -> Process m [a])
-> (ProcessId m -> Cont m [a]) -> Process m [a]
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  do Event m () -> Cont m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Cont m ()) -> Event m () -> Cont m ()
forall a b. (a -> b) -> a -> b
$ [(ProcessId m, Process m a)] -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
[(ProcessId m, Process m a)] -> Event m ()
processParallelPrepare [(ProcessId m, Process m a)]
xs
     [(Cont m a, ContId m)] -> Cont m [a]
forall (m :: * -> *) a.
MonadDES m =>
[(Cont m a, ContId m)] -> Cont m [a]
contParallel ([(Cont m a, ContId m)] -> Cont m [a])
-> [(Cont m a, ContId m)] -> Cont m [a]
forall a b. (a -> b) -> a -> b
$
       (((ProcessId m, Process m a) -> (Cont m a, ContId m))
 -> [(ProcessId m, Process m a)] -> [(Cont m a, ContId m)])
-> [(ProcessId m, Process m a)]
-> ((ProcessId m, Process m a) -> (Cont m a, ContId m))
-> [(Cont m a, ContId m)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ProcessId m, Process m a) -> (Cont m a, ContId m))
-> [(ProcessId m, Process m a)] -> [(Cont m a, ContId m)]
forall a b. (a -> b) -> [a] -> [b]
map [(ProcessId m, Process m a)]
xs (((ProcessId m, Process m a) -> (Cont m a, ContId m))
 -> [(Cont m a, ContId m)])
-> ((ProcessId m, Process m a) -> (Cont m a, ContId m))
-> [(Cont m a, ContId m)]
forall a b. (a -> b) -> a -> b
$ \(ProcessId m
pid, Process m a
m) ->
       (ProcessId m -> Process m a -> Cont m a
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid Process m a
m, ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid)

-- | Like 'processParallel' but ignores the result.
processParallel_ :: MonadDES m => [Process m a] -> Process m ()
{-# INLINABLE processParallel_ #-}
processParallel_ :: [Process m a] -> Process m ()
processParallel_ [Process m a]
xs =
  Simulation m [(ProcessId m, Process m a)]
-> Process m [(ProcessId m, Process m a)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation ([Process m a] -> Simulation m [(ProcessId m, Process m a)]
forall (m :: * -> *) a.
MonadDES m =>
[Process m a] -> Simulation m [(ProcessId m, Process m a)]
processParallelCreateIds [Process m a]
xs) Process m [(ProcessId m, Process m a)]
-> ([(ProcessId m, Process m a)] -> Process m ()) -> Process m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(ProcessId m, Process m a)] -> Process m ()
forall (m :: * -> *) a.
MonadDES m =>
[(ProcessId m, Process m a)] -> Process m ()
processParallelUsingIds_ 

-- | Like 'processParallelUsingIds' but ignores the result.
processParallelUsingIds_ :: MonadDES m => [(ProcessId m, Process m a)] -> Process m ()
{-# INLINABLE processParallelUsingIds_ #-}
processParallelUsingIds_ :: [(ProcessId m, Process m a)] -> Process m ()
processParallelUsingIds_ [(ProcessId m, Process m a)]
xs =
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  do Event m () -> Cont m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Cont m ()) -> Event m () -> Cont m ()
forall a b. (a -> b) -> a -> b
$ [(ProcessId m, Process m a)] -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
[(ProcessId m, Process m a)] -> Event m ()
processParallelPrepare [(ProcessId m, Process m a)]
xs
     [(Cont m a, ContId m)] -> Cont m ()
forall (m :: * -> *) a.
MonadDES m =>
[(Cont m a, ContId m)] -> Cont m ()
contParallel_ ([(Cont m a, ContId m)] -> Cont m ())
-> [(Cont m a, ContId m)] -> Cont m ()
forall a b. (a -> b) -> a -> b
$
       (((ProcessId m, Process m a) -> (Cont m a, ContId m))
 -> [(ProcessId m, Process m a)] -> [(Cont m a, ContId m)])
-> [(ProcessId m, Process m a)]
-> ((ProcessId m, Process m a) -> (Cont m a, ContId m))
-> [(Cont m a, ContId m)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ProcessId m, Process m a) -> (Cont m a, ContId m))
-> [(ProcessId m, Process m a)] -> [(Cont m a, ContId m)]
forall a b. (a -> b) -> [a] -> [b]
map [(ProcessId m, Process m a)]
xs (((ProcessId m, Process m a) -> (Cont m a, ContId m))
 -> [(Cont m a, ContId m)])
-> ((ProcessId m, Process m a) -> (Cont m a, ContId m))
-> [(Cont m a, ContId m)]
forall a b. (a -> b) -> a -> b
$ \(ProcessId m
pid, Process m a
m) ->
       (ProcessId m -> Process m a -> Cont m a
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid Process m a
m, ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid)

-- | Create the new process identifiers.
processParallelCreateIds :: MonadDES m => [Process m a] -> Simulation m [(ProcessId m, Process m a)]
{-# INLINABLE processParallelCreateIds #-}
processParallelCreateIds :: [Process m a] -> Simulation m [(ProcessId m, Process m a)]
processParallelCreateIds [Process m a]
xs =
  do [ProcessId m]
pids <- Simulation m [ProcessId m] -> Simulation m [ProcessId m]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m [ProcessId m] -> Simulation m [ProcessId m])
-> Simulation m [ProcessId m] -> Simulation m [ProcessId m]
forall a b. (a -> b) -> a -> b
$ [Process m a]
-> (Process m a -> Simulation m (ProcessId m))
-> Simulation m [ProcessId m]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Process m a]
xs ((Process m a -> Simulation m (ProcessId m))
 -> Simulation m [ProcessId m])
-> (Process m a -> Simulation m (ProcessId m))
-> Simulation m [ProcessId m]
forall a b. (a -> b) -> a -> b
$ Simulation m (ProcessId m)
-> Process m a -> Simulation m (ProcessId m)
forall a b. a -> b -> a
const Simulation m (ProcessId m)
forall (m :: * -> *). MonadDES m => Simulation m (ProcessId m)
newProcessId
     [(ProcessId m, Process m a)]
-> Simulation m [(ProcessId m, Process m a)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ProcessId m, Process m a)]
 -> Simulation m [(ProcessId m, Process m a)])
-> [(ProcessId m, Process m a)]
-> Simulation m [(ProcessId m, Process m a)]
forall a b. (a -> b) -> a -> b
$ [ProcessId m] -> [Process m a] -> [(ProcessId m, Process m a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ProcessId m]
pids [Process m a]
xs

-- | Prepare the processes for parallel execution.
processParallelPrepare :: MonadDES m => [(ProcessId m, Process m a)] -> Event m ()
{-# INLINABLE processParallelPrepare #-}
processParallelPrepare :: [(ProcessId m, Process m a)] -> Event m ()
processParallelPrepare [(ProcessId m, Process m a)]
xs =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  [(ProcessId m, Process m a)]
-> ((ProcessId m, Process m a) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ProcessId m, Process m a)]
xs (((ProcessId m, Process m a) -> m ()) -> m ())
-> ((ProcessId m, Process m a) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ())
-> ((ProcessId m, Process m a) -> Event m ())
-> (ProcessId m, Process m a)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processIdPrepare (ProcessId m -> Event m ())
-> ((ProcessId m, Process m a) -> ProcessId m)
-> (ProcessId m, Process m a)
-> Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcessId m, Process m a) -> ProcessId m
forall a b. (a, b) -> a
fst

-- | Allow calling the process with the specified identifier.
-- It creates a nested process when canceling any of two, or raising an
-- @IO@ exception in any of the both, affects the 'Process' computation.
--
-- At the same time, the interruption has no such effect as it requires
-- explicit specifying the 'ProcessId' identifier of the nested process itself,
-- that is the nested process cannot be interrupted using only the parent
-- process identifier.
processUsingId :: MonadDES m => ProcessId m -> Process m a -> Process m a
{-# INLINABLE processUsingId #-}
processUsingId :: ProcessId m -> Process m a -> Process m a
processUsingId ProcessId m
pid Process m a
x =
  (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (ProcessId m -> Cont m a) -> Process m a
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid' ->
  do Event m () -> Cont m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Cont m ()) -> Event m () -> Cont m ()
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processIdPrepare ProcessId m
pid
     Cont m a -> ContId m -> Cont m a
forall (m :: * -> *) a.
MonadDES m =>
Cont m a -> ContId m -> Cont m a
rerunCont (ProcessId m -> Process m a -> Cont m a
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid Process m a
x) (ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid)

-- | Spawn the child process. In case of cancelling one of the processes,
-- other process will be cancelled too.
spawnProcess :: MonadDES m => Process m () -> Process m ()
{-# INLINABLE spawnProcess #-}
spawnProcess :: Process m () -> Process m ()
spawnProcess = ContCancellation -> Process m () -> Process m ()
forall (m :: * -> *).
MonadDES m =>
ContCancellation -> Process m () -> Process m ()
spawnProcessWith ContCancellation
CancelTogether

-- | Spawn the child process specifying the process identifier.
-- In case of cancelling one of the processes, other process will be cancelled too.
spawnProcessUsingId :: MonadDES m => ProcessId m -> Process m () -> Process m ()
{-# INLINABLE spawnProcessUsingId #-}
spawnProcessUsingId :: ProcessId m -> Process m () -> Process m ()
spawnProcessUsingId = ContCancellation -> ProcessId m -> Process m () -> Process m ()
forall (m :: * -> *).
MonadDES m =>
ContCancellation -> ProcessId m -> Process m () -> Process m ()
spawnProcessUsingIdWith ContCancellation
CancelTogether

-- | Spawn the child process specifying how the child and parent processes
-- should be cancelled in case of need.
spawnProcessWith :: MonadDES m => ContCancellation -> Process m () -> Process m ()
{-# INLINABLE spawnProcessWith #-}
spawnProcessWith :: ContCancellation -> Process m () -> Process m ()
spawnProcessWith ContCancellation
cancellation Process m ()
x =
  do ProcessId m
pid <- Simulation m (ProcessId m) -> Process m (ProcessId m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation Simulation m (ProcessId m)
forall (m :: * -> *). MonadDES m => Simulation m (ProcessId m)
newProcessId
     ContCancellation -> ProcessId m -> Process m () -> Process m ()
forall (m :: * -> *).
MonadDES m =>
ContCancellation -> ProcessId m -> Process m () -> Process m ()
spawnProcessUsingIdWith ContCancellation
cancellation ProcessId m
pid Process m ()
x

-- | Spawn the child process specifying how the child and parent processes
-- should be cancelled in case of need.
spawnProcessUsingIdWith :: MonadDES m => ContCancellation -> ProcessId m -> Process m () -> Process m ()
{-# INLINABLE spawnProcessUsingIdWith #-}
spawnProcessUsingIdWith :: ContCancellation -> ProcessId m -> Process m () -> Process m ()
spawnProcessUsingIdWith ContCancellation
cancellation ProcessId m
pid Process m ()
x =
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid' ->
  do Event m () -> Cont m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Cont m ()) -> Event m () -> Cont m ()
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processIdPrepare ProcessId m
pid
     ContCancellation -> Cont m () -> ContId m -> Cont m ()
forall (m :: * -> *).
MonadDES m =>
ContCancellation -> Cont m () -> ContId m -> Cont m ()
spawnCont ContCancellation
cancellation (ProcessId m -> Process m () -> Cont m ()
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid Process m ()
x) (ProcessId m -> ContId m
forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid)

-- | Await the signal.
processAwait :: MonadDES m => Signal m a -> Process m a
{-# INLINABLE processAwait #-}
processAwait :: Signal m a -> Process m a
processAwait Signal m a
signal =
  (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (ProcessId m -> Cont m a) -> Process m a
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid -> Signal m a -> Cont m a
forall (m :: * -> *) a. MonadDES m => Signal m a -> Cont m a
contAwait Signal m a
signal

-- | The result of memoization.
data MemoResult a = MemoComputed a
                  | MemoError IOException
                  | MemoCancelled

-- | Memoize the process so that it would always return the same value
-- within the simulation run.
memoProcess :: MonadDES m => Process m a -> Simulation m (Process m a)
{-# INLINABLE memoProcess #-}
memoProcess :: Process m a -> Simulation m (Process m a)
memoProcess Process m a
x =
  (Run m -> m (Process m a)) -> Simulation m (Process m a)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Process m a)) -> Simulation m (Process m a))
-> (Run m -> m (Process m a)) -> Simulation m (Process m a)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  do Ref m Bool
started  <- Run m -> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Bool) -> m (Ref m Bool))
-> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Simulation m (Ref m Bool)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
     SignalSource m ()
computed <- Run m -> Simulation m (SignalSource m ()) -> m (SignalSource m ())
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r Simulation m (SignalSource m ())
forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
     Ref m (Maybe (MemoResult a))
value    <- Run m
-> Simulation m (Ref m (Maybe (MemoResult a)))
-> m (Ref m (Maybe (MemoResult a)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (MemoResult a)))
 -> m (Ref m (Maybe (MemoResult a))))
-> Simulation m (Ref m (Maybe (MemoResult a)))
-> m (Ref m (Maybe (MemoResult a)))
forall a b. (a -> b) -> a -> b
$ Maybe (MemoResult a) -> Simulation m (Ref m (Maybe (MemoResult a)))
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (MemoResult a)
forall a. Maybe a
Nothing
     let result :: Process m a
result =
           do Just MemoResult a
x <- Event m (Maybe (MemoResult a)) -> Process m (Maybe (MemoResult a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m (Maybe (MemoResult a))
 -> Process m (Maybe (MemoResult a)))
-> Event m (Maybe (MemoResult a))
-> Process m (Maybe (MemoResult a))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (MemoResult a)) -> Event m (Maybe (MemoResult a))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (MemoResult a))
value
              case MemoResult a
x of
                MemoComputed a -> a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
                MemoError e    -> IOException -> Process m a
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Process m a
throwProcess IOException
e
                MemoResult a
MemoCancelled  -> Process m a
forall (m :: * -> *) a. MonadDES m => Process m a
cancelProcess
     Process m a -> m (Process m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Process m a -> m (Process m a)) -> Process m a -> m (Process m a)
forall a b. (a -> b) -> a -> b
$
       do Maybe (MemoResult a)
v <- Event m (Maybe (MemoResult a)) -> Process m (Maybe (MemoResult a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m (Maybe (MemoResult a))
 -> Process m (Maybe (MemoResult a)))
-> Event m (Maybe (MemoResult a))
-> Process m (Maybe (MemoResult a))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (MemoResult a)) -> Event m (Maybe (MemoResult a))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (MemoResult a))
value
          case Maybe (MemoResult a)
v of
            Just MemoResult a
_ -> Process m a
result
            Maybe (MemoResult a)
Nothing ->
              do Bool
f <- Event m Bool -> Process m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m Bool -> Process m Bool) -> Event m Bool -> Process m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Bool
started
                 case Bool
f of
                   Bool
True ->
                     do Signal m () -> Process m ()
forall (m :: * -> *) a. MonadDES m => Signal m a -> Process m a
processAwait (Signal m () -> Process m ()) -> Signal m () -> Process m ()
forall a b. (a -> b) -> a -> b
$ SignalSource m () -> Signal m ()
forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal SignalSource m ()
computed
                        Process m a
result
                   Bool
False ->
                     do 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 Bool -> Bool -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m Bool
started Bool
True
                        Ref m (MemoResult a)
r <- Simulation m (Ref m (MemoResult a))
-> Process m (Ref m (MemoResult a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m (Ref m (MemoResult a))
 -> Process m (Ref m (MemoResult a)))
-> Simulation m (Ref m (MemoResult a))
-> Process m (Ref m (MemoResult a))
forall a b. (a -> b) -> a -> b
$ MemoResult a -> Simulation m (Ref m (MemoResult a))
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef MemoResult a
forall a. MemoResult a
MemoCancelled
                        Process m () -> Process m () -> Process m ()
forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess
                          (Process m () -> (IOException -> Process m ()) -> Process m ()
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
Process m a -> (e -> Process m a) -> Process m a
catchProcess
                           (do a
a <- Process m a
x    -- compute only once!
                               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 (MemoResult a) -> MemoResult a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (MemoResult a)
r (a -> MemoResult a
forall a. a -> MemoResult a
MemoComputed a
a))
                           (\IOException
e ->
                             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 (MemoResult a) -> MemoResult a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (MemoResult a)
r (IOException -> MemoResult a
forall a. IOException -> MemoResult a
MemoError IOException
e)))
                          (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
$
                           do MemoResult a
x <- Ref m (MemoResult a) -> Event m (MemoResult a)
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (MemoResult a)
r
                              Ref m (Maybe (MemoResult a)) -> Maybe (MemoResult a) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (MemoResult a))
value (MemoResult a -> Maybe (MemoResult a)
forall a. a -> Maybe a
Just MemoResult a
x)
                              SignalSource m () -> () -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal SignalSource m ()
computed ())
                        Process m a
result

-- | Zip two parallel processes waiting for the both.
zipProcessParallel :: MonadDES m => Process m a -> Process m b -> Process m (a, b)
{-# INLINABLE zipProcessParallel #-}
zipProcessParallel :: Process m a -> Process m b -> Process m (a, b)
zipProcessParallel Process m a
x Process m b
y =
  do [Left a
a, Right b
b] <- [Process m (Either a b)] -> Process m [Either a b]
forall (m :: * -> *) a.
MonadDES m =>
[Process m a] -> Process m [a]
processParallel [(a -> Either a b) -> Process m a -> Process m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left Process m a
x, (b -> Either a b) -> Process m b -> Process m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right Process m b
y]
     (a, b) -> Process m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)

-- | Zip three parallel processes waiting for their results.
zip3ProcessParallel :: MonadDES m => Process m a -> Process m b -> Process m c -> Process m (a, b, c)
{-# INLINABLE zip3ProcessParallel #-}
zip3ProcessParallel :: Process m a -> Process m b -> Process m c -> Process m (a, b, c)
zip3ProcessParallel Process m a
x Process m b
y Process m c
z =
  do [Left a
a,
      Right (Left b
b),
      Right (Right c
c)] <-
       [Process m (Either a (Either b c))]
-> Process m [Either a (Either b c)]
forall (m :: * -> *) a.
MonadDES m =>
[Process m a] -> Process m [a]
processParallel [(a -> Either a (Either b c))
-> Process m a -> Process m (Either a (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a (Either b c)
forall a b. a -> Either a b
Left Process m a
x,
                        (b -> Either a (Either b c))
-> Process m b -> Process m (Either a (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either b c -> Either a (Either b c)
forall a b. b -> Either a b
Right (Either b c -> Either a (Either b c))
-> (b -> Either b c) -> b -> Either a (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b c
forall a b. a -> Either a b
Left) Process m b
y,
                        (c -> Either a (Either b c))
-> Process m c -> Process m (Either a (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either b c -> Either a (Either b c)
forall a b. b -> Either a b
Right (Either b c -> Either a (Either b c))
-> (c -> Either b c) -> c -> Either a (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right) Process m c
z]
     (a, b, c) -> Process m (a, b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c)

-- | Unzip the process using memoization so that the both returned
-- processes could be applied independently, although they will refer
-- to the same pair of values.
unzipProcess :: MonadDES m => Process m (a, b) -> Simulation m (Process m a, Process m b)
{-# INLINABLE unzipProcess #-}
unzipProcess :: Process m (a, b) -> Simulation m (Process m a, Process m b)
unzipProcess Process m (a, b)
xy =
  do Process m (a, b)
xy' <- Process m (a, b) -> Simulation m (Process m (a, b))
forall (m :: * -> *) a.
MonadDES m =>
Process m a -> Simulation m (Process m a)
memoProcess Process m (a, b)
xy
     (Process m a, Process m b)
-> Simulation m (Process m a, Process m b)
forall (m :: * -> *) a. Monad m => a -> m a
return (((a, b) -> a) -> Process m (a, b) -> Process m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst Process m (a, b)
xy', ((a, b) -> b) -> Process m (a, b) -> Process m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd Process m (a, b)
xy')

-- | Try to run the child process within the specified timeout.
-- If the process will finish successfully within this time interval then
-- the result wrapped in 'Just' will be returned; otherwise, the child process
-- will be cancelled and 'Nothing' will be returned.
--
-- If an exception is raised in the child process then it is propagated to
-- the parent computation as well.
--
-- A cancellation of the child process doesn't lead to cancelling the parent process.
-- Then 'Nothing' is returned within the computation.
--
-- This is a heavy-weight operation destined for working with arbitrary discontinuous
-- processes. Please consider using a more light-weight function 'interruptProcess' or else
-- 'cancelProcessWithId' whenever possible.
timeoutProcess :: MonadDES m => Double -> Process m a -> Process m (Maybe a)
{-# INLINABLE timeoutProcess #-}
timeoutProcess :: Double -> Process m a -> Process m (Maybe a)
timeoutProcess Double
timeout Process m a
p =
  do ProcessId m
pid <- Simulation m (ProcessId m) -> Process m (ProcessId m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation Simulation m (ProcessId m)
forall (m :: * -> *). MonadDES m => Simulation m (ProcessId m)
newProcessId
     Double -> ProcessId m -> Process m a -> Process m (Maybe a)
forall (m :: * -> *) a.
MonadDES m =>
Double -> ProcessId m -> Process m a -> Process m (Maybe a)
timeoutProcessUsingId Double
timeout ProcessId m
pid Process m a
p

-- | Try to run the child process with the given identifier within the specified timeout.
-- If the process will finish successfully within this time interval then
-- the result wrapped in 'Just' will be returned; otherwise, the child process
-- will be cancelled and 'Nothing' will be returned.
--
-- If an exception is raised in the child process then it is propagated to
-- the parent computation as well.
--
-- A cancellation of the child process doesn't lead to cancelling the parent process.
-- Then 'Nothing' is returned within the computation.
--
-- This is a heavy-weight operation destined for working with arbitrary discontinuous
-- processes. Please consider using a more light-weight function 'interruptProcess' or else
-- 'cancelProcessWithId' whenever possible.
timeoutProcessUsingId :: MonadDES m => Double -> ProcessId m -> Process m a -> Process m (Maybe a)
{-# INLINABLE timeoutProcessUsingId #-}
timeoutProcessUsingId :: Double -> ProcessId m -> Process m a -> Process m (Maybe a)
timeoutProcessUsingId Double
timeout ProcessId m
pid Process m a
p =
  do SignalSource m (Maybe (Either SomeException a))
s <- Simulation m (SignalSource m (Maybe (Either SomeException a)))
-> Process m (SignalSource m (Maybe (Either SomeException a)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation Simulation m (SignalSource m (Maybe (Either SomeException a)))
forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
     ProcessId m
timeoutPid <- Simulation m (ProcessId m) -> Process m (ProcessId m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation Simulation m (ProcessId m)
forall (m :: * -> *). MonadDES m => Simulation m (ProcessId m)
newProcessId
     ContCancellation -> ProcessId m -> Process m () -> Process m ()
forall (m :: * -> *).
MonadDES m =>
ContCancellation -> ProcessId m -> Process m () -> Process m ()
spawnProcessUsingIdWith ContCancellation
CancelChildAfterParent ProcessId m
timeoutPid (Process m () -> Process m ()) -> Process m () -> Process m ()
forall a b. (a -> b) -> a -> b
$
       do Double -> Process m ()
forall (m :: * -> *). MonadDES m => Double -> Process m ()
holdProcess Double
timeout
          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
$
            ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
cancelProcessWithId ProcessId m
pid
     ContCancellation -> ProcessId m -> Process m () -> Process m ()
forall (m :: * -> *).
MonadDES m =>
ContCancellation -> ProcessId m -> Process m () -> Process m ()
spawnProcessUsingIdWith ContCancellation
CancelChildAfterParent ProcessId m
pid (Process m () -> Process m ()) -> Process m () -> Process m ()
forall a b. (a -> b) -> a -> b
$
       do Ref m (Maybe (Either SomeException a))
r <- Simulation m (Ref m (Maybe (Either SomeException a)))
-> Process m (Ref m (Maybe (Either SomeException a)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m (Ref m (Maybe (Either SomeException a)))
 -> Process m (Ref m (Maybe (Either SomeException a))))
-> Simulation m (Ref m (Maybe (Either SomeException a)))
-> Process m (Ref m (Maybe (Either SomeException a)))
forall a b. (a -> b) -> a -> b
$ Maybe (Either SomeException a)
-> Simulation m (Ref m (Maybe (Either SomeException a)))
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (Either SomeException a)
forall a. Maybe a
Nothing
          Process m () -> Process m () -> Process m ()
forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess
            (Process m () -> (SomeException -> Process m ()) -> Process m ()
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
Process m a -> (e -> Process m a) -> Process m a
catchProcess
             (do a
a <- Process m a
p
                 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 (Either SomeException a))
-> Maybe (Either SomeException a) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (Either SomeException a))
r (Maybe (Either SomeException a) -> Event m ())
-> Maybe (Either SomeException a) -> Event m ()
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
Just (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a))
             (\SomeException
e ->
               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 (Either SomeException a))
-> Maybe (Either SomeException a) -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (Either SomeException a))
r (Maybe (Either SomeException a) -> Event m ())
-> Maybe (Either SomeException a) -> Event m ()
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
Just (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
e)))
            (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
$
             do ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
cancelProcessWithId ProcessId m
timeoutPid
                Maybe (Either SomeException a)
x <- Ref m (Maybe (Either SomeException a))
-> Event m (Maybe (Either SomeException a))
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (Either SomeException a))
r
                SignalSource m (Maybe (Either SomeException a))
-> Maybe (Either SomeException a) -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal SignalSource m (Maybe (Either SomeException a))
s Maybe (Either SomeException a)
x)
     Maybe (Either SomeException a)
x <- Signal m (Maybe (Either SomeException a))
-> Process m (Maybe (Either SomeException a))
forall (m :: * -> *) a. MonadDES m => Signal m a -> Process m a
processAwait (Signal m (Maybe (Either SomeException a))
 -> Process m (Maybe (Either SomeException a)))
-> Signal m (Maybe (Either SomeException a))
-> Process m (Maybe (Either SomeException a))
forall a b. (a -> b) -> a -> b
$ SignalSource m (Maybe (Either SomeException a))
-> Signal m (Maybe (Either SomeException a))
forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal SignalSource m (Maybe (Either SomeException a))
s
     case Maybe (Either SomeException a)
x of
       Maybe (Either SomeException a)
Nothing -> Maybe a -> Process m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
       Just (Right a
a) -> Maybe a -> Process m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
       Just (Left (SomeException e
e)) -> e -> Process m (Maybe a)
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Process m a
throwProcess e
e

-- | Yield to allow other 'Process' and 'Event' computations to run
-- at the current simulation time point.
processYield :: MonadDES m => Process m ()
{-# INLINABLE processYield #-}
processYield :: Process m ()
processYield =
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  (ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
  Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
  ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()

-- | A computation that never computes the result. It behaves like a black hole for
-- the discontinuous process, although such a process can still be canceled outside
-- (see 'cancelProcessWithId'), but then only its finalization parts (see 'finallyProcess')
-- will be called, usually, to release the resources acquired before.
neverProcess :: MonadDES m => Process m a
{-# INLINABLE neverProcess #-}
neverProcess :: Process m a
neverProcess =
  (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (ProcessId m -> Cont m a) -> Process m a
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  (ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
  let signal :: Signal m ()
signal = ProcessId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Signal m ()
processCancelling ProcessId m
pid
  in Signal m () -> (() -> Event m ()) -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> (a -> Event m ()) -> Event m ()
handleSignal_ Signal m ()
signal ((() -> Event m ()) -> Event m ())
-> (() -> Event m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \()
_ ->
     ContParams m a -> a -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m a
c (a -> Event m ()) -> a -> Event m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"It must never be computed: neverProcess"

-- | Retry the current computation as possible, using the specified argument
-- as a 'SimulationRetry' exception message in case of failure.
retryProcess :: MonadDES m => String -> Process m a
{-# INLINABLE retryProcess #-}
retryProcess :: [Char] -> Process m a
retryProcess = Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m a -> Process m a)
-> ([Char] -> Event m a) -> [Char] -> Process m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Event m a
forall (m :: * -> *) a. MonadException m => [Char] -> Event m a
retryEvent

-- | Like the GoTo statement it transfers the direction of computation,
-- but raises an exception when used within 'catchProcess' or 'finallyProcess'.
transferProcess :: MonadDES m => Process m () -> Process m a
{-# INLINABLE transferProcess #-}
transferProcess :: Process m () -> Process m a
transferProcess (Process ProcessId m -> Cont m ()
m) =
  (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (ProcessId m -> Cont m a) -> Process m a
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid -> Cont m () -> Cont m a
forall (m :: * -> *) a. MonadDES m => Cont m () -> Cont m a
transferCont (ProcessId m -> Cont m ()
m ProcessId m
pid)

-- | Show the debug message with the current simulation time.
traceProcess :: MonadDES m => String -> Process m a -> Process m a
{-# INLINABLE traceProcess #-}
traceProcess :: [Char] -> Process m a -> Process m a
traceProcess [Char]
message Process m a
m =
  (ProcessId m -> Cont m a) -> Process m a
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m a) -> Process m a)
-> (ProcessId m -> Cont m a) -> Process m a
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  [Char] -> Cont m a -> Cont m a
forall (m :: * -> *) a.
MonadDES m =>
[Char] -> Cont m a -> Cont m a
traceCont [Char]
message (Cont m a -> Cont m a) -> Cont m a -> Cont m a
forall a b. (a -> b) -> a -> b
$
  ProcessId m -> Process m a -> Cont m a
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid Process m a
m