{-# LANGUAGE DeriveLift #-}

module Temporal.Client.Types where

import Data.Map.Strict (Map)
import Data.Text (Text)
import Data.Vector (Vector)
import Language.Haskell.TH.Syntax (Lift)
import Temporal.Common
import Temporal.Core.Client (Client)
import Temporal.Duration
import Temporal.Payload
import Temporal.SearchAttributes


-- | Configuration parameters for starting a workflow execution.
data StartWorkflowOptions = StartWorkflowOptions
  { StartWorkflowOptions -> TaskQueue
taskQueue :: TaskQueue
  -- ^ A Task Queue is a lightweight, dynamically allocated queue that one or more Worker Entities poll for Tasks.
  --
  -- Task Queues are very lightweight components. Task Queues do not require explicit registration but instead are created on demand when
  -- a Workflow Execution spawns or when a Worker Process subscribes to it. When a Task Queue is created, both a Workflow Task Queue and
  -- an Activity Task Queue are created under the same name. There is no limit to the number of Task Queues a Temporal Application
  -- can use or a Temporal Cluster can maintain.
  , StartWorkflowOptions -> Bool
followRuns :: Bool
  , StartWorkflowOptions -> Maybe WorkflowIdReusePolicy
workflowIdReusePolicy :: Maybe WorkflowIdReusePolicy
  -- ^ A Workflow Id Reuse Policy determines whether a Workflow Execution is allowed to spawn with a particular Workflow Id, if that Workflow Id has been used with a previous, and now Closed, Workflow Execution.
  --
  -- It is not possible for a new Workflow Execution to spawn with the same Workflow Id as another Open Workflow Execution, regardless of the Workflow Id Reuse Policy. In some cases, an attempt to spawn a Workflow
  -- Execution with a Workflow Id that is the same as the Id of a currently Open Workflow Execution results in a @Workflow execution already started@ error.
  , StartWorkflowOptions -> Maybe RetryPolicy
retryPolicy :: Maybe RetryPolicy
  -- ^ A Retry Policy can work in cooperation with the timeouts to provide fine controls to optimize the execution experience.
  --
  -- Use a Retry Policy to retry a Workflow Execution in the event of a failure.
  --
  -- Workflow Executions do not retry by default, and Retry Policies should be used with Workflow Executions only in
  -- certain situations.
  --
  -- This should not be confused with Activity retry policies, which are used to retry Activities and specified at those
  -- callsites.
  , StartWorkflowOptions -> Maybe Text
cronSchedule :: Maybe Text
  -- ^ A Temporal Cron Job is the series of Workflow Executions that occur when a Cron Schedule is
  -- provided in the call to spawn a Workflow Execution.
  --
  -- A Cron Schedule is provided as an option when the call to spawn a Workflow Execution is made.
  --
  -- You can set each Workflow to repeat on a schedule with the cronSchedule option:
  --
  -- >
  -- > Temporal.Client.start scheduledWorkflow
  -- >   (Temporal.Client.startWorkflowOptions "my-workflow" "my-task-queue") { cronSchedule = Just "* * * * *" } -- start every minute
  -- >
  --
  -- Note that Temporal offers more advanced scheduling support via 'Temporal.Client.Schedule', so
  -- it is generally recommended to use that instead of Cron Schedules.
  , StartWorkflowOptions -> Map Text Payload
memo :: !(Map Text Payload)
  -- ^ A Memo is a non-indexed set of Workflow Execution metadata that developers supply at start time or
  -- in Workflow code and that is returned when you describe or list Workflow Executions.
  --
  -- The primary purpose of using a Memo is to enhance the organization and management of Workflow Executions.
  -- Add your own metadata, such as notes or descriptions, to a Workflow Execution, which lets you annotate and
  -- categorize Workflow Executions based on developer-defined criteria. This feature is particularly useful
  -- when dealing with numerous Workflow Executions because it facilitates the addition of context, reminders,
  -- or any other relevant information that aids in understanding or tracking the Workflow Execution.
  , StartWorkflowOptions -> Map SearchAttributeKey SearchAttributeType
searchAttributes :: !(Map SearchAttributeKey SearchAttributeType)
  -- ^ Search attributes are indexed by the Temporal server and can be used in queries on the dashboard
  -- or by the Temporal CLI to find Workflows. These values are not encrypted and can be seen by anyone
  -- with access to the Temporal namespace.
  , StartWorkflowOptions -> Map Text Payload
headers :: !(Map Text Payload)
  -- ^ Custom headers to be added to the Workflow Execution. These are generally more useful for interceptors
  -- to add metadata to the Workflow rather than for application code.
  , StartWorkflowOptions -> TimeoutOptions
timeouts :: TimeoutOptions
  -- ^ Each Workflow timeout controls the maximum duration of a different aspect of a Workflow Execution.
  , StartWorkflowOptions -> Bool
requestEagerExecution :: Bool
  -- ^ Eager activity execution is an optimization on some servers that sends activities
  -- back to the same worker as the calling workflow if they can run there.
  , StartWorkflowOptions -> Maybe Duration
workflowStartDelay :: Maybe Duration
  }
  deriving stock (Int -> StartWorkflowOptions -> ShowS
[StartWorkflowOptions] -> ShowS
StartWorkflowOptions -> String
(Int -> StartWorkflowOptions -> ShowS)
-> (StartWorkflowOptions -> String)
-> ([StartWorkflowOptions] -> ShowS)
-> Show StartWorkflowOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StartWorkflowOptions -> ShowS
showsPrec :: Int -> StartWorkflowOptions -> ShowS
$cshow :: StartWorkflowOptions -> String
show :: StartWorkflowOptions -> String
$cshowList :: [StartWorkflowOptions] -> ShowS
showList :: [StartWorkflowOptions] -> ShowS
Show, StartWorkflowOptions -> StartWorkflowOptions -> Bool
(StartWorkflowOptions -> StartWorkflowOptions -> Bool)
-> (StartWorkflowOptions -> StartWorkflowOptions -> Bool)
-> Eq StartWorkflowOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StartWorkflowOptions -> StartWorkflowOptions -> Bool
== :: StartWorkflowOptions -> StartWorkflowOptions -> Bool
$c/= :: StartWorkflowOptions -> StartWorkflowOptions -> Bool
/= :: StartWorkflowOptions -> StartWorkflowOptions -> Bool
Eq, (forall (m :: * -> *). Quote m => StartWorkflowOptions -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    StartWorkflowOptions -> Code m StartWorkflowOptions)
-> Lift StartWorkflowOptions
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => StartWorkflowOptions -> m Exp
forall (m :: * -> *).
Quote m =>
StartWorkflowOptions -> Code m StartWorkflowOptions
$clift :: forall (m :: * -> *). Quote m => StartWorkflowOptions -> m Exp
lift :: forall (m :: * -> *). Quote m => StartWorkflowOptions -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
StartWorkflowOptions -> Code m StartWorkflowOptions
liftTyped :: forall (m :: * -> *).
Quote m =>
StartWorkflowOptions -> Code m StartWorkflowOptions
Lift)


{- | Smart constructor for 'StartWorkflowOptions'.

At a minimum, a 'Workflow' execution requires a 'WorkflowId' and a 'TaskQueue'.

It is recommend to specify 'WorkflowId' in most cases, as it is used to uniquely identify a 'Workflow' execution,
but if one is not specified then a random UUID will be generated.
-}
startWorkflowOptions :: TaskQueue -> StartWorkflowOptions
startWorkflowOptions :: TaskQueue -> StartWorkflowOptions
startWorkflowOptions TaskQueue
tq =
  StartWorkflowOptions
    { taskQueue :: TaskQueue
taskQueue = TaskQueue
tq
    , followRuns :: Bool
followRuns = Bool
True
    , workflowIdReusePolicy :: Maybe WorkflowIdReusePolicy
workflowIdReusePolicy = Maybe WorkflowIdReusePolicy
forall a. Maybe a
Nothing
    , retryPolicy :: Maybe RetryPolicy
retryPolicy = Maybe RetryPolicy
forall a. Maybe a
Nothing
    , cronSchedule :: Maybe Text
cronSchedule = Maybe Text
forall a. Maybe a
Nothing
    , memo :: Map Text Payload
memo = Map Text Payload
forall a. Monoid a => a
mempty
    , searchAttributes :: Map SearchAttributeKey SearchAttributeType
searchAttributes = Map SearchAttributeKey SearchAttributeType
forall a. Monoid a => a
mempty
    , headers :: Map Text Payload
headers = Map Text Payload
forall a. Monoid a => a
mempty
    , timeouts :: TimeoutOptions
timeouts =
        TimeoutOptions
          { executionTimeout :: Maybe Duration
executionTimeout = Maybe Duration
forall a. Maybe a
Nothing
          , runTimeout :: Maybe Duration
runTimeout = Maybe Duration
forall a. Maybe a
Nothing
          , taskTimeout :: Maybe Duration
taskTimeout = Maybe Duration
forall a. Maybe a
Nothing
          }
    , requestEagerExecution :: Bool
requestEagerExecution = Bool
False
    , workflowStartDelay :: Maybe Duration
workflowStartDelay = Maybe Duration
forall a. Maybe a
Nothing
    }


data WorkflowClientConfig = WorkflowClientConfig
  { WorkflowClientConfig -> Namespace
namespace :: !Namespace
  -- ^ Default namespace for all workflows started by this client.
  , WorkflowClientConfig -> ClientInterceptors
interceptors :: !ClientInterceptors
  -- ^ Interceptors to be used by the client.
  , WorkflowClientConfig -> PayloadProcessor
payloadProcessor :: !PayloadProcessor
  -- ^ The payload processor to be used by the client.
  --
  -- This can be used to apply encryption and compression to payloads.
  }


-- TODO
-- , clientHeaders :: Map Text Payload

mkWorkflowClientConfig :: Namespace -> WorkflowClientConfig
mkWorkflowClientConfig :: Namespace -> WorkflowClientConfig
mkWorkflowClientConfig Namespace
ns =
  WorkflowClientConfig
    { namespace :: Namespace
namespace = Namespace
ns
    , interceptors :: ClientInterceptors
interceptors = ClientInterceptors
forall a. Monoid a => a
mempty
    , payloadProcessor :: PayloadProcessor
payloadProcessor = (Payload -> IO Payload)
-> (Payload -> IO (Either String Payload)) -> PayloadProcessor
PayloadProcessor Payload -> IO Payload
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Payload -> IO (Either String Payload)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Payload -> IO (Either String Payload))
-> (Payload -> Either String Payload)
-> Payload
-> IO (Either String Payload)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Payload -> Either String Payload
forall a b. b -> Either a b
Right)
    }


data WorkflowClient = WorkflowClient
  { WorkflowClient -> Client
clientCore :: {-# UNPACK #-} !Client
  , WorkflowClient -> WorkflowClientConfig
clientConfig :: {-# UNPACK #-} !WorkflowClientConfig
  }


data WorkflowHandle a = WorkflowHandle
  { forall a. WorkflowHandle a -> Payload -> IO a
workflowHandleReadResult :: Payload -> IO a
  , forall a. WorkflowHandle a -> WorkflowType
workflowHandleType :: WorkflowType
  , forall a. WorkflowHandle a -> WorkflowClient
workflowHandleClient :: WorkflowClient
  , forall a. WorkflowHandle a -> WorkflowId
workflowHandleWorkflowId :: WorkflowId
  , forall a. WorkflowHandle a -> Maybe RunId
workflowHandleRunId :: Maybe RunId
  }


instance Functor WorkflowHandle where
  fmap :: forall a b. (a -> b) -> WorkflowHandle a -> WorkflowHandle b
fmap a -> b
f WorkflowHandle a
w = WorkflowHandle a
w {workflowHandleReadResult = fmap f . workflowHandleReadResult w}


-- | QueryRejectCondition can used to reject the query if workflow state does not satisfy condition.
data QueryRejectCondition
  = -- | indicates that query should not be rejected
    QueryRejectConditionRejectNone
  | -- | indicates that query should be rejected if workflow is not open
    QueryRejectConditionNotOpen
  | -- | indicates that query should be rejected if workflow did not complete cleanly
    QueryRejectConditionNotCompletedCleanly


data QueryWorkflowInput = QueryWorkflowInput
  { QueryWorkflowInput -> WorkflowId
queryWorkflowWorkflowId :: WorkflowId
  , QueryWorkflowInput -> QueryRejectCondition
queryWorkflowRejectCondition :: QueryRejectCondition
  , QueryWorkflowInput -> Map Text Payload
queryWorkflowHeaders :: Map Text Payload
  , QueryWorkflowInput -> Text
queryWorkflowType :: Text
  , QueryWorkflowInput -> Maybe RunId
queryWorkflowRunId :: Maybe RunId
  , QueryWorkflowInput -> Vector Payload
queryWorkflowArgs :: Vector Payload
  }


data WorkflowExecutionStatus
  = Running
  | Completed
  | Failed
  | Canceled
  | Terminated
  | ContinuedAsNew
  | TimedOut
  | UnknownStatus
  deriving stock (ReadPrec [WorkflowExecutionStatus]
ReadPrec WorkflowExecutionStatus
Int -> ReadS WorkflowExecutionStatus
ReadS [WorkflowExecutionStatus]
(Int -> ReadS WorkflowExecutionStatus)
-> ReadS [WorkflowExecutionStatus]
-> ReadPrec WorkflowExecutionStatus
-> ReadPrec [WorkflowExecutionStatus]
-> Read WorkflowExecutionStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WorkflowExecutionStatus
readsPrec :: Int -> ReadS WorkflowExecutionStatus
$creadList :: ReadS [WorkflowExecutionStatus]
readList :: ReadS [WorkflowExecutionStatus]
$creadPrec :: ReadPrec WorkflowExecutionStatus
readPrec :: ReadPrec WorkflowExecutionStatus
$creadListPrec :: ReadPrec [WorkflowExecutionStatus]
readListPrec :: ReadPrec [WorkflowExecutionStatus]
Read, Int -> WorkflowExecutionStatus -> ShowS
[WorkflowExecutionStatus] -> ShowS
WorkflowExecutionStatus -> String
(Int -> WorkflowExecutionStatus -> ShowS)
-> (WorkflowExecutionStatus -> String)
-> ([WorkflowExecutionStatus] -> ShowS)
-> Show WorkflowExecutionStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowExecutionStatus -> ShowS
showsPrec :: Int -> WorkflowExecutionStatus -> ShowS
$cshow :: WorkflowExecutionStatus -> String
show :: WorkflowExecutionStatus -> String
$cshowList :: [WorkflowExecutionStatus] -> ShowS
showList :: [WorkflowExecutionStatus] -> ShowS
Show, WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
(WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool)
-> (WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool)
-> Eq WorkflowExecutionStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
== :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
$c/= :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
/= :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
Eq, Eq WorkflowExecutionStatus
Eq WorkflowExecutionStatus =>
(WorkflowExecutionStatus -> WorkflowExecutionStatus -> Ordering)
-> (WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool)
-> (WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool)
-> (WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool)
-> (WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool)
-> (WorkflowExecutionStatus
    -> WorkflowExecutionStatus -> WorkflowExecutionStatus)
-> (WorkflowExecutionStatus
    -> WorkflowExecutionStatus -> WorkflowExecutionStatus)
-> Ord WorkflowExecutionStatus
WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
WorkflowExecutionStatus -> WorkflowExecutionStatus -> Ordering
WorkflowExecutionStatus
-> WorkflowExecutionStatus -> WorkflowExecutionStatus
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Ordering
compare :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Ordering
$c< :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
< :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
$c<= :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
<= :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
$c> :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
> :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
$c>= :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
>= :: WorkflowExecutionStatus -> WorkflowExecutionStatus -> Bool
$cmax :: WorkflowExecutionStatus
-> WorkflowExecutionStatus -> WorkflowExecutionStatus
max :: WorkflowExecutionStatus
-> WorkflowExecutionStatus -> WorkflowExecutionStatus
$cmin :: WorkflowExecutionStatus
-> WorkflowExecutionStatus -> WorkflowExecutionStatus
min :: WorkflowExecutionStatus
-> WorkflowExecutionStatus -> WorkflowExecutionStatus
Ord)


data QueryRejected = QueryRejected
  { QueryRejected -> WorkflowExecutionStatus
status :: WorkflowExecutionStatus
  }
  deriving stock (ReadPrec [QueryRejected]
ReadPrec QueryRejected
Int -> ReadS QueryRejected
ReadS [QueryRejected]
(Int -> ReadS QueryRejected)
-> ReadS [QueryRejected]
-> ReadPrec QueryRejected
-> ReadPrec [QueryRejected]
-> Read QueryRejected
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS QueryRejected
readsPrec :: Int -> ReadS QueryRejected
$creadList :: ReadS [QueryRejected]
readList :: ReadS [QueryRejected]
$creadPrec :: ReadPrec QueryRejected
readPrec :: ReadPrec QueryRejected
$creadListPrec :: ReadPrec [QueryRejected]
readListPrec :: ReadPrec [QueryRejected]
Read, Int -> QueryRejected -> ShowS
[QueryRejected] -> ShowS
QueryRejected -> String
(Int -> QueryRejected -> ShowS)
-> (QueryRejected -> String)
-> ([QueryRejected] -> ShowS)
-> Show QueryRejected
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryRejected -> ShowS
showsPrec :: Int -> QueryRejected -> ShowS
$cshow :: QueryRejected -> String
show :: QueryRejected -> String
$cshowList :: [QueryRejected] -> ShowS
showList :: [QueryRejected] -> ShowS
Show, QueryRejected -> QueryRejected -> Bool
(QueryRejected -> QueryRejected -> Bool)
-> (QueryRejected -> QueryRejected -> Bool) -> Eq QueryRejected
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryRejected -> QueryRejected -> Bool
== :: QueryRejected -> QueryRejected -> Bool
$c/= :: QueryRejected -> QueryRejected -> Bool
/= :: QueryRejected -> QueryRejected -> Bool
Eq, Eq QueryRejected
Eq QueryRejected =>
(QueryRejected -> QueryRejected -> Ordering)
-> (QueryRejected -> QueryRejected -> Bool)
-> (QueryRejected -> QueryRejected -> Bool)
-> (QueryRejected -> QueryRejected -> Bool)
-> (QueryRejected -> QueryRejected -> Bool)
-> (QueryRejected -> QueryRejected -> QueryRejected)
-> (QueryRejected -> QueryRejected -> QueryRejected)
-> Ord QueryRejected
QueryRejected -> QueryRejected -> Bool
QueryRejected -> QueryRejected -> Ordering
QueryRejected -> QueryRejected -> QueryRejected
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: QueryRejected -> QueryRejected -> Ordering
compare :: QueryRejected -> QueryRejected -> Ordering
$c< :: QueryRejected -> QueryRejected -> Bool
< :: QueryRejected -> QueryRejected -> Bool
$c<= :: QueryRejected -> QueryRejected -> Bool
<= :: QueryRejected -> QueryRejected -> Bool
$c> :: QueryRejected -> QueryRejected -> Bool
> :: QueryRejected -> QueryRejected -> Bool
$c>= :: QueryRejected -> QueryRejected -> Bool
>= :: QueryRejected -> QueryRejected -> Bool
$cmax :: QueryRejected -> QueryRejected -> QueryRejected
max :: QueryRejected -> QueryRejected -> QueryRejected
$cmin :: QueryRejected -> QueryRejected -> QueryRejected
min :: QueryRejected -> QueryRejected -> QueryRejected
Ord)


data SignalWithStartWorkflowInput = SignalWithStartWorkflowInput
  { SignalWithStartWorkflowInput -> WorkflowType
signalWithStartWorkflowType :: WorkflowType
  , SignalWithStartWorkflowInput -> WorkflowId
signalWithStartWorkflowId :: WorkflowId
  , SignalWithStartWorkflowInput -> Vector Payload
signalWithStartArgs :: Vector Payload
  , SignalWithStartWorkflowInput -> Text
signalWithStartSignalName :: Text
  , SignalWithStartWorkflowInput -> Vector Payload
signalWithStartSignalArgs :: Vector Payload
  , SignalWithStartWorkflowInput -> StartWorkflowOptions
signalWithStartOptions :: StartWorkflowOptions
  }


data ClientInterceptors = ClientInterceptors
  { ClientInterceptors
-> WorkflowType
-> WorkflowId
-> StartWorkflowOptions
-> Vector Payload
-> (WorkflowType
    -> WorkflowId
    -> StartWorkflowOptions
    -> Vector Payload
    -> IO (WorkflowHandle Payload))
-> IO (WorkflowHandle Payload)
start :: WorkflowType -> WorkflowId -> StartWorkflowOptions -> Vector Payload -> (WorkflowType -> WorkflowId -> StartWorkflowOptions -> Vector Payload -> IO (WorkflowHandle Payload)) -> IO (WorkflowHandle Payload)
  , ClientInterceptors
-> QueryWorkflowInput
-> (QueryWorkflowInput -> IO (Either QueryRejected Payload))
-> IO (Either QueryRejected Payload)
queryWorkflow :: QueryWorkflowInput -> (QueryWorkflowInput -> IO (Either QueryRejected Payload)) -> IO (Either QueryRejected Payload)
  , ClientInterceptors
-> SignalWithStartWorkflowInput
-> (SignalWithStartWorkflowInput -> IO (WorkflowHandle Payload))
-> IO (WorkflowHandle Payload)
signalWithStart :: SignalWithStartWorkflowInput -> (SignalWithStartWorkflowInput -> IO (WorkflowHandle Payload)) -> IO (WorkflowHandle Payload)
  -- TODO
  -- signal
  -- terminate
  -- cancel
  -- describe
  }


instance Semigroup ClientInterceptors where
  ClientInterceptors
a <> :: ClientInterceptors -> ClientInterceptors -> ClientInterceptors
<> ClientInterceptors
b =
    ClientInterceptors
      { start :: WorkflowType
-> WorkflowId
-> StartWorkflowOptions
-> Vector Payload
-> (WorkflowType
    -> WorkflowId
    -> StartWorkflowOptions
    -> Vector Payload
    -> IO (WorkflowHandle Payload))
-> IO (WorkflowHandle Payload)
start = \WorkflowType
t WorkflowId
wfId StartWorkflowOptions
o Vector Payload
ps WorkflowType
-> WorkflowId
-> StartWorkflowOptions
-> Vector Payload
-> IO (WorkflowHandle Payload)
next -> ClientInterceptors
a.start WorkflowType
t WorkflowId
wfId StartWorkflowOptions
o Vector Payload
ps ((WorkflowType
  -> WorkflowId
  -> StartWorkflowOptions
  -> Vector Payload
  -> IO (WorkflowHandle Payload))
 -> IO (WorkflowHandle Payload))
-> (WorkflowType
    -> WorkflowId
    -> StartWorkflowOptions
    -> Vector Payload
    -> IO (WorkflowHandle Payload))
-> IO (WorkflowHandle Payload)
forall a b. (a -> b) -> a -> b
$ \WorkflowType
t' WorkflowId
wfId' StartWorkflowOptions
o' Vector Payload
ps' -> ClientInterceptors
b.start WorkflowType
t' WorkflowId
wfId' StartWorkflowOptions
o' Vector Payload
ps' WorkflowType
-> WorkflowId
-> StartWorkflowOptions
-> Vector Payload
-> IO (WorkflowHandle Payload)
next
      , queryWorkflow :: QueryWorkflowInput
-> (QueryWorkflowInput -> IO (Either QueryRejected Payload))
-> IO (Either QueryRejected Payload)
queryWorkflow = \QueryWorkflowInput
i QueryWorkflowInput -> IO (Either QueryRejected Payload)
next -> ClientInterceptors
a.queryWorkflow QueryWorkflowInput
i ((QueryWorkflowInput -> IO (Either QueryRejected Payload))
 -> IO (Either QueryRejected Payload))
-> (QueryWorkflowInput -> IO (Either QueryRejected Payload))
-> IO (Either QueryRejected Payload)
forall a b. (a -> b) -> a -> b
$ \QueryWorkflowInput
i' -> ClientInterceptors
b.queryWorkflow QueryWorkflowInput
i' QueryWorkflowInput -> IO (Either QueryRejected Payload)
next
      , signalWithStart :: SignalWithStartWorkflowInput
-> (SignalWithStartWorkflowInput -> IO (WorkflowHandle Payload))
-> IO (WorkflowHandle Payload)
signalWithStart = \SignalWithStartWorkflowInput
i SignalWithStartWorkflowInput -> IO (WorkflowHandle Payload)
next -> ClientInterceptors
a.signalWithStart SignalWithStartWorkflowInput
i ((SignalWithStartWorkflowInput -> IO (WorkflowHandle Payload))
 -> IO (WorkflowHandle Payload))
-> (SignalWithStartWorkflowInput -> IO (WorkflowHandle Payload))
-> IO (WorkflowHandle Payload)
forall a b. (a -> b) -> a -> b
$ \SignalWithStartWorkflowInput
i' -> ClientInterceptors
b.signalWithStart SignalWithStartWorkflowInput
i' SignalWithStartWorkflowInput -> IO (WorkflowHandle Payload)
next
      }


instance Monoid ClientInterceptors where
  mempty :: ClientInterceptors
mempty =
    (WorkflowType
 -> WorkflowId
 -> StartWorkflowOptions
 -> Vector Payload
 -> (WorkflowType
     -> WorkflowId
     -> StartWorkflowOptions
     -> Vector Payload
     -> IO (WorkflowHandle Payload))
 -> IO (WorkflowHandle Payload))
-> (QueryWorkflowInput
    -> (QueryWorkflowInput -> IO (Either QueryRejected Payload))
    -> IO (Either QueryRejected Payload))
-> (SignalWithStartWorkflowInput
    -> (SignalWithStartWorkflowInput -> IO (WorkflowHandle Payload))
    -> IO (WorkflowHandle Payload))
-> ClientInterceptors
ClientInterceptors
      (\WorkflowType
t WorkflowId
wf StartWorkflowOptions
o Vector Payload
ps WorkflowType
-> WorkflowId
-> StartWorkflowOptions
-> Vector Payload
-> IO (WorkflowHandle Payload)
next -> WorkflowType
-> WorkflowId
-> StartWorkflowOptions
-> Vector Payload
-> IO (WorkflowHandle Payload)
next WorkflowType
t WorkflowId
wf StartWorkflowOptions
o Vector Payload
ps)
      (\QueryWorkflowInput
i QueryWorkflowInput -> IO (Either QueryRejected Payload)
next -> QueryWorkflowInput -> IO (Either QueryRejected Payload)
next QueryWorkflowInput
i)
      (\SignalWithStartWorkflowInput
i SignalWithStartWorkflowInput -> IO (WorkflowHandle Payload)
next -> SignalWithStartWorkflowInput -> IO (WorkflowHandle Payload)
next SignalWithStartWorkflowInput
i)

-- , signal :: SignalWorkflowInput -> (SignalWorkflowInput -> IO ()) -> IO ()
--   -- , signalWithStart :: SignalWithStartWorkflowInput -> (SignalWithStartWorkflowInput -> IO ()) -> IO ()
--   -- , query :: QueryWorkflowInput -> (QueryWorkflowInput -> IO ()) -> IO ()
--   -- , terminate :: TerminateWorkflowInput -> (TerminateWorkflowInput -> IO ()) -> IO ()
--   -- , cancel :: CancelWorkflowInput -> (CancelWorkflowInput -> IO ()) -> IO ()
--   -- , describe :: DescribeWorkflowInput -> (DescribeWorkflowInput -> IO ()) -> IO ()
--   }