{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Temporal.Workflow.Definition (
WorkflowDef (..),
WorkflowRef (..),
WorkflowDefinition (..),
KnownWorkflow (..),
SignalRef (..),
WorkflowSignalDefinition (..),
provideWorkflow,
ProvidedWorkflow (..),
GatherArgs,
) where
import Control.Monad.IO.Class
import Data.Kind
import Data.Text (Text)
import Data.Typeable
import Data.Vector (Vector)
import RequireCallStack
import Temporal.Client.Types
import Temporal.Payload
import Temporal.Workflow.Internal.Monad
import Temporal.Workflow.Signal
import Temporal.Workflow.Types (StartChildWorkflowOptions)
data WorkflowDefinition = WorkflowDefinition
{ WorkflowDefinition -> Text
workflowName :: Text
, WorkflowDefinition
-> Vector Payload -> IO (Either String (Workflow Payload))
workflowRun :: Vector Payload -> IO (Either String (Workflow Payload))
}
class WorkflowDef a where
workflowDefinition :: a -> WorkflowDefinition
instance WorkflowDef WorkflowDefinition where
workflowDefinition :: WorkflowDefinition -> WorkflowDefinition
workflowDefinition = WorkflowDefinition -> WorkflowDefinition
forall a. a -> a
id
class WorkflowRef (f :: Type) where
type WorkflowArgs f :: [Type]
type WorkflowResult f :: Type
workflowRef :: f -> KnownWorkflow (WorkflowArgs f) (WorkflowResult f)
instance WorkflowRef (KnownWorkflow args result) where
type WorkflowArgs (KnownWorkflow args result) = args
type WorkflowResult (KnownWorkflow args result) = result
workflowRef :: KnownWorkflow args result
-> KnownWorkflow
(WorkflowArgs (KnownWorkflow args result))
(WorkflowResult (KnownWorkflow args result))
workflowRef = KnownWorkflow args result -> KnownWorkflow args result
KnownWorkflow args result
-> KnownWorkflow
(WorkflowArgs (KnownWorkflow args result))
(WorkflowResult (KnownWorkflow args result))
forall a. a -> a
id
data KnownWorkflow (args :: [Type]) (result :: Type) = forall codec.
( FunctionSupportsCodec codec args result
) =>
KnownWorkflow
{ ()
knownWorkflowCodec :: codec
, forall (args :: [*]) result. KnownWorkflow args result -> Text
knownWorkflowName :: Text
}
data ProvidedWorkflow f = ProvidedWorkflow
{ forall f. ProvidedWorkflow f -> WorkflowDefinition
definition :: WorkflowDefinition
, forall f.
ProvidedWorkflow f
-> KnownWorkflow (ArgsOf f) (ResultOf Workflow f)
reference :: KnownWorkflow (ArgsOf f) (ResultOf Workflow f)
}
instance WorkflowDef (ProvidedWorkflow f) where
workflowDefinition :: ProvidedWorkflow f -> WorkflowDefinition
workflowDefinition :: ProvidedWorkflow f -> WorkflowDefinition
workflowDefinition = ProvidedWorkflow f -> WorkflowDefinition
forall f. ProvidedWorkflow f -> WorkflowDefinition
definition
instance VarArgs (ArgsOf f) => WorkflowRef (ProvidedWorkflow f) where
type WorkflowArgs (ProvidedWorkflow f) = ArgsOf f
type WorkflowResult (ProvidedWorkflow f) = ResultOf Workflow f
workflowRef :: ProvidedWorkflow f -> KnownWorkflow (WorkflowArgs (ProvidedWorkflow f)) (WorkflowResult (ProvidedWorkflow f))
workflowRef :: ProvidedWorkflow f
-> KnownWorkflow
(WorkflowArgs (ProvidedWorkflow f))
(WorkflowResult (ProvidedWorkflow f))
workflowRef = ProvidedWorkflow f
-> KnownWorkflow (ArgsOf f) (ResultOf Workflow f)
ProvidedWorkflow f
-> KnownWorkflow
(WorkflowArgs (ProvidedWorkflow f))
(WorkflowResult (ProvidedWorkflow f))
forall f.
ProvidedWorkflow f
-> KnownWorkflow (ArgsOf f) (ResultOf Workflow f)
reference
provideWorkflow
:: forall codec f
. ( f ~ (ArgsOf f :->: Workflow (ResultOf Workflow f))
, FunctionSupportsCodec codec (ArgsOf f) (ResultOf Workflow f)
)
=> codec
-> Text
-> (RequireCallStackImpl => f)
-> ProvidedWorkflow f
provideWorkflow :: forall codec f.
(f ~ (ArgsOf f :->: Workflow (ResultOf Workflow f)),
FunctionSupportsCodec codec (ArgsOf f) (ResultOf Workflow f)) =>
codec -> Text -> (RequireCallStackImpl => f) -> ProvidedWorkflow f
provideWorkflow codec
codec Text
name RequireCallStackImpl => f
f =
(RequireCallStackImpl => ProvidedWorkflow f) -> ProvidedWorkflow f
forall r. (RequireCallStackImpl => r) -> r
provideCallStack ((RequireCallStackImpl => ProvidedWorkflow f)
-> ProvidedWorkflow f)
-> (RequireCallStackImpl => ProvidedWorkflow f)
-> ProvidedWorkflow f
forall a b. (a -> b) -> a -> b
$
ProvidedWorkflow
{ definition :: WorkflowDefinition
definition =
WorkflowDefinition
{ workflowName :: Text
workflowName = Text
name
, workflowRun :: Vector Payload -> IO (Either String (Workflow Payload))
workflowRun = \Vector Payload
payloads -> do
eWf <-
codec
-> Proxy (ArgsOf f)
-> Proxy (Workflow (ResultOf Workflow f))
-> (ArgsOf f :->: Workflow (ResultOf Workflow f))
-> Vector Payload
-> IO (Either String (Workflow (ResultOf Workflow f)))
forall result.
codec
-> Proxy (ArgsOf f)
-> Proxy result
-> (ArgsOf f :->: result)
-> Vector Payload
-> IO (Either String result)
forall codec (args :: [*]) result.
ApplyPayloads codec args =>
codec
-> Proxy args
-> Proxy result
-> (args :->: result)
-> Vector Payload
-> IO (Either String result)
applyPayloads
codec
codec
(forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ArgsOf f))
(forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Workflow (ResultOf Workflow f)))
f
ArgsOf f :->: Workflow (ResultOf Workflow f)
RequireCallStackImpl => f
f
Vector Payload
payloads
pure $ fmap (\Workflow (ResultOf Workflow f)
wf -> Workflow (ResultOf Workflow f)
wf Workflow (ResultOf Workflow f)
-> (ResultOf Workflow f -> Workflow Payload) -> Workflow Payload
forall a b. Workflow a -> (a -> Workflow b) -> Workflow b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ResultOf Workflow f
result -> InstanceM Payload -> Workflow Payload
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (IO Payload -> InstanceM Payload
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Payload -> InstanceM Payload)
-> IO Payload -> InstanceM Payload
forall a b. (a -> b) -> a -> b
$ codec -> ResultOf Workflow f -> IO Payload
forall fmt a. Codec fmt a => fmt -> a -> IO Payload
encode codec
codec ResultOf Workflow f
result)) eWf
}
, reference :: KnownWorkflow (ArgsOf f) (ResultOf Workflow f)
reference =
KnownWorkflow
{ knownWorkflowCodec :: codec
knownWorkflowCodec = codec
codec
, knownWorkflowName :: Text
knownWorkflowName = Text
name
}
}
data WorkflowSignalDefinition
= forall codec f.
(FunctionSupportsCodec codec (ArgsOf f) (ResultOf Workflow f), ResultOf Workflow f ~ ()) =>
WorkflowSignalDefinition
Text
codec
f
(f -> Vector Payload -> IO (Either String (Workflow ())))