{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
module Temporal.Common where
import Data.Aeson (FromJSON, ToJSON)
import Data.ByteString (ByteString)
import Data.Data (Data)
import Data.Hashable (Hashable)
import Data.Int (Int32)
import Data.Kind
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.ProtoLens
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock.System
import Data.Typeable
import Data.Vector (Vector)
import Data.Word (Word32)
import GHC.Generics (Generic)
import Instances.TH.Lift
import Language.Haskell.TH.Syntax (Lift)
import Lens.Family2
import qualified Proto.Google.Protobuf.Timestamp as Timestamp
import qualified Proto.Google.Protobuf.Timestamp_Fields as Timestamp
import qualified Proto.Temporal.Api.Common.V1.Message as Message
import qualified Proto.Temporal.Api.Common.V1.Message_Fields as Message
import qualified Proto.Temporal.Api.Enums.V1.Workflow as Workflow
import Temporal.Duration
import Temporal.Payload
newtype WorkflowType = WorkflowType {WorkflowType -> Text
rawWorkflowType :: Text}
deriving stock ((forall (m :: * -> *). Quote m => WorkflowType -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
WorkflowType -> Code m WorkflowType)
-> Lift WorkflowType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => WorkflowType -> m Exp
forall (m :: * -> *).
Quote m =>
WorkflowType -> Code m WorkflowType
$clift :: forall (m :: * -> *). Quote m => WorkflowType -> m Exp
lift :: forall (m :: * -> *). Quote m => WorkflowType -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
WorkflowType -> Code m WorkflowType
liftTyped :: forall (m :: * -> *).
Quote m =>
WorkflowType -> Code m WorkflowType
Lift)
deriving newtype (WorkflowType -> WorkflowType -> Bool
(WorkflowType -> WorkflowType -> Bool)
-> (WorkflowType -> WorkflowType -> Bool) -> Eq WorkflowType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkflowType -> WorkflowType -> Bool
== :: WorkflowType -> WorkflowType -> Bool
$c/= :: WorkflowType -> WorkflowType -> Bool
/= :: WorkflowType -> WorkflowType -> Bool
Eq, Eq WorkflowType
Eq WorkflowType =>
(WorkflowType -> WorkflowType -> Ordering)
-> (WorkflowType -> WorkflowType -> Bool)
-> (WorkflowType -> WorkflowType -> Bool)
-> (WorkflowType -> WorkflowType -> Bool)
-> (WorkflowType -> WorkflowType -> Bool)
-> (WorkflowType -> WorkflowType -> WorkflowType)
-> (WorkflowType -> WorkflowType -> WorkflowType)
-> Ord WorkflowType
WorkflowType -> WorkflowType -> Bool
WorkflowType -> WorkflowType -> Ordering
WorkflowType -> WorkflowType -> WorkflowType
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 :: WorkflowType -> WorkflowType -> Ordering
compare :: WorkflowType -> WorkflowType -> Ordering
$c< :: WorkflowType -> WorkflowType -> Bool
< :: WorkflowType -> WorkflowType -> Bool
$c<= :: WorkflowType -> WorkflowType -> Bool
<= :: WorkflowType -> WorkflowType -> Bool
$c> :: WorkflowType -> WorkflowType -> Bool
> :: WorkflowType -> WorkflowType -> Bool
$c>= :: WorkflowType -> WorkflowType -> Bool
>= :: WorkflowType -> WorkflowType -> Bool
$cmax :: WorkflowType -> WorkflowType -> WorkflowType
max :: WorkflowType -> WorkflowType -> WorkflowType
$cmin :: WorkflowType -> WorkflowType -> WorkflowType
min :: WorkflowType -> WorkflowType -> WorkflowType
Ord, Int -> WorkflowType -> ShowS
[WorkflowType] -> ShowS
WorkflowType -> String
(Int -> WorkflowType -> ShowS)
-> (WorkflowType -> String)
-> ([WorkflowType] -> ShowS)
-> Show WorkflowType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowType -> ShowS
showsPrec :: Int -> WorkflowType -> ShowS
$cshow :: WorkflowType -> String
show :: WorkflowType -> String
$cshowList :: [WorkflowType] -> ShowS
showList :: [WorkflowType] -> ShowS
Show, Eq WorkflowType
Eq WorkflowType =>
(Int -> WorkflowType -> Int)
-> (WorkflowType -> Int) -> Hashable WorkflowType
Int -> WorkflowType -> Int
WorkflowType -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> WorkflowType -> Int
hashWithSalt :: Int -> WorkflowType -> Int
$chash :: WorkflowType -> Int
hash :: WorkflowType -> Int
Hashable, String -> WorkflowType
(String -> WorkflowType) -> IsString WorkflowType
forall a. (String -> a) -> IsString a
$cfromString :: String -> WorkflowType
fromString :: String -> WorkflowType
IsString, [WorkflowType] -> Value
[WorkflowType] -> Encoding
WorkflowType -> Bool
WorkflowType -> Value
WorkflowType -> Encoding
(WorkflowType -> Value)
-> (WorkflowType -> Encoding)
-> ([WorkflowType] -> Value)
-> ([WorkflowType] -> Encoding)
-> (WorkflowType -> Bool)
-> ToJSON WorkflowType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: WorkflowType -> Value
toJSON :: WorkflowType -> Value
$ctoEncoding :: WorkflowType -> Encoding
toEncoding :: WorkflowType -> Encoding
$ctoJSONList :: [WorkflowType] -> Value
toJSONList :: [WorkflowType] -> Value
$ctoEncodingList :: [WorkflowType] -> Encoding
toEncodingList :: [WorkflowType] -> Encoding
$comitField :: WorkflowType -> Bool
omitField :: WorkflowType -> Bool
ToJSON, Maybe WorkflowType
Value -> Parser [WorkflowType]
Value -> Parser WorkflowType
(Value -> Parser WorkflowType)
-> (Value -> Parser [WorkflowType])
-> Maybe WorkflowType
-> FromJSON WorkflowType
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser WorkflowType
parseJSON :: Value -> Parser WorkflowType
$cparseJSONList :: Value -> Parser [WorkflowType]
parseJSONList :: Value -> Parser [WorkflowType]
$comittedField :: Maybe WorkflowType
omittedField :: Maybe WorkflowType
FromJSON)
newtype WorkflowId = WorkflowId {WorkflowId -> Text
rawWorkflowId :: Text}
deriving stock ((forall (m :: * -> *). Quote m => WorkflowId -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
WorkflowId -> Code m WorkflowId)
-> Lift WorkflowId
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => WorkflowId -> m Exp
forall (m :: * -> *). Quote m => WorkflowId -> Code m WorkflowId
$clift :: forall (m :: * -> *). Quote m => WorkflowId -> m Exp
lift :: forall (m :: * -> *). Quote m => WorkflowId -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => WorkflowId -> Code m WorkflowId
liftTyped :: forall (m :: * -> *). Quote m => WorkflowId -> Code m WorkflowId
Lift)
deriving newtype (WorkflowId -> WorkflowId -> Bool
(WorkflowId -> WorkflowId -> Bool)
-> (WorkflowId -> WorkflowId -> Bool) -> Eq WorkflowId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkflowId -> WorkflowId -> Bool
== :: WorkflowId -> WorkflowId -> Bool
$c/= :: WorkflowId -> WorkflowId -> Bool
/= :: WorkflowId -> WorkflowId -> Bool
Eq, Eq WorkflowId
Eq WorkflowId =>
(WorkflowId -> WorkflowId -> Ordering)
-> (WorkflowId -> WorkflowId -> Bool)
-> (WorkflowId -> WorkflowId -> Bool)
-> (WorkflowId -> WorkflowId -> Bool)
-> (WorkflowId -> WorkflowId -> Bool)
-> (WorkflowId -> WorkflowId -> WorkflowId)
-> (WorkflowId -> WorkflowId -> WorkflowId)
-> Ord WorkflowId
WorkflowId -> WorkflowId -> Bool
WorkflowId -> WorkflowId -> Ordering
WorkflowId -> WorkflowId -> WorkflowId
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 :: WorkflowId -> WorkflowId -> Ordering
compare :: WorkflowId -> WorkflowId -> Ordering
$c< :: WorkflowId -> WorkflowId -> Bool
< :: WorkflowId -> WorkflowId -> Bool
$c<= :: WorkflowId -> WorkflowId -> Bool
<= :: WorkflowId -> WorkflowId -> Bool
$c> :: WorkflowId -> WorkflowId -> Bool
> :: WorkflowId -> WorkflowId -> Bool
$c>= :: WorkflowId -> WorkflowId -> Bool
>= :: WorkflowId -> WorkflowId -> Bool
$cmax :: WorkflowId -> WorkflowId -> WorkflowId
max :: WorkflowId -> WorkflowId -> WorkflowId
$cmin :: WorkflowId -> WorkflowId -> WorkflowId
min :: WorkflowId -> WorkflowId -> WorkflowId
Ord, Int -> WorkflowId -> ShowS
[WorkflowId] -> ShowS
WorkflowId -> String
(Int -> WorkflowId -> ShowS)
-> (WorkflowId -> String)
-> ([WorkflowId] -> ShowS)
-> Show WorkflowId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowId -> ShowS
showsPrec :: Int -> WorkflowId -> ShowS
$cshow :: WorkflowId -> String
show :: WorkflowId -> String
$cshowList :: [WorkflowId] -> ShowS
showList :: [WorkflowId] -> ShowS
Show, Eq WorkflowId
Eq WorkflowId =>
(Int -> WorkflowId -> Int)
-> (WorkflowId -> Int) -> Hashable WorkflowId
Int -> WorkflowId -> Int
WorkflowId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> WorkflowId -> Int
hashWithSalt :: Int -> WorkflowId -> Int
$chash :: WorkflowId -> Int
hash :: WorkflowId -> Int
Hashable, String -> WorkflowId
(String -> WorkflowId) -> IsString WorkflowId
forall a. (String -> a) -> IsString a
$cfromString :: String -> WorkflowId
fromString :: String -> WorkflowId
IsString, [WorkflowId] -> Value
[WorkflowId] -> Encoding
WorkflowId -> Bool
WorkflowId -> Value
WorkflowId -> Encoding
(WorkflowId -> Value)
-> (WorkflowId -> Encoding)
-> ([WorkflowId] -> Value)
-> ([WorkflowId] -> Encoding)
-> (WorkflowId -> Bool)
-> ToJSON WorkflowId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: WorkflowId -> Value
toJSON :: WorkflowId -> Value
$ctoEncoding :: WorkflowId -> Encoding
toEncoding :: WorkflowId -> Encoding
$ctoJSONList :: [WorkflowId] -> Value
toJSONList :: [WorkflowId] -> Value
$ctoEncodingList :: [WorkflowId] -> Encoding
toEncodingList :: [WorkflowId] -> Encoding
$comitField :: WorkflowId -> Bool
omitField :: WorkflowId -> Bool
ToJSON, Maybe WorkflowId
Value -> Parser [WorkflowId]
Value -> Parser WorkflowId
(Value -> Parser WorkflowId)
-> (Value -> Parser [WorkflowId])
-> Maybe WorkflowId
-> FromJSON WorkflowId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser WorkflowId
parseJSON :: Value -> Parser WorkflowId
$cparseJSONList :: Value -> Parser [WorkflowId]
parseJSONList :: Value -> Parser [WorkflowId]
$comittedField :: Maybe WorkflowId
omittedField :: Maybe WorkflowId
FromJSON)
newtype Namespace = Namespace {Namespace -> Text
rawNamespace :: Text}
deriving stock ((forall (m :: * -> *). Quote m => Namespace -> m Exp)
-> (forall (m :: * -> *). Quote m => Namespace -> Code m Namespace)
-> Lift Namespace
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Namespace -> m Exp
forall (m :: * -> *). Quote m => Namespace -> Code m Namespace
$clift :: forall (m :: * -> *). Quote m => Namespace -> m Exp
lift :: forall (m :: * -> *). Quote m => Namespace -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Namespace -> Code m Namespace
liftTyped :: forall (m :: * -> *). Quote m => Namespace -> Code m Namespace
Lift)
deriving newtype (Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
/= :: Namespace -> Namespace -> Bool
Eq, Eq Namespace
Eq Namespace =>
(Namespace -> Namespace -> Ordering)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Namespace)
-> (Namespace -> Namespace -> Namespace)
-> Ord Namespace
Namespace -> Namespace -> Bool
Namespace -> Namespace -> Ordering
Namespace -> Namespace -> Namespace
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 :: Namespace -> Namespace -> Ordering
compare :: Namespace -> Namespace -> Ordering
$c< :: Namespace -> Namespace -> Bool
< :: Namespace -> Namespace -> Bool
$c<= :: Namespace -> Namespace -> Bool
<= :: Namespace -> Namespace -> Bool
$c> :: Namespace -> Namespace -> Bool
> :: Namespace -> Namespace -> Bool
$c>= :: Namespace -> Namespace -> Bool
>= :: Namespace -> Namespace -> Bool
$cmax :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
min :: Namespace -> Namespace -> Namespace
Ord, Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Namespace -> ShowS
showsPrec :: Int -> Namespace -> ShowS
$cshow :: Namespace -> String
show :: Namespace -> String
$cshowList :: [Namespace] -> ShowS
showList :: [Namespace] -> ShowS
Show, Eq Namespace
Eq Namespace =>
(Int -> Namespace -> Int)
-> (Namespace -> Int) -> Hashable Namespace
Int -> Namespace -> Int
Namespace -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Namespace -> Int
hashWithSalt :: Int -> Namespace -> Int
$chash :: Namespace -> Int
hash :: Namespace -> Int
Hashable, String -> Namespace
(String -> Namespace) -> IsString Namespace
forall a. (String -> a) -> IsString a
$cfromString :: String -> Namespace
fromString :: String -> Namespace
IsString, [Namespace] -> Value
[Namespace] -> Encoding
Namespace -> Bool
Namespace -> Value
Namespace -> Encoding
(Namespace -> Value)
-> (Namespace -> Encoding)
-> ([Namespace] -> Value)
-> ([Namespace] -> Encoding)
-> (Namespace -> Bool)
-> ToJSON Namespace
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Namespace -> Value
toJSON :: Namespace -> Value
$ctoEncoding :: Namespace -> Encoding
toEncoding :: Namespace -> Encoding
$ctoJSONList :: [Namespace] -> Value
toJSONList :: [Namespace] -> Value
$ctoEncodingList :: [Namespace] -> Encoding
toEncodingList :: [Namespace] -> Encoding
$comitField :: Namespace -> Bool
omitField :: Namespace -> Bool
ToJSON, Maybe Namespace
Value -> Parser [Namespace]
Value -> Parser Namespace
(Value -> Parser Namespace)
-> (Value -> Parser [Namespace])
-> Maybe Namespace
-> FromJSON Namespace
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Namespace
parseJSON :: Value -> Parser Namespace
$cparseJSONList :: Value -> Parser [Namespace]
parseJSONList :: Value -> Parser [Namespace]
$comittedField :: Maybe Namespace
omittedField :: Maybe Namespace
FromJSON)
newtype RunId = RunId {RunId -> Text
rawRunId :: Text}
deriving stock ((forall (m :: * -> *). Quote m => RunId -> m Exp)
-> (forall (m :: * -> *). Quote m => RunId -> Code m RunId)
-> Lift RunId
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => RunId -> m Exp
forall (m :: * -> *). Quote m => RunId -> Code m RunId
$clift :: forall (m :: * -> *). Quote m => RunId -> m Exp
lift :: forall (m :: * -> *). Quote m => RunId -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => RunId -> Code m RunId
liftTyped :: forall (m :: * -> *). Quote m => RunId -> Code m RunId
Lift)
deriving newtype (RunId -> RunId -> Bool
(RunId -> RunId -> Bool) -> (RunId -> RunId -> Bool) -> Eq RunId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunId -> RunId -> Bool
== :: RunId -> RunId -> Bool
$c/= :: RunId -> RunId -> Bool
/= :: RunId -> RunId -> Bool
Eq, Eq RunId
Eq RunId =>
(RunId -> RunId -> Ordering)
-> (RunId -> RunId -> Bool)
-> (RunId -> RunId -> Bool)
-> (RunId -> RunId -> Bool)
-> (RunId -> RunId -> Bool)
-> (RunId -> RunId -> RunId)
-> (RunId -> RunId -> RunId)
-> Ord RunId
RunId -> RunId -> Bool
RunId -> RunId -> Ordering
RunId -> RunId -> RunId
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 :: RunId -> RunId -> Ordering
compare :: RunId -> RunId -> Ordering
$c< :: RunId -> RunId -> Bool
< :: RunId -> RunId -> Bool
$c<= :: RunId -> RunId -> Bool
<= :: RunId -> RunId -> Bool
$c> :: RunId -> RunId -> Bool
> :: RunId -> RunId -> Bool
$c>= :: RunId -> RunId -> Bool
>= :: RunId -> RunId -> Bool
$cmax :: RunId -> RunId -> RunId
max :: RunId -> RunId -> RunId
$cmin :: RunId -> RunId -> RunId
min :: RunId -> RunId -> RunId
Ord, Int -> RunId -> ShowS
[RunId] -> ShowS
RunId -> String
(Int -> RunId -> ShowS)
-> (RunId -> String) -> ([RunId] -> ShowS) -> Show RunId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunId -> ShowS
showsPrec :: Int -> RunId -> ShowS
$cshow :: RunId -> String
show :: RunId -> String
$cshowList :: [RunId] -> ShowS
showList :: [RunId] -> ShowS
Show, Eq RunId
Eq RunId =>
(Int -> RunId -> Int) -> (RunId -> Int) -> Hashable RunId
Int -> RunId -> Int
RunId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> RunId -> Int
hashWithSalt :: Int -> RunId -> Int
$chash :: RunId -> Int
hash :: RunId -> Int
Hashable, String -> RunId
(String -> RunId) -> IsString RunId
forall a. (String -> a) -> IsString a
$cfromString :: String -> RunId
fromString :: String -> RunId
IsString, [RunId] -> Value
[RunId] -> Encoding
RunId -> Bool
RunId -> Value
RunId -> Encoding
(RunId -> Value)
-> (RunId -> Encoding)
-> ([RunId] -> Value)
-> ([RunId] -> Encoding)
-> (RunId -> Bool)
-> ToJSON RunId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RunId -> Value
toJSON :: RunId -> Value
$ctoEncoding :: RunId -> Encoding
toEncoding :: RunId -> Encoding
$ctoJSONList :: [RunId] -> Value
toJSONList :: [RunId] -> Value
$ctoEncodingList :: [RunId] -> Encoding
toEncodingList :: [RunId] -> Encoding
$comitField :: RunId -> Bool
omitField :: RunId -> Bool
ToJSON, Maybe RunId
Value -> Parser [RunId]
Value -> Parser RunId
(Value -> Parser RunId)
-> (Value -> Parser [RunId]) -> Maybe RunId -> FromJSON RunId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RunId
parseJSON :: Value -> Parser RunId
$cparseJSONList :: Value -> Parser [RunId]
parseJSONList :: Value -> Parser [RunId]
$comittedField :: Maybe RunId
omittedField :: Maybe RunId
FromJSON)
newtype PatchId = PatchId {PatchId -> Text
rawPatchId :: Text}
deriving stock ((forall (m :: * -> *). Quote m => PatchId -> m Exp)
-> (forall (m :: * -> *). Quote m => PatchId -> Code m PatchId)
-> Lift PatchId
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => PatchId -> m Exp
forall (m :: * -> *). Quote m => PatchId -> Code m PatchId
$clift :: forall (m :: * -> *). Quote m => PatchId -> m Exp
lift :: forall (m :: * -> *). Quote m => PatchId -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => PatchId -> Code m PatchId
liftTyped :: forall (m :: * -> *). Quote m => PatchId -> Code m PatchId
Lift)
deriving newtype (PatchId -> PatchId -> Bool
(PatchId -> PatchId -> Bool)
-> (PatchId -> PatchId -> Bool) -> Eq PatchId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PatchId -> PatchId -> Bool
== :: PatchId -> PatchId -> Bool
$c/= :: PatchId -> PatchId -> Bool
/= :: PatchId -> PatchId -> Bool
Eq, Eq PatchId
Eq PatchId =>
(PatchId -> PatchId -> Ordering)
-> (PatchId -> PatchId -> Bool)
-> (PatchId -> PatchId -> Bool)
-> (PatchId -> PatchId -> Bool)
-> (PatchId -> PatchId -> Bool)
-> (PatchId -> PatchId -> PatchId)
-> (PatchId -> PatchId -> PatchId)
-> Ord PatchId
PatchId -> PatchId -> Bool
PatchId -> PatchId -> Ordering
PatchId -> PatchId -> PatchId
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 :: PatchId -> PatchId -> Ordering
compare :: PatchId -> PatchId -> Ordering
$c< :: PatchId -> PatchId -> Bool
< :: PatchId -> PatchId -> Bool
$c<= :: PatchId -> PatchId -> Bool
<= :: PatchId -> PatchId -> Bool
$c> :: PatchId -> PatchId -> Bool
> :: PatchId -> PatchId -> Bool
$c>= :: PatchId -> PatchId -> Bool
>= :: PatchId -> PatchId -> Bool
$cmax :: PatchId -> PatchId -> PatchId
max :: PatchId -> PatchId -> PatchId
$cmin :: PatchId -> PatchId -> PatchId
min :: PatchId -> PatchId -> PatchId
Ord, Int -> PatchId -> ShowS
[PatchId] -> ShowS
PatchId -> String
(Int -> PatchId -> ShowS)
-> (PatchId -> String) -> ([PatchId] -> ShowS) -> Show PatchId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatchId -> ShowS
showsPrec :: Int -> PatchId -> ShowS
$cshow :: PatchId -> String
show :: PatchId -> String
$cshowList :: [PatchId] -> ShowS
showList :: [PatchId] -> ShowS
Show, Eq PatchId
Eq PatchId =>
(Int -> PatchId -> Int) -> (PatchId -> Int) -> Hashable PatchId
Int -> PatchId -> Int
PatchId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> PatchId -> Int
hashWithSalt :: Int -> PatchId -> Int
$chash :: PatchId -> Int
hash :: PatchId -> Int
Hashable, String -> PatchId
(String -> PatchId) -> IsString PatchId
forall a. (String -> a) -> IsString a
$cfromString :: String -> PatchId
fromString :: String -> PatchId
IsString, [PatchId] -> Value
[PatchId] -> Encoding
PatchId -> Bool
PatchId -> Value
PatchId -> Encoding
(PatchId -> Value)
-> (PatchId -> Encoding)
-> ([PatchId] -> Value)
-> ([PatchId] -> Encoding)
-> (PatchId -> Bool)
-> ToJSON PatchId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PatchId -> Value
toJSON :: PatchId -> Value
$ctoEncoding :: PatchId -> Encoding
toEncoding :: PatchId -> Encoding
$ctoJSONList :: [PatchId] -> Value
toJSONList :: [PatchId] -> Value
$ctoEncodingList :: [PatchId] -> Encoding
toEncodingList :: [PatchId] -> Encoding
$comitField :: PatchId -> Bool
omitField :: PatchId -> Bool
ToJSON, Maybe PatchId
Value -> Parser [PatchId]
Value -> Parser PatchId
(Value -> Parser PatchId)
-> (Value -> Parser [PatchId]) -> Maybe PatchId -> FromJSON PatchId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PatchId
parseJSON :: Value -> Parser PatchId
$cparseJSONList :: Value -> Parser [PatchId]
parseJSONList :: Value -> Parser [PatchId]
$comittedField :: Maybe PatchId
omittedField :: Maybe PatchId
FromJSON)
newtype TaskQueue = TaskQueue {TaskQueue -> Text
rawTaskQueue :: Text}
deriving stock (Typeable TaskQueue
Typeable TaskQueue =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TaskQueue -> c TaskQueue)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TaskQueue)
-> (TaskQueue -> Constr)
-> (TaskQueue -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TaskQueue))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TaskQueue))
-> ((forall b. Data b => b -> b) -> TaskQueue -> TaskQueue)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TaskQueue -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TaskQueue -> r)
-> (forall u. (forall d. Data d => d -> u) -> TaskQueue -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> TaskQueue -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TaskQueue -> m TaskQueue)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TaskQueue -> m TaskQueue)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TaskQueue -> m TaskQueue)
-> Data TaskQueue
TaskQueue -> Constr
TaskQueue -> DataType
(forall b. Data b => b -> b) -> TaskQueue -> TaskQueue
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TaskQueue -> u
forall u. (forall d. Data d => d -> u) -> TaskQueue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TaskQueue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TaskQueue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TaskQueue -> m TaskQueue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TaskQueue -> m TaskQueue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TaskQueue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TaskQueue -> c TaskQueue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TaskQueue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TaskQueue)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TaskQueue -> c TaskQueue
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TaskQueue -> c TaskQueue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TaskQueue
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TaskQueue
$ctoConstr :: TaskQueue -> Constr
toConstr :: TaskQueue -> Constr
$cdataTypeOf :: TaskQueue -> DataType
dataTypeOf :: TaskQueue -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TaskQueue)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TaskQueue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TaskQueue)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TaskQueue)
$cgmapT :: (forall b. Data b => b -> b) -> TaskQueue -> TaskQueue
gmapT :: (forall b. Data b => b -> b) -> TaskQueue -> TaskQueue
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TaskQueue -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TaskQueue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TaskQueue -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TaskQueue -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TaskQueue -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TaskQueue -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TaskQueue -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TaskQueue -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TaskQueue -> m TaskQueue
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TaskQueue -> m TaskQueue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TaskQueue -> m TaskQueue
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TaskQueue -> m TaskQueue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TaskQueue -> m TaskQueue
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TaskQueue -> m TaskQueue
Data, (forall (m :: * -> *). Quote m => TaskQueue -> m Exp)
-> (forall (m :: * -> *). Quote m => TaskQueue -> Code m TaskQueue)
-> Lift TaskQueue
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TaskQueue -> m Exp
forall (m :: * -> *). Quote m => TaskQueue -> Code m TaskQueue
$clift :: forall (m :: * -> *). Quote m => TaskQueue -> m Exp
lift :: forall (m :: * -> *). Quote m => TaskQueue -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => TaskQueue -> Code m TaskQueue
liftTyped :: forall (m :: * -> *). Quote m => TaskQueue -> Code m TaskQueue
Lift)
deriving newtype (TaskQueue -> TaskQueue -> Bool
(TaskQueue -> TaskQueue -> Bool)
-> (TaskQueue -> TaskQueue -> Bool) -> Eq TaskQueue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TaskQueue -> TaskQueue -> Bool
== :: TaskQueue -> TaskQueue -> Bool
$c/= :: TaskQueue -> TaskQueue -> Bool
/= :: TaskQueue -> TaskQueue -> Bool
Eq, Eq TaskQueue
Eq TaskQueue =>
(TaskQueue -> TaskQueue -> Ordering)
-> (TaskQueue -> TaskQueue -> Bool)
-> (TaskQueue -> TaskQueue -> Bool)
-> (TaskQueue -> TaskQueue -> Bool)
-> (TaskQueue -> TaskQueue -> Bool)
-> (TaskQueue -> TaskQueue -> TaskQueue)
-> (TaskQueue -> TaskQueue -> TaskQueue)
-> Ord TaskQueue
TaskQueue -> TaskQueue -> Bool
TaskQueue -> TaskQueue -> Ordering
TaskQueue -> TaskQueue -> TaskQueue
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 :: TaskQueue -> TaskQueue -> Ordering
compare :: TaskQueue -> TaskQueue -> Ordering
$c< :: TaskQueue -> TaskQueue -> Bool
< :: TaskQueue -> TaskQueue -> Bool
$c<= :: TaskQueue -> TaskQueue -> Bool
<= :: TaskQueue -> TaskQueue -> Bool
$c> :: TaskQueue -> TaskQueue -> Bool
> :: TaskQueue -> TaskQueue -> Bool
$c>= :: TaskQueue -> TaskQueue -> Bool
>= :: TaskQueue -> TaskQueue -> Bool
$cmax :: TaskQueue -> TaskQueue -> TaskQueue
max :: TaskQueue -> TaskQueue -> TaskQueue
$cmin :: TaskQueue -> TaskQueue -> TaskQueue
min :: TaskQueue -> TaskQueue -> TaskQueue
Ord, Int -> TaskQueue -> ShowS
[TaskQueue] -> ShowS
TaskQueue -> String
(Int -> TaskQueue -> ShowS)
-> (TaskQueue -> String)
-> ([TaskQueue] -> ShowS)
-> Show TaskQueue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaskQueue -> ShowS
showsPrec :: Int -> TaskQueue -> ShowS
$cshow :: TaskQueue -> String
show :: TaskQueue -> String
$cshowList :: [TaskQueue] -> ShowS
showList :: [TaskQueue] -> ShowS
Show, Eq TaskQueue
Eq TaskQueue =>
(Int -> TaskQueue -> Int)
-> (TaskQueue -> Int) -> Hashable TaskQueue
Int -> TaskQueue -> Int
TaskQueue -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TaskQueue -> Int
hashWithSalt :: Int -> TaskQueue -> Int
$chash :: TaskQueue -> Int
hash :: TaskQueue -> Int
Hashable, String -> TaskQueue
(String -> TaskQueue) -> IsString TaskQueue
forall a. (String -> a) -> IsString a
$cfromString :: String -> TaskQueue
fromString :: String -> TaskQueue
IsString, [TaskQueue] -> Value
[TaskQueue] -> Encoding
TaskQueue -> Bool
TaskQueue -> Value
TaskQueue -> Encoding
(TaskQueue -> Value)
-> (TaskQueue -> Encoding)
-> ([TaskQueue] -> Value)
-> ([TaskQueue] -> Encoding)
-> (TaskQueue -> Bool)
-> ToJSON TaskQueue
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TaskQueue -> Value
toJSON :: TaskQueue -> Value
$ctoEncoding :: TaskQueue -> Encoding
toEncoding :: TaskQueue -> Encoding
$ctoJSONList :: [TaskQueue] -> Value
toJSONList :: [TaskQueue] -> Value
$ctoEncodingList :: [TaskQueue] -> Encoding
toEncodingList :: [TaskQueue] -> Encoding
$comitField :: TaskQueue -> Bool
omitField :: TaskQueue -> Bool
ToJSON, Maybe TaskQueue
Value -> Parser [TaskQueue]
Value -> Parser TaskQueue
(Value -> Parser TaskQueue)
-> (Value -> Parser [TaskQueue])
-> Maybe TaskQueue
-> FromJSON TaskQueue
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TaskQueue
parseJSON :: Value -> Parser TaskQueue
$cparseJSONList :: Value -> Parser [TaskQueue]
parseJSONList :: Value -> Parser [TaskQueue]
$comittedField :: Maybe TaskQueue
omittedField :: Maybe TaskQueue
FromJSON)
newtype ActivityType = ActivityType {ActivityType -> Text
rawActivityType :: Text}
deriving stock (Typeable ActivityType
Typeable ActivityType =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActivityType -> c ActivityType)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActivityType)
-> (ActivityType -> Constr)
-> (ActivityType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActivityType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActivityType))
-> ((forall b. Data b => b -> b) -> ActivityType -> ActivityType)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ActivityType -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ActivityType -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType)
-> Data ActivityType
ActivityType -> Constr
ActivityType -> DataType
(forall b. Data b => b -> b) -> ActivityType -> ActivityType
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ActivityType -> u
forall u. (forall d. Data d => d -> u) -> ActivityType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActivityType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActivityType -> c ActivityType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActivityType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActivityType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActivityType -> c ActivityType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActivityType -> c ActivityType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActivityType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActivityType
$ctoConstr :: ActivityType -> Constr
toConstr :: ActivityType -> Constr
$cdataTypeOf :: ActivityType -> DataType
dataTypeOf :: ActivityType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActivityType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActivityType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActivityType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActivityType)
$cgmapT :: (forall b. Data b => b -> b) -> ActivityType -> ActivityType
gmapT :: (forall b. Data b => b -> b) -> ActivityType -> ActivityType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ActivityType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ActivityType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ActivityType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ActivityType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
Data, (forall (m :: * -> *). Quote m => ActivityType -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
ActivityType -> Code m ActivityType)
-> Lift ActivityType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ActivityType -> m Exp
forall (m :: * -> *).
Quote m =>
ActivityType -> Code m ActivityType
$clift :: forall (m :: * -> *). Quote m => ActivityType -> m Exp
lift :: forall (m :: * -> *). Quote m => ActivityType -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ActivityType -> Code m ActivityType
liftTyped :: forall (m :: * -> *).
Quote m =>
ActivityType -> Code m ActivityType
Lift)
deriving newtype (ActivityType -> ActivityType -> Bool
(ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool) -> Eq ActivityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActivityType -> ActivityType -> Bool
== :: ActivityType -> ActivityType -> Bool
$c/= :: ActivityType -> ActivityType -> Bool
/= :: ActivityType -> ActivityType -> Bool
Eq, Eq ActivityType
Eq ActivityType =>
(ActivityType -> ActivityType -> Ordering)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> ActivityType)
-> (ActivityType -> ActivityType -> ActivityType)
-> Ord ActivityType
ActivityType -> ActivityType -> Bool
ActivityType -> ActivityType -> Ordering
ActivityType -> ActivityType -> ActivityType
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 :: ActivityType -> ActivityType -> Ordering
compare :: ActivityType -> ActivityType -> Ordering
$c< :: ActivityType -> ActivityType -> Bool
< :: ActivityType -> ActivityType -> Bool
$c<= :: ActivityType -> ActivityType -> Bool
<= :: ActivityType -> ActivityType -> Bool
$c> :: ActivityType -> ActivityType -> Bool
> :: ActivityType -> ActivityType -> Bool
$c>= :: ActivityType -> ActivityType -> Bool
>= :: ActivityType -> ActivityType -> Bool
$cmax :: ActivityType -> ActivityType -> ActivityType
max :: ActivityType -> ActivityType -> ActivityType
$cmin :: ActivityType -> ActivityType -> ActivityType
min :: ActivityType -> ActivityType -> ActivityType
Ord, Int -> ActivityType -> ShowS
[ActivityType] -> ShowS
ActivityType -> String
(Int -> ActivityType -> ShowS)
-> (ActivityType -> String)
-> ([ActivityType] -> ShowS)
-> Show ActivityType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivityType -> ShowS
showsPrec :: Int -> ActivityType -> ShowS
$cshow :: ActivityType -> String
show :: ActivityType -> String
$cshowList :: [ActivityType] -> ShowS
showList :: [ActivityType] -> ShowS
Show, Eq ActivityType
Eq ActivityType =>
(Int -> ActivityType -> Int)
-> (ActivityType -> Int) -> Hashable ActivityType
Int -> ActivityType -> Int
ActivityType -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ActivityType -> Int
hashWithSalt :: Int -> ActivityType -> Int
$chash :: ActivityType -> Int
hash :: ActivityType -> Int
Hashable, String -> ActivityType
(String -> ActivityType) -> IsString ActivityType
forall a. (String -> a) -> IsString a
$cfromString :: String -> ActivityType
fromString :: String -> ActivityType
IsString, [ActivityType] -> Value
[ActivityType] -> Encoding
ActivityType -> Bool
ActivityType -> Value
ActivityType -> Encoding
(ActivityType -> Value)
-> (ActivityType -> Encoding)
-> ([ActivityType] -> Value)
-> ([ActivityType] -> Encoding)
-> (ActivityType -> Bool)
-> ToJSON ActivityType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ActivityType -> Value
toJSON :: ActivityType -> Value
$ctoEncoding :: ActivityType -> Encoding
toEncoding :: ActivityType -> Encoding
$ctoJSONList :: [ActivityType] -> Value
toJSONList :: [ActivityType] -> Value
$ctoEncodingList :: [ActivityType] -> Encoding
toEncodingList :: [ActivityType] -> Encoding
$comitField :: ActivityType -> Bool
omitField :: ActivityType -> Bool
ToJSON, Maybe ActivityType
Value -> Parser [ActivityType]
Value -> Parser ActivityType
(Value -> Parser ActivityType)
-> (Value -> Parser [ActivityType])
-> Maybe ActivityType
-> FromJSON ActivityType
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ActivityType
parseJSON :: Value -> Parser ActivityType
$cparseJSONList :: Value -> Parser [ActivityType]
parseJSONList :: Value -> Parser [ActivityType]
$comittedField :: Maybe ActivityType
omittedField :: Maybe ActivityType
FromJSON)
newtype ActivityId = ActivityId {ActivityId -> Text
rawActivityId :: Text}
deriving stock ((forall (m :: * -> *). Quote m => ActivityId -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
ActivityId -> Code m ActivityId)
-> Lift ActivityId
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ActivityId -> m Exp
forall (m :: * -> *). Quote m => ActivityId -> Code m ActivityId
$clift :: forall (m :: * -> *). Quote m => ActivityId -> m Exp
lift :: forall (m :: * -> *). Quote m => ActivityId -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ActivityId -> Code m ActivityId
liftTyped :: forall (m :: * -> *). Quote m => ActivityId -> Code m ActivityId
Lift)
deriving newtype (ActivityId -> ActivityId -> Bool
(ActivityId -> ActivityId -> Bool)
-> (ActivityId -> ActivityId -> Bool) -> Eq ActivityId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActivityId -> ActivityId -> Bool
== :: ActivityId -> ActivityId -> Bool
$c/= :: ActivityId -> ActivityId -> Bool
/= :: ActivityId -> ActivityId -> Bool
Eq, Eq ActivityId
Eq ActivityId =>
(ActivityId -> ActivityId -> Ordering)
-> (ActivityId -> ActivityId -> Bool)
-> (ActivityId -> ActivityId -> Bool)
-> (ActivityId -> ActivityId -> Bool)
-> (ActivityId -> ActivityId -> Bool)
-> (ActivityId -> ActivityId -> ActivityId)
-> (ActivityId -> ActivityId -> ActivityId)
-> Ord ActivityId
ActivityId -> ActivityId -> Bool
ActivityId -> ActivityId -> Ordering
ActivityId -> ActivityId -> ActivityId
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 :: ActivityId -> ActivityId -> Ordering
compare :: ActivityId -> ActivityId -> Ordering
$c< :: ActivityId -> ActivityId -> Bool
< :: ActivityId -> ActivityId -> Bool
$c<= :: ActivityId -> ActivityId -> Bool
<= :: ActivityId -> ActivityId -> Bool
$c> :: ActivityId -> ActivityId -> Bool
> :: ActivityId -> ActivityId -> Bool
$c>= :: ActivityId -> ActivityId -> Bool
>= :: ActivityId -> ActivityId -> Bool
$cmax :: ActivityId -> ActivityId -> ActivityId
max :: ActivityId -> ActivityId -> ActivityId
$cmin :: ActivityId -> ActivityId -> ActivityId
min :: ActivityId -> ActivityId -> ActivityId
Ord, Int -> ActivityId -> ShowS
[ActivityId] -> ShowS
ActivityId -> String
(Int -> ActivityId -> ShowS)
-> (ActivityId -> String)
-> ([ActivityId] -> ShowS)
-> Show ActivityId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivityId -> ShowS
showsPrec :: Int -> ActivityId -> ShowS
$cshow :: ActivityId -> String
show :: ActivityId -> String
$cshowList :: [ActivityId] -> ShowS
showList :: [ActivityId] -> ShowS
Show, Eq ActivityId
Eq ActivityId =>
(Int -> ActivityId -> Int)
-> (ActivityId -> Int) -> Hashable ActivityId
Int -> ActivityId -> Int
ActivityId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ActivityId -> Int
hashWithSalt :: Int -> ActivityId -> Int
$chash :: ActivityId -> Int
hash :: ActivityId -> Int
Hashable, String -> ActivityId
(String -> ActivityId) -> IsString ActivityId
forall a. (String -> a) -> IsString a
$cfromString :: String -> ActivityId
fromString :: String -> ActivityId
IsString, [ActivityId] -> Value
[ActivityId] -> Encoding
ActivityId -> Bool
ActivityId -> Value
ActivityId -> Encoding
(ActivityId -> Value)
-> (ActivityId -> Encoding)
-> ([ActivityId] -> Value)
-> ([ActivityId] -> Encoding)
-> (ActivityId -> Bool)
-> ToJSON ActivityId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ActivityId -> Value
toJSON :: ActivityId -> Value
$ctoEncoding :: ActivityId -> Encoding
toEncoding :: ActivityId -> Encoding
$ctoJSONList :: [ActivityId] -> Value
toJSONList :: [ActivityId] -> Value
$ctoEncodingList :: [ActivityId] -> Encoding
toEncodingList :: [ActivityId] -> Encoding
$comitField :: ActivityId -> Bool
omitField :: ActivityId -> Bool
ToJSON, Maybe ActivityId
Value -> Parser [ActivityId]
Value -> Parser ActivityId
(Value -> Parser ActivityId)
-> (Value -> Parser [ActivityId])
-> Maybe ActivityId
-> FromJSON ActivityId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ActivityId
parseJSON :: Value -> Parser ActivityId
$cparseJSONList :: Value -> Parser [ActivityId]
parseJSONList :: Value -> Parser [ActivityId]
$comittedField :: Maybe ActivityId
omittedField :: Maybe ActivityId
FromJSON)
newtype ScheduleId = ScheduleId {ScheduleId -> Text
rawScheduleId :: Text}
deriving stock ((forall (m :: * -> *). Quote m => ScheduleId -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
ScheduleId -> Code m ScheduleId)
-> Lift ScheduleId
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ScheduleId -> m Exp
forall (m :: * -> *). Quote m => ScheduleId -> Code m ScheduleId
$clift :: forall (m :: * -> *). Quote m => ScheduleId -> m Exp
lift :: forall (m :: * -> *). Quote m => ScheduleId -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ScheduleId -> Code m ScheduleId
liftTyped :: forall (m :: * -> *). Quote m => ScheduleId -> Code m ScheduleId
Lift)
deriving newtype (ScheduleId -> ScheduleId -> Bool
(ScheduleId -> ScheduleId -> Bool)
-> (ScheduleId -> ScheduleId -> Bool) -> Eq ScheduleId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduleId -> ScheduleId -> Bool
== :: ScheduleId -> ScheduleId -> Bool
$c/= :: ScheduleId -> ScheduleId -> Bool
/= :: ScheduleId -> ScheduleId -> Bool
Eq, Eq ScheduleId
Eq ScheduleId =>
(ScheduleId -> ScheduleId -> Ordering)
-> (ScheduleId -> ScheduleId -> Bool)
-> (ScheduleId -> ScheduleId -> Bool)
-> (ScheduleId -> ScheduleId -> Bool)
-> (ScheduleId -> ScheduleId -> Bool)
-> (ScheduleId -> ScheduleId -> ScheduleId)
-> (ScheduleId -> ScheduleId -> ScheduleId)
-> Ord ScheduleId
ScheduleId -> ScheduleId -> Bool
ScheduleId -> ScheduleId -> Ordering
ScheduleId -> ScheduleId -> ScheduleId
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 :: ScheduleId -> ScheduleId -> Ordering
compare :: ScheduleId -> ScheduleId -> Ordering
$c< :: ScheduleId -> ScheduleId -> Bool
< :: ScheduleId -> ScheduleId -> Bool
$c<= :: ScheduleId -> ScheduleId -> Bool
<= :: ScheduleId -> ScheduleId -> Bool
$c> :: ScheduleId -> ScheduleId -> Bool
> :: ScheduleId -> ScheduleId -> Bool
$c>= :: ScheduleId -> ScheduleId -> Bool
>= :: ScheduleId -> ScheduleId -> Bool
$cmax :: ScheduleId -> ScheduleId -> ScheduleId
max :: ScheduleId -> ScheduleId -> ScheduleId
$cmin :: ScheduleId -> ScheduleId -> ScheduleId
min :: ScheduleId -> ScheduleId -> ScheduleId
Ord, Int -> ScheduleId -> ShowS
[ScheduleId] -> ShowS
ScheduleId -> String
(Int -> ScheduleId -> ShowS)
-> (ScheduleId -> String)
-> ([ScheduleId] -> ShowS)
-> Show ScheduleId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduleId -> ShowS
showsPrec :: Int -> ScheduleId -> ShowS
$cshow :: ScheduleId -> String
show :: ScheduleId -> String
$cshowList :: [ScheduleId] -> ShowS
showList :: [ScheduleId] -> ShowS
Show, Eq ScheduleId
Eq ScheduleId =>
(Int -> ScheduleId -> Int)
-> (ScheduleId -> Int) -> Hashable ScheduleId
Int -> ScheduleId -> Int
ScheduleId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ScheduleId -> Int
hashWithSalt :: Int -> ScheduleId -> Int
$chash :: ScheduleId -> Int
hash :: ScheduleId -> Int
Hashable, String -> ScheduleId
(String -> ScheduleId) -> IsString ScheduleId
forall a. (String -> a) -> IsString a
$cfromString :: String -> ScheduleId
fromString :: String -> ScheduleId
IsString, [ScheduleId] -> Value
[ScheduleId] -> Encoding
ScheduleId -> Bool
ScheduleId -> Value
ScheduleId -> Encoding
(ScheduleId -> Value)
-> (ScheduleId -> Encoding)
-> ([ScheduleId] -> Value)
-> ([ScheduleId] -> Encoding)
-> (ScheduleId -> Bool)
-> ToJSON ScheduleId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ScheduleId -> Value
toJSON :: ScheduleId -> Value
$ctoEncoding :: ScheduleId -> Encoding
toEncoding :: ScheduleId -> Encoding
$ctoJSONList :: [ScheduleId] -> Value
toJSONList :: [ScheduleId] -> Value
$ctoEncodingList :: [ScheduleId] -> Encoding
toEncodingList :: [ScheduleId] -> Encoding
$comitField :: ScheduleId -> Bool
omitField :: ScheduleId -> Bool
ToJSON, Maybe ScheduleId
Value -> Parser [ScheduleId]
Value -> Parser ScheduleId
(Value -> Parser ScheduleId)
-> (Value -> Parser [ScheduleId])
-> Maybe ScheduleId
-> FromJSON ScheduleId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ScheduleId
parseJSON :: Value -> Parser ScheduleId
$cparseJSONList :: Value -> Parser [ScheduleId]
parseJSONList :: Value -> Parser [ScheduleId]
$comittedField :: Maybe ScheduleId
omittedField :: Maybe ScheduleId
FromJSON)
newtype SignalId = SignalId {SignalId -> Text
rawSignalId :: Text}
deriving stock ((forall (m :: * -> *). Quote m => SignalId -> m Exp)
-> (forall (m :: * -> *). Quote m => SignalId -> Code m SignalId)
-> Lift SignalId
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SignalId -> m Exp
forall (m :: * -> *). Quote m => SignalId -> Code m SignalId
$clift :: forall (m :: * -> *). Quote m => SignalId -> m Exp
lift :: forall (m :: * -> *). Quote m => SignalId -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => SignalId -> Code m SignalId
liftTyped :: forall (m :: * -> *). Quote m => SignalId -> Code m SignalId
Lift)
deriving newtype (SignalId -> SignalId -> Bool
(SignalId -> SignalId -> Bool)
-> (SignalId -> SignalId -> Bool) -> Eq SignalId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignalId -> SignalId -> Bool
== :: SignalId -> SignalId -> Bool
$c/= :: SignalId -> SignalId -> Bool
/= :: SignalId -> SignalId -> Bool
Eq, Eq SignalId
Eq SignalId =>
(SignalId -> SignalId -> Ordering)
-> (SignalId -> SignalId -> Bool)
-> (SignalId -> SignalId -> Bool)
-> (SignalId -> SignalId -> Bool)
-> (SignalId -> SignalId -> Bool)
-> (SignalId -> SignalId -> SignalId)
-> (SignalId -> SignalId -> SignalId)
-> Ord SignalId
SignalId -> SignalId -> Bool
SignalId -> SignalId -> Ordering
SignalId -> SignalId -> SignalId
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 :: SignalId -> SignalId -> Ordering
compare :: SignalId -> SignalId -> Ordering
$c< :: SignalId -> SignalId -> Bool
< :: SignalId -> SignalId -> Bool
$c<= :: SignalId -> SignalId -> Bool
<= :: SignalId -> SignalId -> Bool
$c> :: SignalId -> SignalId -> Bool
> :: SignalId -> SignalId -> Bool
$c>= :: SignalId -> SignalId -> Bool
>= :: SignalId -> SignalId -> Bool
$cmax :: SignalId -> SignalId -> SignalId
max :: SignalId -> SignalId -> SignalId
$cmin :: SignalId -> SignalId -> SignalId
min :: SignalId -> SignalId -> SignalId
Ord, Int -> SignalId -> ShowS
[SignalId] -> ShowS
SignalId -> String
(Int -> SignalId -> ShowS)
-> (SignalId -> String) -> ([SignalId] -> ShowS) -> Show SignalId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignalId -> ShowS
showsPrec :: Int -> SignalId -> ShowS
$cshow :: SignalId -> String
show :: SignalId -> String
$cshowList :: [SignalId] -> ShowS
showList :: [SignalId] -> ShowS
Show, Eq SignalId
Eq SignalId =>
(Int -> SignalId -> Int) -> (SignalId -> Int) -> Hashable SignalId
Int -> SignalId -> Int
SignalId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SignalId -> Int
hashWithSalt :: Int -> SignalId -> Int
$chash :: SignalId -> Int
hash :: SignalId -> Int
Hashable, String -> SignalId
(String -> SignalId) -> IsString SignalId
forall a. (String -> a) -> IsString a
$cfromString :: String -> SignalId
fromString :: String -> SignalId
IsString, [SignalId] -> Value
[SignalId] -> Encoding
SignalId -> Bool
SignalId -> Value
SignalId -> Encoding
(SignalId -> Value)
-> (SignalId -> Encoding)
-> ([SignalId] -> Value)
-> ([SignalId] -> Encoding)
-> (SignalId -> Bool)
-> ToJSON SignalId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SignalId -> Value
toJSON :: SignalId -> Value
$ctoEncoding :: SignalId -> Encoding
toEncoding :: SignalId -> Encoding
$ctoJSONList :: [SignalId] -> Value
toJSONList :: [SignalId] -> Value
$ctoEncodingList :: [SignalId] -> Encoding
toEncodingList :: [SignalId] -> Encoding
$comitField :: SignalId -> Bool
omitField :: SignalId -> Bool
ToJSON, Maybe SignalId
Value -> Parser [SignalId]
Value -> Parser SignalId
(Value -> Parser SignalId)
-> (Value -> Parser [SignalId])
-> Maybe SignalId
-> FromJSON SignalId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SignalId
parseJSON :: Value -> Parser SignalId
$cparseJSONList :: Value -> Parser [SignalId]
parseJSONList :: Value -> Parser [SignalId]
$comittedField :: Maybe SignalId
omittedField :: Maybe SignalId
FromJSON)
newtype TimerId = TimerId {TimerId -> Text
rawTimerId :: Text}
deriving stock ((forall (m :: * -> *). Quote m => TimerId -> m Exp)
-> (forall (m :: * -> *). Quote m => TimerId -> Code m TimerId)
-> Lift TimerId
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TimerId -> m Exp
forall (m :: * -> *). Quote m => TimerId -> Code m TimerId
$clift :: forall (m :: * -> *). Quote m => TimerId -> m Exp
lift :: forall (m :: * -> *). Quote m => TimerId -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => TimerId -> Code m TimerId
liftTyped :: forall (m :: * -> *). Quote m => TimerId -> Code m TimerId
Lift)
deriving newtype (TimerId -> TimerId -> Bool
(TimerId -> TimerId -> Bool)
-> (TimerId -> TimerId -> Bool) -> Eq TimerId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimerId -> TimerId -> Bool
== :: TimerId -> TimerId -> Bool
$c/= :: TimerId -> TimerId -> Bool
/= :: TimerId -> TimerId -> Bool
Eq, Eq TimerId
Eq TimerId =>
(TimerId -> TimerId -> Ordering)
-> (TimerId -> TimerId -> Bool)
-> (TimerId -> TimerId -> Bool)
-> (TimerId -> TimerId -> Bool)
-> (TimerId -> TimerId -> Bool)
-> (TimerId -> TimerId -> TimerId)
-> (TimerId -> TimerId -> TimerId)
-> Ord TimerId
TimerId -> TimerId -> Bool
TimerId -> TimerId -> Ordering
TimerId -> TimerId -> TimerId
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 :: TimerId -> TimerId -> Ordering
compare :: TimerId -> TimerId -> Ordering
$c< :: TimerId -> TimerId -> Bool
< :: TimerId -> TimerId -> Bool
$c<= :: TimerId -> TimerId -> Bool
<= :: TimerId -> TimerId -> Bool
$c> :: TimerId -> TimerId -> Bool
> :: TimerId -> TimerId -> Bool
$c>= :: TimerId -> TimerId -> Bool
>= :: TimerId -> TimerId -> Bool
$cmax :: TimerId -> TimerId -> TimerId
max :: TimerId -> TimerId -> TimerId
$cmin :: TimerId -> TimerId -> TimerId
min :: TimerId -> TimerId -> TimerId
Ord, Int -> TimerId -> ShowS
[TimerId] -> ShowS
TimerId -> String
(Int -> TimerId -> ShowS)
-> (TimerId -> String) -> ([TimerId] -> ShowS) -> Show TimerId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimerId -> ShowS
showsPrec :: Int -> TimerId -> ShowS
$cshow :: TimerId -> String
show :: TimerId -> String
$cshowList :: [TimerId] -> ShowS
showList :: [TimerId] -> ShowS
Show, Eq TimerId
Eq TimerId =>
(Int -> TimerId -> Int) -> (TimerId -> Int) -> Hashable TimerId
Int -> TimerId -> Int
TimerId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TimerId -> Int
hashWithSalt :: Int -> TimerId -> Int
$chash :: TimerId -> Int
hash :: TimerId -> Int
Hashable, String -> TimerId
(String -> TimerId) -> IsString TimerId
forall a. (String -> a) -> IsString a
$cfromString :: String -> TimerId
fromString :: String -> TimerId
IsString, [TimerId] -> Value
[TimerId] -> Encoding
TimerId -> Bool
TimerId -> Value
TimerId -> Encoding
(TimerId -> Value)
-> (TimerId -> Encoding)
-> ([TimerId] -> Value)
-> ([TimerId] -> Encoding)
-> (TimerId -> Bool)
-> ToJSON TimerId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TimerId -> Value
toJSON :: TimerId -> Value
$ctoEncoding :: TimerId -> Encoding
toEncoding :: TimerId -> Encoding
$ctoJSONList :: [TimerId] -> Value
toJSONList :: [TimerId] -> Value
$ctoEncodingList :: [TimerId] -> Encoding
toEncodingList :: [TimerId] -> Encoding
$comitField :: TimerId -> Bool
omitField :: TimerId -> Bool
ToJSON, Maybe TimerId
Value -> Parser [TimerId]
Value -> Parser TimerId
(Value -> Parser TimerId)
-> (Value -> Parser [TimerId]) -> Maybe TimerId -> FromJSON TimerId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TimerId
parseJSON :: Value -> Parser TimerId
$cparseJSONList :: Value -> Parser [TimerId]
parseJSONList :: Value -> Parser [TimerId]
$comittedField :: Maybe TimerId
omittedField :: Maybe TimerId
FromJSON)
newtype CancellationId = CancellationId {CancellationId -> Text
rawCancellationId :: Text}
deriving stock ((forall (m :: * -> *). Quote m => CancellationId -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
CancellationId -> Code m CancellationId)
-> Lift CancellationId
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => CancellationId -> m Exp
forall (m :: * -> *).
Quote m =>
CancellationId -> Code m CancellationId
$clift :: forall (m :: * -> *). Quote m => CancellationId -> m Exp
lift :: forall (m :: * -> *). Quote m => CancellationId -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
CancellationId -> Code m CancellationId
liftTyped :: forall (m :: * -> *).
Quote m =>
CancellationId -> Code m CancellationId
Lift)
deriving newtype (CancellationId -> CancellationId -> Bool
(CancellationId -> CancellationId -> Bool)
-> (CancellationId -> CancellationId -> Bool) -> Eq CancellationId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CancellationId -> CancellationId -> Bool
== :: CancellationId -> CancellationId -> Bool
$c/= :: CancellationId -> CancellationId -> Bool
/= :: CancellationId -> CancellationId -> Bool
Eq, Eq CancellationId
Eq CancellationId =>
(CancellationId -> CancellationId -> Ordering)
-> (CancellationId -> CancellationId -> Bool)
-> (CancellationId -> CancellationId -> Bool)
-> (CancellationId -> CancellationId -> Bool)
-> (CancellationId -> CancellationId -> Bool)
-> (CancellationId -> CancellationId -> CancellationId)
-> (CancellationId -> CancellationId -> CancellationId)
-> Ord CancellationId
CancellationId -> CancellationId -> Bool
CancellationId -> CancellationId -> Ordering
CancellationId -> CancellationId -> CancellationId
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 :: CancellationId -> CancellationId -> Ordering
compare :: CancellationId -> CancellationId -> Ordering
$c< :: CancellationId -> CancellationId -> Bool
< :: CancellationId -> CancellationId -> Bool
$c<= :: CancellationId -> CancellationId -> Bool
<= :: CancellationId -> CancellationId -> Bool
$c> :: CancellationId -> CancellationId -> Bool
> :: CancellationId -> CancellationId -> Bool
$c>= :: CancellationId -> CancellationId -> Bool
>= :: CancellationId -> CancellationId -> Bool
$cmax :: CancellationId -> CancellationId -> CancellationId
max :: CancellationId -> CancellationId -> CancellationId
$cmin :: CancellationId -> CancellationId -> CancellationId
min :: CancellationId -> CancellationId -> CancellationId
Ord, Int -> CancellationId -> ShowS
[CancellationId] -> ShowS
CancellationId -> String
(Int -> CancellationId -> ShowS)
-> (CancellationId -> String)
-> ([CancellationId] -> ShowS)
-> Show CancellationId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CancellationId -> ShowS
showsPrec :: Int -> CancellationId -> ShowS
$cshow :: CancellationId -> String
show :: CancellationId -> String
$cshowList :: [CancellationId] -> ShowS
showList :: [CancellationId] -> ShowS
Show, Eq CancellationId
Eq CancellationId =>
(Int -> CancellationId -> Int)
-> (CancellationId -> Int) -> Hashable CancellationId
Int -> CancellationId -> Int
CancellationId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> CancellationId -> Int
hashWithSalt :: Int -> CancellationId -> Int
$chash :: CancellationId -> Int
hash :: CancellationId -> Int
Hashable, String -> CancellationId
(String -> CancellationId) -> IsString CancellationId
forall a. (String -> a) -> IsString a
$cfromString :: String -> CancellationId
fromString :: String -> CancellationId
IsString, [CancellationId] -> Value
[CancellationId] -> Encoding
CancellationId -> Bool
CancellationId -> Value
CancellationId -> Encoding
(CancellationId -> Value)
-> (CancellationId -> Encoding)
-> ([CancellationId] -> Value)
-> ([CancellationId] -> Encoding)
-> (CancellationId -> Bool)
-> ToJSON CancellationId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CancellationId -> Value
toJSON :: CancellationId -> Value
$ctoEncoding :: CancellationId -> Encoding
toEncoding :: CancellationId -> Encoding
$ctoJSONList :: [CancellationId] -> Value
toJSONList :: [CancellationId] -> Value
$ctoEncodingList :: [CancellationId] -> Encoding
toEncodingList :: [CancellationId] -> Encoding
$comitField :: CancellationId -> Bool
omitField :: CancellationId -> Bool
ToJSON, Maybe CancellationId
Value -> Parser [CancellationId]
Value -> Parser CancellationId
(Value -> Parser CancellationId)
-> (Value -> Parser [CancellationId])
-> Maybe CancellationId
-> FromJSON CancellationId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CancellationId
parseJSON :: Value -> Parser CancellationId
$cparseJSONList :: Value -> Parser [CancellationId]
parseJSONList :: Value -> Parser [CancellationId]
$comittedField :: Maybe CancellationId
omittedField :: Maybe CancellationId
FromJSON)
newtype QueryId = QueryId {QueryId -> Text
rawQueryId :: Text}
deriving stock ((forall (m :: * -> *). Quote m => QueryId -> m Exp)
-> (forall (m :: * -> *). Quote m => QueryId -> Code m QueryId)
-> Lift QueryId
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => QueryId -> m Exp
forall (m :: * -> *). Quote m => QueryId -> Code m QueryId
$clift :: forall (m :: * -> *). Quote m => QueryId -> m Exp
lift :: forall (m :: * -> *). Quote m => QueryId -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => QueryId -> Code m QueryId
liftTyped :: forall (m :: * -> *). Quote m => QueryId -> Code m QueryId
Lift)
deriving newtype (QueryId -> QueryId -> Bool
(QueryId -> QueryId -> Bool)
-> (QueryId -> QueryId -> Bool) -> Eq QueryId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryId -> QueryId -> Bool
== :: QueryId -> QueryId -> Bool
$c/= :: QueryId -> QueryId -> Bool
/= :: QueryId -> QueryId -> Bool
Eq, Eq QueryId
Eq QueryId =>
(QueryId -> QueryId -> Ordering)
-> (QueryId -> QueryId -> Bool)
-> (QueryId -> QueryId -> Bool)
-> (QueryId -> QueryId -> Bool)
-> (QueryId -> QueryId -> Bool)
-> (QueryId -> QueryId -> QueryId)
-> (QueryId -> QueryId -> QueryId)
-> Ord QueryId
QueryId -> QueryId -> Bool
QueryId -> QueryId -> Ordering
QueryId -> QueryId -> QueryId
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 :: QueryId -> QueryId -> Ordering
compare :: QueryId -> QueryId -> Ordering
$c< :: QueryId -> QueryId -> Bool
< :: QueryId -> QueryId -> Bool
$c<= :: QueryId -> QueryId -> Bool
<= :: QueryId -> QueryId -> Bool
$c> :: QueryId -> QueryId -> Bool
> :: QueryId -> QueryId -> Bool
$c>= :: QueryId -> QueryId -> Bool
>= :: QueryId -> QueryId -> Bool
$cmax :: QueryId -> QueryId -> QueryId
max :: QueryId -> QueryId -> QueryId
$cmin :: QueryId -> QueryId -> QueryId
min :: QueryId -> QueryId -> QueryId
Ord, Int -> QueryId -> ShowS
[QueryId] -> ShowS
QueryId -> String
(Int -> QueryId -> ShowS)
-> (QueryId -> String) -> ([QueryId] -> ShowS) -> Show QueryId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryId -> ShowS
showsPrec :: Int -> QueryId -> ShowS
$cshow :: QueryId -> String
show :: QueryId -> String
$cshowList :: [QueryId] -> ShowS
showList :: [QueryId] -> ShowS
Show, Eq QueryId
Eq QueryId =>
(Int -> QueryId -> Int) -> (QueryId -> Int) -> Hashable QueryId
Int -> QueryId -> Int
QueryId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> QueryId -> Int
hashWithSalt :: Int -> QueryId -> Int
$chash :: QueryId -> Int
hash :: QueryId -> Int
Hashable, String -> QueryId
(String -> QueryId) -> IsString QueryId
forall a. (String -> a) -> IsString a
$cfromString :: String -> QueryId
fromString :: String -> QueryId
IsString, [QueryId] -> Value
[QueryId] -> Encoding
QueryId -> Bool
QueryId -> Value
QueryId -> Encoding
(QueryId -> Value)
-> (QueryId -> Encoding)
-> ([QueryId] -> Value)
-> ([QueryId] -> Encoding)
-> (QueryId -> Bool)
-> ToJSON QueryId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: QueryId -> Value
toJSON :: QueryId -> Value
$ctoEncoding :: QueryId -> Encoding
toEncoding :: QueryId -> Encoding
$ctoJSONList :: [QueryId] -> Value
toJSONList :: [QueryId] -> Value
$ctoEncodingList :: [QueryId] -> Encoding
toEncodingList :: [QueryId] -> Encoding
$comitField :: QueryId -> Bool
omitField :: QueryId -> Bool
ToJSON, Maybe QueryId
Value -> Parser [QueryId]
Value -> Parser QueryId
(Value -> Parser QueryId)
-> (Value -> Parser [QueryId]) -> Maybe QueryId -> FromJSON QueryId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser QueryId
parseJSON :: Value -> Parser QueryId
$cparseJSONList :: Value -> Parser [QueryId]
parseJSONList :: Value -> Parser [QueryId]
$comittedField :: Maybe QueryId
omittedField :: Maybe QueryId
FromJSON)
newtype TaskToken = TaskToken
{ TaskToken -> ByteString
rawTaskToken :: ByteString
}
deriving newtype (TaskToken -> TaskToken -> Bool
(TaskToken -> TaskToken -> Bool)
-> (TaskToken -> TaskToken -> Bool) -> Eq TaskToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TaskToken -> TaskToken -> Bool
== :: TaskToken -> TaskToken -> Bool
$c/= :: TaskToken -> TaskToken -> Bool
/= :: TaskToken -> TaskToken -> Bool
Eq, Int -> TaskToken -> ShowS
[TaskToken] -> ShowS
TaskToken -> String
(Int -> TaskToken -> ShowS)
-> (TaskToken -> String)
-> ([TaskToken] -> ShowS)
-> Show TaskToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaskToken -> ShowS
showsPrec :: Int -> TaskToken -> ShowS
$cshow :: TaskToken -> String
show :: TaskToken -> String
$cshowList :: [TaskToken] -> ShowS
showList :: [TaskToken] -> ShowS
Show, Eq TaskToken
Eq TaskToken =>
(TaskToken -> TaskToken -> Ordering)
-> (TaskToken -> TaskToken -> Bool)
-> (TaskToken -> TaskToken -> Bool)
-> (TaskToken -> TaskToken -> Bool)
-> (TaskToken -> TaskToken -> Bool)
-> (TaskToken -> TaskToken -> TaskToken)
-> (TaskToken -> TaskToken -> TaskToken)
-> Ord TaskToken
TaskToken -> TaskToken -> Bool
TaskToken -> TaskToken -> Ordering
TaskToken -> TaskToken -> TaskToken
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 :: TaskToken -> TaskToken -> Ordering
compare :: TaskToken -> TaskToken -> Ordering
$c< :: TaskToken -> TaskToken -> Bool
< :: TaskToken -> TaskToken -> Bool
$c<= :: TaskToken -> TaskToken -> Bool
<= :: TaskToken -> TaskToken -> Bool
$c> :: TaskToken -> TaskToken -> Bool
> :: TaskToken -> TaskToken -> Bool
$c>= :: TaskToken -> TaskToken -> Bool
>= :: TaskToken -> TaskToken -> Bool
$cmax :: TaskToken -> TaskToken -> TaskToken
max :: TaskToken -> TaskToken -> TaskToken
$cmin :: TaskToken -> TaskToken -> TaskToken
min :: TaskToken -> TaskToken -> TaskToken
Ord, Eq TaskToken
Eq TaskToken =>
(Int -> TaskToken -> Int)
-> (TaskToken -> Int) -> Hashable TaskToken
Int -> TaskToken -> Int
TaskToken -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TaskToken -> Int
hashWithSalt :: Int -> TaskToken -> Int
$chash :: TaskToken -> Int
hash :: TaskToken -> Int
Hashable, String -> TaskToken
(String -> TaskToken) -> IsString TaskToken
forall a. (String -> a) -> IsString a
$cfromString :: String -> TaskToken
fromString :: String -> TaskToken
IsString)
timespecFromTimestamp :: Timestamp.Timestamp -> SystemTime
timespecFromTimestamp :: Timestamp -> SystemTime
timespecFromTimestamp Timestamp
ts =
MkSystemTime
{ systemSeconds :: Int64
systemSeconds = Timestamp
ts Timestamp
-> FoldLike Int64 Timestamp Timestamp Int64 Int64 -> Int64
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Int64 Timestamp Timestamp Int64 Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "seconds" a) =>
LensLike' f s a
Timestamp.seconds
, systemNanoseconds :: Word32
systemNanoseconds = Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Timestamp
ts Timestamp
-> FoldLike Int32 Timestamp Timestamp Int32 Int32 -> Int32
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Int32 Timestamp Timestamp Int32 Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "nanos" a) =>
LensLike' f s a
Timestamp.nanos)
}
timespecToTimestamp :: SystemTime -> Timestamp.Timestamp
timespecToTimestamp :: SystemTime -> Timestamp
timespecToTimestamp SystemTime
ts =
Timestamp
forall msg. Message msg => msg
defMessage
Timestamp -> (Timestamp -> Timestamp) -> Timestamp
forall s t. s -> (s -> t) -> t
& LensLike' f Timestamp Int64
forall {f :: * -> *}. Identical f => LensLike' f Timestamp Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "seconds" a) =>
LensLike' f s a
Timestamp.seconds (forall {f :: * -> *}. Identical f => LensLike' f Timestamp Int64)
-> Int64 -> Timestamp -> Timestamp
forall s t a b. Setter s t a b -> b -> s -> t
.~ SystemTime -> Int64
systemSeconds SystemTime
ts
Timestamp -> (Timestamp -> Timestamp) -> Timestamp
forall s t. s -> (s -> t) -> t
& LensLike' f Timestamp Int32
forall {f :: * -> *}. Identical f => LensLike' f Timestamp Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "nanos" a) =>
LensLike' f s a
Timestamp.nanos (forall {f :: * -> *}. Identical f => LensLike' f Timestamp Int32)
-> Int32 -> Timestamp -> Timestamp
forall s t a b. Setter s t a b -> b -> s -> t
.~ Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SystemTime -> Word32
systemNanoseconds SystemTime
ts)
data RetryPolicy = RetryPolicy
{ RetryPolicy -> Duration
initialInterval :: Duration
, RetryPolicy -> Double
backoffCoefficient :: Double
, RetryPolicy -> Maybe Duration
maximumInterval :: Maybe Duration
, RetryPolicy -> Int32
maximumAttempts :: Int32
, RetryPolicy -> Vector Text
nonRetryableErrorTypes :: Vector Text
}
deriving stock (Int -> RetryPolicy -> ShowS
[RetryPolicy] -> ShowS
RetryPolicy -> String
(Int -> RetryPolicy -> ShowS)
-> (RetryPolicy -> String)
-> ([RetryPolicy] -> ShowS)
-> Show RetryPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RetryPolicy -> ShowS
showsPrec :: Int -> RetryPolicy -> ShowS
$cshow :: RetryPolicy -> String
show :: RetryPolicy -> String
$cshowList :: [RetryPolicy] -> ShowS
showList :: [RetryPolicy] -> ShowS
Show, RetryPolicy -> RetryPolicy -> Bool
(RetryPolicy -> RetryPolicy -> Bool)
-> (RetryPolicy -> RetryPolicy -> Bool) -> Eq RetryPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RetryPolicy -> RetryPolicy -> Bool
== :: RetryPolicy -> RetryPolicy -> Bool
$c/= :: RetryPolicy -> RetryPolicy -> Bool
/= :: RetryPolicy -> RetryPolicy -> Bool
Eq, (forall x. RetryPolicy -> Rep RetryPolicy x)
-> (forall x. Rep RetryPolicy x -> RetryPolicy)
-> Generic RetryPolicy
forall x. Rep RetryPolicy x -> RetryPolicy
forall x. RetryPolicy -> Rep RetryPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RetryPolicy -> Rep RetryPolicy x
from :: forall x. RetryPolicy -> Rep RetryPolicy x
$cto :: forall x. Rep RetryPolicy x -> RetryPolicy
to :: forall x. Rep RetryPolicy x -> RetryPolicy
Generic, (forall (m :: * -> *). Quote m => RetryPolicy -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
RetryPolicy -> Code m RetryPolicy)
-> Lift RetryPolicy
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => RetryPolicy -> m Exp
forall (m :: * -> *). Quote m => RetryPolicy -> Code m RetryPolicy
$clift :: forall (m :: * -> *). Quote m => RetryPolicy -> m Exp
lift :: forall (m :: * -> *). Quote m => RetryPolicy -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => RetryPolicy -> Code m RetryPolicy
liftTyped :: forall (m :: * -> *). Quote m => RetryPolicy -> Code m RetryPolicy
Lift, Typeable RetryPolicy
Typeable RetryPolicy =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RetryPolicy -> c RetryPolicy)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RetryPolicy)
-> (RetryPolicy -> Constr)
-> (RetryPolicy -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RetryPolicy))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RetryPolicy))
-> ((forall b. Data b => b -> b) -> RetryPolicy -> RetryPolicy)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RetryPolicy -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RetryPolicy -> r)
-> (forall u. (forall d. Data d => d -> u) -> RetryPolicy -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> RetryPolicy -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RetryPolicy -> m RetryPolicy)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RetryPolicy -> m RetryPolicy)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RetryPolicy -> m RetryPolicy)
-> Data RetryPolicy
RetryPolicy -> Constr
RetryPolicy -> DataType
(forall b. Data b => b -> b) -> RetryPolicy -> RetryPolicy
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RetryPolicy -> u
forall u. (forall d. Data d => d -> u) -> RetryPolicy -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RetryPolicy -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RetryPolicy -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RetryPolicy -> m RetryPolicy
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RetryPolicy -> m RetryPolicy
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RetryPolicy
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RetryPolicy -> c RetryPolicy
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RetryPolicy)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RetryPolicy)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RetryPolicy -> c RetryPolicy
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RetryPolicy -> c RetryPolicy
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RetryPolicy
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RetryPolicy
$ctoConstr :: RetryPolicy -> Constr
toConstr :: RetryPolicy -> Constr
$cdataTypeOf :: RetryPolicy -> DataType
dataTypeOf :: RetryPolicy -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RetryPolicy)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RetryPolicy)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RetryPolicy)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RetryPolicy)
$cgmapT :: (forall b. Data b => b -> b) -> RetryPolicy -> RetryPolicy
gmapT :: (forall b. Data b => b -> b) -> RetryPolicy -> RetryPolicy
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RetryPolicy -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RetryPolicy -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RetryPolicy -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RetryPolicy -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RetryPolicy -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RetryPolicy -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RetryPolicy -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RetryPolicy -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RetryPolicy -> m RetryPolicy
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RetryPolicy -> m RetryPolicy
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RetryPolicy -> m RetryPolicy
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RetryPolicy -> m RetryPolicy
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RetryPolicy -> m RetryPolicy
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RetryPolicy -> m RetryPolicy
Data)
instance ToJSON RetryPolicy
instance FromJSON RetryPolicy
errorType :: Typeable e => proxy e -> Text
errorType :: forall e (proxy :: * -> *). Typeable e => proxy e -> Text
errorType = String -> Text
T.pack (String -> Text) -> (proxy e -> String) -> proxy e -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> (proxy e -> TypeRep) -> proxy e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy e -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep
retryPolicyToProto :: RetryPolicy -> Message.RetryPolicy
retryPolicyToProto :: RetryPolicy -> RetryPolicy
retryPolicyToProto (RetryPolicy Duration
initialInterval Double
backoffCoefficient Maybe Duration
maximumInterval Int32
maximumAttempts Vector Text
nonRetryableErrorTypes) =
RetryPolicy
forall msg. Message msg => msg
defMessage
RetryPolicy -> (RetryPolicy -> RetryPolicy) -> RetryPolicy
forall s t. s -> (s -> t) -> t
& LensLike' f RetryPolicy Duration
forall {f :: * -> *}.
Identical f =>
LensLike' f RetryPolicy Duration
forall (f :: * -> *) s a.
(Functor f, HasField s "initialInterval" a) =>
LensLike' f s a
Message.initialInterval (forall {f :: * -> *}.
Identical f =>
LensLike' f RetryPolicy Duration)
-> Duration -> RetryPolicy -> RetryPolicy
forall s t a b. Setter s t a b -> b -> s -> t
.~ Duration -> Duration
durationToProto Duration
initialInterval
RetryPolicy -> (RetryPolicy -> RetryPolicy) -> RetryPolicy
forall s t. s -> (s -> t) -> t
& LensLike' f RetryPolicy Double
forall {f :: * -> *}. Identical f => LensLike' f RetryPolicy Double
forall (f :: * -> *) s a.
(Functor f, HasField s "backoffCoefficient" a) =>
LensLike' f s a
Message.backoffCoefficient (forall {f :: * -> *}.
Identical f =>
LensLike' f RetryPolicy Double)
-> Double -> RetryPolicy -> RetryPolicy
forall s t a b. Setter s t a b -> b -> s -> t
.~ Double
backoffCoefficient
RetryPolicy -> (RetryPolicy -> RetryPolicy) -> RetryPolicy
forall s t. s -> (s -> t) -> t
& LensLike' f RetryPolicy (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f RetryPolicy (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'maximumInterval" a) =>
LensLike' f s a
Message.maybe'maximumInterval (forall {f :: * -> *}.
Identical f =>
LensLike' f RetryPolicy (Maybe Duration))
-> Maybe Duration -> RetryPolicy -> RetryPolicy
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 Maybe Duration
maximumInterval
RetryPolicy -> (RetryPolicy -> RetryPolicy) -> RetryPolicy
forall s t. s -> (s -> t) -> t
& LensLike' f RetryPolicy Int32
forall {f :: * -> *}. Identical f => LensLike' f RetryPolicy Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "maximumAttempts" a) =>
LensLike' f s a
Message.maximumAttempts (forall {f :: * -> *}.
Identical f =>
LensLike' f RetryPolicy Int32)
-> Int32 -> RetryPolicy -> RetryPolicy
forall s t a b. Setter s t a b -> b -> s -> t
.~ Int32
maximumAttempts
RetryPolicy -> (RetryPolicy -> RetryPolicy) -> RetryPolicy
forall s t. s -> (s -> t) -> t
& LensLike' f RetryPolicy (Vector Text)
forall {f :: * -> *}.
Identical f =>
LensLike' f RetryPolicy (Vector Text)
forall (f :: * -> *) s a.
(Functor f, HasField s "vec'nonRetryableErrorTypes" a) =>
LensLike' f s a
Message.vec'nonRetryableErrorTypes (forall {f :: * -> *}.
Identical f =>
LensLike' f RetryPolicy (Vector Text))
-> Vector Text -> RetryPolicy -> RetryPolicy
forall s t a b. Setter s t a b -> b -> s -> t
.~ Vector Text
nonRetryableErrorTypes
retryPolicyFromProto :: Message.RetryPolicy -> RetryPolicy
retryPolicyFromProto :: RetryPolicy -> RetryPolicy
retryPolicyFromProto RetryPolicy
p =
RetryPolicy
{ initialInterval :: Duration
initialInterval = Duration -> Duration
durationFromProto (RetryPolicy
p RetryPolicy
-> FoldLike Duration RetryPolicy RetryPolicy Duration Duration
-> Duration
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Duration RetryPolicy RetryPolicy Duration Duration
forall (f :: * -> *) s a.
(Functor f, HasField s "initialInterval" a) =>
LensLike' f s a
Message.initialInterval)
, backoffCoefficient :: Double
backoffCoefficient = RetryPolicy
p RetryPolicy
-> FoldLike Double RetryPolicy RetryPolicy Double Double -> Double
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Double RetryPolicy RetryPolicy Double Double
forall (f :: * -> *) s a.
(Functor f, HasField s "backoffCoefficient" a) =>
LensLike' f s a
Message.backoffCoefficient
, maximumInterval :: Maybe Duration
maximumInterval = (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
durationFromProto (RetryPolicy
p RetryPolicy
-> FoldLike
(Maybe Duration)
RetryPolicy
RetryPolicy
(Maybe Duration)
(Maybe Duration)
-> Maybe Duration
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
(Maybe Duration)
RetryPolicy
RetryPolicy
(Maybe Duration)
(Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'maximumInterval" a) =>
LensLike' f s a
Message.maybe'maximumInterval)
, maximumAttempts :: Int32
maximumAttempts = RetryPolicy
p RetryPolicy
-> FoldLike Int32 RetryPolicy RetryPolicy Int32 Int32 -> Int32
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Int32 RetryPolicy RetryPolicy Int32 Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "maximumAttempts" a) =>
LensLike' f s a
Message.maximumAttempts
, nonRetryableErrorTypes :: Vector Text
nonRetryableErrorTypes = RetryPolicy
p RetryPolicy
-> FoldLike
(Vector Text) RetryPolicy RetryPolicy (Vector Text) (Vector Text)
-> Vector Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
(Vector Text) RetryPolicy RetryPolicy (Vector Text) (Vector Text)
forall (f :: * -> *) s a.
(Functor f, HasField s "vec'nonRetryableErrorTypes" a) =>
LensLike' f s a
Message.vec'nonRetryableErrorTypes
}
data RetryState
= RetryStateUnspecified
| RetryStateInProgress
| RetryStateNonRetryableFailure
| RetryStateTimeout
| RetryStateMaximumAttemptsReached
| RetryStateRetryPolicyNotSet
| RetryStateInternalServerError
| RetryStateCancelRequested
deriving stock (Int -> RetryState -> ShowS
[RetryState] -> ShowS
RetryState -> String
(Int -> RetryState -> ShowS)
-> (RetryState -> String)
-> ([RetryState] -> ShowS)
-> Show RetryState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RetryState -> ShowS
showsPrec :: Int -> RetryState -> ShowS
$cshow :: RetryState -> String
show :: RetryState -> String
$cshowList :: [RetryState] -> ShowS
showList :: [RetryState] -> ShowS
Show, RetryState -> RetryState -> Bool
(RetryState -> RetryState -> Bool)
-> (RetryState -> RetryState -> Bool) -> Eq RetryState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RetryState -> RetryState -> Bool
== :: RetryState -> RetryState -> Bool
$c/= :: RetryState -> RetryState -> Bool
/= :: RetryState -> RetryState -> Bool
Eq)
retryStateFromProto :: Workflow.RetryState -> RetryState
retryStateFromProto :: RetryState -> RetryState
retryStateFromProto = \case
RetryState
Workflow.RETRY_STATE_UNSPECIFIED -> RetryState
RetryStateUnspecified
RetryState
Workflow.RETRY_STATE_IN_PROGRESS -> RetryState
RetryStateInProgress
RetryState
Workflow.RETRY_STATE_NON_RETRYABLE_FAILURE -> RetryState
RetryStateNonRetryableFailure
RetryState
Workflow.RETRY_STATE_TIMEOUT -> RetryState
RetryStateTimeout
RetryState
Workflow.RETRY_STATE_MAXIMUM_ATTEMPTS_REACHED -> RetryState
RetryStateMaximumAttemptsReached
RetryState
Workflow.RETRY_STATE_RETRY_POLICY_NOT_SET -> RetryState
RetryStateRetryPolicyNotSet
RetryState
Workflow.RETRY_STATE_INTERNAL_SERVER_ERROR -> RetryState
RetryStateInternalServerError
RetryState
Workflow.RETRY_STATE_CANCEL_REQUESTED -> RetryState
RetryStateCancelRequested
(Workflow.RetryState'Unrecognized RetryState'UnrecognizedValue
_) -> String -> RetryState
forall a. HasCallStack => String -> a
error String
"retryStateFromProto: invalid retry state"
data WorkflowIdReusePolicy
= WorkflowIdReusePolicyUnspecified
|
WorkflowIdReusePolicyAllowDuplicate
|
WorkflowIdReusePolicyAllowDuplicateFailedOnly
|
WorkflowIdReusePolicyRejectDuplicate
|
WorkflowIdReusePolicyTerminateIfRunning
deriving stock (WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
(WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool)
-> (WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool)
-> Eq WorkflowIdReusePolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
== :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
$c/= :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
/= :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
Eq, Eq WorkflowIdReusePolicy
Eq WorkflowIdReusePolicy =>
(WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Ordering)
-> (WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool)
-> (WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool)
-> (WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool)
-> (WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool)
-> (WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> WorkflowIdReusePolicy)
-> (WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> WorkflowIdReusePolicy)
-> Ord WorkflowIdReusePolicy
WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Ordering
WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> WorkflowIdReusePolicy
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 :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Ordering
compare :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Ordering
$c< :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
< :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
$c<= :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
<= :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
$c> :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
> :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
$c>= :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
>= :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy -> Bool
$cmax :: WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> WorkflowIdReusePolicy
max :: WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> WorkflowIdReusePolicy
$cmin :: WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> WorkflowIdReusePolicy
min :: WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> WorkflowIdReusePolicy
Ord, ReadPrec [WorkflowIdReusePolicy]
ReadPrec WorkflowIdReusePolicy
Int -> ReadS WorkflowIdReusePolicy
ReadS [WorkflowIdReusePolicy]
(Int -> ReadS WorkflowIdReusePolicy)
-> ReadS [WorkflowIdReusePolicy]
-> ReadPrec WorkflowIdReusePolicy
-> ReadPrec [WorkflowIdReusePolicy]
-> Read WorkflowIdReusePolicy
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WorkflowIdReusePolicy
readsPrec :: Int -> ReadS WorkflowIdReusePolicy
$creadList :: ReadS [WorkflowIdReusePolicy]
readList :: ReadS [WorkflowIdReusePolicy]
$creadPrec :: ReadPrec WorkflowIdReusePolicy
readPrec :: ReadPrec WorkflowIdReusePolicy
$creadListPrec :: ReadPrec [WorkflowIdReusePolicy]
readListPrec :: ReadPrec [WorkflowIdReusePolicy]
Read, Int -> WorkflowIdReusePolicy -> ShowS
[WorkflowIdReusePolicy] -> ShowS
WorkflowIdReusePolicy -> String
(Int -> WorkflowIdReusePolicy -> ShowS)
-> (WorkflowIdReusePolicy -> String)
-> ([WorkflowIdReusePolicy] -> ShowS)
-> Show WorkflowIdReusePolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowIdReusePolicy -> ShowS
showsPrec :: Int -> WorkflowIdReusePolicy -> ShowS
$cshow :: WorkflowIdReusePolicy -> String
show :: WorkflowIdReusePolicy -> String
$cshowList :: [WorkflowIdReusePolicy] -> ShowS
showList :: [WorkflowIdReusePolicy] -> ShowS
Show, Int -> WorkflowIdReusePolicy
WorkflowIdReusePolicy -> Int
WorkflowIdReusePolicy -> [WorkflowIdReusePolicy]
WorkflowIdReusePolicy -> WorkflowIdReusePolicy
WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> [WorkflowIdReusePolicy]
WorkflowIdReusePolicy
-> WorkflowIdReusePolicy
-> WorkflowIdReusePolicy
-> [WorkflowIdReusePolicy]
(WorkflowIdReusePolicy -> WorkflowIdReusePolicy)
-> (WorkflowIdReusePolicy -> WorkflowIdReusePolicy)
-> (Int -> WorkflowIdReusePolicy)
-> (WorkflowIdReusePolicy -> Int)
-> (WorkflowIdReusePolicy -> [WorkflowIdReusePolicy])
-> (WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> [WorkflowIdReusePolicy])
-> (WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> [WorkflowIdReusePolicy])
-> (WorkflowIdReusePolicy
-> WorkflowIdReusePolicy
-> WorkflowIdReusePolicy
-> [WorkflowIdReusePolicy])
-> Enum WorkflowIdReusePolicy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy
succ :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy
$cpred :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy
pred :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy
$ctoEnum :: Int -> WorkflowIdReusePolicy
toEnum :: Int -> WorkflowIdReusePolicy
$cfromEnum :: WorkflowIdReusePolicy -> Int
fromEnum :: WorkflowIdReusePolicy -> Int
$cenumFrom :: WorkflowIdReusePolicy -> [WorkflowIdReusePolicy]
enumFrom :: WorkflowIdReusePolicy -> [WorkflowIdReusePolicy]
$cenumFromThen :: WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> [WorkflowIdReusePolicy]
enumFromThen :: WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> [WorkflowIdReusePolicy]
$cenumFromTo :: WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> [WorkflowIdReusePolicy]
enumFromTo :: WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> [WorkflowIdReusePolicy]
$cenumFromThenTo :: WorkflowIdReusePolicy
-> WorkflowIdReusePolicy
-> WorkflowIdReusePolicy
-> [WorkflowIdReusePolicy]
enumFromThenTo :: WorkflowIdReusePolicy
-> WorkflowIdReusePolicy
-> WorkflowIdReusePolicy
-> [WorkflowIdReusePolicy]
Enum, WorkflowIdReusePolicy
WorkflowIdReusePolicy
-> WorkflowIdReusePolicy -> Bounded WorkflowIdReusePolicy
forall a. a -> a -> Bounded a
$cminBound :: WorkflowIdReusePolicy
minBound :: WorkflowIdReusePolicy
$cmaxBound :: WorkflowIdReusePolicy
maxBound :: WorkflowIdReusePolicy
Bounded, (forall x. WorkflowIdReusePolicy -> Rep WorkflowIdReusePolicy x)
-> (forall x. Rep WorkflowIdReusePolicy x -> WorkflowIdReusePolicy)
-> Generic WorkflowIdReusePolicy
forall x. Rep WorkflowIdReusePolicy x -> WorkflowIdReusePolicy
forall x. WorkflowIdReusePolicy -> Rep WorkflowIdReusePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WorkflowIdReusePolicy -> Rep WorkflowIdReusePolicy x
from :: forall x. WorkflowIdReusePolicy -> Rep WorkflowIdReusePolicy x
$cto :: forall x. Rep WorkflowIdReusePolicy x -> WorkflowIdReusePolicy
to :: forall x. Rep WorkflowIdReusePolicy x -> WorkflowIdReusePolicy
Generic, (forall (m :: * -> *). Quote m => WorkflowIdReusePolicy -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
WorkflowIdReusePolicy -> Code m WorkflowIdReusePolicy)
-> Lift WorkflowIdReusePolicy
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => WorkflowIdReusePolicy -> m Exp
forall (m :: * -> *).
Quote m =>
WorkflowIdReusePolicy -> Code m WorkflowIdReusePolicy
$clift :: forall (m :: * -> *). Quote m => WorkflowIdReusePolicy -> m Exp
lift :: forall (m :: * -> *). Quote m => WorkflowIdReusePolicy -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
WorkflowIdReusePolicy -> Code m WorkflowIdReusePolicy
liftTyped :: forall (m :: * -> *).
Quote m =>
WorkflowIdReusePolicy -> Code m WorkflowIdReusePolicy
Lift, Typeable WorkflowIdReusePolicy
Typeable WorkflowIdReusePolicy =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> WorkflowIdReusePolicy
-> c WorkflowIdReusePolicy)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WorkflowIdReusePolicy)
-> (WorkflowIdReusePolicy -> Constr)
-> (WorkflowIdReusePolicy -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WorkflowIdReusePolicy))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WorkflowIdReusePolicy))
-> ((forall b. Data b => b -> b)
-> WorkflowIdReusePolicy -> WorkflowIdReusePolicy)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> WorkflowIdReusePolicy
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> WorkflowIdReusePolicy
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> WorkflowIdReusePolicy -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> WorkflowIdReusePolicy -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WorkflowIdReusePolicy -> m WorkflowIdReusePolicy)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowIdReusePolicy -> m WorkflowIdReusePolicy)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowIdReusePolicy -> m WorkflowIdReusePolicy)
-> Data WorkflowIdReusePolicy
WorkflowIdReusePolicy -> Constr
WorkflowIdReusePolicy -> DataType
(forall b. Data b => b -> b)
-> WorkflowIdReusePolicy -> WorkflowIdReusePolicy
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> WorkflowIdReusePolicy -> u
forall u.
(forall d. Data d => d -> u) -> WorkflowIdReusePolicy -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowIdReusePolicy -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowIdReusePolicy -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WorkflowIdReusePolicy -> m WorkflowIdReusePolicy
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowIdReusePolicy -> m WorkflowIdReusePolicy
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WorkflowIdReusePolicy
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> WorkflowIdReusePolicy
-> c WorkflowIdReusePolicy
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WorkflowIdReusePolicy)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WorkflowIdReusePolicy)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> WorkflowIdReusePolicy
-> c WorkflowIdReusePolicy
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> WorkflowIdReusePolicy
-> c WorkflowIdReusePolicy
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WorkflowIdReusePolicy
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WorkflowIdReusePolicy
$ctoConstr :: WorkflowIdReusePolicy -> Constr
toConstr :: WorkflowIdReusePolicy -> Constr
$cdataTypeOf :: WorkflowIdReusePolicy -> DataType
dataTypeOf :: WorkflowIdReusePolicy -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WorkflowIdReusePolicy)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WorkflowIdReusePolicy)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WorkflowIdReusePolicy)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WorkflowIdReusePolicy)
$cgmapT :: (forall b. Data b => b -> b)
-> WorkflowIdReusePolicy -> WorkflowIdReusePolicy
gmapT :: (forall b. Data b => b -> b)
-> WorkflowIdReusePolicy -> WorkflowIdReusePolicy
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowIdReusePolicy -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowIdReusePolicy -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowIdReusePolicy -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowIdReusePolicy -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> WorkflowIdReusePolicy -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> WorkflowIdReusePolicy -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> WorkflowIdReusePolicy -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> WorkflowIdReusePolicy -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WorkflowIdReusePolicy -> m WorkflowIdReusePolicy
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WorkflowIdReusePolicy -> m WorkflowIdReusePolicy
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowIdReusePolicy -> m WorkflowIdReusePolicy
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowIdReusePolicy -> m WorkflowIdReusePolicy
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowIdReusePolicy -> m WorkflowIdReusePolicy
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowIdReusePolicy -> m WorkflowIdReusePolicy
Data)
instance ToJSON WorkflowIdReusePolicy
instance FromJSON WorkflowIdReusePolicy
workflowIdReusePolicyToProto :: WorkflowIdReusePolicy -> Workflow.WorkflowIdReusePolicy
workflowIdReusePolicyToProto :: WorkflowIdReusePolicy -> WorkflowIdReusePolicy
workflowIdReusePolicyToProto = \case
WorkflowIdReusePolicy
WorkflowIdReusePolicyUnspecified -> WorkflowIdReusePolicy
Workflow.WORKFLOW_ID_REUSE_POLICY_UNSPECIFIED
WorkflowIdReusePolicy
WorkflowIdReusePolicyAllowDuplicate -> WorkflowIdReusePolicy
Workflow.WORKFLOW_ID_REUSE_POLICY_ALLOW_DUPLICATE
WorkflowIdReusePolicy
WorkflowIdReusePolicyAllowDuplicateFailedOnly -> WorkflowIdReusePolicy
Workflow.WORKFLOW_ID_REUSE_POLICY_ALLOW_DUPLICATE_FAILED_ONLY
WorkflowIdReusePolicy
WorkflowIdReusePolicyRejectDuplicate -> WorkflowIdReusePolicy
Workflow.WORKFLOW_ID_REUSE_POLICY_REJECT_DUPLICATE
WorkflowIdReusePolicy
WorkflowIdReusePolicyTerminateIfRunning -> WorkflowIdReusePolicy
Workflow.WORKFLOW_ID_REUSE_POLICY_TERMINATE_IF_RUNNING
memoAttributesToProto :: Map.Map Text Message.Payload -> Message.Memo
memoAttributesToProto :: Map Text Payload -> Memo
memoAttributesToProto Map Text Payload
memoAttrs = Memo
forall msg. Message msg => msg
defMessage Memo -> (Memo -> Memo) -> Memo
forall s t. s -> (s -> t) -> t
& LensLike' f Memo (Map Text Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f Memo (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "fields" a) =>
LensLike' f s a
Message.fields (forall {f :: * -> *}.
Identical f =>
LensLike' f Memo (Map Text Payload))
-> Map Text Payload -> Memo -> Memo
forall s t a b. Setter s t a b -> b -> s -> t
.~ Map Text Payload
memoAttrs
memoAttributesFromProto :: Message.Memo -> Map.Map Text Message.Payload
memoAttributesFromProto :: Memo -> Map Text Payload
memoAttributesFromProto = FoldLike
(Map Text Payload) Memo Memo (Map Text Payload) (Map Text Payload)
-> Memo -> Map Text Payload
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
(Map Text Payload) Memo Memo (Map Text Payload) (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "fields" a) =>
LensLike' f s a
Message.fields
headerToProto :: Map.Map Text Message.Payload -> Message.Header
Map Text Payload
header = Header
forall msg. Message msg => msg
defMessage Header -> (Header -> Header) -> Header
forall s t. s -> (s -> t) -> t
& LensLike' f Header (Map Text Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f Header (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "fields" a) =>
LensLike' f s a
Message.fields (forall {f :: * -> *}.
Identical f =>
LensLike' f Header (Map Text Payload))
-> Map Text Payload -> Header -> Header
forall s t a b. Setter s t a b -> b -> s -> t
.~ Map Text Payload
header
headerFromProto :: Message.Header -> Map.Map Text Message.Payload
= FoldLike
(Map Text Payload)
Header
Header
(Map Text Payload)
(Map Text Payload)
-> Header -> Map Text Payload
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
(Map Text Payload)
Header
Header
(Map Text Payload)
(Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "fields" a) =>
LensLike' f s a
Message.fields
data ParentInfo = ParentInfo
{ ParentInfo -> Namespace
parentNamespace :: Namespace
, ParentInfo -> RunId
parentRunId :: RunId
, ParentInfo -> WorkflowId
parentWorkflowId :: WorkflowId
}
deriving stock (Int -> ParentInfo -> ShowS
[ParentInfo] -> ShowS
ParentInfo -> String
(Int -> ParentInfo -> ShowS)
-> (ParentInfo -> String)
-> ([ParentInfo] -> ShowS)
-> Show ParentInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParentInfo -> ShowS
showsPrec :: Int -> ParentInfo -> ShowS
$cshow :: ParentInfo -> String
show :: ParentInfo -> String
$cshowList :: [ParentInfo] -> ShowS
showList :: [ParentInfo] -> ShowS
Show, ParentInfo -> ParentInfo -> Bool
(ParentInfo -> ParentInfo -> Bool)
-> (ParentInfo -> ParentInfo -> Bool) -> Eq ParentInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParentInfo -> ParentInfo -> Bool
== :: ParentInfo -> ParentInfo -> Bool
$c/= :: ParentInfo -> ParentInfo -> Bool
/= :: ParentInfo -> ParentInfo -> Bool
Eq, (forall x. ParentInfo -> Rep ParentInfo x)
-> (forall x. Rep ParentInfo x -> ParentInfo) -> Generic ParentInfo
forall x. Rep ParentInfo x -> ParentInfo
forall x. ParentInfo -> Rep ParentInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParentInfo -> Rep ParentInfo x
from :: forall x. ParentInfo -> Rep ParentInfo x
$cto :: forall x. Rep ParentInfo x -> ParentInfo
to :: forall x. Rep ParentInfo x -> ParentInfo
Generic)
newtype Sequence = Sequence {Sequence -> Word32
rawSequence :: Word32}
deriving stock (Sequence -> Sequence -> Bool
(Sequence -> Sequence -> Bool)
-> (Sequence -> Sequence -> Bool) -> Eq Sequence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sequence -> Sequence -> Bool
== :: Sequence -> Sequence -> Bool
$c/= :: Sequence -> Sequence -> Bool
/= :: Sequence -> Sequence -> Bool
Eq, Eq Sequence
Eq Sequence =>
(Sequence -> Sequence -> Ordering)
-> (Sequence -> Sequence -> Bool)
-> (Sequence -> Sequence -> Bool)
-> (Sequence -> Sequence -> Bool)
-> (Sequence -> Sequence -> Bool)
-> (Sequence -> Sequence -> Sequence)
-> (Sequence -> Sequence -> Sequence)
-> Ord Sequence
Sequence -> Sequence -> Bool
Sequence -> Sequence -> Ordering
Sequence -> Sequence -> Sequence
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 :: Sequence -> Sequence -> Ordering
compare :: Sequence -> Sequence -> Ordering
$c< :: Sequence -> Sequence -> Bool
< :: Sequence -> Sequence -> Bool
$c<= :: Sequence -> Sequence -> Bool
<= :: Sequence -> Sequence -> Bool
$c> :: Sequence -> Sequence -> Bool
> :: Sequence -> Sequence -> Bool
$c>= :: Sequence -> Sequence -> Bool
>= :: Sequence -> Sequence -> Bool
$cmax :: Sequence -> Sequence -> Sequence
max :: Sequence -> Sequence -> Sequence
$cmin :: Sequence -> Sequence -> Sequence
min :: Sequence -> Sequence -> Sequence
Ord, Int -> Sequence -> ShowS
[Sequence] -> ShowS
Sequence -> String
(Int -> Sequence -> ShowS)
-> (Sequence -> String) -> ([Sequence] -> ShowS) -> Show Sequence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sequence -> ShowS
showsPrec :: Int -> Sequence -> ShowS
$cshow :: Sequence -> String
show :: Sequence -> String
$cshowList :: [Sequence] -> ShowS
showList :: [Sequence] -> ShowS
Show)
deriving newtype (Eq Sequence
Eq Sequence =>
(Int -> Sequence -> Int) -> (Sequence -> Int) -> Hashable Sequence
Int -> Sequence -> Int
Sequence -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Sequence -> Int
hashWithSalt :: Int -> Sequence -> Int
$chash :: Sequence -> Int
hash :: Sequence -> Int
Hashable, Int -> Sequence
Sequence -> Int
Sequence -> [Sequence]
Sequence -> Sequence
Sequence -> Sequence -> [Sequence]
Sequence -> Sequence -> Sequence -> [Sequence]
(Sequence -> Sequence)
-> (Sequence -> Sequence)
-> (Int -> Sequence)
-> (Sequence -> Int)
-> (Sequence -> [Sequence])
-> (Sequence -> Sequence -> [Sequence])
-> (Sequence -> Sequence -> [Sequence])
-> (Sequence -> Sequence -> Sequence -> [Sequence])
-> Enum Sequence
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Sequence -> Sequence
succ :: Sequence -> Sequence
$cpred :: Sequence -> Sequence
pred :: Sequence -> Sequence
$ctoEnum :: Int -> Sequence
toEnum :: Int -> Sequence
$cfromEnum :: Sequence -> Int
fromEnum :: Sequence -> Int
$cenumFrom :: Sequence -> [Sequence]
enumFrom :: Sequence -> [Sequence]
$cenumFromThen :: Sequence -> Sequence -> [Sequence]
enumFromThen :: Sequence -> Sequence -> [Sequence]
$cenumFromTo :: Sequence -> Sequence -> [Sequence]
enumFromTo :: Sequence -> Sequence -> [Sequence]
$cenumFromThenTo :: Sequence -> Sequence -> Sequence -> [Sequence]
enumFromThenTo :: Sequence -> Sequence -> Sequence -> [Sequence]
Enum, Integer -> Sequence
Sequence -> Sequence
Sequence -> Sequence -> Sequence
(Sequence -> Sequence -> Sequence)
-> (Sequence -> Sequence -> Sequence)
-> (Sequence -> Sequence -> Sequence)
-> (Sequence -> Sequence)
-> (Sequence -> Sequence)
-> (Sequence -> Sequence)
-> (Integer -> Sequence)
-> Num Sequence
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Sequence -> Sequence -> Sequence
+ :: Sequence -> Sequence -> Sequence
$c- :: Sequence -> Sequence -> Sequence
- :: Sequence -> Sequence -> Sequence
$c* :: Sequence -> Sequence -> Sequence
* :: Sequence -> Sequence -> Sequence
$cnegate :: Sequence -> Sequence
negate :: Sequence -> Sequence
$cabs :: Sequence -> Sequence
abs :: Sequence -> Sequence
$csignum :: Sequence -> Sequence
signum :: Sequence -> Sequence
$cfromInteger :: Integer -> Sequence
fromInteger :: Integer -> Sequence
Num)
class FunctionHoist (args :: [Type]) where
hoistFn :: (forall x. m x -> n x) -> Proxy args -> Proxy result -> (args :->: m result) -> (args :->: n result)
instance FunctionHoist '[] where
hoistFn :: forall (m :: * -> *) (n :: * -> *) result.
(forall x. m x -> n x)
-> Proxy '[]
-> Proxy result
-> ('[] :->: m result)
-> '[] :->: n result
hoistFn forall x. m x -> n x
trans Proxy '[]
_ Proxy result
_ = m result -> n result
('[] :->: m result) -> '[] :->: n result
forall x. m x -> n x
trans
instance FunctionHoist args => FunctionHoist (a ': args) where
hoistFn :: forall (m :: * -> *) (n :: * -> *) result.
(forall x. m x -> n x)
-> Proxy (a : args)
-> Proxy result
-> ((a : args) :->: m result)
-> (a : args) :->: n result
hoistFn forall x. m x -> n x
trans Proxy (a : args)
_ Proxy result
res (a : args) :->: m result
f = (forall x. m x -> n x)
-> Proxy args
-> Proxy result
-> (args :->: m result)
-> args :->: n result
forall (args :: [*]) (m :: * -> *) (n :: * -> *) result.
FunctionHoist args =>
(forall x. m x -> n x)
-> Proxy args
-> Proxy result
-> (args :->: m result)
-> args :->: n result
forall (m :: * -> *) (n :: * -> *) result.
(forall x. m x -> n x)
-> Proxy args
-> Proxy result
-> (args :->: m result)
-> args :->: n result
hoistFn m x -> n x
forall x. m x -> n x
trans (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @args) Proxy result
res ((args :->: m result) -> args :->: n result)
-> (a -> args :->: m result) -> a -> args :->: n result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a : args) :->: m result
a -> args :->: m result
f
hoist
:: forall m n f
. (f ~ (ArgsOf f :->: m (ResultOf m f)), FunctionHoist (ArgsOf f))
=> (forall x. m x -> n x)
-> f
-> (ArgsOf f :->: n (ResultOf m f))
hoist :: forall (m :: * -> *) (n :: * -> *) f.
(f ~ (ArgsOf f :->: m (ResultOf m f)), FunctionHoist (ArgsOf f)) =>
(forall x. m x -> n x) -> f -> ArgsOf f :->: n (ResultOf m f)
hoist forall x. m x -> n x
trans = (forall x. m x -> n x)
-> Proxy (ArgsOf f)
-> Proxy (ResultOf m f)
-> (ArgsOf f :->: m (ResultOf m f))
-> ArgsOf f :->: n (ResultOf m f)
forall (args :: [*]) (m :: * -> *) (n :: * -> *) result.
FunctionHoist args =>
(forall x. m x -> n x)
-> Proxy args
-> Proxy result
-> (args :->: m result)
-> args :->: n result
forall (m :: * -> *) (n :: * -> *) result.
(forall x. m x -> n x)
-> Proxy (ArgsOf f)
-> Proxy result
-> (ArgsOf f :->: m result)
-> ArgsOf f :->: n result
hoistFn m x -> n x
forall x. m x -> n x
trans (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ArgsOf f)) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ResultOf m f))
nonEmptyString :: Text -> Maybe Text
nonEmptyString :: Text -> Maybe Text
nonEmptyString Text
t = if Text -> Bool
T.null Text
t then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
convertToProtoMemo :: Map Text Payload -> Message.Memo
convertToProtoMemo :: Map Text Payload -> Memo
convertToProtoMemo Map Text Payload
m = Memo
forall msg. Message msg => msg
defMessage Memo -> (Memo -> Memo) -> Memo
forall s t. s -> (s -> t) -> t
& LensLike' f Memo (Map Text Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f Memo (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "fields" a) =>
LensLike' f s a
Message.fields (forall {f :: * -> *}.
Identical f =>
LensLike' f Memo (Map Text Payload))
-> Map Text Payload -> Memo -> Memo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Payload -> Payload) -> Map Text Payload -> Map Text Payload
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload Map Text Payload
m
convertFromProtoMemo :: Message.Memo -> Map Text Payload
convertFromProtoMemo :: Memo -> Map Text Payload
convertFromProtoMemo Memo
m = (Payload -> Payload) -> Map Text Payload -> Map Text Payload
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertFromProtoPayload (Memo
m Memo
-> FoldLike
(Map Text Payload) Memo Memo (Map Text Payload) (Map Text Payload)
-> Map Text Payload
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
(Map Text Payload) Memo Memo (Map Text Payload) (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "fields" a) =>
LensLike' f s a
Message.fields)
data TimeoutOptions = TimeoutOptions
{ TimeoutOptions -> Maybe Duration
executionTimeout :: Maybe Duration
, TimeoutOptions -> Maybe Duration
runTimeout :: Maybe Duration
, TimeoutOptions -> Maybe Duration
taskTimeout :: Maybe Duration
}
deriving stock (Int -> TimeoutOptions -> ShowS
[TimeoutOptions] -> ShowS
TimeoutOptions -> String
(Int -> TimeoutOptions -> ShowS)
-> (TimeoutOptions -> String)
-> ([TimeoutOptions] -> ShowS)
-> Show TimeoutOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeoutOptions -> ShowS
showsPrec :: Int -> TimeoutOptions -> ShowS
$cshow :: TimeoutOptions -> String
show :: TimeoutOptions -> String
$cshowList :: [TimeoutOptions] -> ShowS
showList :: [TimeoutOptions] -> ShowS
Show, TimeoutOptions -> TimeoutOptions -> Bool
(TimeoutOptions -> TimeoutOptions -> Bool)
-> (TimeoutOptions -> TimeoutOptions -> Bool) -> Eq TimeoutOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeoutOptions -> TimeoutOptions -> Bool
== :: TimeoutOptions -> TimeoutOptions -> Bool
$c/= :: TimeoutOptions -> TimeoutOptions -> Bool
/= :: TimeoutOptions -> TimeoutOptions -> Bool
Eq, (forall (m :: * -> *). Quote m => TimeoutOptions -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
TimeoutOptions -> Code m TimeoutOptions)
-> Lift TimeoutOptions
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TimeoutOptions -> m Exp
forall (m :: * -> *).
Quote m =>
TimeoutOptions -> Code m TimeoutOptions
$clift :: forall (m :: * -> *). Quote m => TimeoutOptions -> m Exp
lift :: forall (m :: * -> *). Quote m => TimeoutOptions -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
TimeoutOptions -> Code m TimeoutOptions
liftTyped :: forall (m :: * -> *).
Quote m =>
TimeoutOptions -> Code m TimeoutOptions
Lift, Typeable TimeoutOptions
Typeable TimeoutOptions =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeoutOptions -> c TimeoutOptions)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeoutOptions)
-> (TimeoutOptions -> Constr)
-> (TimeoutOptions -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeoutOptions))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimeoutOptions))
-> ((forall b. Data b => b -> b)
-> TimeoutOptions -> TimeoutOptions)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeoutOptions -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeoutOptions -> r)
-> (forall u.
(forall d. Data d => d -> u) -> TimeoutOptions -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> TimeoutOptions -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TimeoutOptions -> m TimeoutOptions)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TimeoutOptions -> m TimeoutOptions)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TimeoutOptions -> m TimeoutOptions)
-> Data TimeoutOptions
TimeoutOptions -> Constr
TimeoutOptions -> DataType
(forall b. Data b => b -> b) -> TimeoutOptions -> TimeoutOptions
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TimeoutOptions -> u
forall u. (forall d. Data d => d -> u) -> TimeoutOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeoutOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeoutOptions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TimeoutOptions -> m TimeoutOptions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TimeoutOptions -> m TimeoutOptions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeoutOptions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeoutOptions -> c TimeoutOptions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeoutOptions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimeoutOptions)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeoutOptions -> c TimeoutOptions
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeoutOptions -> c TimeoutOptions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeoutOptions
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeoutOptions
$ctoConstr :: TimeoutOptions -> Constr
toConstr :: TimeoutOptions -> Constr
$cdataTypeOf :: TimeoutOptions -> DataType
dataTypeOf :: TimeoutOptions -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeoutOptions)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeoutOptions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimeoutOptions)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimeoutOptions)
$cgmapT :: (forall b. Data b => b -> b) -> TimeoutOptions -> TimeoutOptions
gmapT :: (forall b. Data b => b -> b) -> TimeoutOptions -> TimeoutOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeoutOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeoutOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeoutOptions -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeoutOptions -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TimeoutOptions -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TimeoutOptions -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TimeoutOptions -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TimeoutOptions -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TimeoutOptions -> m TimeoutOptions
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TimeoutOptions -> m TimeoutOptions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TimeoutOptions -> m TimeoutOptions
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TimeoutOptions -> m TimeoutOptions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TimeoutOptions -> m TimeoutOptions
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TimeoutOptions -> m TimeoutOptions
Data)
defaultTimeoutOptions :: TimeoutOptions
defaultTimeoutOptions :: TimeoutOptions
defaultTimeoutOptions =
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
}