{-# LANGUAGE AllowAmbiguousTypes #-}
module Temporal.Activity.Definition where
import Control.Applicative
import Control.Monad
import Control.Monad.Catch
import Control.Monad.Error.Class
import Control.Monad.Fix
import Control.Monad.Reader
import Data.Kind
import Data.Text (Text)
import GHC.TypeLits
import Temporal.Activity.Types
import Temporal.Client.Types
import Temporal.Core.Client (Client)
import Temporal.Core.Worker (Worker, WorkerType (Real), getWorkerClient)
import Temporal.Payload
import Temporal.Workflow.Types
import UnliftIO
class ActivityDef a where
type ActivityDefinitionEnv a :: Type
activityDefinition :: a -> ActivityDefinition (ActivityDefinitionEnv a)
instance ActivityDef (ActivityDefinition env) where
type ActivityDefinitionEnv (ActivityDefinition env) = env
activityDefinition :: ActivityDefinition env
-> ActivityDefinition
(ActivityDefinitionEnv (ActivityDefinition env))
activityDefinition = ActivityDefinition env -> ActivityDefinition env
ActivityDefinition env
-> ActivityDefinition
(ActivityDefinitionEnv (ActivityDefinition env))
forall a. a -> a
id
data ProvidedActivity env f = ProvidedActivity
{ forall env f. ProvidedActivity env f -> ActivityDefinition env
definition :: ActivityDefinition env
, forall env f.
ProvidedActivity env f
-> KnownActivity (ArgsOf f) (ResultOf (Activity env) f)
reference :: KnownActivity (ArgsOf f) (ResultOf (Activity env) f)
}
instance ActivityDef (ProvidedActivity env f) where
type ActivityDefinitionEnv (ProvidedActivity env f) = env
activityDefinition :: ProvidedActivity env f
-> ActivityDefinition
(ActivityDefinitionEnv (ProvidedActivity env f))
activityDefinition (ProvidedActivity ActivityDefinition env
def KnownActivity (ArgsOf f) (ResultOf (Activity env) f)
_) = ActivityDefinition env
ActivityDefinition (ActivityDefinitionEnv (ProvidedActivity env f))
def
data KnownActivity (args :: [Type]) (result :: Type) = forall codec.
( FunctionSupportsCodec codec args result
) =>
KnownActivity
{ ()
knownActivityCodec :: codec
, forall (args :: [*]) result. KnownActivity args result -> Text
knownActivityName :: Text
}
data ActivityDefinition env = ActivityDefinition
{ forall env. ActivityDefinition env -> Text
activityName :: Text
, forall env.
ActivityDefinition env
-> ActivityEnv env
-> ExecuteActivityInput
-> IO (Either String Payload)
activityRun :: ActivityEnv env -> ExecuteActivityInput -> IO (Either String Payload)
}
data ActivityEnv env = ActivityEnv
{ forall env. ActivityEnv env -> Worker 'Real
activityWorker :: {-# UNPACK #-} !(Worker 'Real)
, forall env. ActivityEnv env -> ActivityInfo
activityInfo :: {-# UNPACK #-} !ActivityInfo
, forall env. ActivityEnv env -> ClientInterceptors
activityClientInterceptors :: {-# UNPACK #-} !ClientInterceptors
, forall env. ActivityEnv env -> PayloadProcessor
activityPayloadProcessor :: {-# UNPACK #-} !PayloadProcessor
, forall env. ActivityEnv env -> env
activityEnv :: env
}
class ActivityRef (f :: Type) where
type ActivityArgs f :: [Type]
type ActivityResult f :: Type
activityRef :: f -> KnownActivity (ActivityArgs f) (ActivityResult f)
instance VarArgs args => ActivityRef (KnownActivity args result) where
type ActivityArgs (KnownActivity args result) = args
type ActivityResult (KnownActivity args result) = result
activityRef :: KnownActivity args result
-> KnownActivity
(ActivityArgs (KnownActivity args result))
(ActivityResult (KnownActivity args result))
activityRef = KnownActivity args result -> KnownActivity args result
KnownActivity args result
-> KnownActivity
(ActivityArgs (KnownActivity args result))
(ActivityResult (KnownActivity args result))
forall a. a -> a
id
instance ActivityRef (ProvidedActivity env f) where
type ActivityArgs (ProvidedActivity env f) = ArgsOf f
type ActivityResult (ProvidedActivity env f) = ResultOf (Activity env) f
activityRef :: ProvidedActivity env f
-> KnownActivity
(ActivityArgs (ProvidedActivity env f))
(ActivityResult (ProvidedActivity env f))
activityRef ProvidedActivity env f
act = ProvidedActivity env f
act.reference
type DirectActivityReferenceMsg =
'Text "You can't run an 'Activity' directly in a 'Workflow' like this."
':$$: 'Text "A 'Workflow' must be deterministic, and 'Activity' values execute arbitrary IO."
':$$: 'Text "You will want to use a reference to a registered activity like 'KnownActivity' or 'RefFromFunction' to invoke the activity here."
':$$: 'Text "Then, you'll be able to call 'startActivity' or 'executeActivity' on it. So, instead of writing:"
':$$: 'Text " > executeActivity myActivity ..."
':$$: 'Text "write:"
':$$: 'Text " > executeActivity myActivityRef ..."
instance {-# OVERLAPPABLE #-} (f ~ (ArgsOf f :->: Activity env (ResultOf (Activity env) f)), TypeError DirectActivityReferenceMsg) => ActivityRef (a -> f) where
type ActivityArgs (a -> f) = '[]
type ActivityResult (a -> f) = ()
activityRef :: (a -> f)
-> KnownActivity (ActivityArgs (a -> f)) (ActivityResult (a -> f))
activityRef a -> f
_ = String -> KnownActivity '[] ()
forall a. HasCallStack => String -> a
error String
"Should never be called"
instance TypeError DirectActivityReferenceMsg => ActivityRef (Activity env a) where
type ActivityArgs (Activity env a) = '[]
type ActivityResult (Activity env a) = a
activityRef :: Activity env a
-> KnownActivity
(ActivityArgs (Activity env a)) (ActivityResult (Activity env a))
activityRef Activity env a
_ = String -> KnownActivity '[] a
forall a. HasCallStack => String -> a
error String
"Should never be called"
newtype Activity env a = Activity {forall env a. Activity env a -> ReaderT (ActivityEnv env) IO a
unActivity :: ReaderT (ActivityEnv env) IO a}
deriving newtype
( (forall a b. (a -> b) -> Activity env a -> Activity env b)
-> (forall a b. a -> Activity env b -> Activity env a)
-> Functor (Activity env)
forall a b. a -> Activity env b -> Activity env a
forall a b. (a -> b) -> Activity env a -> Activity env b
forall env a b. a -> Activity env b -> Activity env a
forall env a b. (a -> b) -> Activity env a -> Activity env b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall env a b. (a -> b) -> Activity env a -> Activity env b
fmap :: forall a b. (a -> b) -> Activity env a -> Activity env b
$c<$ :: forall env a b. a -> Activity env b -> Activity env a
<$ :: forall a b. a -> Activity env b -> Activity env a
Functor
, Functor (Activity env)
Functor (Activity env) =>
(forall a. a -> Activity env a)
-> (forall a b.
Activity env (a -> b) -> Activity env a -> Activity env b)
-> (forall a b c.
(a -> b -> c)
-> Activity env a -> Activity env b -> Activity env c)
-> (forall a b. Activity env a -> Activity env b -> Activity env b)
-> (forall a b. Activity env a -> Activity env b -> Activity env a)
-> Applicative (Activity env)
forall env. Functor (Activity env)
forall a. a -> Activity env a
forall env a. a -> Activity env a
forall a b. Activity env a -> Activity env b -> Activity env a
forall a b. Activity env a -> Activity env b -> Activity env b
forall a b.
Activity env (a -> b) -> Activity env a -> Activity env b
forall env a b. Activity env a -> Activity env b -> Activity env a
forall env a b. Activity env a -> Activity env b -> Activity env b
forall env a b.
Activity env (a -> b) -> Activity env a -> Activity env b
forall a b c.
(a -> b -> c) -> Activity env a -> Activity env b -> Activity env c
forall env a b c.
(a -> b -> c) -> Activity env a -> Activity env b -> Activity env 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 env a. a -> Activity env a
pure :: forall a. a -> Activity env a
$c<*> :: forall env a b.
Activity env (a -> b) -> Activity env a -> Activity env b
<*> :: forall a b.
Activity env (a -> b) -> Activity env a -> Activity env b
$cliftA2 :: forall env a b c.
(a -> b -> c) -> Activity env a -> Activity env b -> Activity env c
liftA2 :: forall a b c.
(a -> b -> c) -> Activity env a -> Activity env b -> Activity env c
$c*> :: forall env a b. Activity env a -> Activity env b -> Activity env b
*> :: forall a b. Activity env a -> Activity env b -> Activity env b
$c<* :: forall env a b. Activity env a -> Activity env b -> Activity env a
<* :: forall a b. Activity env a -> Activity env b -> Activity env a
Applicative
, Applicative (Activity env)
Applicative (Activity env) =>
(forall a. Activity env a)
-> (forall a. Activity env a -> Activity env a -> Activity env a)
-> (forall a. Activity env a -> Activity env [a])
-> (forall a. Activity env a -> Activity env [a])
-> Alternative (Activity env)
forall env. Applicative (Activity env)
forall a. Activity env a
forall a. Activity env a -> Activity env [a]
forall a. Activity env a -> Activity env a -> Activity env a
forall env a. Activity env a
forall env a. Activity env a -> Activity env [a]
forall env a. Activity env a -> Activity env a -> Activity env a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
$cempty :: forall env a. Activity env a
empty :: forall a. Activity env a
$c<|> :: forall env a. Activity env a -> Activity env a -> Activity env a
<|> :: forall a. Activity env a -> Activity env a -> Activity env a
$csome :: forall env a. Activity env a -> Activity env [a]
some :: forall a. Activity env a -> Activity env [a]
$cmany :: forall env a. Activity env a -> Activity env [a]
many :: forall a. Activity env a -> Activity env [a]
Alternative
, Applicative (Activity env)
Applicative (Activity env) =>
(forall a b.
Activity env a -> (a -> Activity env b) -> Activity env b)
-> (forall a b. Activity env a -> Activity env b -> Activity env b)
-> (forall a. a -> Activity env a)
-> Monad (Activity env)
forall env. Applicative (Activity env)
forall a. a -> Activity env a
forall env a. a -> Activity env a
forall a b. Activity env a -> Activity env b -> Activity env b
forall a b.
Activity env a -> (a -> Activity env b) -> Activity env b
forall env a b. Activity env a -> Activity env b -> Activity env b
forall env a b.
Activity env a -> (a -> Activity env b) -> Activity env 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 env a b.
Activity env a -> (a -> Activity env b) -> Activity env b
>>= :: forall a b.
Activity env a -> (a -> Activity env b) -> Activity env b
$c>> :: forall env a b. Activity env a -> Activity env b -> Activity env b
>> :: forall a b. Activity env a -> Activity env b -> Activity env b
$creturn :: forall env a. a -> Activity env a
return :: forall a. a -> Activity env a
Monad
, Monad (Activity env)
Monad (Activity env) =>
(forall a. String -> Activity env a) -> MonadFail (Activity env)
forall env. Monad (Activity env)
forall a. String -> Activity env a
forall env a. String -> Activity env a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall env a. String -> Activity env a
fail :: forall a. String -> Activity env a
MonadFail
, Monad (Activity env)
Monad (Activity env) =>
(forall a. (a -> Activity env a) -> Activity env a)
-> MonadFix (Activity env)
forall env. Monad (Activity env)
forall a. (a -> Activity env a) -> Activity env a
forall env a. (a -> Activity env a) -> Activity env a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall env a. (a -> Activity env a) -> Activity env a
mfix :: forall a. (a -> Activity env a) -> Activity env a
MonadFix
, MonadError IOException
, Monad (Activity env)
Monad (Activity env) =>
(forall a. IO a -> Activity env a) -> MonadIO (Activity env)
forall env. Monad (Activity env)
forall a. IO a -> Activity env a
forall env a. IO a -> Activity env a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall env a. IO a -> Activity env a
liftIO :: forall a. IO a -> Activity env a
MonadIO
, Monad (Activity env)
Alternative (Activity env)
(Alternative (Activity env), Monad (Activity env)) =>
(forall a. Activity env a)
-> (forall a. Activity env a -> Activity env a -> Activity env a)
-> MonadPlus (Activity env)
forall env. Monad (Activity env)
forall env. Alternative (Activity env)
forall a. Activity env a
forall a. Activity env a -> Activity env a -> Activity env a
forall env a. Activity env a
forall env a. Activity env a -> Activity env a -> Activity env a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall env a. Activity env a
mzero :: forall a. Activity env a
$cmplus :: forall env a. Activity env a -> Activity env a -> Activity env a
mplus :: forall a. Activity env a -> Activity env a -> Activity env a
MonadPlus
, MonadIO (Activity env)
MonadIO (Activity env) =>
(forall b.
((forall a. Activity env a -> IO a) -> IO b) -> Activity env b)
-> MonadUnliftIO (Activity env)
forall env. MonadIO (Activity env)
forall b.
((forall a. Activity env a -> IO a) -> IO b) -> Activity env b
forall env b.
((forall a. Activity env a -> IO a) -> IO b) -> Activity env b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall env b.
((forall a. Activity env a -> IO a) -> IO b) -> Activity env b
withRunInIO :: forall b.
((forall a. Activity env a -> IO a) -> IO b) -> Activity env b
MonadUnliftIO
, Monad (Activity env)
Monad (Activity env) =>
(forall e a. (HasCallStack, Exception e) => e -> Activity env a)
-> MonadThrow (Activity env)
forall env. Monad (Activity env)
forall e a. (HasCallStack, Exception e) => e -> Activity env a
forall env e a. (HasCallStack, Exception e) => e -> Activity env a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall env e a. (HasCallStack, Exception e) => e -> Activity env a
throwM :: forall e a. (HasCallStack, Exception e) => e -> Activity env a
MonadThrow
, MonadThrow (Activity env)
MonadThrow (Activity env) =>
(forall e a.
(HasCallStack, Exception e) =>
Activity env a -> (e -> Activity env a) -> Activity env a)
-> MonadCatch (Activity env)
forall env. MonadThrow (Activity env)
forall e a.
(HasCallStack, Exception e) =>
Activity env a -> (e -> Activity env a) -> Activity env a
forall env e a.
(HasCallStack, Exception e) =>
Activity env a -> (e -> Activity env a) -> Activity env a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall env e a.
(HasCallStack, Exception e) =>
Activity env a -> (e -> Activity env a) -> Activity env a
catch :: forall e a.
(HasCallStack, Exception e) =>
Activity env a -> (e -> Activity env a) -> Activity env a
MonadCatch
, MonadCatch (Activity env)
MonadCatch (Activity env) =>
(forall b.
HasCallStack =>
((forall a. Activity env a -> Activity env a) -> Activity env b)
-> Activity env b)
-> (forall b.
HasCallStack =>
((forall a. Activity env a -> Activity env a) -> Activity env b)
-> Activity env b)
-> (forall a b c.
HasCallStack =>
Activity env a
-> (a -> ExitCase b -> Activity env c)
-> (a -> Activity env b)
-> Activity env (b, c))
-> MonadMask (Activity env)
forall env. MonadCatch (Activity env)
forall b.
HasCallStack =>
((forall a. Activity env a -> Activity env a) -> Activity env b)
-> Activity env b
forall env b.
HasCallStack =>
((forall a. Activity env a -> Activity env a) -> Activity env b)
-> Activity env b
forall a b c.
HasCallStack =>
Activity env a
-> (a -> ExitCase b -> Activity env c)
-> (a -> Activity env b)
-> Activity env (b, c)
forall env a b c.
HasCallStack =>
Activity env a
-> (a -> ExitCase b -> Activity env c)
-> (a -> Activity env b)
-> Activity env (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 env b.
HasCallStack =>
((forall a. Activity env a -> Activity env a) -> Activity env b)
-> Activity env b
mask :: forall b.
HasCallStack =>
((forall a. Activity env a -> Activity env a) -> Activity env b)
-> Activity env b
$cuninterruptibleMask :: forall env b.
HasCallStack =>
((forall a. Activity env a -> Activity env a) -> Activity env b)
-> Activity env b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Activity env a -> Activity env a) -> Activity env b)
-> Activity env b
$cgeneralBracket :: forall env a b c.
HasCallStack =>
Activity env a
-> (a -> ExitCase b -> Activity env c)
-> (a -> Activity env b)
-> Activity env (b, c)
generalBracket :: forall a b c.
HasCallStack =>
Activity env a
-> (a -> ExitCase b -> Activity env c)
-> (a -> Activity env b)
-> Activity env (b, c)
MonadMask
)
runActivity :: ActivityEnv env -> Activity env a -> IO a
runActivity :: forall env a. ActivityEnv env -> Activity env a -> IO a
runActivity ActivityEnv env
env (Activity ReaderT (ActivityEnv env) IO a
m) = ReaderT (ActivityEnv env) IO a -> ActivityEnv env -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (ActivityEnv env) IO a
m ActivityEnv env
env
askActivityInfo :: Activity env ActivityInfo
askActivityInfo :: forall env. Activity env ActivityInfo
askActivityInfo = ReaderT (ActivityEnv env) IO ActivityInfo
-> Activity env ActivityInfo
forall env a. ReaderT (ActivityEnv env) IO a -> Activity env a
Activity (ReaderT (ActivityEnv env) IO ActivityInfo
-> Activity env ActivityInfo)
-> ReaderT (ActivityEnv env) IO ActivityInfo
-> Activity env ActivityInfo
forall a b. (a -> b) -> a -> b
$ (ActivityEnv env -> ActivityInfo)
-> ReaderT (ActivityEnv env) IO ActivityInfo
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.activityInfo)
askActivityWorker :: Activity env (Worker 'Real)
askActivityWorker :: forall env. Activity env (Worker 'Real)
askActivityWorker = ReaderT (ActivityEnv env) IO (Worker 'Real)
-> Activity env (Worker 'Real)
forall env a. ReaderT (ActivityEnv env) IO a -> Activity env a
Activity (ReaderT (ActivityEnv env) IO (Worker 'Real)
-> Activity env (Worker 'Real))
-> ReaderT (ActivityEnv env) IO (Worker 'Real)
-> Activity env (Worker 'Real)
forall a b. (a -> b) -> a -> b
$ (ActivityEnv env -> Worker 'Real)
-> ReaderT (ActivityEnv env) IO (Worker 'Real)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.activityWorker)
askActivityClient :: Activity env Client
askActivityClient :: forall env. Activity env Client
askActivityClient = ReaderT (ActivityEnv env) IO Client -> Activity env Client
forall env a. ReaderT (ActivityEnv env) IO a -> Activity env a
Activity (ReaderT (ActivityEnv env) IO Client -> Activity env Client)
-> ReaderT (ActivityEnv env) IO Client -> Activity env Client
forall a b. (a -> b) -> a -> b
$ (ActivityEnv env -> Client) -> ReaderT (ActivityEnv env) IO Client
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Worker 'Real -> Client
getWorkerClient (Worker 'Real -> Client)
-> (ActivityEnv env -> Worker 'Real) -> ActivityEnv env -> Client
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.activityWorker))
instance MonadReader env (Activity env) where
ask :: Activity env env
ask = ReaderT (ActivityEnv env) IO env -> Activity env env
forall env a. ReaderT (ActivityEnv env) IO a -> Activity env a
Activity (ReaderT (ActivityEnv env) IO env -> Activity env env)
-> ReaderT (ActivityEnv env) IO env -> Activity env env
forall a b. (a -> b) -> a -> b
$ (ActivityEnv env -> env) -> ReaderT (ActivityEnv env) IO env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.activityEnv)
local :: forall a. (env -> env) -> Activity env a -> Activity env a
local env -> env
f (Activity ReaderT (ActivityEnv env) IO a
m) = ReaderT (ActivityEnv env) IO a -> Activity env a
forall env a. ReaderT (ActivityEnv env) IO a -> Activity env a
Activity (ReaderT (ActivityEnv env) IO a -> Activity env a)
-> ReaderT (ActivityEnv env) IO a -> Activity env a
forall a b. (a -> b) -> a -> b
$ (ActivityEnv env -> ActivityEnv env)
-> ReaderT (ActivityEnv env) IO a -> ReaderT (ActivityEnv env) IO a
forall a.
(ActivityEnv env -> ActivityEnv env)
-> ReaderT (ActivityEnv env) IO a -> ReaderT (ActivityEnv env) IO a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ActivityEnv env
a -> ActivityEnv env
a {Temporal.Activity.Definition.activityEnv = f $ Temporal.Activity.Definition.activityEnv a}) ReaderT (ActivityEnv env) IO a
m