module Simulation.Aivika.Trans.Task
(
Task,
TaskResult(..),
taskId,
tryGetTaskResult,
taskResult,
taskResultReceived,
taskProcess,
cancelTask,
taskCancelled,
runTask,
runTaskUsingId,
spawnTask,
spawnTaskUsingId,
spawnTaskWith,
spawnTaskUsingIdWith,
enqueueTask,
enqueueTaskUsingId,
taskParallelResult,
taskParallelProcess) where
import Data.Monoid
import Control.Monad
import Control.Monad.Trans
import Control.Exception
import Simulation.Aivika.Trans.Ref.Base
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.Internal.Process
import Simulation.Aivika.Trans.Signal
data Task m a =
Task { forall (m :: * -> *) a. Task m a -> ProcessId m
taskId :: ProcessId m,
forall (m :: * -> *) a. Task m a -> Ref m (Maybe (TaskResult a))
taskResultRef :: Ref m (Maybe (TaskResult a)),
forall (m :: * -> *) a. Task m a -> Signal m (TaskResult a)
taskResultReceived :: Signal m (TaskResult a)
}
data TaskResult a = TaskCompleted a
| TaskError SomeException
| TaskCancelled
tryGetTaskResult :: MonadDES m => Task m a -> Event m (Maybe (TaskResult a))
{-# INLINABLE tryGetTaskResult #-}
tryGetTaskResult :: forall (m :: * -> *) a.
MonadDES m =>
Task m a -> Event m (Maybe (TaskResult a))
tryGetTaskResult Task m a
t = Ref m (Maybe (TaskResult a)) -> Event m (Maybe (TaskResult a))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Task m a -> Ref m (Maybe (TaskResult a))
forall (m :: * -> *) a. Task m a -> Ref m (Maybe (TaskResult a))
taskResultRef Task m a
t)
taskResult :: MonadDES m => Task m a -> Process m (TaskResult a)
{-# INLINABLE taskResult #-}
taskResult :: forall (m :: * -> *) a.
MonadDES m =>
Task m a -> Process m (TaskResult a)
taskResult Task m a
t =
do Maybe (TaskResult a)
x <- Event m (Maybe (TaskResult a)) -> Process m (Maybe (TaskResult a))
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m (Maybe (TaskResult a))
-> Process m (Maybe (TaskResult a)))
-> Event m (Maybe (TaskResult a))
-> Process m (Maybe (TaskResult a))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (TaskResult a)) -> Event m (Maybe (TaskResult a))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Task m a -> Ref m (Maybe (TaskResult a))
forall (m :: * -> *) a. Task m a -> Ref m (Maybe (TaskResult a))
taskResultRef Task m a
t)
case Maybe (TaskResult a)
x of
Just TaskResult a
x -> TaskResult a -> Process m (TaskResult a)
forall a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return TaskResult a
x
Maybe (TaskResult a)
Nothing -> Signal m (TaskResult a) -> Process m (TaskResult a)
forall (m :: * -> *) a. MonadDES m => Signal m a -> Process m a
processAwait (Task m a -> Signal m (TaskResult a)
forall (m :: * -> *) a. Task m a -> Signal m (TaskResult a)
taskResultReceived Task m a
t)
cancelTask :: MonadDES m => Task m a -> Event m ()
{-# INLINABLE cancelTask #-}
cancelTask :: forall (m :: * -> *) a. MonadDES m => Task m a -> Event m ()
cancelTask Task m a
t =
ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
cancelProcessWithId (Task m a -> ProcessId m
forall (m :: * -> *) a. Task m a -> ProcessId m
taskId Task m a
t)
taskCancelled :: MonadDES m => Task m a -> Event m Bool
{-# INLINABLE taskCancelled #-}
taskCancelled :: forall (m :: * -> *) a. MonadDES m => Task m a -> Event m Bool
taskCancelled Task m a
t =
ProcessId m -> Event m Bool
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m Bool
processCancelled (Task m a -> ProcessId m
forall (m :: * -> *) a. Task m a -> ProcessId m
taskId Task m a
t)
newTaskUsingId :: MonadDES m => ProcessId m -> Process m a -> Event m (Task m a, Process m ())
{-# INLINABLE newTaskUsingId #-}
newTaskUsingId :: forall (m :: * -> *) a.
MonadDES m =>
ProcessId m -> Process m a -> Event m (Task m a, Process m ())
newTaskUsingId ProcessId m
pid Process m a
p =
do Ref m (Maybe (TaskResult a))
r <- Simulation m (Ref m (Maybe (TaskResult a)))
-> Event m (Ref m (Maybe (TaskResult a)))
forall a. Simulation m a -> Event m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m (Ref m (Maybe (TaskResult a)))
-> Event m (Ref m (Maybe (TaskResult a))))
-> Simulation m (Ref m (Maybe (TaskResult a)))
-> Event m (Ref m (Maybe (TaskResult a)))
forall a b. (a -> b) -> a -> b
$ Maybe (TaskResult a) -> Simulation m (Ref m (Maybe (TaskResult a)))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (TaskResult a)
forall a. Maybe a
Nothing
SignalSource m (TaskResult a)
s <- Simulation m (SignalSource m (TaskResult a))
-> Event m (SignalSource m (TaskResult a))
forall a. Simulation m a -> Event m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation Simulation m (SignalSource m (TaskResult a))
forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
let t :: Task m a
t = Task { taskId :: ProcessId m
taskId = ProcessId m
pid,
taskResultRef :: Ref m (Maybe (TaskResult a))
taskResultRef = Ref m (Maybe (TaskResult a))
r,
taskResultReceived :: Signal m (TaskResult a)
taskResultReceived = SignalSource m (TaskResult a) -> Signal m (TaskResult a)
forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal SignalSource m (TaskResult a)
s }
let m :: Process m ()
m =
do Ref m (TaskResult a)
v <- Simulation m (Ref m (TaskResult a))
-> Process m (Ref m (TaskResult a))
forall a. Simulation m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (Simulation m (Ref m (TaskResult a))
-> Process m (Ref m (TaskResult a)))
-> Simulation m (Ref m (TaskResult a))
-> Process m (Ref m (TaskResult a))
forall a b. (a -> b) -> a -> b
$ TaskResult a -> Simulation m (Ref m (TaskResult a))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef TaskResult a
forall a. TaskResult a
TaskCancelled
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 a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Process m ()) -> Event m () -> Process m ()
forall a b. (a -> b) -> a -> b
$ Ref m (TaskResult a) -> TaskResult a -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (TaskResult a)
v (a -> TaskResult a
forall a. a -> TaskResult a
TaskCompleted a
a))
(\SomeException
e ->
Event m () -> Process m ()
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Process m ()) -> Event m () -> Process m ()
forall a b. (a -> b) -> a -> b
$ Ref m (TaskResult a) -> TaskResult a -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (TaskResult a)
v (SomeException -> TaskResult a
forall a. SomeException -> TaskResult a
TaskError SomeException
e)))
(Event m () -> Process m ()
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Process m ()) -> Event m () -> Process m ()
forall a b. (a -> b) -> a -> b
$
do TaskResult a
x <- Ref m (TaskResult a) -> Event m (TaskResult a)
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (TaskResult a)
v
Ref m (Maybe (TaskResult a)) -> Maybe (TaskResult a) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (TaskResult a))
r (TaskResult a -> Maybe (TaskResult a)
forall a. a -> Maybe a
Just TaskResult a
x)
SignalSource m (TaskResult a) -> TaskResult a -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal SignalSource m (TaskResult a)
s TaskResult a
x)
(Task m a, Process m ()) -> Event m (Task m a, Process m ())
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Task m a
t, Process m ()
m)
runTaskUsingId :: MonadDES m => ProcessId m -> Process m a -> Event m (Task m a)
{-# INLINABLE runTaskUsingId #-}
runTaskUsingId :: forall (m :: * -> *) a.
MonadDES m =>
ProcessId m -> Process m a -> Event m (Task m a)
runTaskUsingId ProcessId m
pid Process m a
p =
do (Task m a
t, Process m ()
m) <- ProcessId m -> Process m a -> Event m (Task m a, Process m ())
forall (m :: * -> *) a.
MonadDES m =>
ProcessId m -> Process m a -> Event m (Task m a, Process m ())
newTaskUsingId ProcessId m
pid Process m a
p
ProcessId m -> Process m () -> Event m ()
forall (m :: * -> *).
MonadDES m =>
ProcessId m -> Process m () -> Event m ()
runProcessUsingId ProcessId m
pid Process m ()
m
Task m a -> Event m (Task m a)
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return Task m a
t
runTask :: MonadDES m => Process m a -> Event m (Task m a)
{-# INLINABLE runTask #-}
runTask :: forall (m :: * -> *) a.
MonadDES m =>
Process m a -> Event m (Task m a)
runTask Process m a
p =
do ProcessId m
pid <- Simulation m (ProcessId m) -> Event m (ProcessId m)
forall a. Simulation m a -> Event m a
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 a -> Event m (Task m a)
forall (m :: * -> *) a.
MonadDES m =>
ProcessId m -> Process m a -> Event m (Task m a)
runTaskUsingId ProcessId m
pid Process m a
p
enqueueTaskUsingId :: MonadDES m => Double -> ProcessId m -> Process m a -> Event m (Task m a)
{-# INLINABLE enqueueTaskUsingId #-}
enqueueTaskUsingId :: forall (m :: * -> *) a.
MonadDES m =>
Double -> ProcessId m -> Process m a -> Event m (Task m a)
enqueueTaskUsingId Double
time ProcessId m
pid Process m a
p =
do (Task m a
t, Process m ()
m) <- ProcessId m -> Process m a -> Event m (Task m a, Process m ())
forall (m :: * -> *) a.
MonadDES m =>
ProcessId m -> Process m a -> Event m (Task m a, Process m ())
newTaskUsingId ProcessId m
pid Process m a
p
Double -> ProcessId m -> Process m () -> Event m ()
forall (m :: * -> *).
MonadDES m =>
Double -> ProcessId m -> Process m () -> Event m ()
enqueueProcessUsingId Double
time ProcessId m
pid Process m ()
m
Task m a -> Event m (Task m a)
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return Task m a
t
enqueueTask :: MonadDES m => Double -> Process m a -> Event m (Task m a)
{-# INLINABLE enqueueTask #-}
enqueueTask :: forall (m :: * -> *) a.
MonadDES m =>
Double -> Process m a -> Event m (Task m a)
enqueueTask Double
time Process m a
p =
do ProcessId m
pid <- Simulation m (ProcessId m) -> Event m (ProcessId m)
forall a. Simulation m a -> Event m a
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 -> Event m (Task m a)
forall (m :: * -> *) a.
MonadDES m =>
Double -> ProcessId m -> Process m a -> Event m (Task m a)
enqueueTaskUsingId Double
time ProcessId m
pid Process m a
p
spawnTaskUsingId :: MonadDES m => ProcessId m -> Process m a -> Process m (Task m a)
{-# INLINABLE spawnTaskUsingId #-}
spawnTaskUsingId :: forall (m :: * -> *) a.
MonadDES m =>
ProcessId m -> Process m a -> Process m (Task m a)
spawnTaskUsingId = ContCancellation
-> ProcessId m -> Process m a -> Process m (Task m a)
forall (m :: * -> *) a.
MonadDES m =>
ContCancellation
-> ProcessId m -> Process m a -> Process m (Task m a)
spawnTaskUsingIdWith ContCancellation
CancelTogether
spawnTask :: MonadDES m => Process m a -> Process m (Task m a)
{-# INLINABLE spawnTask #-}
spawnTask :: forall (m :: * -> *) a.
MonadDES m =>
Process m a -> Process m (Task m a)
spawnTask = ContCancellation -> Process m a -> Process m (Task m a)
forall (m :: * -> *) a.
MonadDES m =>
ContCancellation -> Process m a -> Process m (Task m a)
spawnTaskWith ContCancellation
CancelTogether
spawnTaskUsingIdWith :: MonadDES m => ContCancellation -> ProcessId m -> Process m a -> Process m (Task m a)
{-# INLINABLE spawnTaskUsingIdWith #-}
spawnTaskUsingIdWith :: forall (m :: * -> *) a.
MonadDES m =>
ContCancellation
-> ProcessId m -> Process m a -> Process m (Task m a)
spawnTaskUsingIdWith ContCancellation
cancellation ProcessId m
pid Process m a
p =
do (Task m a
t, Process m ()
m) <- Event m (Task m a, Process m ())
-> Process m (Task m a, Process m ())
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m (Task m a, Process m ())
-> Process m (Task m a, Process m ()))
-> Event m (Task m a, Process m ())
-> Process m (Task m a, Process m ())
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Process m a -> Event m (Task m a, Process m ())
forall (m :: * -> *) a.
MonadDES m =>
ProcessId m -> Process m a -> Event m (Task m a, Process m ())
newTaskUsingId ProcessId m
pid Process m a
p
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 ()
m
Task m a -> Process m (Task m a)
forall a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return Task m a
t
spawnTaskWith :: MonadDES m => ContCancellation -> Process m a -> Process m (Task m a)
{-# INLINABLE spawnTaskWith #-}
spawnTaskWith :: forall (m :: * -> *) a.
MonadDES m =>
ContCancellation -> Process m a -> Process m (Task m a)
spawnTaskWith ContCancellation
cancellation Process m a
p =
do ProcessId m
pid <- Simulation m (ProcessId m) -> Process m (ProcessId m)
forall a. Simulation m a -> Process m a
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 a -> Process m (Task m a)
forall (m :: * -> *) a.
MonadDES m =>
ContCancellation
-> ProcessId m -> Process m a -> Process m (Task m a)
spawnTaskUsingIdWith ContCancellation
cancellation ProcessId m
pid Process m a
p
taskProcess :: MonadDES m => Task m a -> Process m a
{-# INLINABLE taskProcess #-}
taskProcess :: forall (m :: * -> *) a. MonadDES m => Task m a -> Process m a
taskProcess Task m a
t =
do TaskResult a
x <- Process m (TaskResult a)
-> Process m () -> Process m (TaskResult a)
forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess
(Task m a -> Process m (TaskResult a)
forall (m :: * -> *) a.
MonadDES m =>
Task m a -> Process m (TaskResult a)
taskResult Task m a
t)
(do ProcessId m
pid <- Process m (ProcessId m)
forall (m :: * -> *). MonadDES m => Process m (ProcessId m)
processId
Event m () -> Process m ()
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Process m ()) -> Event m () -> Process m ()
forall a b. (a -> b) -> a -> b
$
do Bool
cancelled <- ProcessId m -> Event m Bool
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m Bool
processCancelled ProcessId m
pid
Bool -> Event m () -> Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cancelled (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
Task m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => Task m a -> Event m ()
cancelTask Task m a
t)
case TaskResult a
x of
TaskCompleted a
a -> a -> Process m a
forall a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
TaskError SomeException
e -> SomeException -> Process m a
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Process m a
throwProcess SomeException
e
TaskResult a
TaskCancelled -> Process m a
forall (m :: * -> *) a. MonadDES m => Process m a
cancelProcess
taskParallelResult :: MonadDES m => Task m a -> Task m a -> Process m (TaskResult a, Task m a)
{-# INLINABLE taskParallelResult #-}
taskParallelResult :: forall (m :: * -> *) a.
MonadDES m =>
Task m a -> Task m a -> Process m (TaskResult a, Task m a)
taskParallelResult Task m a
t1 Task m a
t2 =
do Maybe (TaskResult a)
x1 <- Event m (Maybe (TaskResult a)) -> Process m (Maybe (TaskResult a))
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m (Maybe (TaskResult a))
-> Process m (Maybe (TaskResult a)))
-> Event m (Maybe (TaskResult a))
-> Process m (Maybe (TaskResult a))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (TaskResult a)) -> Event m (Maybe (TaskResult a))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Task m a -> Ref m (Maybe (TaskResult a))
forall (m :: * -> *) a. Task m a -> Ref m (Maybe (TaskResult a))
taskResultRef Task m a
t1)
case Maybe (TaskResult a)
x1 of
Just TaskResult a
x1 -> (TaskResult a, Task m a) -> Process m (TaskResult a, Task m a)
forall a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TaskResult a
x1, Task m a
t2)
Maybe (TaskResult a)
Nothing ->
do Maybe (TaskResult a)
x2 <- Event m (Maybe (TaskResult a)) -> Process m (Maybe (TaskResult a))
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m (Maybe (TaskResult a))
-> Process m (Maybe (TaskResult a)))
-> Event m (Maybe (TaskResult a))
-> Process m (Maybe (TaskResult a))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (TaskResult a)) -> Event m (Maybe (TaskResult a))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Task m a -> Ref m (Maybe (TaskResult a))
forall (m :: * -> *) a. Task m a -> Ref m (Maybe (TaskResult a))
taskResultRef Task m a
t2)
case Maybe (TaskResult a)
x2 of
Just TaskResult a
x2 -> (TaskResult a, Task m a) -> Process m (TaskResult a, Task m a)
forall a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TaskResult a
x2, Task m a
t1)
Maybe (TaskResult a)
Nothing ->
do let s1 :: Signal m (Either (TaskResult a) b)
s1 = (TaskResult a -> Either (TaskResult a) b)
-> Signal m (TaskResult a) -> Signal m (Either (TaskResult a) b)
forall a b. (a -> b) -> Signal m a -> Signal m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TaskResult a -> Either (TaskResult a) b
forall a b. a -> Either a b
Left (Signal m (TaskResult a) -> Signal m (Either (TaskResult a) b))
-> Signal m (TaskResult a) -> Signal m (Either (TaskResult a) b)
forall a b. (a -> b) -> a -> b
$ Task m a -> Signal m (TaskResult a)
forall (m :: * -> *) a. Task m a -> Signal m (TaskResult a)
taskResultReceived Task m a
t1
s2 :: Signal m (Either a (TaskResult a))
s2 = (TaskResult a -> Either a (TaskResult a))
-> Signal m (TaskResult a) -> Signal m (Either a (TaskResult a))
forall a b. (a -> b) -> Signal m a -> Signal m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TaskResult a -> Either a (TaskResult a)
forall a b. b -> Either a b
Right (Signal m (TaskResult a) -> Signal m (Either a (TaskResult a)))
-> Signal m (TaskResult a) -> Signal m (Either a (TaskResult a))
forall a b. (a -> b) -> a -> b
$ Task m a -> Signal m (TaskResult a)
forall (m :: * -> *) a. Task m a -> Signal m (TaskResult a)
taskResultReceived Task m a
t2
Either (TaskResult a) (TaskResult a)
x <- Signal m (Either (TaskResult a) (TaskResult a))
-> Process m (Either (TaskResult a) (TaskResult a))
forall (m :: * -> *) a. MonadDES m => Signal m a -> Process m a
processAwait (Signal m (Either (TaskResult a) (TaskResult a))
-> Process m (Either (TaskResult a) (TaskResult a)))
-> Signal m (Either (TaskResult a) (TaskResult a))
-> Process m (Either (TaskResult a) (TaskResult a))
forall a b. (a -> b) -> a -> b
$ Signal m (Either (TaskResult a) (TaskResult a))
forall {b}. Signal m (Either (TaskResult a) b)
s1 Signal m (Either (TaskResult a) (TaskResult a))
-> Signal m (Either (TaskResult a) (TaskResult a))
-> Signal m (Either (TaskResult a) (TaskResult a))
forall a. Semigroup a => a -> a -> a
<> Signal m (Either (TaskResult a) (TaskResult a))
forall {a}. Signal m (Either a (TaskResult a))
s2
case Either (TaskResult a) (TaskResult a)
x of
Left TaskResult a
x1 -> (TaskResult a, Task m a) -> Process m (TaskResult a, Task m a)
forall a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TaskResult a
x1, Task m a
t2)
Right TaskResult a
x2 -> (TaskResult a, Task m a) -> Process m (TaskResult a, Task m a)
forall a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TaskResult a
x2, Task m a
t1)
taskParallelProcess :: MonadDES m => Task m a -> Task m a -> Process m (a, Task m a)
{-# INLINABLE taskParallelProcess #-}
taskParallelProcess :: forall (m :: * -> *) a.
MonadDES m =>
Task m a -> Task m a -> Process m (a, Task m a)
taskParallelProcess Task m a
t1 Task m a
t2 =
do (TaskResult a
x, Task m a
t) <-
Process m (TaskResult a, Task m a)
-> Process m () -> Process m (TaskResult a, Task m a)
forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess
(Task m a -> Task m a -> Process m (TaskResult a, Task m a)
forall (m :: * -> *) a.
MonadDES m =>
Task m a -> Task m a -> Process m (TaskResult a, Task m a)
taskParallelResult Task m a
t1 Task m a
t2)
(do ProcessId m
pid <- Process m (ProcessId m)
forall (m :: * -> *). MonadDES m => Process m (ProcessId m)
processId
Event m () -> Process m ()
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Process m ()) -> Event m () -> Process m ()
forall a b. (a -> b) -> a -> b
$
do Bool
cancelled <- ProcessId m -> Event m Bool
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m Bool
processCancelled ProcessId m
pid
Bool -> Event m () -> Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cancelled (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
do Task m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => Task m a -> Event m ()
cancelTask Task m a
t1
Task m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => Task m a -> Event m ()
cancelTask Task m a
t2)
case TaskResult a
x of
TaskCompleted a
a -> (a, Task m a) -> Process m (a, Task m a)
forall a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Task m a
t)
TaskError SomeException
e ->
do Event m () -> Process m ()
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Process m ()) -> Event m () -> Process m ()
forall a b. (a -> b) -> a -> b
$ Task m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => Task m a -> Event m ()
cancelTask Task m a
t
SomeException -> Process m (a, Task m a)
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Process m a
throwProcess SomeException
e
TaskResult a
TaskCancelled ->
do Event m () -> Process m ()
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m () -> Process m ()) -> Event m () -> Process m ()
forall a b. (a -> b) -> a -> b
$ Task m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => Task m a -> Event m ()
cancelTask Task m a
t
Process m (a, Task m a)
forall (m :: * -> *) a. MonadDES m => Process m a
cancelProcess