{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

module Temporal.Workflow.Internal.Monad where

import Control.Applicative
import Control.Concurrent.Async
-- import Debug.Trace
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


{- | The Workflow monad is a constrained execution environment that helps
developers write code that can be executed deterministically and reliably.

If a Workflow execution is interrupted, for example due to a server failure,
or otherwise fails to complete, the Temporal service will automatically
replay the Workflow execution up to the point of interruption with the same
inputs at each step in the function.

The 'st' state may be used to store information that is needed to respond to
any queries or signals that are received by the Workflow execution.

Workflow code must be deterministic. This means:

- no threading
- no randomness
- no external calls to processes
- no network I/O
- no global state mutation
- no system date or time

This might seem like a lot of restrictions, but Temporal provides a number of
functions that allow you to use similar functionality in a deterministic way.

A critical aspect of developing Workflow Definitions is ensuring they exhibit certain deterministic traits –
that is, making sure that the same Commands are emitted in the same sequence,
whenever a corresponding Workflow Function Execution (instance of the Function Definition) is re-executed.
-}
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


{- | This function can be used to trace a bunch of lines to stdout when
debugging core.
-}
trace_ :: String -> a -> a
trace_ :: forall a. String -> a -> a
trace_ String
_ = a -> a
forall a. a -> a
id


-- trace_ = Debug.Trace.trace

data ContinuationEnv = ContinuationEnv
  { ContinuationEnv -> IORef JobList
runQueueRef :: {-# UNPACK #-} !(IORef JobList)
  -- ^ runnable computations. Things get added to here when we wake up
  -- a computation that was waiting for something.  When the list is
  -- empty, either we're finished, or we're waiting for some data fetch
  -- to return.
  }


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)


  -- TODO: Don't use parallelAp here, because people get too
  -- confused about what's going on.
  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

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)))
        -- Note [Blocked/Blocked]
        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)


-- Note [Blocked/Blocked]
--
-- This is the tricky case: we're blocked on both sides of the <*>.
-- We need to divide the computation into two pieces that may continue
-- independently when the resources they are blocked on become
-- available.  Moreover, the computation as a whole depends on the two
-- pieces.  It works like this:
--
--   ff <*> aa
--
-- becomes
--
--   (ff >>= putIVar i) <*> (a <- aa; f <- getIVar i; return (f a)
--
-- where the IVar i is a new synchronisation point.  If the right side
-- gets to the `getIVar` first, it will block until the left side has
-- called 'putIVar'.
--
-- We can also do it the other way around:
--
--   (do ff <- f; getIVar i; return (ff a)) <*> (a >>= putIVar i)

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))


-- A note on (>>):
--
-- Unlike Haxl, we can't use the the Applicative version here, because
-- it prevents us from sleeping between two actions. We can use (*>) ourselves
-- to opt into the Applicative version when we want to.

-- TODO If the first computation throws a value that implements 'SomeWorkflowException',
-- try the second one.
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


-- -----------------------------------------------------------------------------
-- Exceptions

-- | Throw an exception in the Workflow monad
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 an exception in the Workflow monad
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


-- | Catch exceptions that satisfy a predicate
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


{- | Returns @'Left' e@ if the computation throws an exception @e@, or
@'Right' a@ if it returns a result @a@.
-}
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"


-- -----------------------------------------------------------------------------
-- Cont

{- | A data representation of a Workflow continuation.  This is to avoid
repeatedly traversing a left-biased tree in a continuation, leading
O(n^2) complexity for some pathalogical cases.

See "A Smart View on Datatypes", Jaskelioff/Rivas, ICFP'15
-}
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


-- -----------------------------------------------------------------------------
-- Result

{- | The result of a computation is either 'Done' with a value, 'Throw'
with an exception, or 'Blocked' on the result of a data fetch with
a continuation.
-}
data Result a
  = Done a
  | Throw SomeException
  | -- | The 'IVar' is what we are blocked on; 'Cont' is the
    -- continuation.  This might be wrapped further if we're
    -- nested inside multiple '>>=', before finally being added
    -- to the 'IVar'.
    forall b.
    Blocked
      {-# UNPACK #-} !(IVar b)
      (Cont a)


{- | A list of computations together with the IVar into which they
should put their result.

This could be an ordinary list, but the optimised representation
saves space and time.
-}
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


-- | A synchronisation point. It either contains a value, or a list of computations waiting for the value.
newtype IVar a = IVar {forall a. IVar a -> IORef (IVarContents a)
ivarRef :: IORef (IVarContents a)}


{- | The contents of a full IVar.  We have to distinguish exceptions
thrown by the machinery of the library from those thrown in the
Workflow, so -- that when the result is fetched using getIVar,
we can handle the exception in the right way.
-}
data ResultVal a
  = Ok a
  | -- Unrecoverable error in the temporal library that should crash the worker
    ThrowInternal SomeException
  | -- Error in the workflow that should be returned to the caller
    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)


-- Just a specialised version of getIVar, for efficiency in <*>
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)
    -- An IVar is typically only meant to be written to once
    -- so it would make sense to throw an error here. But there
    -- are legitimate use-cases for writing several times.
    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)


{- | A very restricted Monad that allows for reading 'StateVar' values. This Monad
keeps track of which 'StateVar' values are read so that it can block and retry
the computation if any of the values change.
-}
newtype Condition a = Condition
  { forall a. Condition a -> ReaderT (IORef (Set Sequence)) InstanceM a
unCondition :: ReaderT (IORef (Set Sequence)) InstanceM a
  -- ^ We track the sequence number of each accessed StateVar so that we can
  -- block and retry the condition evaluation if the state changes.
  }
  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)


{- | 'StateVar' values are mutable variables scoped to a Workflow run.

'Workflow's are deterministic, so you may not use normal IORefs, since the IORef
could have been created outside of the workflow and cause nondeterminism.

However, it is totally safe to mutate state variables as long as they are scoped
to a workflow and derive their state transitions from the workflow's deterministic
execution.

StateVar values may also be read from within a query and mutated within signal handlers.
-}
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


{- | The Query monad is a very constrained version of the Workflow monad. It can
only read state variables and return values. It is used to define query handlers.
-}
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


-- Bit of a hack. This needs to be called for each workflow activity in the official SDK
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
  , -- These are how the instance gets its work done
    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
  , -- Improves error reporting
    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
  }


-- Newtyped because the list is reversed
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))
  }


-- | An async action handle that can be awaited or cancelled.
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)


{- | Sometimes you want to alter the result of a task, but you 'Task' doesn't work as
a monad due to the 'cancel' action. This function lets you alter the result of a task
in the workflow monad.
-}
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'


{- | Handle representing an external Workflow Execution.

This handle can only be cancelled and signalled.

To call other methods, like query and result, use a WorkflowClient.getHandle inside an Activity.
-}
data ExternalWorkflowHandle (result :: Type) = ExternalWorkflowHandle
  { forall result. ExternalWorkflowHandle result -> WorkflowId
externalWorkflowWorkflowId :: WorkflowId
  , forall result. ExternalWorkflowHandle result -> Maybe RunId
externalWorkflowRunId :: Maybe RunId
  }


{- | A client side handle to a single child Workflow instance.

It can be used to signal, wait for completion, and cancel the workflow.
-}
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}


{- | This is only intended for use by interceptors. Normal workflow code should be able to use
the 'fmap' instance for simple transformations or else provide an appropriate codec.
-}
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
  , ExecuteWorkflowInput -> Map LogSource Payload
executeWorkflowInputHeaders :: 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')