{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Temporal.Workflow.Internal.Monad where
import Control.Applicative
import Control.Concurrent.Async
import Control.Monad
import qualified Control.Monad.Catch as Catch
import Control.Monad.Logger
import Control.Monad.Reader
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Kind
import Data.Map.Strict (Map)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import Data.Time.Clock.System (SystemTime)
import Data.Vector (Vector)
import Data.Word (Word32)
import GHC.Stack
import GHC.TypeLits
import Proto.Temporal.Sdk.Core.WorkflowActivation.WorkflowActivation
import Proto.Temporal.Sdk.Core.WorkflowCommands.WorkflowCommands (WorkflowCommand)
import RequireCallStack
import System.Random (
genShortByteString,
genWord16,
genWord32,
genWord32R,
genWord64,
genWord64R,
genWord8,
)
import System.Random.Stateful (FrozenGen (..), RandomGenM (..), StatefulGen (..), StdGen)
import Temporal.Common
import qualified Temporal.Core.Worker as Core
import Temporal.Exception
import Temporal.Payload
import Temporal.Workflow.Types
import Text.Printf
import UnliftIO
newtype Workflow a = Workflow {forall a. Workflow a -> ContinuationEnv -> InstanceM (Result a)
unWorkflow :: ContinuationEnv -> InstanceM (Result a)}
ilift :: RequireCallStack => InstanceM a -> Workflow a
ilift :: forall a. RequireCallStack => InstanceM a -> Workflow a
ilift InstanceM a
m = (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result a)) -> Workflow a)
-> (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> a -> Result a
forall a. a -> Result a
Done (a -> Result a) -> InstanceM a -> InstanceM (Result a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InstanceM a
m
askInstance :: Workflow WorkflowInstance
askInstance :: Workflow WorkflowInstance
askInstance = (ContinuationEnv -> InstanceM (Result WorkflowInstance))
-> Workflow WorkflowInstance
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result WorkflowInstance))
-> Workflow WorkflowInstance)
-> (ContinuationEnv -> InstanceM (Result WorkflowInstance))
-> Workflow WorkflowInstance
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> (WorkflowInstance -> Result WorkflowInstance)
-> InstanceM (Result WorkflowInstance)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WorkflowInstance -> Result WorkflowInstance
forall a. a -> Result a
Done
addCommand :: WorkflowCommand -> InstanceM ()
addCommand :: WorkflowCommand -> InstanceM ()
addCommand WorkflowCommand
command = do
inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
atomically $ do
modifyTVar' inst.workflowCommands $ \Reversed WorkflowCommand
cmds -> WorkflowCommand
-> Reversed WorkflowCommand -> Reversed WorkflowCommand
forall a. a -> Reversed a -> Reversed a
push WorkflowCommand
command Reversed WorkflowCommand
cmds
trace_ :: String -> a -> a
trace_ :: forall a. String -> a -> a
trace_ String
_ = a -> a
forall a. a -> a
id
data ContinuationEnv = ContinuationEnv
{ ContinuationEnv -> IORef JobList
runQueueRef :: {-# UNPACK #-} !(IORef JobList)
}
instance Functor Workflow where
fmap :: forall a b. (a -> b) -> Workflow a -> Workflow b
fmap a -> b
f (Workflow ContinuationEnv -> InstanceM (Result a)
m) = (ContinuationEnv -> InstanceM (Result b)) -> Workflow b
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result b)) -> Workflow b)
-> (ContinuationEnv -> InstanceM (Result b)) -> Workflow b
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
env -> do
r <- ContinuationEnv -> InstanceM (Result a)
m ContinuationEnv
env
case r of
Done a
a -> Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Result b
forall a. a -> Result a
Done (a -> b
f a
a))
Throw SomeException
e -> Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Result b
forall a. SomeException -> Result a
Throw SomeException
e)
Blocked IVar b
ivar Cont a
cont ->
String -> InstanceM (Result b) -> InstanceM (Result b)
forall a. String -> a -> a
trace_ String
"fmap Blocked" (InstanceM (Result b) -> InstanceM (Result b))
-> InstanceM (Result b) -> InstanceM (Result b)
forall a b. (a -> b) -> a -> b
$
Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IVar b -> Cont b -> Result b
forall a b. IVar b -> Cont a -> Result a
Blocked IVar b
ivar (a -> b
f (a -> b) -> Cont a -> Cont b
forall a b. (b -> a) -> Cont b -> Cont a
:<$> Cont a
cont))
instance Applicative Workflow where
pure :: forall a. a -> Workflow a
pure a
a = (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result a)) -> Workflow a)
-> (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_env -> Result a -> InstanceM (Result a)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Result a
forall a. a -> Result a
Done a
a)
Workflow (a -> b)
ff <*> :: forall a b. Workflow (a -> b) -> Workflow a -> Workflow b
<*> Workflow a
aa = Workflow (a -> b)
ff Workflow (a -> b) -> ((a -> b) -> Workflow b) -> Workflow b
forall a b. Workflow a -> (a -> Workflow b) -> Workflow b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
f -> Workflow a
aa Workflow a -> (a -> Workflow b) -> Workflow b
forall a b. Workflow a -> (a -> Workflow b) -> Workflow b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> b -> Workflow b
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b
f a
a)
parallelAp :: Workflow (a -> b) -> Workflow a -> Workflow b
parallelAp :: forall a b. Workflow (a -> b) -> Workflow a -> Workflow b
parallelAp (Workflow ContinuationEnv -> InstanceM (Result (a -> b))
ff) (Workflow ContinuationEnv -> InstanceM (Result a)
aa) = (ContinuationEnv -> InstanceM (Result b)) -> Workflow b
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result b)) -> Workflow b)
-> (ContinuationEnv -> InstanceM (Result b)) -> Workflow b
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
env -> do
rf <- ContinuationEnv -> InstanceM (Result (a -> b))
ff ContinuationEnv
env
case rf of
Done a -> b
f -> do
ra <- ContinuationEnv -> InstanceM (Result a)
aa ContinuationEnv
env
case ra of
Done a
a -> String -> InstanceM (Result b) -> InstanceM (Result b)
forall a. String -> a -> a
trace_ String
"Done/Done" (InstanceM (Result b) -> InstanceM (Result b))
-> InstanceM (Result b) -> InstanceM (Result b)
forall a b. (a -> b) -> a -> b
$ Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Result b
forall a. a -> Result a
Done (a -> b
f a
a))
Throw SomeException
e -> String -> InstanceM (Result b) -> InstanceM (Result b)
forall a. String -> a -> a
trace_ String
"Done/Throw" (InstanceM (Result b) -> InstanceM (Result b))
-> InstanceM (Result b) -> InstanceM (Result b)
forall a b. (a -> b) -> a -> b
$ Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Result b
forall a. SomeException -> Result a
Throw SomeException
e)
Blocked IVar b
ivar Cont a
fcont ->
String -> InstanceM (Result b) -> InstanceM (Result b)
forall a. String -> a -> a
trace_ String
"Done/Blocked" (InstanceM (Result b) -> InstanceM (Result b))
-> InstanceM (Result b) -> InstanceM (Result b)
forall a b. (a -> b) -> a -> b
$
Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IVar b -> Cont b -> Result b
forall a b. IVar b -> Cont a -> Result a
Blocked IVar b
ivar (a -> b
f (a -> b) -> Cont a -> Cont b
forall a b. (b -> a) -> Cont b -> Cont a
:<$> Cont a
fcont))
Throw SomeException
e -> String -> InstanceM (Result b) -> InstanceM (Result b)
forall a. String -> a -> a
trace_ String
"Throw" (InstanceM (Result b) -> InstanceM (Result b))
-> InstanceM (Result b) -> InstanceM (Result b)
forall a b. (a -> b) -> a -> b
$ Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Result b
forall a. SomeException -> Result a
Throw SomeException
e)
Blocked IVar b
ivar1 Cont (a -> b)
fcont -> do
ra <- ContinuationEnv -> InstanceM (Result a)
aa ContinuationEnv
env
case ra of
Done a
a ->
String -> InstanceM (Result b) -> InstanceM (Result b)
forall a. String -> a -> a
trace_ String
"Blocked/Done" (InstanceM (Result b) -> InstanceM (Result b))
-> InstanceM (Result b) -> InstanceM (Result b)
forall a b. (a -> b) -> a -> b
$
Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IVar b -> Cont b -> Result b
forall a b. IVar b -> Cont a -> Result a
Blocked IVar b
ivar1 (((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a) ((a -> b) -> b) -> Cont (a -> b) -> Cont b
forall a b. (b -> a) -> Cont b -> Cont a
:<$> Cont (a -> b)
fcont))
Throw SomeException
e ->
String -> InstanceM (Result b) -> InstanceM (Result b)
forall a. String -> a -> a
trace_ String
"Blocked/Throw" (InstanceM (Result b) -> InstanceM (Result b))
-> InstanceM (Result b) -> InstanceM (Result b)
forall a b. (a -> b) -> a -> b
$
Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IVar b -> Cont b -> Result b
forall a b. IVar b -> Cont a -> Result a
Blocked IVar b
ivar1 (Cont (a -> b)
fcont Cont (a -> b) -> ((a -> b) -> Workflow b) -> Cont b
forall a b. Cont b -> (b -> Workflow a) -> Cont a
:>>= (\a -> b
_ -> SomeException -> Workflow b
forall e a. (HasCallStack, Exception e) => e -> Workflow a
throw SomeException
e)))
Blocked IVar b
ivar2 Cont a
acont ->
String -> InstanceM (Result b) -> InstanceM (Result b)
forall a. String -> a -> a
trace_ String
"Blocked/Blocked" (InstanceM (Result b) -> InstanceM (Result b))
-> InstanceM (Result b) -> InstanceM (Result b)
forall a b. (a -> b) -> a -> b
$
ContinuationEnv
-> IVar b
-> Cont (a -> b)
-> IVar b
-> Cont a
-> InstanceM (Result b)
forall c a b d.
ContinuationEnv
-> IVar c
-> Cont (a -> b)
-> IVar d
-> Cont a
-> InstanceM (Result b)
blockedBlocked ContinuationEnv
env IVar b
ivar1 Cont (a -> b)
fcont IVar b
ivar2 Cont a
acont
blockedBlocked
:: ContinuationEnv
-> IVar c
-> Cont (a -> b)
-> IVar d
-> Cont a
-> InstanceM (Result b)
blockedBlocked :: forall c a b d.
ContinuationEnv
-> IVar c
-> Cont (a -> b)
-> IVar d
-> Cont a
-> InstanceM (Result b)
blockedBlocked ContinuationEnv
_ IVar c
_ (Return IVar (a -> b)
i) IVar d
ivar2 Cont a
acont =
Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IVar d -> Cont b -> Result b
forall a b. IVar b -> Cont a -> Result a
Blocked IVar d
ivar2 (Cont a
acont Cont a -> (a -> Workflow b) -> Cont b
forall a b. Cont b -> (b -> Workflow a) -> Cont a
:>>= IVar (a -> b) -> a -> Workflow b
forall a b. IVar (a -> b) -> a -> Workflow b
getIVarApply IVar (a -> b)
i))
blockedBlocked ContinuationEnv
_ IVar c
_ (b -> a -> b
g :<$> Return IVar b
i) IVar d
ivar2 Cont a
acont =
Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IVar d -> Cont b -> Result b
forall a b. IVar b -> Cont a -> Result a
Blocked IVar d
ivar2 (Cont a
acont Cont a -> (a -> Workflow b) -> Cont b
forall a b. Cont b -> (b -> Workflow a) -> Cont a
:>>= \a
a -> (b -> a -> b
`g` a
a) (b -> b) -> Workflow b -> Workflow b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IVar b -> Workflow b
forall a. IVar a -> Workflow a
getIVar IVar b
i))
blockedBlocked ContinuationEnv
env IVar c
ivar1 Cont (a -> b)
fcont IVar d
ivar2 Cont a
acont = do
i <- InstanceM (IVar (a -> b))
forall (m :: * -> *) a. MonadIO m => m (IVar a)
newIVar
addJob env (toWf fcont) i ivar1
let cont = Cont a
acont Cont a -> (a -> Workflow b) -> Cont b
forall a b. Cont b -> (b -> Workflow a) -> Cont a
:>>= \a
a -> IVar (a -> b) -> a -> Workflow b
forall a b. IVar (a -> b) -> a -> Workflow b
getIVarApply IVar (a -> b)
i a
a
return (Blocked ivar2 cont)
instance Monad Workflow where
Workflow ContinuationEnv -> InstanceM (Result a)
m >>= :: forall a b. Workflow a -> (a -> Workflow b) -> Workflow b
>>= a -> Workflow b
k = (ContinuationEnv -> InstanceM (Result b)) -> Workflow b
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result b)) -> Workflow b)
-> (ContinuationEnv -> InstanceM (Result b)) -> Workflow b
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
env -> do
e <- ContinuationEnv -> InstanceM (Result a)
m ContinuationEnv
env
case e of
Done a
a -> Workflow b -> ContinuationEnv -> InstanceM (Result b)
forall a. Workflow a -> ContinuationEnv -> InstanceM (Result a)
unWorkflow (a -> Workflow b
k a
a) ContinuationEnv
env
Throw SomeException
e' -> Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Result b
forall a. SomeException -> Result a
Throw SomeException
e')
Blocked IVar b
ivar Cont a
cont ->
String -> InstanceM (Result b) -> InstanceM (Result b)
forall a. String -> a -> a
trace_ String
">>= Blocked" (InstanceM (Result b) -> InstanceM (Result b))
-> InstanceM (Result b) -> InstanceM (Result b)
forall a b. (a -> b) -> a -> b
$
Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IVar b -> Cont b -> Result b
forall a b. IVar b -> Cont a -> Result a
Blocked IVar b
ivar (Cont a
cont Cont a -> (a -> Workflow b) -> Cont b
forall a b. Cont b -> (b -> Workflow a) -> Cont a
:>>= a -> Workflow b
k))
instance Alternative Workflow where
empty :: forall a. Workflow a
empty = AlternativeInstanceFailure -> Workflow a
forall e a. (HasCallStack, Exception e) => e -> Workflow a
throw AlternativeInstanceFailure
AlternativeInstanceFailure
<|> :: forall a. Workflow a -> Workflow a -> Workflow a
(<|>) Workflow a
l Workflow a
r = Workflow a
l Workflow a -> (SomeException -> Workflow a) -> Workflow a
forall e a.
Exception e =>
Workflow a -> (e -> Workflow a) -> Workflow a
`Temporal.Workflow.Internal.Monad.catch` \(SomeException e
_) -> Workflow a
r
instance TypeError ('Text "A workflow definition cannot directly perform IO. Use executeActivity or executeLocalActivity instead.") => MonadIO Workflow where
liftIO :: forall a. IO a -> Workflow a
liftIO = String -> IO a -> Workflow a
forall a. HasCallStack => String -> a
error String
"Unreachable"
instance TypeError ('Text "A workflow definition cannot directly perform IO. Use executeActivity or executeLocalActivity instead.") => MonadUnliftIO Workflow where
withRunInIO :: forall b. ((forall a. Workflow a -> IO a) -> IO b) -> Workflow b
withRunInIO (forall a. Workflow a -> IO a) -> IO b
_ = String -> Workflow b
forall a. HasCallStack => String -> a
error String
"Unreachable"
instance {-# OVERLAPPABLE #-} MonadLogger Workflow where
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> Workflow ()
monadLoggerLog Loc
loc LogSource
src LogLevel
lvl msg
msg = (ContinuationEnv -> InstanceM (Result ())) -> Workflow ()
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result ())) -> Workflow ())
-> (ContinuationEnv -> InstanceM (Result ())) -> Workflow ()
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> do
logger <- (WorkflowInstance
-> Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> InstanceM (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WorkflowInstance -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
workflowInstanceLogger
fmap Done $ liftIO $ logger loc src lvl (toLogStr msg)
instance Semigroup a => Semigroup (Workflow a) where
<> :: Workflow a -> Workflow a -> Workflow a
(<>) = (a -> a -> a) -> Workflow a -> Workflow a -> Workflow a
forall a b c.
(a -> b -> c) -> Workflow a -> Workflow b -> Workflow c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid a => Monoid (Workflow a) where
mempty :: Workflow a
mempty = a -> Workflow a
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
throw :: (HasCallStack, Exception e) => e -> Workflow a
throw :: forall e a. (HasCallStack, Exception e) => e -> Workflow a
throw e
e = (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result a)) -> Workflow a)
-> (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
env -> IO (Result a) -> InstanceM (Result a)
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result a) -> InstanceM (Result a))
-> IO (Result a) -> InstanceM (Result a)
forall a b. (a -> b) -> a -> b
$ ContinuationEnv -> e -> IO (Result a)
forall e a. Exception e => ContinuationEnv -> e -> IO (Result a)
raise ContinuationEnv
env e
e
{-# INLINE raiseImpl #-}
raiseImpl :: ContinuationEnv -> SomeException -> IO (Result b)
raiseImpl :: forall b. ContinuationEnv -> SomeException -> IO (Result b)
raiseImpl ContinuationEnv
_ SomeException
e = Result b -> IO (Result b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result b -> IO (Result b)) -> Result b -> IO (Result b)
forall a b. (a -> b) -> a -> b
$ SomeException -> Result b
forall a. SomeException -> Result a
Throw SomeException
e
raise :: Exception e => ContinuationEnv -> e -> IO (Result a)
raise :: forall e a. Exception e => ContinuationEnv -> e -> IO (Result a)
raise ContinuationEnv
env e
e = ContinuationEnv -> SomeException -> IO (Result a)
forall b. ContinuationEnv -> SomeException -> IO (Result b)
raiseImpl ContinuationEnv
env (e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e)
catch :: Exception e => Workflow a -> (e -> Workflow a) -> Workflow a
catch :: forall e a.
Exception e =>
Workflow a -> (e -> Workflow a) -> Workflow a
catch (Workflow ContinuationEnv -> InstanceM (Result a)
m) e -> Workflow a
h = (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result a)) -> Workflow a)
-> (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
env -> do
r <- ContinuationEnv -> InstanceM (Result a)
m ContinuationEnv
env
case r of
Done a
a -> Result a -> InstanceM (Result a)
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result a -> InstanceM (Result a))
-> Result a -> InstanceM (Result a)
forall a b. (a -> b) -> a -> b
$ a -> Result a
forall a. a -> Result a
Done a
a
Throw SomeException
e
| Just e
e' <- SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e -> Workflow a -> ContinuationEnv -> InstanceM (Result a)
forall a. Workflow a -> ContinuationEnv -> InstanceM (Result a)
unWorkflow (e -> Workflow a
h e
e') ContinuationEnv
env
| Bool
otherwise -> IO (Result a) -> InstanceM (Result a)
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result a) -> InstanceM (Result a))
-> IO (Result a) -> InstanceM (Result a)
forall a b. (a -> b) -> a -> b
$ ContinuationEnv -> SomeException -> IO (Result a)
forall e a. Exception e => ContinuationEnv -> e -> IO (Result a)
raise ContinuationEnv
env SomeException
e
Blocked IVar b
ivar Cont a
k -> Result a -> InstanceM (Result a)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> InstanceM (Result a))
-> Result a -> InstanceM (Result a)
forall a b. (a -> b) -> a -> b
$ IVar b -> Cont a -> Result a
forall a b. IVar b -> Cont a -> Result a
Blocked IVar b
ivar (Cont a -> Result a) -> Cont a -> Result a
forall a b. (a -> b) -> a -> b
$ Workflow a -> Cont a
forall a. Workflow a -> Cont a
Cont (Workflow a -> Cont a) -> Workflow a -> Cont a
forall a b. (a -> b) -> a -> b
$ Workflow a -> (e -> Workflow a) -> Workflow a
forall e a.
Exception e =>
Workflow a -> (e -> Workflow a) -> Workflow a
Temporal.Workflow.Internal.Monad.catch (Cont a -> Workflow a
forall a. Cont a -> Workflow a
toWf Cont a
k) e -> Workflow a
h
catchIf
:: Exception e
=> (e -> Bool)
-> Workflow a
-> (e -> Workflow a)
-> Workflow a
catchIf :: forall e a.
Exception e =>
(e -> Bool) -> Workflow a -> (e -> Workflow a) -> Workflow a
catchIf e -> Bool
cond Workflow a
m e -> Workflow a
handler =
Workflow a -> (e -> Workflow a) -> Workflow a
forall e a.
Exception e =>
Workflow a -> (e -> Workflow a) -> Workflow a
Temporal.Workflow.Internal.Monad.catch Workflow a
m ((e -> Workflow a) -> Workflow a)
-> (e -> Workflow a) -> Workflow a
forall a b. (a -> b) -> a -> b
$ \e
e -> if e -> Bool
cond e
e then e -> Workflow a
handler e
e else e -> Workflow a
forall e a. (HasCallStack, Exception e) => e -> Workflow a
throw e
e
try :: Exception e => Workflow a -> Workflow (Either e a)
try :: forall e a. Exception e => Workflow a -> Workflow (Either e a)
try Workflow a
m = (a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> Workflow a -> Workflow (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workflow a
m) Workflow (Either e a)
-> (e -> Workflow (Either e a)) -> Workflow (Either e a)
forall e a.
Exception e =>
Workflow a -> (e -> Workflow a) -> Workflow a
`Temporal.Workflow.Internal.Monad.catch` (Either e a -> Workflow (Either e a)
forall a. a -> Workflow a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> Workflow (Either e a))
-> (e -> Either e a) -> e -> Workflow (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)
instance Catch.MonadThrow Workflow where throwM :: forall e a. (HasCallStack, Exception e) => e -> Workflow a
throwM = e -> Workflow a
forall e a. (HasCallStack, Exception e) => e -> Workflow a
Temporal.Workflow.Internal.Monad.throw
instance Catch.MonadCatch Workflow where catch :: forall e a.
(HasCallStack, Exception e) =>
Workflow a -> (e -> Workflow a) -> Workflow a
catch = Workflow a -> (e -> Workflow a) -> Workflow a
forall e a.
Exception e =>
Workflow a -> (e -> Workflow a) -> Workflow a
Temporal.Workflow.Internal.Monad.catch
newtype WorkflowGenM = WorkflowGenM {WorkflowGenM -> IORef StdGen
unWorkflowGenM :: IORef StdGen}
instance StatefulGen WorkflowGenM Workflow where
uniformWord32R :: Word32 -> WorkflowGenM -> Workflow Word32
uniformWord32R Word32
r = (StdGen -> (Word32, StdGen)) -> WorkflowGenM -> Workflow Word32
forall a. (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
applyWorkflowGen (Word32 -> StdGen -> (Word32, StdGen)
forall g. RandomGen g => Word32 -> g -> (Word32, g)
genWord32R Word32
r)
{-# INLINE uniformWord32R #-}
uniformWord64R :: Word64 -> WorkflowGenM -> Workflow Word64
uniformWord64R Word64
r = (StdGen -> (Word64, StdGen)) -> WorkflowGenM -> Workflow Word64
forall a. (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
applyWorkflowGen (Word64 -> StdGen -> (Word64, StdGen)
forall g. RandomGen g => Word64 -> g -> (Word64, g)
genWord64R Word64
r)
{-# INLINE uniformWord64R #-}
uniformWord8 :: WorkflowGenM -> Workflow Word8
uniformWord8 = (StdGen -> (Word8, StdGen)) -> WorkflowGenM -> Workflow Word8
forall a. (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
applyWorkflowGen StdGen -> (Word8, StdGen)
forall g. RandomGen g => g -> (Word8, g)
genWord8
{-# INLINE uniformWord8 #-}
uniformWord16 :: WorkflowGenM -> Workflow Word16
uniformWord16 = (StdGen -> (Word16, StdGen)) -> WorkflowGenM -> Workflow Word16
forall a. (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
applyWorkflowGen StdGen -> (Word16, StdGen)
forall g. RandomGen g => g -> (Word16, g)
genWord16
{-# INLINE uniformWord16 #-}
uniformWord32 :: WorkflowGenM -> Workflow Word32
uniformWord32 = (StdGen -> (Word32, StdGen)) -> WorkflowGenM -> Workflow Word32
forall a. (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
applyWorkflowGen StdGen -> (Word32, StdGen)
forall g. RandomGen g => g -> (Word32, g)
genWord32
{-# INLINE uniformWord32 #-}
uniformWord64 :: WorkflowGenM -> Workflow Word64
uniformWord64 = (StdGen -> (Word64, StdGen)) -> WorkflowGenM -> Workflow Word64
forall a. (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
applyWorkflowGen StdGen -> (Word64, StdGen)
forall g. RandomGen g => g -> (Word64, g)
genWord64
{-# INLINE uniformWord64 #-}
uniformShortByteString :: Int -> WorkflowGenM -> Workflow ShortByteString
uniformShortByteString Int
n = (StdGen -> (ShortByteString, StdGen))
-> WorkflowGenM -> Workflow ShortByteString
forall a. (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
applyWorkflowGen (Int -> StdGen -> (ShortByteString, StdGen)
forall g. RandomGen g => Int -> g -> (ShortByteString, g)
genShortByteString Int
n)
applyWorkflowGen :: (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
applyWorkflowGen :: forall a. (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
applyWorkflowGen StdGen -> (a, StdGen)
f (WorkflowGenM IORef StdGen
ref) = (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result a)) -> Workflow a)
-> (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> do
g <- IORef StdGen -> InstanceM StdGen
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef StdGen
ref
case f g of
(!a
a, !StdGen
g') -> a -> Result a
forall a. a -> Result a
Done a
a Result a -> InstanceM () -> InstanceM (Result a)
forall a b. a -> InstanceM b -> InstanceM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IORef StdGen -> StdGen -> InstanceM ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef StdGen
ref StdGen
g'
{-# INLINE applyWorkflowGen #-}
newWorkflowGenM :: StdGen -> Workflow WorkflowGenM
newWorkflowGenM :: StdGen -> Workflow WorkflowGenM
newWorkflowGenM StdGen
g = (ContinuationEnv -> InstanceM (Result WorkflowGenM))
-> Workflow WorkflowGenM
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result WorkflowGenM))
-> Workflow WorkflowGenM)
-> (ContinuationEnv -> InstanceM (Result WorkflowGenM))
-> Workflow WorkflowGenM
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> WorkflowGenM -> Result WorkflowGenM
forall a. a -> Result a
Done (WorkflowGenM -> Result WorkflowGenM)
-> (IORef StdGen -> WorkflowGenM)
-> IORef StdGen
-> Result WorkflowGenM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef StdGen -> WorkflowGenM
WorkflowGenM (IORef StdGen -> Result WorkflowGenM)
-> InstanceM (IORef StdGen) -> InstanceM (Result WorkflowGenM)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StdGen -> InstanceM (IORef StdGen)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef StdGen
g
{-# INLINE newWorkflowGenM #-}
instance RandomGenM WorkflowGenM StdGen Workflow where
applyRandomGenM :: forall a. (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
applyRandomGenM = (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
forall a. (StdGen -> (a, StdGen)) -> WorkflowGenM -> Workflow a
applyWorkflowGen
instance FrozenGen StdGen Workflow where
type MutableGen StdGen Workflow = WorkflowGenM
freezeGen :: MutableGen StdGen Workflow -> Workflow StdGen
freezeGen MutableGen StdGen Workflow
g = (ContinuationEnv -> InstanceM (Result StdGen)) -> Workflow StdGen
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result StdGen)) -> Workflow StdGen)
-> (ContinuationEnv -> InstanceM (Result StdGen))
-> Workflow StdGen
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> StdGen -> Result StdGen
forall a. a -> Result a
Done (StdGen -> Result StdGen)
-> InstanceM StdGen -> InstanceM (Result StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef StdGen -> InstanceM StdGen
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (WorkflowGenM -> IORef StdGen
unWorkflowGenM MutableGen StdGen Workflow
WorkflowGenM
g)
thawGen :: StdGen -> Workflow (MutableGen StdGen Workflow)
thawGen = StdGen -> Workflow (MutableGen StdGen Workflow)
StdGen -> Workflow WorkflowGenM
newWorkflowGenM
{-# INLINE addJob #-}
addJob :: ContinuationEnv -> Workflow b -> IVar b -> IVar a -> InstanceM ()
addJob :: forall b a.
ContinuationEnv -> Workflow b -> IVar b -> IVar a -> InstanceM ()
addJob ContinuationEnv
env !Workflow b
wf !IVar b
resultIVar IVar {ivarRef :: forall a. IVar a -> IORef (IVarContents a)
ivarRef = !IORef (IVarContents a)
ref} =
InstanceM (InstanceM ()) -> InstanceM ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (InstanceM (InstanceM ()) -> InstanceM ())
-> InstanceM (InstanceM ()) -> InstanceM ()
forall a b. (a -> b) -> a -> b
$ IORef (IVarContents a)
-> (IVarContents a -> (IVarContents a, InstanceM ()))
-> InstanceM (InstanceM ())
forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef' IORef (IVarContents a)
ref ((IVarContents a -> (IVarContents a, InstanceM ()))
-> InstanceM (InstanceM ()))
-> (IVarContents a -> (IVarContents a, InstanceM ()))
-> InstanceM (InstanceM ())
forall a b. (a -> b) -> a -> b
$ \case
IVarEmpty JobList
list -> (JobList -> IVarContents a
forall a. JobList -> IVarContents a
IVarEmpty (ContinuationEnv -> Workflow b -> IVar b -> JobList -> JobList
forall a.
ContinuationEnv -> Workflow a -> IVar a -> JobList -> JobList
JobCons ContinuationEnv
env Workflow b
wf IVar b
resultIVar JobList
list), () -> InstanceM ()
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
IVarContents a
full -> (IVarContents a
full, IORef JobList -> (JobList -> JobList) -> InstanceM ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' ContinuationEnv
env.runQueueRef (ContinuationEnv -> Workflow b -> IVar b -> JobList -> JobList
forall a.
ContinuationEnv -> Workflow a -> IVar a -> JobList -> JobList
JobCons ContinuationEnv
env Workflow b
wf IVar b
resultIVar))
addJobPanic :: forall a. a
addJobPanic :: forall a. a
addJobPanic = String -> a
forall a. HasCallStack => String -> a
error String
"addJob: not empty"
data Cont a
= Cont (Workflow a)
| forall b. Cont b :>>= (b -> Workflow a)
| forall b. (b -> a) :<$> (Cont b)
| Return (IVar a)
toWf :: Cont a -> Workflow a
toWf :: forall a. Cont a -> Workflow a
toWf (Cont Workflow a
wf) = Workflow a
wf
toWf (Cont b
m :>>= b -> Workflow a
k) = Cont b -> (b -> Workflow a) -> Workflow a
forall b a. Cont b -> (b -> Workflow a) -> Workflow a
toWfBind Cont b
m b -> Workflow a
k
toWf (b -> a
f :<$> Cont b
x) = (b -> a) -> Cont b -> Workflow a
forall a b. (a -> b) -> Cont a -> Workflow b
toWfFmap b -> a
f Cont b
x
toWf (Return IVar a
i) = IVar a -> Workflow a
forall a. IVar a -> Workflow a
getIVar IVar a
i
toWfBind :: Cont b -> (b -> Workflow a) -> Workflow a
toWfBind :: forall b a. Cont b -> (b -> Workflow a) -> Workflow a
toWfBind (Cont b
m :>>= b -> Workflow b
k) b -> Workflow a
k2 = Cont b -> (b -> Workflow a) -> Workflow a
forall b a. Cont b -> (b -> Workflow a) -> Workflow a
toWfBind Cont b
m (b -> Workflow b
k (b -> Workflow b) -> (b -> Workflow a) -> b -> Workflow a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> Workflow a
k2)
toWfBind (Cont Workflow b
wf) b -> Workflow a
k = Workflow b
wf Workflow b -> (b -> Workflow a) -> Workflow a
forall a b. Workflow a -> (a -> Workflow b) -> Workflow b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Workflow a
k
toWfBind (b -> b
f :<$> Cont b
x) b -> Workflow a
k = Cont b -> (b -> Workflow a) -> Workflow a
forall b a. Cont b -> (b -> Workflow a) -> Workflow a
toWfBind Cont b
x (b -> Workflow a
k (b -> Workflow a) -> (b -> b) -> b -> Workflow a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
f)
toWfBind (Return IVar b
i) b -> Workflow a
k = IVar b -> Workflow b
forall a. IVar a -> Workflow a
getIVar IVar b
i Workflow b -> (b -> Workflow a) -> Workflow a
forall a b. Workflow a -> (a -> Workflow b) -> Workflow b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Workflow a
k
toWfFmap :: (a -> b) -> Cont a -> Workflow b
toWfFmap :: forall a b. (a -> b) -> Cont a -> Workflow b
toWfFmap a -> b
f (Cont b
m :>>= b -> Workflow a
k) = Cont b -> (b -> Workflow b) -> Workflow b
forall b a. Cont b -> (b -> Workflow a) -> Workflow a
toWfBind Cont b
m (b -> Workflow a
k (b -> Workflow a) -> (a -> Workflow b) -> b -> Workflow b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> Workflow b
forall a. a -> Workflow a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Workflow b) -> (a -> b) -> a -> Workflow b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
toWfFmap a -> b
f (Cont Workflow a
wf) = a -> b
f (a -> b) -> Workflow a -> Workflow b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workflow a
wf
toWfFmap a -> b
f (b -> a
g :<$> Cont b
x) = (b -> b) -> Cont b -> Workflow b
forall a b. (a -> b) -> Cont a -> Workflow b
toWfFmap (a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g) Cont b
x
toWfFmap a -> b
f (Return IVar a
i) = a -> b
f (a -> b) -> Workflow a -> Workflow b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IVar a -> Workflow a
forall a. IVar a -> Workflow a
getIVar IVar a
i
data Result a
= Done a
| Throw SomeException
|
forall b.
Blocked
{-# UNPACK #-} !(IVar b)
(Cont a)
data JobList
= JobNil
| forall a.
JobCons
ContinuationEnv
(Workflow a)
{-# UNPACK #-} !(IVar a)
JobList
appendJobList :: JobList -> JobList -> JobList
appendJobList :: JobList -> JobList -> JobList
appendJobList JobList
JobNil JobList
c = JobList
c
appendJobList JobList
c JobList
JobNil = JobList
c
appendJobList (JobCons ContinuationEnv
a Workflow a
b IVar a
c JobList
d) JobList
e = ContinuationEnv -> Workflow a -> IVar a -> JobList -> JobList
forall a.
ContinuationEnv -> Workflow a -> IVar a -> JobList -> JobList
JobCons ContinuationEnv
a Workflow a
b IVar a
c (JobList -> JobList) -> JobList -> JobList
forall a b. (a -> b) -> a -> b
$! JobList -> JobList -> JobList
appendJobList JobList
d JobList
e
lengthJobList :: JobList -> Int
lengthJobList :: JobList -> Int
lengthJobList JobList
JobNil = Int
0
lengthJobList (JobCons ContinuationEnv
_ Workflow a
_ IVar a
_ JobList
j) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ JobList -> Int
lengthJobList JobList
j
instance (Show a) => Show (Result a) where
show :: Result a -> String
show (Done a
a) = String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Done(%s)" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a
show (Throw SomeException
e) = String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Throw(%s)" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
show Blocked {} = String
"Blocked"
data IVarContents a
= IVarFull (ResultVal a)
| IVarEmpty JobList
newtype IVar a = IVar {forall a. IVar a -> IORef (IVarContents a)
ivarRef :: IORef (IVarContents a)}
data ResultVal a
= Ok a
|
ThrowInternal SomeException
|
ThrowWorkflow SomeException
newIVar :: MonadIO m => m (IVar a)
newIVar :: forall (m :: * -> *) a. MonadIO m => m (IVar a)
newIVar = do
ivarRef <- IVarContents a -> m (IORef (IVarContents a))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (IVarContents a -> m (IORef (IVarContents a)))
-> IVarContents a -> m (IORef (IVarContents a))
forall a b. (a -> b) -> a -> b
$ JobList -> IVarContents a
forall a. JobList -> IVarContents a
IVarEmpty JobList
JobNil
pure IVar {..}
getIVar :: IVar a -> Workflow a
getIVar :: forall a. IVar a -> Workflow a
getIVar i :: IVar a
i@(IVar {ivarRef :: forall a. IVar a -> IORef (IVarContents a)
ivarRef = !IORef (IVarContents a)
ref}) = (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result a)) -> Workflow a)
-> (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
env -> do
e <- IORef (IVarContents a) -> InstanceM (IVarContents a)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (IVarContents a)
ref
case e of
IVarFull (Ok a
a) -> Result a -> InstanceM (Result a)
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result a -> InstanceM (Result a))
-> Result a -> InstanceM (Result a)
forall a b. (a -> b) -> a -> b
$ a -> Result a
forall a. a -> Result a
Done a
a
IVarFull (ThrowWorkflow SomeException
e') -> IO (Result a) -> InstanceM (Result a)
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result a) -> InstanceM (Result a))
-> IO (Result a) -> InstanceM (Result a)
forall a b. (a -> b) -> a -> b
$ ContinuationEnv -> IVar a -> SomeException -> IO (Result a)
forall e a b.
Exception e =>
ContinuationEnv -> IVar a -> e -> IO (Result b)
raiseFromIVar ContinuationEnv
env IVar a
i SomeException
e'
IVarFull (ThrowInternal SomeException
e') -> SomeException -> InstanceM (Result a)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
e'
IVarEmpty JobList
_ -> Result a -> InstanceM (Result a)
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result a -> InstanceM (Result a))
-> Result a -> InstanceM (Result a)
forall a b. (a -> b) -> a -> b
$ IVar a -> Cont a -> Result a
forall a b. IVar b -> Cont a -> Result a
Blocked IVar a
i (IVar a -> Cont a
forall a. IVar a -> Cont a
Return IVar a
i)
getIVarApply :: IVar (a -> b) -> a -> Workflow b
getIVarApply :: forall a b. IVar (a -> b) -> a -> Workflow b
getIVarApply i :: IVar (a -> b)
i@IVar {ivarRef :: forall a. IVar a -> IORef (IVarContents a)
ivarRef = !IORef (IVarContents (a -> b))
ref} a
a = (ContinuationEnv -> InstanceM (Result b)) -> Workflow b
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result b)) -> Workflow b)
-> (ContinuationEnv -> InstanceM (Result b)) -> Workflow b
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
env -> do
e <- IORef (IVarContents (a -> b)) -> InstanceM (IVarContents (a -> b))
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (IVarContents (a -> b))
ref
case e of
IVarFull (Ok a -> b
f) -> Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Result b
forall a. a -> Result a
Done (a -> b
f a
a))
IVarFull (ThrowWorkflow SomeException
e') -> IO (Result b) -> InstanceM (Result b)
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result b) -> InstanceM (Result b))
-> IO (Result b) -> InstanceM (Result b)
forall a b. (a -> b) -> a -> b
$ ContinuationEnv -> IVar (a -> b) -> SomeException -> IO (Result b)
forall e a b.
Exception e =>
ContinuationEnv -> IVar a -> e -> IO (Result b)
raiseFromIVar ContinuationEnv
env IVar (a -> b)
i SomeException
e'
IVarFull (ThrowInternal SomeException
e') -> SomeException -> InstanceM (Result b)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
e'
IVarEmpty JobList
_ ->
Result b -> InstanceM (Result b)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IVar (a -> b) -> Cont b -> Result b
forall a b. IVar b -> Cont a -> Result a
Blocked IVar (a -> b)
i (Workflow b -> Cont b
forall a. Workflow a -> Cont a
Cont (IVar (a -> b) -> a -> Workflow b
forall a b. IVar (a -> b) -> a -> Workflow b
getIVarApply IVar (a -> b)
i a
a)))
putIVar :: IVar a -> ResultVal a -> ContinuationEnv -> IO ()
putIVar :: forall a. IVar a -> ResultVal a -> ContinuationEnv -> IO ()
putIVar IVar {ivarRef :: forall a. IVar a -> IORef (IVarContents a)
ivarRef = !IORef (IVarContents a)
ref} ResultVal a
a ContinuationEnv {IORef JobList
runQueueRef :: ContinuationEnv -> IORef JobList
runQueueRef :: IORef JobList
..} = do
e <- IORef (IVarContents a) -> IO (IVarContents a)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (IVarContents a)
ref
case e of
IVarEmpty JobList
jobs -> String -> IO () -> IO ()
forall a. String -> a -> a
trace_ String
"putIVar/Empty" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IORef (IVarContents a) -> IVarContents a -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (IVarContents a)
ref (ResultVal a -> IVarContents a
forall a. ResultVal a -> IVarContents a
IVarFull ResultVal a
a)
IORef JobList -> (JobList -> JobList) -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' IORef JobList
runQueueRef (JobList -> JobList -> JobList
appendJobList JobList
jobs)
IVarFull {} -> String -> (() -> IO ()) -> () -> IO ()
forall a. String -> a -> a
trace_ String
"putIVar/Full" () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
tryReadIVar :: IVar a -> Workflow (Maybe a)
tryReadIVar :: forall a. IVar a -> Workflow (Maybe a)
tryReadIVar i :: IVar a
i@IVar {ivarRef :: forall a. IVar a -> IORef (IVarContents a)
ivarRef = !IORef (IVarContents a)
ref} = (ContinuationEnv -> InstanceM (Result (Maybe a)))
-> Workflow (Maybe a)
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result (Maybe a)))
-> Workflow (Maybe a))
-> (ContinuationEnv -> InstanceM (Result (Maybe a)))
-> Workflow (Maybe a)
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
env -> do
e <- IORef (IVarContents a) -> InstanceM (IVarContents a)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (IVarContents a)
ref
case e of
IVarFull (Ok a
a) -> Result (Maybe a) -> InstanceM (Result (Maybe a))
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (Maybe a) -> InstanceM (Result (Maybe a)))
-> Result (Maybe a) -> InstanceM (Result (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Result (Maybe a)
forall a. a -> Result a
Done (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
IVarFull (ThrowWorkflow SomeException
e') -> IO (Result (Maybe a)) -> InstanceM (Result (Maybe a))
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result (Maybe a)) -> InstanceM (Result (Maybe a)))
-> IO (Result (Maybe a)) -> InstanceM (Result (Maybe a))
forall a b. (a -> b) -> a -> b
$ ContinuationEnv -> IVar a -> SomeException -> IO (Result (Maybe a))
forall e a b.
Exception e =>
ContinuationEnv -> IVar a -> e -> IO (Result b)
raiseFromIVar ContinuationEnv
env IVar a
i SomeException
e'
IVarFull (ThrowInternal SomeException
e') -> SomeException -> InstanceM (Result (Maybe a))
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
e'
IVarEmpty JobList
_ -> Result (Maybe a) -> InstanceM (Result (Maybe a))
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (Maybe a) -> InstanceM (Result (Maybe a)))
-> Result (Maybe a) -> InstanceM (Result (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Result (Maybe a)
forall a. a -> Result a
Done Maybe a
forall a. Maybe a
Nothing
raiseFromIVar :: Exception e => ContinuationEnv -> IVar a -> e -> IO (Result b)
raiseFromIVar :: forall e a b.
Exception e =>
ContinuationEnv -> IVar a -> e -> IO (Result b)
raiseFromIVar ContinuationEnv
env IVar a
_ivar e
e = ContinuationEnv -> SomeException -> IO (Result b)
forall b. ContinuationEnv -> SomeException -> IO (Result b)
raiseImpl ContinuationEnv
env (e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e)
newtype Condition a = Condition
{ forall a. Condition a -> ReaderT (IORef (Set Sequence)) InstanceM a
unCondition :: ReaderT (IORef (Set Sequence)) InstanceM a
}
deriving newtype ((forall a b. (a -> b) -> Condition a -> Condition b)
-> (forall a b. a -> Condition b -> Condition a)
-> Functor Condition
forall a b. a -> Condition b -> Condition a
forall a b. (a -> b) -> Condition a -> Condition b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Condition a -> Condition b
fmap :: forall a b. (a -> b) -> Condition a -> Condition b
$c<$ :: forall a b. a -> Condition b -> Condition a
<$ :: forall a b. a -> Condition b -> Condition a
Functor, Functor Condition
Functor Condition =>
(forall a. a -> Condition a)
-> (forall a b. Condition (a -> b) -> Condition a -> Condition b)
-> (forall a b c.
(a -> b -> c) -> Condition a -> Condition b -> Condition c)
-> (forall a b. Condition a -> Condition b -> Condition b)
-> (forall a b. Condition a -> Condition b -> Condition a)
-> Applicative Condition
forall a. a -> Condition a
forall a b. Condition a -> Condition b -> Condition a
forall a b. Condition a -> Condition b -> Condition b
forall a b. Condition (a -> b) -> Condition a -> Condition b
forall a b c.
(a -> b -> c) -> Condition a -> Condition b -> Condition c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Condition a
pure :: forall a. a -> Condition a
$c<*> :: forall a b. Condition (a -> b) -> Condition a -> Condition b
<*> :: forall a b. Condition (a -> b) -> Condition a -> Condition b
$cliftA2 :: forall a b c.
(a -> b -> c) -> Condition a -> Condition b -> Condition c
liftA2 :: forall a b c.
(a -> b -> c) -> Condition a -> Condition b -> Condition c
$c*> :: forall a b. Condition a -> Condition b -> Condition b
*> :: forall a b. Condition a -> Condition b -> Condition b
$c<* :: forall a b. Condition a -> Condition b -> Condition a
<* :: forall a b. Condition a -> Condition b -> Condition a
Applicative, Applicative Condition
Applicative Condition =>
(forall a b. Condition a -> (a -> Condition b) -> Condition b)
-> (forall a b. Condition a -> Condition b -> Condition b)
-> (forall a. a -> Condition a)
-> Monad Condition
forall a. a -> Condition a
forall a b. Condition a -> Condition b -> Condition b
forall a b. Condition a -> (a -> Condition b) -> Condition b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Condition a -> (a -> Condition b) -> Condition b
>>= :: forall a b. Condition a -> (a -> Condition b) -> Condition b
$c>> :: forall a b. Condition a -> Condition b -> Condition b
>> :: forall a b. Condition a -> Condition b -> Condition b
$creturn :: forall a. a -> Condition a
return :: forall a. a -> Condition a
Monad)
data StateVar a = StateVar
{ forall a. StateVar a -> Sequence
stateVarId :: !Sequence
, forall a. StateVar a -> IORef a
stateVarRef :: !(IORef a)
}
instance Eq (StateVar a) where
StateVar a
a == :: StateVar a -> StateVar a -> Bool
== StateVar a
b = StateVar a -> Sequence
forall a. StateVar a -> Sequence
stateVarId StateVar a
a Sequence -> Sequence -> Bool
forall a. Eq a => a -> a -> Bool
== StateVar a -> Sequence
forall a. StateVar a -> Sequence
stateVarId StateVar a
b
instance Ord (StateVar a) where
compare :: StateVar a -> StateVar a -> Ordering
compare StateVar a
a StateVar a
b = Sequence -> Sequence -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (StateVar a -> Sequence
forall a. StateVar a -> Sequence
stateVarId StateVar a
a) (StateVar a -> Sequence
forall a. StateVar a -> Sequence
stateVarId StateVar a
b)
newStateVar :: a -> Workflow (StateVar a)
newStateVar :: forall a. a -> Workflow (StateVar a)
newStateVar a
a = (ContinuationEnv -> InstanceM (Result (StateVar a)))
-> Workflow (StateVar a)
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result (StateVar a)))
-> Workflow (StateVar a))
-> (ContinuationEnv -> InstanceM (Result (StateVar a)))
-> Workflow (StateVar a)
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> do
StateVar a -> Result (StateVar a)
forall a. a -> Result a
Done (StateVar a -> Result (StateVar a))
-> InstanceM (StateVar a) -> InstanceM (Result (StateVar a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sequence -> IORef a -> StateVar a
forall a. Sequence -> IORef a -> StateVar a
StateVar (Sequence -> IORef a -> StateVar a)
-> InstanceM Sequence -> InstanceM (IORef a -> StateVar a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InstanceM Sequence
nextVarIdSequence InstanceM (IORef a -> StateVar a)
-> InstanceM (IORef a) -> InstanceM (StateVar a)
forall a b. InstanceM (a -> b) -> InstanceM a -> InstanceM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> InstanceM (IORef a)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef a
a)
reevaluateDependentConditions :: StateVar a -> InstanceM ()
reevaluateDependentConditions :: forall a. StateVar a -> InstanceM ()
reevaluateDependentConditions StateVar a
cref = do
inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
join $ atomically $ do
seqMaps <- readTVar inst.workflowSequenceMaps
let pendingConds = SequenceMaps
seqMaps.conditionsAwaitingSignal
(reactivateConds, unactivatedConds) =
HashMap.foldlWithKey'
( \(InstanceM ()
reactivateConds', HashMap Sequence (IVar (), Set Sequence)
unactivatedConds') Sequence
k v :: (IVar (), Set Sequence)
v@(IVar ()
ivar, Set Sequence
varDependencies) ->
if StateVar a
cref.stateVarId Sequence -> Set Sequence -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Sequence
varDependencies
then
( InstanceM ()
reactivateConds' InstanceM () -> InstanceM () -> InstanceM ()
forall a b. InstanceM a -> InstanceM b -> InstanceM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> InstanceM ()
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IVar () -> ResultVal () -> ContinuationEnv -> IO ()
forall a. IVar a -> ResultVal a -> ContinuationEnv -> IO ()
putIVar IVar ()
ivar (() -> ResultVal ()
forall a. a -> ResultVal a
Ok ()) WorkflowInstance
inst.workflowInstanceContinuationEnv)
, HashMap Sequence (IVar (), Set Sequence)
unactivatedConds'
)
else
( InstanceM ()
reactivateConds'
, Sequence
-> (IVar (), Set Sequence)
-> HashMap Sequence (IVar (), Set Sequence)
-> HashMap Sequence (IVar (), Set Sequence)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Sequence
k (IVar (), Set Sequence)
v HashMap Sequence (IVar (), Set Sequence)
unactivatedConds'
)
)
(pure (), mempty)
pendingConds
writeTVar inst.workflowSequenceMaps (seqMaps {conditionsAwaitingSignal = unactivatedConds})
pure reactivateConds
class MonadReadStateVar m where
readStateVar :: StateVar a -> m a
class MonadWriteStateVar m where
writeStateVar :: StateVar a -> a -> m ()
modifyStateVar :: StateVar a -> (a -> a) -> m ()
instance MonadReadStateVar Condition where
readStateVar :: forall a. StateVar a -> Condition a
readStateVar StateVar a
var = ReaderT (IORef (Set Sequence)) InstanceM a -> Condition a
forall a. ReaderT (IORef (Set Sequence)) InstanceM a -> Condition a
Condition (ReaderT (IORef (Set Sequence)) InstanceM a -> Condition a)
-> ReaderT (IORef (Set Sequence)) InstanceM a -> Condition a
forall a b. (a -> b) -> a -> b
$ do
touchedVars <- ReaderT (IORef (Set Sequence)) InstanceM (IORef (Set Sequence))
forall r (m :: * -> *). MonadReader r m => m r
ask
modifyIORef' touchedVars (Set.insert var.stateVarId)
readIORef var.stateVarRef
instance MonadReadStateVar Workflow where
readStateVar :: forall a. StateVar a -> Workflow a
readStateVar StateVar a
var = (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result a)) -> Workflow a)
-> (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> a -> Result a
forall a. a -> Result a
Done (a -> Result a) -> InstanceM a -> InstanceM (Result a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef StateVar a
var.stateVarRef
instance MonadWriteStateVar Workflow where
writeStateVar :: forall a. StateVar a -> a -> Workflow ()
writeStateVar StateVar a
var a
a = (ContinuationEnv -> InstanceM (Result ())) -> Workflow ()
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result ())) -> Workflow ())
-> (ContinuationEnv -> InstanceM (Result ())) -> Workflow ()
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> do
IORef a -> a -> InstanceM ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef StateVar a
var.stateVarRef a
a
StateVar a -> InstanceM ()
forall a. StateVar a -> InstanceM ()
reevaluateDependentConditions StateVar a
var
Result () -> InstanceM (Result ())
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result () -> InstanceM (Result ()))
-> Result () -> InstanceM (Result ())
forall a b. (a -> b) -> a -> b
$ () -> Result ()
forall a. a -> Result a
Done ()
modifyStateVar :: forall a. StateVar a -> (a -> a) -> Workflow ()
modifyStateVar StateVar a
var a -> a
f = (ContinuationEnv -> InstanceM (Result ())) -> Workflow ()
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result ())) -> Workflow ())
-> (ContinuationEnv -> InstanceM (Result ())) -> Workflow ()
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> do
res <- IORef a -> (a -> a) -> InstanceM ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' StateVar a
var.stateVarRef a -> a
f
reevaluateDependentConditions var
pure $ Done res
newtype Query a = Query (InstanceM a)
deriving newtype ((forall a b. (a -> b) -> Query a -> Query b)
-> (forall a b. a -> Query b -> Query a) -> Functor Query
forall a b. a -> Query b -> Query a
forall a b. (a -> b) -> Query a -> Query b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Query a -> Query b
fmap :: forall a b. (a -> b) -> Query a -> Query b
$c<$ :: forall a b. a -> Query b -> Query a
<$ :: forall a b. a -> Query b -> Query a
Functor, Functor Query
Functor Query =>
(forall a. a -> Query a)
-> (forall a b. Query (a -> b) -> Query a -> Query b)
-> (forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c)
-> (forall a b. Query a -> Query b -> Query b)
-> (forall a b. Query a -> Query b -> Query a)
-> Applicative Query
forall a. a -> Query a
forall a b. Query a -> Query b -> Query a
forall a b. Query a -> Query b -> Query b
forall a b. Query (a -> b) -> Query a -> Query b
forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Query a
pure :: forall a. a -> Query a
$c<*> :: forall a b. Query (a -> b) -> Query a -> Query b
<*> :: forall a b. Query (a -> b) -> Query a -> Query b
$cliftA2 :: forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
liftA2 :: forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
$c*> :: forall a b. Query a -> Query b -> Query b
*> :: forall a b. Query a -> Query b -> Query b
$c<* :: forall a b. Query a -> Query b -> Query a
<* :: forall a b. Query a -> Query b -> Query a
Applicative, Applicative Query
Applicative Query =>
(forall a b. Query a -> (a -> Query b) -> Query b)
-> (forall a b. Query a -> Query b -> Query b)
-> (forall a. a -> Query a)
-> Monad Query
forall a. a -> Query a
forall a b. Query a -> Query b -> Query b
forall a b. Query a -> (a -> Query b) -> Query b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Query a -> (a -> Query b) -> Query b
>>= :: forall a b. Query a -> (a -> Query b) -> Query b
$c>> :: forall a b. Query a -> Query b -> Query b
>> :: forall a b. Query a -> Query b -> Query b
$creturn :: forall a. a -> Query a
return :: forall a. a -> Query a
Monad)
instance MonadReadStateVar Query where
readStateVar :: forall a. StateVar a -> Query a
readStateVar StateVar a
var = InstanceM a -> Query a
forall a. InstanceM a -> Query a
Query (InstanceM a -> Query a) -> InstanceM a -> Query a
forall a b. (a -> b) -> a -> b
$ IORef a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef StateVar a
var.stateVarRef
newtype InstanceM (a :: Type) = InstanceM {forall a. InstanceM a -> ReaderT WorkflowInstance IO a
unInstanceM :: ReaderT WorkflowInstance IO a}
deriving newtype
( (forall a b. (a -> b) -> InstanceM a -> InstanceM b)
-> (forall a b. a -> InstanceM b -> InstanceM a)
-> Functor InstanceM
forall a b. a -> InstanceM b -> InstanceM a
forall a b. (a -> b) -> InstanceM a -> InstanceM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> InstanceM a -> InstanceM b
fmap :: forall a b. (a -> b) -> InstanceM a -> InstanceM b
$c<$ :: forall a b. a -> InstanceM b -> InstanceM a
<$ :: forall a b. a -> InstanceM b -> InstanceM a
Functor
, Functor InstanceM
Functor InstanceM =>
(forall a. a -> InstanceM a)
-> (forall a b. InstanceM (a -> b) -> InstanceM a -> InstanceM b)
-> (forall a b c.
(a -> b -> c) -> InstanceM a -> InstanceM b -> InstanceM c)
-> (forall a b. InstanceM a -> InstanceM b -> InstanceM b)
-> (forall a b. InstanceM a -> InstanceM b -> InstanceM a)
-> Applicative InstanceM
forall a. a -> InstanceM a
forall a b. InstanceM a -> InstanceM b -> InstanceM a
forall a b. InstanceM a -> InstanceM b -> InstanceM b
forall a b. InstanceM (a -> b) -> InstanceM a -> InstanceM b
forall a b c.
(a -> b -> c) -> InstanceM a -> InstanceM b -> InstanceM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> InstanceM a
pure :: forall a. a -> InstanceM a
$c<*> :: forall a b. InstanceM (a -> b) -> InstanceM a -> InstanceM b
<*> :: forall a b. InstanceM (a -> b) -> InstanceM a -> InstanceM b
$cliftA2 :: forall a b c.
(a -> b -> c) -> InstanceM a -> InstanceM b -> InstanceM c
liftA2 :: forall a b c.
(a -> b -> c) -> InstanceM a -> InstanceM b -> InstanceM c
$c*> :: forall a b. InstanceM a -> InstanceM b -> InstanceM b
*> :: forall a b. InstanceM a -> InstanceM b -> InstanceM b
$c<* :: forall a b. InstanceM a -> InstanceM b -> InstanceM a
<* :: forall a b. InstanceM a -> InstanceM b -> InstanceM a
Applicative
, Applicative InstanceM
Applicative InstanceM =>
(forall a b. InstanceM a -> (a -> InstanceM b) -> InstanceM b)
-> (forall a b. InstanceM a -> InstanceM b -> InstanceM b)
-> (forall a. a -> InstanceM a)
-> Monad InstanceM
forall a. a -> InstanceM a
forall a b. InstanceM a -> InstanceM b -> InstanceM b
forall a b. InstanceM a -> (a -> InstanceM b) -> InstanceM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. InstanceM a -> (a -> InstanceM b) -> InstanceM b
>>= :: forall a b. InstanceM a -> (a -> InstanceM b) -> InstanceM b
$c>> :: forall a b. InstanceM a -> InstanceM b -> InstanceM b
>> :: forall a b. InstanceM a -> InstanceM b -> InstanceM b
$creturn :: forall a. a -> InstanceM a
return :: forall a. a -> InstanceM a
Monad
, Monad InstanceM
Monad InstanceM =>
(forall a. IO a -> InstanceM a) -> MonadIO InstanceM
forall a. IO a -> InstanceM a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> InstanceM a
liftIO :: forall a. IO a -> InstanceM a
MonadIO
, MonadReader WorkflowInstance
, MonadIO InstanceM
MonadIO InstanceM =>
(forall b.
((forall a. InstanceM a -> IO a) -> IO b) -> InstanceM b)
-> MonadUnliftIO InstanceM
forall b. ((forall a. InstanceM a -> IO a) -> IO b) -> InstanceM b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall b. ((forall a. InstanceM a -> IO a) -> IO b) -> InstanceM b
withRunInIO :: forall b. ((forall a. InstanceM a -> IO a) -> IO b) -> InstanceM b
MonadUnliftIO
, Monad InstanceM
Monad InstanceM =>
(forall e a. (HasCallStack, Exception e) => e -> InstanceM a)
-> MonadThrow InstanceM
forall e a. (HasCallStack, Exception e) => e -> InstanceM a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> InstanceM a
throwM :: forall e a. (HasCallStack, Exception e) => e -> InstanceM a
Catch.MonadThrow
, MonadThrow InstanceM
MonadThrow InstanceM =>
(forall e a.
(HasCallStack, Exception e) =>
InstanceM a -> (e -> InstanceM a) -> InstanceM a)
-> MonadCatch InstanceM
forall e a.
(HasCallStack, Exception e) =>
InstanceM a -> (e -> InstanceM a) -> InstanceM a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
InstanceM a -> (e -> InstanceM a) -> InstanceM a
catch :: forall e a.
(HasCallStack, Exception e) =>
InstanceM a -> (e -> InstanceM a) -> InstanceM a
Catch.MonadCatch
, MonadCatch InstanceM
MonadCatch InstanceM =>
(forall b.
HasCallStack =>
((forall a. InstanceM a -> InstanceM a) -> InstanceM b)
-> InstanceM b)
-> (forall b.
HasCallStack =>
((forall a. InstanceM a -> InstanceM a) -> InstanceM b)
-> InstanceM b)
-> (forall a b c.
HasCallStack =>
InstanceM a
-> (a -> ExitCase b -> InstanceM c)
-> (a -> InstanceM b)
-> InstanceM (b, c))
-> MonadMask InstanceM
forall b.
HasCallStack =>
((forall a. InstanceM a -> InstanceM a) -> InstanceM b)
-> InstanceM b
forall a b c.
HasCallStack =>
InstanceM a
-> (a -> ExitCase b -> InstanceM c)
-> (a -> InstanceM b)
-> InstanceM (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
HasCallStack =>
((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. InstanceM a -> InstanceM a) -> InstanceM b)
-> InstanceM b
mask :: forall b.
HasCallStack =>
((forall a. InstanceM a -> InstanceM a) -> InstanceM b)
-> InstanceM b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. InstanceM a -> InstanceM a) -> InstanceM b)
-> InstanceM b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. InstanceM a -> InstanceM a) -> InstanceM b)
-> InstanceM b
$cgeneralBracket :: forall a b c.
HasCallStack =>
InstanceM a
-> (a -> ExitCase b -> InstanceM c)
-> (a -> InstanceM b)
-> InstanceM (b, c)
generalBracket :: forall a b c.
HasCallStack =>
InstanceM a
-> (a -> ExitCase b -> InstanceM c)
-> (a -> InstanceM b)
-> InstanceM (b, c)
Catch.MonadMask
)
instance MonadLogger InstanceM where
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> InstanceM ()
monadLoggerLog Loc
loc LogSource
src LogLevel
lvl msg
msg = do
logger <- (WorkflowInstance
-> Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> InstanceM (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WorkflowInstance -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
workflowInstanceLogger
liftIO $ logger loc src lvl (toLogStr msg)
instance MonadLoggerIO InstanceM where
askLoggerIO :: InstanceM (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO = (WorkflowInstance
-> Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> InstanceM (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WorkflowInstance -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
workflowInstanceLogger
updateCallStack :: RequireCallStack => InstanceM ()
updateCallStack :: RequireCallStack => InstanceM ()
updateCallStack = do
inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
writeIORef inst.workflowCallStack $ popCallStack callStack
updateCallStackW :: RequireCallStack => Workflow ()
updateCallStackW :: RequireCallStack => Workflow ()
updateCallStackW = (ContinuationEnv -> InstanceM (Result ())) -> Workflow ()
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result ())) -> Workflow ())
-> (ContinuationEnv -> InstanceM (Result ())) -> Workflow ()
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> do
inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
writeIORef inst.workflowCallStack $ popCallStack callStack
pure $ Done ()
data WorkflowInstance = WorkflowInstance
{ WorkflowInstance -> IORef Info
workflowInstanceInfo :: {-# UNPACK #-} !(IORef Info)
, WorkflowInstance -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
workflowInstanceLogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
, WorkflowInstance -> WorkflowGenM
workflowRandomnessSeed :: WorkflowGenM
, WorkflowInstance -> IORef (Set PatchId)
workflowNotifiedPatches :: {-# UNPACK #-} !(IORef (Set PatchId))
, WorkflowInstance -> IORef (HashMap PatchId Bool)
workflowMemoizedPatches :: {-# UNPACK #-} !(IORef (HashMap PatchId Bool))
, WorkflowInstance -> IORef Sequences
workflowSequences :: {-# UNPACK #-} !(IORef Sequences)
, WorkflowInstance -> IORef SystemTime
workflowTime :: {-# UNPACK #-} !(IORef SystemTime)
, WorkflowInstance -> IORef Bool
workflowIsReplaying :: {-# UNPACK #-} !(IORef Bool)
, WorkflowInstance -> TVar (Reversed WorkflowCommand)
workflowCommands :: {-# UNPACK #-} !(TVar (Reversed WorkflowCommand))
, WorkflowInstance -> TVar SequenceMaps
workflowSequenceMaps :: {-# UNPACK #-} !(TVar SequenceMaps)
, WorkflowInstance
-> IORef
(HashMap (Maybe LogSource) (Vector Payload -> Workflow ()))
workflowSignalHandlers :: {-# UNPACK #-} !(IORef (HashMap (Maybe Text) (Vector Payload -> Workflow ())))
, WorkflowInstance
-> IORef
(HashMap
(Maybe LogSource)
(QueryId
-> Vector Payload
-> Map LogSource Payload
-> IO (Either SomeException Payload)))
workflowQueryHandlers :: {-# UNPACK #-} !(IORef (HashMap (Maybe Text) (QueryId -> Vector Payload -> Map Text Payload -> IO (Either SomeException Payload))))
, WorkflowInstance -> IORef CallStack
workflowCallStack :: {-# UNPACK #-} !(IORef CallStack)
, WorkflowInstance
-> WorkflowActivationCompletion -> IO (Either WorkerError ())
workflowCompleteActivation :: !(Core.WorkflowActivationCompletion -> IO (Either Core.WorkerError ()))
, WorkflowInstance -> ContinuationEnv
workflowInstanceContinuationEnv :: {-# UNPACK #-} !ContinuationEnv
, WorkflowInstance -> IVar ()
workflowCancellationVar :: {-# UNPACK #-} !(IVar ())
, WorkflowInstance -> Maybe Int
workflowDeadlockTimeout :: Maybe Int
,
WorkflowInstance -> TQueue WorkflowActivation
activationChannel :: {-# UNPACK #-} !(TQueue Core.WorkflowActivation)
, WorkflowInstance -> IORef (Async ())
executionThread :: {-# UNPACK #-} !(IORef (Async ()))
, WorkflowInstance -> WorkflowInboundInterceptor
inboundInterceptor :: {-# UNPACK #-} !WorkflowInboundInterceptor
, WorkflowInstance -> WorkflowOutboundInterceptor
outboundInterceptor :: {-# UNPACK #-} !WorkflowOutboundInterceptor
,
WorkflowInstance -> [ApplicationFailureHandler]
errorConverters :: [ApplicationFailureHandler]
, WorkflowInstance -> PayloadProcessor
payloadProcessor :: {-# UNPACK #-} !PayloadProcessor
}
data SomeChildWorkflowHandle = forall result. SomeChildWorkflowHandle (ChildWorkflowHandle result)
type SequenceMap a = HashMap Sequence a
data Sequences = Sequences
{ Sequences -> Word32
externalCancel :: !Word32
, Sequences -> Word32
childWorkflow :: !Word32
, Sequences -> Word32
externalSignal :: !Word32
, Sequences -> Word32
timer :: !Word32
, Sequences -> Word32
activity :: !Word32
, Sequences -> Word32
condition :: !Word32
, Sequences -> Word32
varId :: !Word32
}
newtype Reversed a = Reversed [a]
deriving newtype ((forall a b. (a -> b) -> Reversed a -> Reversed b)
-> (forall a b. a -> Reversed b -> Reversed a) -> Functor Reversed
forall a b. a -> Reversed b -> Reversed a
forall a b. (a -> b) -> Reversed a -> Reversed b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Reversed a -> Reversed b
fmap :: forall a b. (a -> b) -> Reversed a -> Reversed b
$c<$ :: forall a b. a -> Reversed b -> Reversed a
<$ :: forall a b. a -> Reversed b -> Reversed a
Functor, Int -> Reversed a -> ShowS
[Reversed a] -> ShowS
Reversed a -> String
(Int -> Reversed a -> ShowS)
-> (Reversed a -> String)
-> ([Reversed a] -> ShowS)
-> Show (Reversed a)
forall a. Show a => Int -> Reversed a -> ShowS
forall a. Show a => [Reversed a] -> ShowS
forall a. Show a => Reversed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Reversed a -> ShowS
showsPrec :: Int -> Reversed a -> ShowS
$cshow :: forall a. Show a => Reversed a -> String
show :: Reversed a -> String
$cshowList :: forall a. Show a => [Reversed a] -> ShowS
showList :: [Reversed a] -> ShowS
Show, Reversed a -> Reversed a -> Bool
(Reversed a -> Reversed a -> Bool)
-> (Reversed a -> Reversed a -> Bool) -> Eq (Reversed a)
forall a. Eq a => Reversed a -> Reversed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Reversed a -> Reversed a -> Bool
== :: Reversed a -> Reversed a -> Bool
$c/= :: forall a. Eq a => Reversed a -> Reversed a -> Bool
/= :: Reversed a -> Reversed a -> Bool
Eq)
fromReversed :: Reversed a -> [a]
fromReversed :: forall a. Reversed a -> [a]
fromReversed (Reversed [a]
xs) = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs
push :: a -> Reversed a -> Reversed a
push :: forall a. a -> Reversed a -> Reversed a
push a
x (Reversed [a]
xs) = [a] -> Reversed a
forall a. [a] -> Reversed a
Reversed (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
data SequenceMaps = SequenceMaps
{ SequenceMaps -> SequenceMap (IVar ())
timers :: {-# UNPACK #-} !(SequenceMap (IVar ()))
, SequenceMaps -> SequenceMap (IVar ResolveActivity)
activities :: {-# UNPACK #-} !(SequenceMap (IVar ResolveActivity))
, SequenceMaps -> SequenceMap SomeChildWorkflowHandle
childWorkflows :: {-# UNPACK #-} !(SequenceMap SomeChildWorkflowHandle)
, SequenceMaps -> SequenceMap (IVar ResolveSignalExternalWorkflow)
externalSignals :: {-# UNPACK #-} !(SequenceMap (IVar ResolveSignalExternalWorkflow))
, SequenceMaps
-> SequenceMap (IVar ResolveRequestCancelExternalWorkflow)
externalCancels :: {-# UNPACK #-} !(SequenceMap (IVar ResolveRequestCancelExternalWorkflow))
, SequenceMaps -> HashMap Sequence (IVar (), Set Sequence)
conditionsAwaitingSignal :: {-# UNPACK #-} !(SequenceMap (IVar (), Set Sequence))
}
data Task a = Task
{ forall a. Task a -> Workflow a
waitAction :: Workflow a
, forall a. Task a -> Workflow ()
cancelAction :: Workflow ()
}
instance Functor Task where
fmap :: forall a b. (a -> b) -> Task a -> Task b
fmap a -> b
f (Task Workflow a
wait' Workflow ()
cancel') = Workflow b -> Workflow () -> Task b
forall a. Workflow a -> Workflow () -> Task a
Task ((a -> b) -> Workflow a -> Workflow b
forall a b. (a -> b) -> Workflow a -> Workflow b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Workflow a
wait') Workflow ()
cancel'
instance Applicative Task where
pure :: forall a. a -> Task a
pure a
a = Workflow a -> Workflow () -> Task a
forall a. Workflow a -> Workflow () -> Task a
Task (a -> Workflow a
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (() -> Workflow ()
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
Task Workflow (a -> b)
waitL Workflow ()
cancelL <*> :: forall a b. Task (a -> b) -> Task a -> Task b
<*> Task Workflow a
waitR Workflow ()
cancelR = Workflow b -> Workflow () -> Task b
forall a. Workflow a -> Workflow () -> Task a
Task (Workflow (a -> b)
waitL Workflow (a -> b) -> Workflow a -> Workflow b
forall a b. Workflow (a -> b) -> Workflow a -> Workflow b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Workflow a
waitR) (Workflow ()
cancelL Workflow () -> Workflow () -> Workflow ()
forall a b. Workflow a -> Workflow b -> Workflow b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Workflow ()
cancelR)
bindTask :: Task a -> (a -> Workflow b) -> Task b
bindTask :: forall a b. Task a -> (a -> Workflow b) -> Task b
bindTask (Task Workflow a
wait' Workflow ()
cancel') a -> Workflow b
f = Workflow b -> Workflow () -> Task b
forall a. Workflow a -> Workflow () -> Task a
Task (Workflow a
wait' Workflow a -> (a -> Workflow b) -> Workflow b
forall a b. Workflow a -> (a -> Workflow b) -> Workflow b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Workflow b
f) Workflow ()
cancel'
data ExternalWorkflowHandle (result :: Type) = ExternalWorkflowHandle
{ forall result. ExternalWorkflowHandle result -> WorkflowId
externalWorkflowWorkflowId :: WorkflowId
, forall result. ExternalWorkflowHandle result -> Maybe RunId
externalWorkflowRunId :: Maybe RunId
}
data ChildWorkflowHandle result = ChildWorkflowHandle
{ forall result. ChildWorkflowHandle result -> Sequence
childWorkflowSequence :: Sequence
, forall result. ChildWorkflowHandle result -> IVar ()
startHandle :: IVar ()
, forall result.
ChildWorkflowHandle result -> IVar ResolveChildWorkflowExecution
resultHandle :: IVar ResolveChildWorkflowExecution
, forall result. ChildWorkflowHandle result -> Payload -> IO result
childWorkflowResultConverter :: Payload -> IO result
, forall result. ChildWorkflowHandle result -> WorkflowId
childWorkflowId :: WorkflowId
, forall result. ChildWorkflowHandle result -> IVar RunId
firstExecutionRunId :: IVar RunId
}
instance Functor ChildWorkflowHandle where
fmap :: forall a b.
(a -> b) -> ChildWorkflowHandle a -> ChildWorkflowHandle b
fmap a -> b
f ChildWorkflowHandle a
h = ChildWorkflowHandle a
h {childWorkflowResultConverter = fmap f . childWorkflowResultConverter h}
interceptorConvertChildWorkflowHandle :: ChildWorkflowHandle a -> (a -> IO b) -> ChildWorkflowHandle b
interceptorConvertChildWorkflowHandle :: forall a b.
ChildWorkflowHandle a -> (a -> IO b) -> ChildWorkflowHandle b
interceptorConvertChildWorkflowHandle ChildWorkflowHandle a
h a -> IO b
f =
ChildWorkflowHandle a
h
{ childWorkflowResultConverter = childWorkflowResultConverter h >=> f
}
data ExecuteWorkflowInput = ExecuteWorkflowInput
{ ExecuteWorkflowInput -> LogSource
executeWorkflowInputType :: Text
, ExecuteWorkflowInput -> Vector Payload
executeWorkflowInputArgs :: Vector Payload
, :: Map Text Payload
, ExecuteWorkflowInput -> Info
executeWorkflowInputInfo :: Info
}
data WorkflowExitVariant a
= WorkflowExitContinuedAsNew ContinueAsNewException
| WorkflowExitCancelled WorkflowCancelRequested
| WorkflowExitFailed SomeException
| WorkflowExitSuccess a
data HandleQueryInput = HandleQueryInput
{ HandleQueryInput -> LogSource
handleQueryId :: Text
, HandleQueryInput -> LogSource
handleQueryInputType :: Text
, HandleQueryInput -> Vector Payload
handleQueryInputArgs :: Vector Payload
, HandleQueryInput -> Map LogSource Payload
handleQueryInputHeaders :: Map Text Payload
}
data WorkflowInboundInterceptor = WorkflowInboundInterceptor
{ WorkflowInboundInterceptor
-> ExecuteWorkflowInput
-> (ExecuteWorkflowInput -> IO (WorkflowExitVariant Payload))
-> IO (WorkflowExitVariant Payload)
executeWorkflow
:: ExecuteWorkflowInput
-> (ExecuteWorkflowInput -> IO (WorkflowExitVariant Payload))
-> IO (WorkflowExitVariant Payload)
, WorkflowInboundInterceptor
-> HandleQueryInput
-> (HandleQueryInput -> IO (Either SomeException Payload))
-> IO (Either SomeException Payload)
handleQuery
:: HandleQueryInput
-> (HandleQueryInput -> IO (Either SomeException Payload))
-> IO (Either SomeException Payload)
}
instance Semigroup WorkflowInboundInterceptor where
WorkflowInboundInterceptor
a <> :: WorkflowInboundInterceptor
-> WorkflowInboundInterceptor -> WorkflowInboundInterceptor
<> WorkflowInboundInterceptor
b =
WorkflowInboundInterceptor
{ executeWorkflow :: ExecuteWorkflowInput
-> (ExecuteWorkflowInput -> IO (WorkflowExitVariant Payload))
-> IO (WorkflowExitVariant Payload)
executeWorkflow = \ExecuteWorkflowInput
input ExecuteWorkflowInput -> IO (WorkflowExitVariant Payload)
cont -> WorkflowInboundInterceptor
a.executeWorkflow ExecuteWorkflowInput
input ((ExecuteWorkflowInput -> IO (WorkflowExitVariant Payload))
-> IO (WorkflowExitVariant Payload))
-> (ExecuteWorkflowInput -> IO (WorkflowExitVariant Payload))
-> IO (WorkflowExitVariant Payload)
forall a b. (a -> b) -> a -> b
$ \ExecuteWorkflowInput
input' -> WorkflowInboundInterceptor
b.executeWorkflow ExecuteWorkflowInput
input' ExecuteWorkflowInput -> IO (WorkflowExitVariant Payload)
cont
, handleQuery :: HandleQueryInput
-> (HandleQueryInput -> IO (Either SomeException Payload))
-> IO (Either SomeException Payload)
handleQuery = \HandleQueryInput
input HandleQueryInput -> IO (Either SomeException Payload)
cont -> WorkflowInboundInterceptor
a.handleQuery HandleQueryInput
input ((HandleQueryInput -> IO (Either SomeException Payload))
-> IO (Either SomeException Payload))
-> (HandleQueryInput -> IO (Either SomeException Payload))
-> IO (Either SomeException Payload)
forall a b. (a -> b) -> a -> b
$ \HandleQueryInput
input' -> WorkflowInboundInterceptor
b.handleQuery HandleQueryInput
input' HandleQueryInput -> IO (Either SomeException Payload)
cont
}
instance Monoid WorkflowInboundInterceptor where
mempty :: WorkflowInboundInterceptor
mempty =
WorkflowInboundInterceptor
{ executeWorkflow :: ExecuteWorkflowInput
-> (ExecuteWorkflowInput -> IO (WorkflowExitVariant Payload))
-> IO (WorkflowExitVariant Payload)
executeWorkflow = \ExecuteWorkflowInput
input ExecuteWorkflowInput -> IO (WorkflowExitVariant Payload)
cont -> ExecuteWorkflowInput -> IO (WorkflowExitVariant Payload)
cont ExecuteWorkflowInput
input
, handleQuery :: HandleQueryInput
-> (HandleQueryInput -> IO (Either SomeException Payload))
-> IO (Either SomeException Payload)
handleQuery = \HandleQueryInput
input HandleQueryInput -> IO (Either SomeException Payload)
cont -> HandleQueryInput -> IO (Either SomeException Payload)
cont HandleQueryInput
input
}
data ActivityInput = ActivityInput
{ ActivityInput -> LogSource
activityType :: Text
, ActivityInput -> Vector Payload
args :: Vector Payload
, ActivityInput -> StartActivityOptions
options :: StartActivityOptions
, ActivityInput -> Sequence
seq :: Sequence
}
data WorkflowOutboundInterceptor = WorkflowOutboundInterceptor
{ WorkflowOutboundInterceptor
-> ActivityInput
-> (ActivityInput -> IO (Task Payload))
-> IO (Task Payload)
scheduleActivity :: ActivityInput -> (ActivityInput -> IO (Task Payload)) -> IO (Task Payload)
, WorkflowOutboundInterceptor
-> LogSource
-> StartChildWorkflowOptions
-> (LogSource
-> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload))
-> IO (ChildWorkflowHandle Payload)
startChildWorkflowExecution :: Text -> StartChildWorkflowOptions -> (Text -> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload)) -> IO (ChildWorkflowHandle Payload)
, WorkflowOutboundInterceptor
-> forall a.
LogSource
-> ContinueAsNewOptions
-> (LogSource -> ContinueAsNewOptions -> IO a)
-> IO a
continueAsNew :: forall a. Text -> ContinueAsNewOptions -> (Text -> ContinueAsNewOptions -> IO a) -> IO a
}
instance Semigroup WorkflowOutboundInterceptor where
WorkflowOutboundInterceptor
l <> :: WorkflowOutboundInterceptor
-> WorkflowOutboundInterceptor -> WorkflowOutboundInterceptor
<> WorkflowOutboundInterceptor
r =
WorkflowOutboundInterceptor
{ scheduleActivity :: ActivityInput
-> (ActivityInput -> IO (Task Payload)) -> IO (Task Payload)
scheduleActivity = \ActivityInput
input ActivityInput -> IO (Task Payload)
cont -> WorkflowOutboundInterceptor
-> ActivityInput
-> (ActivityInput -> IO (Task Payload))
-> IO (Task Payload)
scheduleActivity WorkflowOutboundInterceptor
l ActivityInput
input ((ActivityInput -> IO (Task Payload)) -> IO (Task Payload))
-> (ActivityInput -> IO (Task Payload)) -> IO (Task Payload)
forall a b. (a -> b) -> a -> b
$ \ActivityInput
input' -> WorkflowOutboundInterceptor
-> ActivityInput
-> (ActivityInput -> IO (Task Payload))
-> IO (Task Payload)
scheduleActivity WorkflowOutboundInterceptor
r ActivityInput
input' ActivityInput -> IO (Task Payload)
cont
, startChildWorkflowExecution :: LogSource
-> StartChildWorkflowOptions
-> (LogSource
-> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload))
-> IO (ChildWorkflowHandle Payload)
startChildWorkflowExecution = \LogSource
t StartChildWorkflowOptions
input LogSource
-> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload)
cont -> WorkflowOutboundInterceptor
-> LogSource
-> StartChildWorkflowOptions
-> (LogSource
-> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload))
-> IO (ChildWorkflowHandle Payload)
startChildWorkflowExecution WorkflowOutboundInterceptor
l LogSource
t StartChildWorkflowOptions
input ((LogSource
-> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload))
-> IO (ChildWorkflowHandle Payload))
-> (LogSource
-> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload))
-> IO (ChildWorkflowHandle Payload)
forall a b. (a -> b) -> a -> b
$ \LogSource
t' StartChildWorkflowOptions
input' -> WorkflowOutboundInterceptor
-> LogSource
-> StartChildWorkflowOptions
-> (LogSource
-> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload))
-> IO (ChildWorkflowHandle Payload)
startChildWorkflowExecution WorkflowOutboundInterceptor
r LogSource
t' StartChildWorkflowOptions
input' LogSource
-> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload)
cont
, continueAsNew :: forall a.
LogSource
-> ContinueAsNewOptions
-> (LogSource -> ContinueAsNewOptions -> IO a)
-> IO a
continueAsNew = \LogSource
n ContinueAsNewOptions
input LogSource -> ContinueAsNewOptions -> IO a
cont -> WorkflowOutboundInterceptor
-> forall a.
LogSource
-> ContinueAsNewOptions
-> (LogSource -> ContinueAsNewOptions -> IO a)
-> IO a
continueAsNew WorkflowOutboundInterceptor
l LogSource
n ContinueAsNewOptions
input ((LogSource -> ContinueAsNewOptions -> IO a) -> IO a)
-> (LogSource -> ContinueAsNewOptions -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \LogSource
n' ContinueAsNewOptions
input' -> WorkflowOutboundInterceptor
-> forall a.
LogSource
-> ContinueAsNewOptions
-> (LogSource -> ContinueAsNewOptions -> IO a)
-> IO a
continueAsNew WorkflowOutboundInterceptor
r LogSource
n' ContinueAsNewOptions
input' LogSource -> ContinueAsNewOptions -> IO a
cont
}
instance Monoid WorkflowOutboundInterceptor where
mempty :: WorkflowOutboundInterceptor
mempty =
WorkflowOutboundInterceptor
{ scheduleActivity :: ActivityInput
-> (ActivityInput -> IO (Task Payload)) -> IO (Task Payload)
scheduleActivity = \ActivityInput
input ActivityInput -> IO (Task Payload)
cont -> ActivityInput -> IO (Task Payload)
cont ActivityInput
input
, startChildWorkflowExecution :: LogSource
-> StartChildWorkflowOptions
-> (LogSource
-> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload))
-> IO (ChildWorkflowHandle Payload)
startChildWorkflowExecution = \LogSource
t StartChildWorkflowOptions
input LogSource
-> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload)
cont -> LogSource
-> StartChildWorkflowOptions -> IO (ChildWorkflowHandle Payload)
cont LogSource
t StartChildWorkflowOptions
input
, continueAsNew :: forall a.
LogSource
-> ContinueAsNewOptions
-> (LogSource -> ContinueAsNewOptions -> IO a)
-> IO a
continueAsNew = \LogSource
n ContinueAsNewOptions
input LogSource -> ContinueAsNewOptions -> IO a
cont -> LogSource -> ContinueAsNewOptions -> IO a
cont LogSource
n ContinueAsNewOptions
input
}
nextVarIdSequence :: InstanceM Sequence
nextVarIdSequence :: InstanceM Sequence
nextVarIdSequence = do
inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
atomicModifyIORef' inst.workflowSequences $ \Sequences
seqs ->
let seq' :: Word32
seq' = Sequences -> Word32
varId Sequences
seqs
in (Sequences
seqs {varId = succ seq'}, Word32 -> Sequence
Sequence Word32
seq')