{-# LANGUAGE DuplicateRecordFields #-}
module Temporal.Exception (
module Temporal.Exception,
ActivityType (..),
RetryState (..),
) where
import Control.Applicative (Alternative (..))
import Control.Exception
import Control.Exception.Annotated
import Data.Annotation
import Data.Int
import Data.ProtoLens (Message (..))
import Data.Text
import Data.Typeable
import Data.Vector (Vector)
import GHC.Stack
import Lens.Family2
import qualified Proto.Temporal.Api.Common.V1.Message as Common
import qualified Proto.Temporal.Api.Common.V1.Message_Fields as Common
import Proto.Temporal.Api.Failure.V1.Message
import qualified Proto.Temporal.Api.Failure.V1.Message as F
import qualified Proto.Temporal.Api.Failure.V1.Message as Proto
import qualified Proto.Temporal.Api.Failure.V1.Message_Fields as F
import Proto.Temporal.Api.History.V1.Message
import System.IO.Unsafe (unsafePerformIO)
import Temporal.Common
import Temporal.Duration
import Temporal.Payload
import Temporal.Workflow.Types
data SomeWorkerException = forall e. Exception e => SomeWorkerException e
instance Show SomeWorkerException where
show :: SomeWorkerException -> String
show (SomeWorkerException e
e) = e -> String
forall a. Show a => a -> String
show e
e
instance Exception SomeWorkerException
workerExceptionToException :: Exception e => e -> SomeException
workerExceptionToException :: forall e. Exception e => e -> SomeException
workerExceptionToException = SomeWorkerException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeWorkerException -> SomeException)
-> (e -> SomeWorkerException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeWorkerException
forall e. Exception e => e -> SomeWorkerException
SomeWorkerException
workerExceptionFromException :: Exception e => SomeException -> Maybe e
workerExceptionFromException :: forall e. Exception e => SomeException -> Maybe e
workerExceptionFromException SomeException
x = do
SomeWorkerException a <- SomeException -> Maybe SomeWorkerException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
cast a
data RuntimeError = RuntimeError String
deriving stock (Int -> RuntimeError -> ShowS
[RuntimeError] -> ShowS
RuntimeError -> String
(Int -> RuntimeError -> ShowS)
-> (RuntimeError -> String)
-> ([RuntimeError] -> ShowS)
-> Show RuntimeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuntimeError -> ShowS
showsPrec :: Int -> RuntimeError -> ShowS
$cshow :: RuntimeError -> String
show :: RuntimeError -> String
$cshowList :: [RuntimeError] -> ShowS
showList :: [RuntimeError] -> ShowS
Show)
instance Exception RuntimeError where
toException :: RuntimeError -> SomeException
toException = RuntimeError -> SomeException
forall e. Exception e => e -> SomeException
workerExceptionToException
fromException :: SomeException -> Maybe RuntimeError
fromException = SomeException -> Maybe RuntimeError
forall e. Exception e => SomeException -> Maybe e
workerExceptionFromException
data WorkflowNotFound = WorkflowNotFound String
deriving stock (Int -> WorkflowNotFound -> ShowS
[WorkflowNotFound] -> ShowS
WorkflowNotFound -> String
(Int -> WorkflowNotFound -> ShowS)
-> (WorkflowNotFound -> String)
-> ([WorkflowNotFound] -> ShowS)
-> Show WorkflowNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowNotFound -> ShowS
showsPrec :: Int -> WorkflowNotFound -> ShowS
$cshow :: WorkflowNotFound -> String
show :: WorkflowNotFound -> String
$cshowList :: [WorkflowNotFound] -> ShowS
showList :: [WorkflowNotFound] -> ShowS
Show)
instance Exception WorkflowNotFound where
toException :: WorkflowNotFound -> SomeException
toException = WorkflowNotFound -> SomeException
forall e. Exception e => e -> SomeException
workerExceptionToException
fromException :: SomeException -> Maybe WorkflowNotFound
fromException = SomeException -> Maybe WorkflowNotFound
forall e. Exception e => SomeException -> Maybe e
workerExceptionFromException
data ActivityNotFound = ActivityNotFound String
deriving stock (Int -> ActivityNotFound -> ShowS
[ActivityNotFound] -> ShowS
ActivityNotFound -> String
(Int -> ActivityNotFound -> ShowS)
-> (ActivityNotFound -> String)
-> ([ActivityNotFound] -> ShowS)
-> Show ActivityNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivityNotFound -> ShowS
showsPrec :: Int -> ActivityNotFound -> ShowS
$cshow :: ActivityNotFound -> String
show :: ActivityNotFound -> String
$cshowList :: [ActivityNotFound] -> ShowS
showList :: [ActivityNotFound] -> ShowS
Show)
instance Exception ActivityNotFound where
toException :: ActivityNotFound -> SomeException
toException = ActivityNotFound -> SomeException
forall e. Exception e => e -> SomeException
workerExceptionToException
fromException :: SomeException -> Maybe ActivityNotFound
fromException = SomeException -> Maybe ActivityNotFound
forall e. Exception e => SomeException -> Maybe e
workerExceptionFromException
data QueryNotFound = QueryNotFound String
deriving stock (Int -> QueryNotFound -> ShowS
[QueryNotFound] -> ShowS
QueryNotFound -> String
(Int -> QueryNotFound -> ShowS)
-> (QueryNotFound -> String)
-> ([QueryNotFound] -> ShowS)
-> Show QueryNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryNotFound -> ShowS
showsPrec :: Int -> QueryNotFound -> ShowS
$cshow :: QueryNotFound -> String
show :: QueryNotFound -> String
$cshowList :: [QueryNotFound] -> ShowS
showList :: [QueryNotFound] -> ShowS
Show)
instance Exception QueryNotFound where
toException :: QueryNotFound -> SomeException
toException = QueryNotFound -> SomeException
forall e. Exception e => e -> SomeException
workerExceptionToException
fromException :: SomeException -> Maybe QueryNotFound
fromException = SomeException -> Maybe QueryNotFound
forall e. Exception e => SomeException -> Maybe e
workerExceptionFromException
data LogicBugType
= ReadingCompletionsFailedRun
| WorkflowActivationDeadlock
deriving stock (Int -> LogicBugType -> ShowS
[LogicBugType] -> ShowS
LogicBugType -> String
(Int -> LogicBugType -> ShowS)
-> (LogicBugType -> String)
-> ([LogicBugType] -> ShowS)
-> Show LogicBugType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogicBugType -> ShowS
showsPrec :: Int -> LogicBugType -> ShowS
$cshow :: LogicBugType -> String
show :: LogicBugType -> String
$cshowList :: [LogicBugType] -> ShowS
showList :: [LogicBugType] -> ShowS
Show)
data LogicBug = LogicBug LogicBugType
deriving stock (Int -> LogicBug -> ShowS
[LogicBug] -> ShowS
LogicBug -> String
(Int -> LogicBug -> ShowS)
-> (LogicBug -> String) -> ([LogicBug] -> ShowS) -> Show LogicBug
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogicBug -> ShowS
showsPrec :: Int -> LogicBug -> ShowS
$cshow :: LogicBug -> String
show :: LogicBug -> String
$cshowList :: [LogicBug] -> ShowS
showList :: [LogicBug] -> ShowS
Show)
instance Exception LogicBug
data WorkflowAlreadyStarted = WorkflowAlreadyStarted
{ WorkflowAlreadyStarted -> WorkflowId
workflowAlreadyStartedWorkflowId :: WorkflowId
, WorkflowAlreadyStarted -> WorkflowType
workflowAlreadyStartedWorkflowType :: WorkflowType
}
deriving stock (Int -> WorkflowAlreadyStarted -> ShowS
[WorkflowAlreadyStarted] -> ShowS
WorkflowAlreadyStarted -> String
(Int -> WorkflowAlreadyStarted -> ShowS)
-> (WorkflowAlreadyStarted -> String)
-> ([WorkflowAlreadyStarted] -> ShowS)
-> Show WorkflowAlreadyStarted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowAlreadyStarted -> ShowS
showsPrec :: Int -> WorkflowAlreadyStarted -> ShowS
$cshow :: WorkflowAlreadyStarted -> String
show :: WorkflowAlreadyStarted -> String
$cshowList :: [WorkflowAlreadyStarted] -> ShowS
showList :: [WorkflowAlreadyStarted] -> ShowS
Show)
instance Exception WorkflowAlreadyStarted
data ChildWorkflowFailed = ChildWorkflowFailed Proto.Failure
deriving stock (Int -> ChildWorkflowFailed -> ShowS
[ChildWorkflowFailed] -> ShowS
ChildWorkflowFailed -> String
(Int -> ChildWorkflowFailed -> ShowS)
-> (ChildWorkflowFailed -> String)
-> ([ChildWorkflowFailed] -> ShowS)
-> Show ChildWorkflowFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChildWorkflowFailed -> ShowS
showsPrec :: Int -> ChildWorkflowFailed -> ShowS
$cshow :: ChildWorkflowFailed -> String
show :: ChildWorkflowFailed -> String
$cshowList :: [ChildWorkflowFailed] -> ShowS
showList :: [ChildWorkflowFailed] -> ShowS
Show)
instance Exception ChildWorkflowFailed
data ChildWorkflowCancelled = ChildWorkflowCancelled
deriving stock (Int -> ChildWorkflowCancelled -> ShowS
[ChildWorkflowCancelled] -> ShowS
ChildWorkflowCancelled -> String
(Int -> ChildWorkflowCancelled -> ShowS)
-> (ChildWorkflowCancelled -> String)
-> ([ChildWorkflowCancelled] -> ShowS)
-> Show ChildWorkflowCancelled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChildWorkflowCancelled -> ShowS
showsPrec :: Int -> ChildWorkflowCancelled -> ShowS
$cshow :: ChildWorkflowCancelled -> String
show :: ChildWorkflowCancelled -> String
$cshowList :: [ChildWorkflowCancelled] -> ShowS
showList :: [ChildWorkflowCancelled] -> ShowS
Show, ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool
(ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool)
-> (ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool)
-> Eq ChildWorkflowCancelled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool
== :: ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool
$c/= :: ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool
/= :: ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool
Eq)
instance Exception ChildWorkflowCancelled
data SignalExternalWorkflowFailed = SignalExternalWorkflowFailed Proto.Failure
deriving stock (Int -> SignalExternalWorkflowFailed -> ShowS
[SignalExternalWorkflowFailed] -> ShowS
SignalExternalWorkflowFailed -> String
(Int -> SignalExternalWorkflowFailed -> ShowS)
-> (SignalExternalWorkflowFailed -> String)
-> ([SignalExternalWorkflowFailed] -> ShowS)
-> Show SignalExternalWorkflowFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignalExternalWorkflowFailed -> ShowS
showsPrec :: Int -> SignalExternalWorkflowFailed -> ShowS
$cshow :: SignalExternalWorkflowFailed -> String
show :: SignalExternalWorkflowFailed -> String
$cshowList :: [SignalExternalWorkflowFailed] -> ShowS
showList :: [SignalExternalWorkflowFailed] -> ShowS
Show)
instance Exception SignalExternalWorkflowFailed
data ContinueAsNewException = ContinueAsNewException
{ ContinueAsNewException -> WorkflowType
continueAsNewWorkflowType :: WorkflowType
, ContinueAsNewException -> Vector Payload
continueAsNewArguments :: Vector Payload
, ContinueAsNewException -> ContinueAsNewOptions
continueAsNewOptions :: ContinueAsNewOptions
}
deriving stock (Int -> ContinueAsNewException -> ShowS
[ContinueAsNewException] -> ShowS
ContinueAsNewException -> String
(Int -> ContinueAsNewException -> ShowS)
-> (ContinueAsNewException -> String)
-> ([ContinueAsNewException] -> ShowS)
-> Show ContinueAsNewException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContinueAsNewException -> ShowS
showsPrec :: Int -> ContinueAsNewException -> ShowS
$cshow :: ContinueAsNewException -> String
show :: ContinueAsNewException -> String
$cshowList :: [ContinueAsNewException] -> ShowS
showList :: [ContinueAsNewException] -> ShowS
Show)
instance Exception ContinueAsNewException
data AlternativeInstanceFailure = AlternativeInstanceFailure
deriving stock (Int -> AlternativeInstanceFailure -> ShowS
[AlternativeInstanceFailure] -> ShowS
AlternativeInstanceFailure -> String
(Int -> AlternativeInstanceFailure -> ShowS)
-> (AlternativeInstanceFailure -> String)
-> ([AlternativeInstanceFailure] -> ShowS)
-> Show AlternativeInstanceFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlternativeInstanceFailure -> ShowS
showsPrec :: Int -> AlternativeInstanceFailure -> ShowS
$cshow :: AlternativeInstanceFailure -> String
show :: AlternativeInstanceFailure -> String
$cshowList :: [AlternativeInstanceFailure] -> ShowS
showList :: [AlternativeInstanceFailure] -> ShowS
Show)
instance Exception AlternativeInstanceFailure
data CancelExternalWorkflowFailed = CancelExternalWorkflowFailed Proto.Failure
deriving stock (Int -> CancelExternalWorkflowFailed -> ShowS
[CancelExternalWorkflowFailed] -> ShowS
CancelExternalWorkflowFailed -> String
(Int -> CancelExternalWorkflowFailed -> ShowS)
-> (CancelExternalWorkflowFailed -> String)
-> ([CancelExternalWorkflowFailed] -> ShowS)
-> Show CancelExternalWorkflowFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CancelExternalWorkflowFailed -> ShowS
showsPrec :: Int -> CancelExternalWorkflowFailed -> ShowS
$cshow :: CancelExternalWorkflowFailed -> String
show :: CancelExternalWorkflowFailed -> String
$cshowList :: [CancelExternalWorkflowFailed] -> ShowS
showList :: [CancelExternalWorkflowFailed] -> ShowS
Show)
instance Exception CancelExternalWorkflowFailed
data WorkflowCancelRequested = WorkflowCancelRequested
deriving stock (Int -> WorkflowCancelRequested -> ShowS
[WorkflowCancelRequested] -> ShowS
WorkflowCancelRequested -> String
(Int -> WorkflowCancelRequested -> ShowS)
-> (WorkflowCancelRequested -> String)
-> ([WorkflowCancelRequested] -> ShowS)
-> Show WorkflowCancelRequested
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowCancelRequested -> ShowS
showsPrec :: Int -> WorkflowCancelRequested -> ShowS
$cshow :: WorkflowCancelRequested -> String
show :: WorkflowCancelRequested -> String
$cshowList :: [WorkflowCancelRequested] -> ShowS
showList :: [WorkflowCancelRequested] -> ShowS
Show)
instance Exception WorkflowCancelRequested
data ActivityCancelled = ActivityCancelled Proto.Temporal.Api.Failure.V1.Message.Failure
deriving stock (Int -> ActivityCancelled -> ShowS
[ActivityCancelled] -> ShowS
ActivityCancelled -> String
(Int -> ActivityCancelled -> ShowS)
-> (ActivityCancelled -> String)
-> ([ActivityCancelled] -> ShowS)
-> Show ActivityCancelled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivityCancelled -> ShowS
showsPrec :: Int -> ActivityCancelled -> ShowS
$cshow :: ActivityCancelled -> String
show :: ActivityCancelled -> String
$cshowList :: [ActivityCancelled] -> ShowS
showList :: [ActivityCancelled] -> ShowS
Show, ActivityCancelled -> ActivityCancelled -> Bool
(ActivityCancelled -> ActivityCancelled -> Bool)
-> (ActivityCancelled -> ActivityCancelled -> Bool)
-> Eq ActivityCancelled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActivityCancelled -> ActivityCancelled -> Bool
== :: ActivityCancelled -> ActivityCancelled -> Bool
$c/= :: ActivityCancelled -> ActivityCancelled -> Bool
/= :: ActivityCancelled -> ActivityCancelled -> Bool
Eq)
instance Exception ActivityCancelled
data ApplicationFailure = ApplicationFailure
{ ApplicationFailure -> Text
type' :: Text
, ApplicationFailure -> Text
message :: Text
, ApplicationFailure -> Bool
nonRetryable :: Bool
, ApplicationFailure -> [Payload]
details :: [Payload]
, ApplicationFailure -> Text
stack :: Text
, ApplicationFailure -> Maybe Duration
nextRetryDelay :: Maybe Duration
}
deriving stock (Int -> ApplicationFailure -> ShowS
[ApplicationFailure] -> ShowS
ApplicationFailure -> String
(Int -> ApplicationFailure -> ShowS)
-> (ApplicationFailure -> String)
-> ([ApplicationFailure] -> ShowS)
-> Show ApplicationFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApplicationFailure -> ShowS
showsPrec :: Int -> ApplicationFailure -> ShowS
$cshow :: ApplicationFailure -> String
show :: ApplicationFailure -> String
$cshowList :: [ApplicationFailure] -> ShowS
showList :: [ApplicationFailure] -> ShowS
Show, ApplicationFailure -> ApplicationFailure -> Bool
(ApplicationFailure -> ApplicationFailure -> Bool)
-> (ApplicationFailure -> ApplicationFailure -> Bool)
-> Eq ApplicationFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplicationFailure -> ApplicationFailure -> Bool
== :: ApplicationFailure -> ApplicationFailure -> Bool
$c/= :: ApplicationFailure -> ApplicationFailure -> Bool
/= :: ApplicationFailure -> ApplicationFailure -> Bool
Eq)
applicationFailureToFailureProto :: ApplicationFailure -> F.Failure
applicationFailureToFailureProto :: ApplicationFailure -> Failure
applicationFailureToFailureProto ApplicationFailure
appFailure =
Failure
forall msg. Message msg => msg
defMessage
Failure -> (Failure -> Failure) -> Failure
forall s t. s -> (s -> t) -> t
& LensLike' f Failure Text
forall {f :: * -> *}. Identical f => LensLike' f Failure Text
forall (f :: * -> *) s a.
(Functor f, HasField s "message" a) =>
LensLike' f s a
F.message (forall {f :: * -> *}. Identical f => LensLike' f Failure Text)
-> Text -> Failure -> Failure
forall s t a b. Setter s t a b -> b -> s -> t
.~ ApplicationFailure
appFailure.message
Failure -> (Failure -> Failure) -> Failure
forall s t. s -> (s -> t) -> t
& LensLike' f Failure Text
forall {f :: * -> *}. Identical f => LensLike' f Failure Text
forall (f :: * -> *) s a.
(Functor f, HasField s "source" a) =>
LensLike' f s a
F.source (forall {f :: * -> *}. Identical f => LensLike' f Failure Text)
-> Text -> Failure -> Failure
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
"hs-temporal-sdk"
Failure -> (Failure -> Failure) -> Failure
forall s t. s -> (s -> t) -> t
& LensLike' f Failure Text
forall {f :: * -> *}. Identical f => LensLike' f Failure Text
forall (f :: * -> *) s a.
(Functor f, HasField s "stackTrace" a) =>
LensLike' f s a
F.stackTrace (forall {f :: * -> *}. Identical f => LensLike' f Failure Text)
-> Text -> Failure -> Failure
forall s t a b. Setter s t a b -> b -> s -> t
.~ ApplicationFailure
appFailure.stack
Failure -> (Failure -> Failure) -> Failure
forall s t. s -> (s -> t) -> t
& LensLike' f Failure ApplicationFailureInfo
forall {f :: * -> *}.
Identical f =>
LensLike' f Failure ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "applicationFailureInfo" a) =>
LensLike' f s a
F.applicationFailureInfo
(forall {f :: * -> *}.
Identical f =>
LensLike' f Failure ApplicationFailureInfo)
-> ApplicationFailureInfo -> Failure -> Failure
forall s t a b. Setter s t a b -> b -> s -> t
.~ ( ApplicationFailureInfo
forall msg. Message msg => msg
defMessage
ApplicationFailureInfo
-> (ApplicationFailureInfo -> ApplicationFailureInfo)
-> ApplicationFailureInfo
forall s t. s -> (s -> t) -> t
& LensLike' f ApplicationFailureInfo Text
forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo Text
forall (f :: * -> *) s a.
(Functor f, HasField s "type'" a) =>
LensLike' f s a
F.type' (forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo Text)
-> Text -> ApplicationFailureInfo -> ApplicationFailureInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ ApplicationFailure
appFailure.type'
ApplicationFailureInfo
-> (ApplicationFailureInfo -> ApplicationFailureInfo)
-> ApplicationFailureInfo
forall s t. s -> (s -> t) -> t
& LensLike' f ApplicationFailureInfo Payloads
forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo Payloads
forall (f :: * -> *) s a.
(Functor f, HasField s "details" a) =>
LensLike' f s a
F.details (forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo Payloads)
-> Payloads -> ApplicationFailureInfo -> ApplicationFailureInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (forall msg. Message msg => msg
defMessage @Common.Payloads Payloads -> (Payloads -> Payloads) -> Payloads
forall s t. s -> (s -> t) -> t
& LensLike' f Payloads [Payload]
forall {f :: * -> *}. Identical f => LensLike' f Payloads [Payload]
forall (f :: * -> *) s a.
(Functor f, HasField s "payloads" a) =>
LensLike' f s a
Common.payloads (forall {f :: * -> *}.
Identical f =>
LensLike' f Payloads [Payload])
-> [Payload] -> Payloads -> Payloads
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Payload -> Payload) -> [Payload] -> [Payload]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload ApplicationFailure
appFailure.details)
ApplicationFailureInfo
-> (ApplicationFailureInfo -> ApplicationFailureInfo)
-> ApplicationFailureInfo
forall s t. s -> (s -> t) -> t
& LensLike' f ApplicationFailureInfo Bool
forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "nonRetryable" a) =>
LensLike' f s a
F.nonRetryable (forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo Bool)
-> Bool -> ApplicationFailureInfo -> ApplicationFailureInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ ApplicationFailure
appFailure.nonRetryable
ApplicationFailureInfo
-> (ApplicationFailureInfo -> ApplicationFailureInfo)
-> ApplicationFailureInfo
forall s t. s -> (s -> t) -> t
& LensLike' f ApplicationFailureInfo (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'nextRetryDelay" a) =>
LensLike' f s a
F.maybe'nextRetryDelay (forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo (Maybe Duration))
-> Maybe Duration
-> ApplicationFailureInfo
-> ApplicationFailureInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationToProto ApplicationFailure
appFailure.nextRetryDelay
)
instance Exception ApplicationFailure
class ToApplicationFailure e where
toApplicationFailure :: e -> ApplicationFailure
data SomeApplicationFailure = forall e. (Exception e, ToApplicationFailure e) => SomeApplicationFailure e
instance Show SomeApplicationFailure where
show :: SomeApplicationFailure -> String
show :: SomeApplicationFailure -> String
show (SomeApplicationFailure e
e) = e -> String
forall a. Show a => a -> String
show e
e
instance Exception SomeApplicationFailure
data ActivityCancelReason
=
NotFound
|
CancelRequested
|
Timeout
|
WorkerShutdown
|
UnknownCancellationReason
deriving stock (Int -> ActivityCancelReason -> ShowS
[ActivityCancelReason] -> ShowS
ActivityCancelReason -> String
(Int -> ActivityCancelReason -> ShowS)
-> (ActivityCancelReason -> String)
-> ([ActivityCancelReason] -> ShowS)
-> Show ActivityCancelReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivityCancelReason -> ShowS
showsPrec :: Int -> ActivityCancelReason -> ShowS
$cshow :: ActivityCancelReason -> String
show :: ActivityCancelReason -> String
$cshowList :: [ActivityCancelReason] -> ShowS
showList :: [ActivityCancelReason] -> ShowS
Show)
instance Exception ActivityCancelReason where
toException :: ActivityCancelReason -> SomeException
toException = ActivityCancelReason -> SomeException
forall e. Exception e => e -> SomeException
asyncExceptionToException
fromException :: SomeException -> Maybe ActivityCancelReason
fromException = SomeException -> Maybe ActivityCancelReason
forall e. Exception e => SomeException -> Maybe e
asyncExceptionFromException
applicationFailureToException :: (Exception e, ToApplicationFailure e) => e -> SomeException
applicationFailureToException :: forall e.
(Exception e, ToApplicationFailure e) =>
e -> SomeException
applicationFailureToException e
e = SomeApplicationFailure -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeApplicationFailure -> SomeException)
-> SomeApplicationFailure -> SomeException
forall a b. (a -> b) -> a -> b
$ e -> SomeApplicationFailure
forall e.
(Exception e, ToApplicationFailure e) =>
e -> SomeApplicationFailure
SomeApplicationFailure e
e
applicationFailureFromException :: Exception e => SomeException -> Maybe e
applicationFailureFromException :: forall e. Exception e => SomeException -> Maybe e
applicationFailureFromException SomeException
e = do
(SomeApplicationFailure e') <- SomeException -> Maybe SomeApplicationFailure
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
cast e'
data ApplicationFailureHandler where
ApplicationFailureHandler :: Exception e => (e -> ApplicationFailure) -> ApplicationFailureHandler
prettySrcLoc :: SrcLoc -> String
prettySrcLoc :: SrcLoc -> String
prettySrcLoc SrcLoc {Int
String
srcLocPackage :: String
srcLocModule :: String
srcLocFile :: String
srcLocStartLine :: Int
srcLocStartCol :: Int
srcLocEndLine :: Int
srcLocEndCol :: Int
srcLocEndCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocStartCol :: SrcLoc -> Int
srcLocStartLine :: SrcLoc -> Int
srcLocFile :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocPackage :: SrcLoc -> String
..} =
[String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
srcLocFile
, String
":"
, Int -> String
forall a. Show a => a -> String
show Int
srcLocStartLine
, String
":"
, Int -> String
forall a. Show a => a -> String
show Int
srcLocStartCol
, String
" in "
, String
srcLocPackage
, String
":"
, String
srcLocModule
]
prettyCallStack :: CallStack -> String
prettyCallStack :: CallStack -> String
prettyCallStack = [String] -> String
Prelude.unlines ([String] -> String)
-> (CallStack -> [String]) -> CallStack -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> [String]
prettyCallStackLines
prettyCallStackLines :: CallStack -> [String]
prettyCallStackLines :: CallStack -> [String]
prettyCallStackLines CallStack
cs = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
[] -> []
[(String, SrcLoc)]
stk -> ((String, SrcLoc) -> String) -> [(String, SrcLoc)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (String, SrcLoc) -> String
prettyCallSite [(String, SrcLoc)]
stk
where
prettyCallSite :: (String, SrcLoc) -> String
prettyCallSite (String
f, SrcLoc
loc) = String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", called at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
Temporal.Exception.prettySrcLoc SrcLoc
loc
mkApplicationFailure :: SomeException -> [ApplicationFailureHandler] -> ApplicationFailure
mkApplicationFailure :: SomeException -> [ApplicationFailureHandler] -> ApplicationFailure
mkApplicationFailure e :: SomeException
e@(SomeException e
e') = (ApplicationFailureHandler
-> ApplicationFailure -> ApplicationFailure)
-> ApplicationFailure
-> [ApplicationFailureHandler]
-> ApplicationFailure
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr ApplicationFailureHandler
-> ApplicationFailure -> ApplicationFailure
tryHandler (e -> ApplicationFailure
forall e. Exception e => e -> ApplicationFailure
basicHandler e
e')
where
tryHandler :: ApplicationFailureHandler
-> ApplicationFailure -> ApplicationFailure
tryHandler (ApplicationFailureHandler e -> ApplicationFailure
hndlr) ApplicationFailure
acc = ApplicationFailure
-> (e -> ApplicationFailure) -> Maybe e -> ApplicationFailure
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ApplicationFailure
acc e -> ApplicationFailure
hndlr (Maybe e -> ApplicationFailure) -> Maybe e -> ApplicationFailure
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
annToPayload :: Annotation -> Payload
annToPayload :: Annotation -> Payload
annToPayload Annotation
ann = IO Payload -> Payload
forall a. IO a -> a
unsafePerformIO (IO Payload -> Payload) -> IO Payload -> Payload
forall a b. (a -> b) -> a -> b
$ JSON -> String -> IO Payload
forall fmt a. Codec fmt a => fmt -> a -> IO Payload
encode JSON
JSON (String -> IO Payload) -> String -> IO Payload
forall a b. (a -> b) -> a -> b
$ Annotation -> String
forall a. Show a => a -> String
show Annotation
ann
annotationHandler :: Exception e => (e -> ApplicationFailure) -> AnnotatedException e -> ApplicationFailure
annotationHandler :: forall e.
Exception e =>
(e -> ApplicationFailure)
-> AnnotatedException e -> ApplicationFailure
annotationHandler e -> ApplicationFailure
hndlr (AnnotatedException [Annotation]
anns e
e) =
let
base :: ApplicationFailure
base = e -> ApplicationFailure
hndlr e
e
([CallStack]
stack', [Annotation]
annsWithoutStack) = [Annotation] -> ([CallStack], [Annotation])
forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations [Annotation]
anns
([NonRetryableError]
nonRetryable', [Annotation]
annsWithoutStackOrRetry) = [Annotation] -> ([NonRetryableError], [Annotation])
forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations [Annotation]
annsWithoutStack
([NextRetryDelay]
nextRetryDelay', [Annotation]
annsWithoutDelay) = [Annotation] -> ([NextRetryDelay], [Annotation])
forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations [Annotation]
annsWithoutStackOrRetry
in
ApplicationFailure
base
{ stack =
if base.stack == ""
then case stack' of
(CallStack
cs : [CallStack]
_) -> String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ CallStack -> String
Temporal.Exception.prettyCallStack CallStack
cs
[CallStack]
_ -> ApplicationFailure
base.stack
else base.stack
, details = Prelude.map annToPayload annsWithoutDelay ++ base.details
, nonRetryable = case nonRetryable' of
(NonRetryableError Bool
b : [NonRetryableError]
_) -> Bool
b Bool -> Bool -> Bool
|| ApplicationFailure -> Bool
nonRetryable ApplicationFailure
base
[NonRetryableError]
_ -> ApplicationFailure -> Bool
nonRetryable ApplicationFailure
base
, nextRetryDelay = case nextRetryDelay' of
(NextRetryDelay Maybe Duration
d : [NextRetryDelay]
_) -> Maybe Duration
d Maybe Duration -> Maybe Duration -> Maybe Duration
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ApplicationFailure -> Maybe Duration
nextRetryDelay ApplicationFailure
base
[NextRetryDelay]
_ -> ApplicationFailure -> Maybe Duration
nextRetryDelay ApplicationFailure
base
}
basicHandler :: Exception e => e -> ApplicationFailure
basicHandler :: forall e. Exception e => e -> ApplicationFailure
basicHandler e
e = case e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e of
(SomeException e
e') ->
ApplicationFailure
{ type' :: Text
type' = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
e'
, message :: Text
message = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
displayException e
e'
, nonRetryable :: Bool
nonRetryable = Bool
False
, details :: [Payload]
details = []
, stack :: Text
stack = Text
""
, nextRetryDelay :: Maybe Duration
nextRetryDelay = Maybe Duration
forall a. Maybe a
Nothing
}
mkAnnotatedHandlers :: [ApplicationFailureHandler] -> [ApplicationFailureHandler]
mkAnnotatedHandlers :: [ApplicationFailureHandler] -> [ApplicationFailureHandler]
mkAnnotatedHandlers [ApplicationFailureHandler]
xs =
( [ApplicationFailureHandler]
xs [ApplicationFailureHandler]
-> (ApplicationFailureHandler -> [ApplicationFailureHandler])
-> [ApplicationFailureHandler]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ApplicationFailureHandler e -> ApplicationFailure
hndlr) ->
[ (e -> ApplicationFailure) -> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler e -> ApplicationFailure
hndlr
, (AnnotatedException e -> ApplicationFailure)
-> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler ((AnnotatedException e -> ApplicationFailure)
-> ApplicationFailureHandler)
-> (AnnotatedException e -> ApplicationFailure)
-> ApplicationFailureHandler
forall a b. (a -> b) -> a -> b
$ \AnnotatedException e
e -> (e -> ApplicationFailure)
-> AnnotatedException e -> ApplicationFailure
forall e.
Exception e =>
(e -> ApplicationFailure)
-> AnnotatedException e -> ApplicationFailure
annotationHandler e -> ApplicationFailure
hndlr AnnotatedException e
e
]
)
[ApplicationFailureHandler]
-> [ApplicationFailureHandler] -> [ApplicationFailureHandler]
forall a. [a] -> [a] -> [a]
++ [(AnnotatedException SomeException -> ApplicationFailure)
-> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler ((AnnotatedException SomeException -> ApplicationFailure)
-> ApplicationFailureHandler)
-> (AnnotatedException SomeException -> ApplicationFailure)
-> ApplicationFailureHandler
forall a b. (a -> b) -> a -> b
$ \AnnotatedException SomeException
e -> (SomeException -> ApplicationFailure)
-> AnnotatedException SomeException -> ApplicationFailure
forall e.
Exception e =>
(e -> ApplicationFailure)
-> AnnotatedException e -> ApplicationFailure
annotationHandler SomeException -> ApplicationFailure
forall e. Exception e => e -> ApplicationFailure
basicHandler (AnnotatedException SomeException
e :: AnnotatedException SomeException)]
standardApplicationFailureHandlers :: [ApplicationFailureHandler]
standardApplicationFailureHandlers :: [ApplicationFailureHandler]
standardApplicationFailureHandlers =
[ (ApplicationFailure -> ApplicationFailure)
-> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler ((ApplicationFailure -> ApplicationFailure)
-> ApplicationFailureHandler)
-> (ApplicationFailure -> ApplicationFailure)
-> ApplicationFailureHandler
forall a b. (a -> b) -> a -> b
$ \h :: ApplicationFailure
h@ApplicationFailure {} -> ApplicationFailure
h
, (SomeApplicationFailure -> ApplicationFailure)
-> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler ((SomeApplicationFailure -> ApplicationFailure)
-> ApplicationFailureHandler)
-> (SomeApplicationFailure -> ApplicationFailure)
-> ApplicationFailureHandler
forall a b. (a -> b) -> a -> b
$ \(SomeApplicationFailure e
e) -> e -> ApplicationFailure
forall e. ToApplicationFailure e => e -> ApplicationFailure
toApplicationFailure e
e
, (ErrorCall -> ApplicationFailure) -> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler ((ErrorCall -> ApplicationFailure) -> ApplicationFailureHandler)
-> (ErrorCall -> ApplicationFailure) -> ApplicationFailureHandler
forall a b. (a -> b) -> a -> b
$ \(ErrorCallWithLocation String
msg String
loc) ->
ApplicationFailure
{ type' :: Text
type' = Text
"ErrorCallWithLocation"
, message :: Text
message = String -> Text
pack String
msg
, nonRetryable :: Bool
nonRetryable = Bool
False
, details :: [Payload]
details = []
, stack :: Text
stack = String -> Text
pack String
loc
, nextRetryDelay :: Maybe Duration
nextRetryDelay = Maybe Duration
forall a. Maybe a
Nothing
}
]
data ActivityFailure = ActivityFailure
{ ActivityFailure -> Text
message :: Text
, ActivityFailure -> ActivityType
activityType :: ActivityType
, ActivityFailure -> ActivityId
activityId :: ActivityId
, ActivityFailure -> RetryState
retryState :: RetryState
, ActivityFailure -> Text
identity :: Text
, ActivityFailure -> ApplicationFailure
cause :: ApplicationFailure
, ActivityFailure -> Int64
scheduledEventId :: Int64
, ActivityFailure -> Int64
startedEventId :: Int64
, ActivityFailure -> ActivityFailureInfo
original :: ActivityFailureInfo
, ActivityFailure -> Text
stack :: Text
}
deriving stock (Int -> ActivityFailure -> ShowS
[ActivityFailure] -> ShowS
ActivityFailure -> String
(Int -> ActivityFailure -> ShowS)
-> (ActivityFailure -> String)
-> ([ActivityFailure] -> ShowS)
-> Show ActivityFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivityFailure -> ShowS
showsPrec :: Int -> ActivityFailure -> ShowS
$cshow :: ActivityFailure -> String
show :: ActivityFailure -> String
$cshowList :: [ActivityFailure] -> ShowS
showList :: [ActivityFailure] -> ShowS
Show, ActivityFailure -> ActivityFailure -> Bool
(ActivityFailure -> ActivityFailure -> Bool)
-> (ActivityFailure -> ActivityFailure -> Bool)
-> Eq ActivityFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActivityFailure -> ActivityFailure -> Bool
== :: ActivityFailure -> ActivityFailure -> Bool
$c/= :: ActivityFailure -> ActivityFailure -> Bool
/= :: ActivityFailure -> ActivityFailure -> Bool
Eq)
instance Exception ActivityFailure
data NonRetryableError = NonRetryableError Bool
deriving stock (Int -> NonRetryableError -> ShowS
[NonRetryableError] -> ShowS
NonRetryableError -> String
(Int -> NonRetryableError -> ShowS)
-> (NonRetryableError -> String)
-> ([NonRetryableError] -> ShowS)
-> Show NonRetryableError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonRetryableError -> ShowS
showsPrec :: Int -> NonRetryableError -> ShowS
$cshow :: NonRetryableError -> String
show :: NonRetryableError -> String
$cshowList :: [NonRetryableError] -> ShowS
showList :: [NonRetryableError] -> ShowS
Show, NonRetryableError -> NonRetryableError -> Bool
(NonRetryableError -> NonRetryableError -> Bool)
-> (NonRetryableError -> NonRetryableError -> Bool)
-> Eq NonRetryableError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonRetryableError -> NonRetryableError -> Bool
== :: NonRetryableError -> NonRetryableError -> Bool
$c/= :: NonRetryableError -> NonRetryableError -> Bool
/= :: NonRetryableError -> NonRetryableError -> Bool
Eq)
annotateNonRetryableError :: Annotation
annotateNonRetryableError :: Annotation
annotateNonRetryableError = NonRetryableError -> Annotation
forall a. AnnC a => a -> Annotation
Annotation (NonRetryableError -> Annotation)
-> NonRetryableError -> Annotation
forall a b. (a -> b) -> a -> b
$ Bool -> NonRetryableError
NonRetryableError Bool
True
annotateRetryableError :: Annotation
annotateRetryableError :: Annotation
annotateRetryableError = NonRetryableError -> Annotation
forall a. AnnC a => a -> Annotation
Annotation (NonRetryableError -> Annotation)
-> NonRetryableError -> Annotation
forall a b. (a -> b) -> a -> b
$ Bool -> NonRetryableError
NonRetryableError Bool
False
data NextRetryDelay = NextRetryDelay (Maybe Duration)
deriving stock (Int -> NextRetryDelay -> ShowS
[NextRetryDelay] -> ShowS
NextRetryDelay -> String
(Int -> NextRetryDelay -> ShowS)
-> (NextRetryDelay -> String)
-> ([NextRetryDelay] -> ShowS)
-> Show NextRetryDelay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NextRetryDelay -> ShowS
showsPrec :: Int -> NextRetryDelay -> ShowS
$cshow :: NextRetryDelay -> String
show :: NextRetryDelay -> String
$cshowList :: [NextRetryDelay] -> ShowS
showList :: [NextRetryDelay] -> ShowS
Show, NextRetryDelay -> NextRetryDelay -> Bool
(NextRetryDelay -> NextRetryDelay -> Bool)
-> (NextRetryDelay -> NextRetryDelay -> Bool) -> Eq NextRetryDelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NextRetryDelay -> NextRetryDelay -> Bool
== :: NextRetryDelay -> NextRetryDelay -> Bool
$c/= :: NextRetryDelay -> NextRetryDelay -> Bool
/= :: NextRetryDelay -> NextRetryDelay -> Bool
Eq)
annotateNextRetryDelay :: Duration -> Annotation
annotateNextRetryDelay :: Duration -> Annotation
annotateNextRetryDelay = NextRetryDelay -> Annotation
forall a. AnnC a => a -> Annotation
Annotation (NextRetryDelay -> Annotation)
-> (Duration -> NextRetryDelay) -> Duration -> Annotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Duration -> NextRetryDelay
NextRetryDelay (Maybe Duration -> NextRetryDelay)
-> (Duration -> Maybe Duration) -> Duration -> NextRetryDelay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> Maybe Duration
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
annotateNoRetryDelay :: Annotation
annotateNoRetryDelay :: Annotation
annotateNoRetryDelay = NextRetryDelay -> Annotation
forall a. AnnC a => a -> Annotation
Annotation (NextRetryDelay -> Annotation) -> NextRetryDelay -> Annotation
forall a b. (a -> b) -> a -> b
$ Maybe Duration -> NextRetryDelay
NextRetryDelay Maybe Duration
forall a. Maybe a
Nothing
data SomeActivityException = forall e. Exception e => SomeActivityException e
instance Show SomeActivityException where
show :: SomeActivityException -> String
show (SomeActivityException e
e) = e -> String
forall a. Show a => a -> String
show e
e
instance Exception SomeActivityException
activityExceptionToException :: Exception e => e -> SomeException
activityExceptionToException :: forall e. Exception e => e -> SomeException
activityExceptionToException = SomeActivityException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeActivityException -> SomeException)
-> (e -> SomeActivityException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeActivityException
forall e. Exception e => e -> SomeActivityException
SomeActivityException
activityExceptionFromException :: Exception e => SomeException -> Maybe e
activityExceptionFromException :: forall e. Exception e => SomeException -> Maybe e
activityExceptionFromException SomeException
x = do
SomeActivityException a <- SomeException -> Maybe SomeActivityException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
cast a
data CompleteAsync = CompleteAsync
deriving stock (Int -> CompleteAsync -> ShowS
[CompleteAsync] -> ShowS
CompleteAsync -> String
(Int -> CompleteAsync -> ShowS)
-> (CompleteAsync -> String)
-> ([CompleteAsync] -> ShowS)
-> Show CompleteAsync
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompleteAsync -> ShowS
showsPrec :: Int -> CompleteAsync -> ShowS
$cshow :: CompleteAsync -> String
show :: CompleteAsync -> String
$cshowList :: [CompleteAsync] -> ShowS
showList :: [CompleteAsync] -> ShowS
Show)
instance Exception CompleteAsync where
toException :: CompleteAsync -> SomeException
toException = CompleteAsync -> SomeException
forall e. Exception e => e -> SomeException
activityExceptionToException
fromException :: SomeException -> Maybe CompleteAsync
fromException = SomeException -> Maybe CompleteAsync
forall e. Exception e => SomeException -> Maybe e
activityExceptionFromException
data WorkflowExecutionClosed
= WorkflowExecutionFailed WorkflowExecutionFailedEventAttributes
| WorkflowExecutionTimedOut
| WorkflowExecutionCanceled
| WorkflowExecutionTerminated
| WorkflowExecutionContinuedAsNew
deriving stock (Int -> WorkflowExecutionClosed -> ShowS
[WorkflowExecutionClosed] -> ShowS
WorkflowExecutionClosed -> String
(Int -> WorkflowExecutionClosed -> ShowS)
-> (WorkflowExecutionClosed -> String)
-> ([WorkflowExecutionClosed] -> ShowS)
-> Show WorkflowExecutionClosed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowExecutionClosed -> ShowS
showsPrec :: Int -> WorkflowExecutionClosed -> ShowS
$cshow :: WorkflowExecutionClosed -> String
show :: WorkflowExecutionClosed -> String
$cshowList :: [WorkflowExecutionClosed] -> ShowS
showList :: [WorkflowExecutionClosed] -> ShowS
Show, WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool
(WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool)
-> (WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool)
-> Eq WorkflowExecutionClosed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool
== :: WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool
$c/= :: WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool
/= :: WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool
Eq)
instance Exception WorkflowExecutionClosed
data WorkflowExecutionFailedAttributes = WorkflowExecutionFailedAttributes
{ WorkflowExecutionFailedAttributes -> Maybe Failure
failure :: Maybe Failure
, WorkflowExecutionFailedAttributes -> RetryState
retryState :: RetryState
, WorkflowExecutionFailedAttributes -> Int64
workflowTaskCompletedEventId :: Int64
, WorkflowExecutionFailedAttributes -> Maybe RunId
newExecutionRunId :: Maybe RunId
}
deriving stock (Int -> WorkflowExecutionFailedAttributes -> ShowS
[WorkflowExecutionFailedAttributes] -> ShowS
WorkflowExecutionFailedAttributes -> String
(Int -> WorkflowExecutionFailedAttributes -> ShowS)
-> (WorkflowExecutionFailedAttributes -> String)
-> ([WorkflowExecutionFailedAttributes] -> ShowS)
-> Show WorkflowExecutionFailedAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowExecutionFailedAttributes -> ShowS
showsPrec :: Int -> WorkflowExecutionFailedAttributes -> ShowS
$cshow :: WorkflowExecutionFailedAttributes -> String
show :: WorkflowExecutionFailedAttributes -> String
$cshowList :: [WorkflowExecutionFailedAttributes] -> ShowS
showList :: [WorkflowExecutionFailedAttributes] -> ShowS
Show, WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool
(WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool)
-> (WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool)
-> Eq WorkflowExecutionFailedAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool
== :: WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool
$c/= :: WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool
/= :: WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool
Eq)