{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.SWF.Types.WorkflowExecutionInfo
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.SWF.Types.WorkflowExecutionInfo where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.SWF.Types.CloseStatus
import Amazonka.SWF.Types.ExecutionStatus
import Amazonka.SWF.Types.WorkflowExecution
import Amazonka.SWF.Types.WorkflowType

-- | Contains information about a workflow execution.
--
-- /See:/ 'newWorkflowExecutionInfo' smart constructor.
data WorkflowExecutionInfo = WorkflowExecutionInfo'
  { -- | Set to true if a cancellation is requested for this workflow execution.
    WorkflowExecutionInfo -> Maybe Bool
cancelRequested :: Prelude.Maybe Prelude.Bool,
    -- | If the execution status is closed then this specifies how the execution
    -- was closed:
    --
    -- -   @COMPLETED@ – the execution was successfully completed.
    --
    -- -   @CANCELED@ – the execution was canceled.Cancellation allows the
    --     implementation to gracefully clean up before the execution is
    --     closed.
    --
    -- -   @TERMINATED@ – the execution was force terminated.
    --
    -- -   @FAILED@ – the execution failed to complete.
    --
    -- -   @TIMED_OUT@ – the execution did not complete in the alloted time and
    --     was automatically timed out.
    --
    -- -   @CONTINUED_AS_NEW@ – the execution is logically continued. This
    --     means the current execution was completed and a new execution was
    --     started to carry on the workflow.
    WorkflowExecutionInfo -> Maybe CloseStatus
closeStatus :: Prelude.Maybe CloseStatus,
    -- | The time when the workflow execution was closed. Set only if the
    -- execution status is CLOSED.
    WorkflowExecutionInfo -> Maybe POSIX
closeTimestamp :: Prelude.Maybe Data.POSIX,
    -- | If this workflow execution is a child of another execution then contains
    -- the workflow execution that started this execution.
    WorkflowExecutionInfo -> Maybe WorkflowExecution
parent :: Prelude.Maybe WorkflowExecution,
    -- | The list of tags associated with the workflow execution. Tags can be
    -- used to identify and list workflow executions of interest through the
    -- visibility APIs. A workflow execution can have a maximum of 5 tags.
    WorkflowExecutionInfo -> Maybe [Text]
tagList :: Prelude.Maybe [Prelude.Text],
    -- | The workflow execution this information is about.
    WorkflowExecutionInfo -> WorkflowExecution
execution :: WorkflowExecution,
    -- | The type of the workflow execution.
    WorkflowExecutionInfo -> WorkflowType
workflowType :: WorkflowType,
    -- | The time when the execution was started.
    WorkflowExecutionInfo -> POSIX
startTimestamp :: Data.POSIX,
    -- | The current status of the execution.
    WorkflowExecutionInfo -> ExecutionStatus
executionStatus :: ExecutionStatus
  }
  deriving (WorkflowExecutionInfo -> WorkflowExecutionInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkflowExecutionInfo -> WorkflowExecutionInfo -> Bool
$c/= :: WorkflowExecutionInfo -> WorkflowExecutionInfo -> Bool
== :: WorkflowExecutionInfo -> WorkflowExecutionInfo -> Bool
$c== :: WorkflowExecutionInfo -> WorkflowExecutionInfo -> Bool
Prelude.Eq, ReadPrec [WorkflowExecutionInfo]
ReadPrec WorkflowExecutionInfo
Int -> ReadS WorkflowExecutionInfo
ReadS [WorkflowExecutionInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkflowExecutionInfo]
$creadListPrec :: ReadPrec [WorkflowExecutionInfo]
readPrec :: ReadPrec WorkflowExecutionInfo
$creadPrec :: ReadPrec WorkflowExecutionInfo
readList :: ReadS [WorkflowExecutionInfo]
$creadList :: ReadS [WorkflowExecutionInfo]
readsPrec :: Int -> ReadS WorkflowExecutionInfo
$creadsPrec :: Int -> ReadS WorkflowExecutionInfo
Prelude.Read, Int -> WorkflowExecutionInfo -> ShowS
[WorkflowExecutionInfo] -> ShowS
WorkflowExecutionInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkflowExecutionInfo] -> ShowS
$cshowList :: [WorkflowExecutionInfo] -> ShowS
show :: WorkflowExecutionInfo -> String
$cshow :: WorkflowExecutionInfo -> String
showsPrec :: Int -> WorkflowExecutionInfo -> ShowS
$cshowsPrec :: Int -> WorkflowExecutionInfo -> ShowS
Prelude.Show, forall x. Rep WorkflowExecutionInfo x -> WorkflowExecutionInfo
forall x. WorkflowExecutionInfo -> Rep WorkflowExecutionInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WorkflowExecutionInfo x -> WorkflowExecutionInfo
$cfrom :: forall x. WorkflowExecutionInfo -> Rep WorkflowExecutionInfo x
Prelude.Generic)

-- |
-- Create a value of 'WorkflowExecutionInfo' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'cancelRequested', 'workflowExecutionInfo_cancelRequested' - Set to true if a cancellation is requested for this workflow execution.
--
-- 'closeStatus', 'workflowExecutionInfo_closeStatus' - If the execution status is closed then this specifies how the execution
-- was closed:
--
-- -   @COMPLETED@ – the execution was successfully completed.
--
-- -   @CANCELED@ – the execution was canceled.Cancellation allows the
--     implementation to gracefully clean up before the execution is
--     closed.
--
-- -   @TERMINATED@ – the execution was force terminated.
--
-- -   @FAILED@ – the execution failed to complete.
--
-- -   @TIMED_OUT@ – the execution did not complete in the alloted time and
--     was automatically timed out.
--
-- -   @CONTINUED_AS_NEW@ – the execution is logically continued. This
--     means the current execution was completed and a new execution was
--     started to carry on the workflow.
--
-- 'closeTimestamp', 'workflowExecutionInfo_closeTimestamp' - The time when the workflow execution was closed. Set only if the
-- execution status is CLOSED.
--
-- 'parent', 'workflowExecutionInfo_parent' - If this workflow execution is a child of another execution then contains
-- the workflow execution that started this execution.
--
-- 'tagList', 'workflowExecutionInfo_tagList' - The list of tags associated with the workflow execution. Tags can be
-- used to identify and list workflow executions of interest through the
-- visibility APIs. A workflow execution can have a maximum of 5 tags.
--
-- 'execution', 'workflowExecutionInfo_execution' - The workflow execution this information is about.
--
-- 'workflowType', 'workflowExecutionInfo_workflowType' - The type of the workflow execution.
--
-- 'startTimestamp', 'workflowExecutionInfo_startTimestamp' - The time when the execution was started.
--
-- 'executionStatus', 'workflowExecutionInfo_executionStatus' - The current status of the execution.
newWorkflowExecutionInfo ::
  -- | 'execution'
  WorkflowExecution ->
  -- | 'workflowType'
  WorkflowType ->
  -- | 'startTimestamp'
  Prelude.UTCTime ->
  -- | 'executionStatus'
  ExecutionStatus ->
  WorkflowExecutionInfo
newWorkflowExecutionInfo :: WorkflowExecution
-> WorkflowType
-> UTCTime
-> ExecutionStatus
-> WorkflowExecutionInfo
newWorkflowExecutionInfo
  WorkflowExecution
pExecution_
  WorkflowType
pWorkflowType_
  UTCTime
pStartTimestamp_
  ExecutionStatus
pExecutionStatus_ =
    WorkflowExecutionInfo'
      { $sel:cancelRequested:WorkflowExecutionInfo' :: Maybe Bool
cancelRequested =
          forall a. Maybe a
Prelude.Nothing,
        $sel:closeStatus:WorkflowExecutionInfo' :: Maybe CloseStatus
closeStatus = forall a. Maybe a
Prelude.Nothing,
        $sel:closeTimestamp:WorkflowExecutionInfo' :: Maybe POSIX
closeTimestamp = forall a. Maybe a
Prelude.Nothing,
        $sel:parent:WorkflowExecutionInfo' :: Maybe WorkflowExecution
parent = forall a. Maybe a
Prelude.Nothing,
        $sel:tagList:WorkflowExecutionInfo' :: Maybe [Text]
tagList = forall a. Maybe a
Prelude.Nothing,
        $sel:execution:WorkflowExecutionInfo' :: WorkflowExecution
execution = WorkflowExecution
pExecution_,
        $sel:workflowType:WorkflowExecutionInfo' :: WorkflowType
workflowType = WorkflowType
pWorkflowType_,
        $sel:startTimestamp:WorkflowExecutionInfo' :: POSIX
startTimestamp = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTimestamp_,
        $sel:executionStatus:WorkflowExecutionInfo' :: ExecutionStatus
executionStatus = ExecutionStatus
pExecutionStatus_
      }

-- | Set to true if a cancellation is requested for this workflow execution.
workflowExecutionInfo_cancelRequested :: Lens.Lens' WorkflowExecutionInfo (Prelude.Maybe Prelude.Bool)
workflowExecutionInfo_cancelRequested :: Lens' WorkflowExecutionInfo (Maybe Bool)
workflowExecutionInfo_cancelRequested = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowExecutionInfo' {Maybe Bool
cancelRequested :: Maybe Bool
$sel:cancelRequested:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe Bool
cancelRequested} -> Maybe Bool
cancelRequested) (\s :: WorkflowExecutionInfo
s@WorkflowExecutionInfo' {} Maybe Bool
a -> WorkflowExecutionInfo
s {$sel:cancelRequested:WorkflowExecutionInfo' :: Maybe Bool
cancelRequested = Maybe Bool
a} :: WorkflowExecutionInfo)

-- | If the execution status is closed then this specifies how the execution
-- was closed:
--
-- -   @COMPLETED@ – the execution was successfully completed.
--
-- -   @CANCELED@ – the execution was canceled.Cancellation allows the
--     implementation to gracefully clean up before the execution is
--     closed.
--
-- -   @TERMINATED@ – the execution was force terminated.
--
-- -   @FAILED@ – the execution failed to complete.
--
-- -   @TIMED_OUT@ – the execution did not complete in the alloted time and
--     was automatically timed out.
--
-- -   @CONTINUED_AS_NEW@ – the execution is logically continued. This
--     means the current execution was completed and a new execution was
--     started to carry on the workflow.
workflowExecutionInfo_closeStatus :: Lens.Lens' WorkflowExecutionInfo (Prelude.Maybe CloseStatus)
workflowExecutionInfo_closeStatus :: Lens' WorkflowExecutionInfo (Maybe CloseStatus)
workflowExecutionInfo_closeStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowExecutionInfo' {Maybe CloseStatus
closeStatus :: Maybe CloseStatus
$sel:closeStatus:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe CloseStatus
closeStatus} -> Maybe CloseStatus
closeStatus) (\s :: WorkflowExecutionInfo
s@WorkflowExecutionInfo' {} Maybe CloseStatus
a -> WorkflowExecutionInfo
s {$sel:closeStatus:WorkflowExecutionInfo' :: Maybe CloseStatus
closeStatus = Maybe CloseStatus
a} :: WorkflowExecutionInfo)

-- | The time when the workflow execution was closed. Set only if the
-- execution status is CLOSED.
workflowExecutionInfo_closeTimestamp :: Lens.Lens' WorkflowExecutionInfo (Prelude.Maybe Prelude.UTCTime)
workflowExecutionInfo_closeTimestamp :: Lens' WorkflowExecutionInfo (Maybe UTCTime)
workflowExecutionInfo_closeTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowExecutionInfo' {Maybe POSIX
closeTimestamp :: Maybe POSIX
$sel:closeTimestamp:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe POSIX
closeTimestamp} -> Maybe POSIX
closeTimestamp) (\s :: WorkflowExecutionInfo
s@WorkflowExecutionInfo' {} Maybe POSIX
a -> WorkflowExecutionInfo
s {$sel:closeTimestamp:WorkflowExecutionInfo' :: Maybe POSIX
closeTimestamp = Maybe POSIX
a} :: WorkflowExecutionInfo) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | If this workflow execution is a child of another execution then contains
-- the workflow execution that started this execution.
workflowExecutionInfo_parent :: Lens.Lens' WorkflowExecutionInfo (Prelude.Maybe WorkflowExecution)
workflowExecutionInfo_parent :: Lens' WorkflowExecutionInfo (Maybe WorkflowExecution)
workflowExecutionInfo_parent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowExecutionInfo' {Maybe WorkflowExecution
parent :: Maybe WorkflowExecution
$sel:parent:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe WorkflowExecution
parent} -> Maybe WorkflowExecution
parent) (\s :: WorkflowExecutionInfo
s@WorkflowExecutionInfo' {} Maybe WorkflowExecution
a -> WorkflowExecutionInfo
s {$sel:parent:WorkflowExecutionInfo' :: Maybe WorkflowExecution
parent = Maybe WorkflowExecution
a} :: WorkflowExecutionInfo)

-- | The list of tags associated with the workflow execution. Tags can be
-- used to identify and list workflow executions of interest through the
-- visibility APIs. A workflow execution can have a maximum of 5 tags.
workflowExecutionInfo_tagList :: Lens.Lens' WorkflowExecutionInfo (Prelude.Maybe [Prelude.Text])
workflowExecutionInfo_tagList :: Lens' WorkflowExecutionInfo (Maybe [Text])
workflowExecutionInfo_tagList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowExecutionInfo' {Maybe [Text]
tagList :: Maybe [Text]
$sel:tagList:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe [Text]
tagList} -> Maybe [Text]
tagList) (\s :: WorkflowExecutionInfo
s@WorkflowExecutionInfo' {} Maybe [Text]
a -> WorkflowExecutionInfo
s {$sel:tagList:WorkflowExecutionInfo' :: Maybe [Text]
tagList = Maybe [Text]
a} :: WorkflowExecutionInfo) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The workflow execution this information is about.
workflowExecutionInfo_execution :: Lens.Lens' WorkflowExecutionInfo WorkflowExecution
workflowExecutionInfo_execution :: Lens' WorkflowExecutionInfo WorkflowExecution
workflowExecutionInfo_execution = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowExecutionInfo' {WorkflowExecution
execution :: WorkflowExecution
$sel:execution:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> WorkflowExecution
execution} -> WorkflowExecution
execution) (\s :: WorkflowExecutionInfo
s@WorkflowExecutionInfo' {} WorkflowExecution
a -> WorkflowExecutionInfo
s {$sel:execution:WorkflowExecutionInfo' :: WorkflowExecution
execution = WorkflowExecution
a} :: WorkflowExecutionInfo)

-- | The type of the workflow execution.
workflowExecutionInfo_workflowType :: Lens.Lens' WorkflowExecutionInfo WorkflowType
workflowExecutionInfo_workflowType :: Lens' WorkflowExecutionInfo WorkflowType
workflowExecutionInfo_workflowType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowExecutionInfo' {WorkflowType
workflowType :: WorkflowType
$sel:workflowType:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> WorkflowType
workflowType} -> WorkflowType
workflowType) (\s :: WorkflowExecutionInfo
s@WorkflowExecutionInfo' {} WorkflowType
a -> WorkflowExecutionInfo
s {$sel:workflowType:WorkflowExecutionInfo' :: WorkflowType
workflowType = WorkflowType
a} :: WorkflowExecutionInfo)

-- | The time when the execution was started.
workflowExecutionInfo_startTimestamp :: Lens.Lens' WorkflowExecutionInfo Prelude.UTCTime
workflowExecutionInfo_startTimestamp :: Lens' WorkflowExecutionInfo UTCTime
workflowExecutionInfo_startTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowExecutionInfo' {POSIX
startTimestamp :: POSIX
$sel:startTimestamp:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> POSIX
startTimestamp} -> POSIX
startTimestamp) (\s :: WorkflowExecutionInfo
s@WorkflowExecutionInfo' {} POSIX
a -> WorkflowExecutionInfo
s {$sel:startTimestamp:WorkflowExecutionInfo' :: POSIX
startTimestamp = POSIX
a} :: WorkflowExecutionInfo) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The current status of the execution.
workflowExecutionInfo_executionStatus :: Lens.Lens' WorkflowExecutionInfo ExecutionStatus
workflowExecutionInfo_executionStatus :: Lens' WorkflowExecutionInfo ExecutionStatus
workflowExecutionInfo_executionStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowExecutionInfo' {ExecutionStatus
executionStatus :: ExecutionStatus
$sel:executionStatus:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> ExecutionStatus
executionStatus} -> ExecutionStatus
executionStatus) (\s :: WorkflowExecutionInfo
s@WorkflowExecutionInfo' {} ExecutionStatus
a -> WorkflowExecutionInfo
s {$sel:executionStatus:WorkflowExecutionInfo' :: ExecutionStatus
executionStatus = ExecutionStatus
a} :: WorkflowExecutionInfo)

instance Data.FromJSON WorkflowExecutionInfo where
  parseJSON :: Value -> Parser WorkflowExecutionInfo
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"WorkflowExecutionInfo"
      ( \Object
x ->
          Maybe Bool
-> Maybe CloseStatus
-> Maybe POSIX
-> Maybe WorkflowExecution
-> Maybe [Text]
-> WorkflowExecution
-> WorkflowType
-> POSIX
-> ExecutionStatus
-> WorkflowExecutionInfo
WorkflowExecutionInfo'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"cancelRequested")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"closeStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"closeTimestamp")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"parent")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"tagList" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"execution")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"workflowType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"startTimestamp")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"executionStatus")
      )

instance Prelude.Hashable WorkflowExecutionInfo where
  hashWithSalt :: Int -> WorkflowExecutionInfo -> Int
hashWithSalt Int
_salt WorkflowExecutionInfo' {Maybe Bool
Maybe [Text]
Maybe POSIX
Maybe CloseStatus
Maybe WorkflowExecution
POSIX
ExecutionStatus
WorkflowExecution
WorkflowType
executionStatus :: ExecutionStatus
startTimestamp :: POSIX
workflowType :: WorkflowType
execution :: WorkflowExecution
tagList :: Maybe [Text]
parent :: Maybe WorkflowExecution
closeTimestamp :: Maybe POSIX
closeStatus :: Maybe CloseStatus
cancelRequested :: Maybe Bool
$sel:executionStatus:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> ExecutionStatus
$sel:startTimestamp:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> POSIX
$sel:workflowType:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> WorkflowType
$sel:execution:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> WorkflowExecution
$sel:tagList:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe [Text]
$sel:parent:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe WorkflowExecution
$sel:closeTimestamp:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe POSIX
$sel:closeStatus:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe CloseStatus
$sel:cancelRequested:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
cancelRequested
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloseStatus
closeStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
closeTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkflowExecution
parent
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
tagList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` WorkflowExecution
execution
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` WorkflowType
workflowType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
startTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ExecutionStatus
executionStatus

instance Prelude.NFData WorkflowExecutionInfo where
  rnf :: WorkflowExecutionInfo -> ()
rnf WorkflowExecutionInfo' {Maybe Bool
Maybe [Text]
Maybe POSIX
Maybe CloseStatus
Maybe WorkflowExecution
POSIX
ExecutionStatus
WorkflowExecution
WorkflowType
executionStatus :: ExecutionStatus
startTimestamp :: POSIX
workflowType :: WorkflowType
execution :: WorkflowExecution
tagList :: Maybe [Text]
parent :: Maybe WorkflowExecution
closeTimestamp :: Maybe POSIX
closeStatus :: Maybe CloseStatus
cancelRequested :: Maybe Bool
$sel:executionStatus:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> ExecutionStatus
$sel:startTimestamp:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> POSIX
$sel:workflowType:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> WorkflowType
$sel:execution:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> WorkflowExecution
$sel:tagList:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe [Text]
$sel:parent:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe WorkflowExecution
$sel:closeTimestamp:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe POSIX
$sel:closeStatus:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe CloseStatus
$sel:cancelRequested:WorkflowExecutionInfo' :: WorkflowExecutionInfo -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
cancelRequested
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CloseStatus
closeStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
closeTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowExecution
parent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
tagList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf WorkflowExecution
execution
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf WorkflowType
workflowType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
startTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ExecutionStatus
executionStatus