{-# 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.Glue.Types.WorkflowRun
-- 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.Glue.Types.WorkflowRun where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Glue.Types.StartingEventBatchCondition
import Amazonka.Glue.Types.WorkflowGraph
import Amazonka.Glue.Types.WorkflowRunStatistics
import Amazonka.Glue.Types.WorkflowRunStatus
import qualified Amazonka.Prelude as Prelude

-- | A workflow run is an execution of a workflow providing all the runtime
-- information.
--
-- /See:/ 'newWorkflowRun' smart constructor.
data WorkflowRun = WorkflowRun'
  { -- | The date and time when the workflow run completed.
    WorkflowRun -> Maybe POSIX
completedOn :: Prelude.Maybe Data.POSIX,
    -- | This error message describes any error that may have occurred in
    -- starting the workflow run. Currently the only error message is
    -- \"Concurrent runs exceeded for workflow: @foo@.\"
    WorkflowRun -> Maybe Text
errorMessage :: Prelude.Maybe Prelude.Text,
    -- | The graph representing all the Glue components that belong to the
    -- workflow as nodes and directed connections between them as edges.
    WorkflowRun -> Maybe WorkflowGraph
graph :: Prelude.Maybe WorkflowGraph,
    -- | Name of the workflow that was run.
    WorkflowRun -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The ID of the previous workflow run.
    WorkflowRun -> Maybe Text
previousRunId :: Prelude.Maybe Prelude.Text,
    -- | The date and time when the workflow run was started.
    WorkflowRun -> Maybe POSIX
startedOn :: Prelude.Maybe Data.POSIX,
    -- | The batch condition that started the workflow run.
    WorkflowRun -> Maybe StartingEventBatchCondition
startingEventBatchCondition :: Prelude.Maybe StartingEventBatchCondition,
    -- | The statistics of the run.
    WorkflowRun -> Maybe WorkflowRunStatistics
statistics :: Prelude.Maybe WorkflowRunStatistics,
    -- | The status of the workflow run.
    WorkflowRun -> Maybe WorkflowRunStatus
status :: Prelude.Maybe WorkflowRunStatus,
    -- | The ID of this workflow run.
    WorkflowRun -> Maybe Text
workflowRunId :: Prelude.Maybe Prelude.Text,
    -- | The workflow run properties which were set during the run.
    WorkflowRun -> Maybe (HashMap Text Text)
workflowRunProperties :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text)
  }
  deriving (WorkflowRun -> WorkflowRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkflowRun -> WorkflowRun -> Bool
$c/= :: WorkflowRun -> WorkflowRun -> Bool
== :: WorkflowRun -> WorkflowRun -> Bool
$c== :: WorkflowRun -> WorkflowRun -> Bool
Prelude.Eq, ReadPrec [WorkflowRun]
ReadPrec WorkflowRun
Int -> ReadS WorkflowRun
ReadS [WorkflowRun]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkflowRun]
$creadListPrec :: ReadPrec [WorkflowRun]
readPrec :: ReadPrec WorkflowRun
$creadPrec :: ReadPrec WorkflowRun
readList :: ReadS [WorkflowRun]
$creadList :: ReadS [WorkflowRun]
readsPrec :: Int -> ReadS WorkflowRun
$creadsPrec :: Int -> ReadS WorkflowRun
Prelude.Read, Int -> WorkflowRun -> ShowS
[WorkflowRun] -> ShowS
WorkflowRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkflowRun] -> ShowS
$cshowList :: [WorkflowRun] -> ShowS
show :: WorkflowRun -> String
$cshow :: WorkflowRun -> String
showsPrec :: Int -> WorkflowRun -> ShowS
$cshowsPrec :: Int -> WorkflowRun -> ShowS
Prelude.Show, forall x. Rep WorkflowRun x -> WorkflowRun
forall x. WorkflowRun -> Rep WorkflowRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WorkflowRun x -> WorkflowRun
$cfrom :: forall x. WorkflowRun -> Rep WorkflowRun x
Prelude.Generic)

-- |
-- Create a value of 'WorkflowRun' 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:
--
-- 'completedOn', 'workflowRun_completedOn' - The date and time when the workflow run completed.
--
-- 'errorMessage', 'workflowRun_errorMessage' - This error message describes any error that may have occurred in
-- starting the workflow run. Currently the only error message is
-- \"Concurrent runs exceeded for workflow: @foo@.\"
--
-- 'graph', 'workflowRun_graph' - The graph representing all the Glue components that belong to the
-- workflow as nodes and directed connections between them as edges.
--
-- 'name', 'workflowRun_name' - Name of the workflow that was run.
--
-- 'previousRunId', 'workflowRun_previousRunId' - The ID of the previous workflow run.
--
-- 'startedOn', 'workflowRun_startedOn' - The date and time when the workflow run was started.
--
-- 'startingEventBatchCondition', 'workflowRun_startingEventBatchCondition' - The batch condition that started the workflow run.
--
-- 'statistics', 'workflowRun_statistics' - The statistics of the run.
--
-- 'status', 'workflowRun_status' - The status of the workflow run.
--
-- 'workflowRunId', 'workflowRun_workflowRunId' - The ID of this workflow run.
--
-- 'workflowRunProperties', 'workflowRun_workflowRunProperties' - The workflow run properties which were set during the run.
newWorkflowRun ::
  WorkflowRun
newWorkflowRun :: WorkflowRun
newWorkflowRun =
  WorkflowRun'
    { $sel:completedOn:WorkflowRun' :: Maybe POSIX
completedOn = forall a. Maybe a
Prelude.Nothing,
      $sel:errorMessage:WorkflowRun' :: Maybe Text
errorMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:graph:WorkflowRun' :: Maybe WorkflowGraph
graph = forall a. Maybe a
Prelude.Nothing,
      $sel:name:WorkflowRun' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:previousRunId:WorkflowRun' :: Maybe Text
previousRunId = forall a. Maybe a
Prelude.Nothing,
      $sel:startedOn:WorkflowRun' :: Maybe POSIX
startedOn = forall a. Maybe a
Prelude.Nothing,
      $sel:startingEventBatchCondition:WorkflowRun' :: Maybe StartingEventBatchCondition
startingEventBatchCondition = forall a. Maybe a
Prelude.Nothing,
      $sel:statistics:WorkflowRun' :: Maybe WorkflowRunStatistics
statistics = forall a. Maybe a
Prelude.Nothing,
      $sel:status:WorkflowRun' :: Maybe WorkflowRunStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:workflowRunId:WorkflowRun' :: Maybe Text
workflowRunId = forall a. Maybe a
Prelude.Nothing,
      $sel:workflowRunProperties:WorkflowRun' :: Maybe (HashMap Text Text)
workflowRunProperties = forall a. Maybe a
Prelude.Nothing
    }

-- | The date and time when the workflow run completed.
workflowRun_completedOn :: Lens.Lens' WorkflowRun (Prelude.Maybe Prelude.UTCTime)
workflowRun_completedOn :: Lens' WorkflowRun (Maybe UTCTime)
workflowRun_completedOn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowRun' {Maybe POSIX
completedOn :: Maybe POSIX
$sel:completedOn:WorkflowRun' :: WorkflowRun -> Maybe POSIX
completedOn} -> Maybe POSIX
completedOn) (\s :: WorkflowRun
s@WorkflowRun' {} Maybe POSIX
a -> WorkflowRun
s {$sel:completedOn:WorkflowRun' :: Maybe POSIX
completedOn = Maybe POSIX
a} :: WorkflowRun) 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

-- | This error message describes any error that may have occurred in
-- starting the workflow run. Currently the only error message is
-- \"Concurrent runs exceeded for workflow: @foo@.\"
workflowRun_errorMessage :: Lens.Lens' WorkflowRun (Prelude.Maybe Prelude.Text)
workflowRun_errorMessage :: Lens' WorkflowRun (Maybe Text)
workflowRun_errorMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowRun' {Maybe Text
errorMessage :: Maybe Text
$sel:errorMessage:WorkflowRun' :: WorkflowRun -> Maybe Text
errorMessage} -> Maybe Text
errorMessage) (\s :: WorkflowRun
s@WorkflowRun' {} Maybe Text
a -> WorkflowRun
s {$sel:errorMessage:WorkflowRun' :: Maybe Text
errorMessage = Maybe Text
a} :: WorkflowRun)

-- | The graph representing all the Glue components that belong to the
-- workflow as nodes and directed connections between them as edges.
workflowRun_graph :: Lens.Lens' WorkflowRun (Prelude.Maybe WorkflowGraph)
workflowRun_graph :: Lens' WorkflowRun (Maybe WorkflowGraph)
workflowRun_graph = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowRun' {Maybe WorkflowGraph
graph :: Maybe WorkflowGraph
$sel:graph:WorkflowRun' :: WorkflowRun -> Maybe WorkflowGraph
graph} -> Maybe WorkflowGraph
graph) (\s :: WorkflowRun
s@WorkflowRun' {} Maybe WorkflowGraph
a -> WorkflowRun
s {$sel:graph:WorkflowRun' :: Maybe WorkflowGraph
graph = Maybe WorkflowGraph
a} :: WorkflowRun)

-- | Name of the workflow that was run.
workflowRun_name :: Lens.Lens' WorkflowRun (Prelude.Maybe Prelude.Text)
workflowRun_name :: Lens' WorkflowRun (Maybe Text)
workflowRun_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowRun' {Maybe Text
name :: Maybe Text
$sel:name:WorkflowRun' :: WorkflowRun -> Maybe Text
name} -> Maybe Text
name) (\s :: WorkflowRun
s@WorkflowRun' {} Maybe Text
a -> WorkflowRun
s {$sel:name:WorkflowRun' :: Maybe Text
name = Maybe Text
a} :: WorkflowRun)

-- | The ID of the previous workflow run.
workflowRun_previousRunId :: Lens.Lens' WorkflowRun (Prelude.Maybe Prelude.Text)
workflowRun_previousRunId :: Lens' WorkflowRun (Maybe Text)
workflowRun_previousRunId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowRun' {Maybe Text
previousRunId :: Maybe Text
$sel:previousRunId:WorkflowRun' :: WorkflowRun -> Maybe Text
previousRunId} -> Maybe Text
previousRunId) (\s :: WorkflowRun
s@WorkflowRun' {} Maybe Text
a -> WorkflowRun
s {$sel:previousRunId:WorkflowRun' :: Maybe Text
previousRunId = Maybe Text
a} :: WorkflowRun)

-- | The date and time when the workflow run was started.
workflowRun_startedOn :: Lens.Lens' WorkflowRun (Prelude.Maybe Prelude.UTCTime)
workflowRun_startedOn :: Lens' WorkflowRun (Maybe UTCTime)
workflowRun_startedOn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowRun' {Maybe POSIX
startedOn :: Maybe POSIX
$sel:startedOn:WorkflowRun' :: WorkflowRun -> Maybe POSIX
startedOn} -> Maybe POSIX
startedOn) (\s :: WorkflowRun
s@WorkflowRun' {} Maybe POSIX
a -> WorkflowRun
s {$sel:startedOn:WorkflowRun' :: Maybe POSIX
startedOn = Maybe POSIX
a} :: WorkflowRun) 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

-- | The batch condition that started the workflow run.
workflowRun_startingEventBatchCondition :: Lens.Lens' WorkflowRun (Prelude.Maybe StartingEventBatchCondition)
workflowRun_startingEventBatchCondition :: Lens' WorkflowRun (Maybe StartingEventBatchCondition)
workflowRun_startingEventBatchCondition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowRun' {Maybe StartingEventBatchCondition
startingEventBatchCondition :: Maybe StartingEventBatchCondition
$sel:startingEventBatchCondition:WorkflowRun' :: WorkflowRun -> Maybe StartingEventBatchCondition
startingEventBatchCondition} -> Maybe StartingEventBatchCondition
startingEventBatchCondition) (\s :: WorkflowRun
s@WorkflowRun' {} Maybe StartingEventBatchCondition
a -> WorkflowRun
s {$sel:startingEventBatchCondition:WorkflowRun' :: Maybe StartingEventBatchCondition
startingEventBatchCondition = Maybe StartingEventBatchCondition
a} :: WorkflowRun)

-- | The statistics of the run.
workflowRun_statistics :: Lens.Lens' WorkflowRun (Prelude.Maybe WorkflowRunStatistics)
workflowRun_statistics :: Lens' WorkflowRun (Maybe WorkflowRunStatistics)
workflowRun_statistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowRun' {Maybe WorkflowRunStatistics
statistics :: Maybe WorkflowRunStatistics
$sel:statistics:WorkflowRun' :: WorkflowRun -> Maybe WorkflowRunStatistics
statistics} -> Maybe WorkflowRunStatistics
statistics) (\s :: WorkflowRun
s@WorkflowRun' {} Maybe WorkflowRunStatistics
a -> WorkflowRun
s {$sel:statistics:WorkflowRun' :: Maybe WorkflowRunStatistics
statistics = Maybe WorkflowRunStatistics
a} :: WorkflowRun)

-- | The status of the workflow run.
workflowRun_status :: Lens.Lens' WorkflowRun (Prelude.Maybe WorkflowRunStatus)
workflowRun_status :: Lens' WorkflowRun (Maybe WorkflowRunStatus)
workflowRun_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowRun' {Maybe WorkflowRunStatus
status :: Maybe WorkflowRunStatus
$sel:status:WorkflowRun' :: WorkflowRun -> Maybe WorkflowRunStatus
status} -> Maybe WorkflowRunStatus
status) (\s :: WorkflowRun
s@WorkflowRun' {} Maybe WorkflowRunStatus
a -> WorkflowRun
s {$sel:status:WorkflowRun' :: Maybe WorkflowRunStatus
status = Maybe WorkflowRunStatus
a} :: WorkflowRun)

-- | The ID of this workflow run.
workflowRun_workflowRunId :: Lens.Lens' WorkflowRun (Prelude.Maybe Prelude.Text)
workflowRun_workflowRunId :: Lens' WorkflowRun (Maybe Text)
workflowRun_workflowRunId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowRun' {Maybe Text
workflowRunId :: Maybe Text
$sel:workflowRunId:WorkflowRun' :: WorkflowRun -> Maybe Text
workflowRunId} -> Maybe Text
workflowRunId) (\s :: WorkflowRun
s@WorkflowRun' {} Maybe Text
a -> WorkflowRun
s {$sel:workflowRunId:WorkflowRun' :: Maybe Text
workflowRunId = Maybe Text
a} :: WorkflowRun)

-- | The workflow run properties which were set during the run.
workflowRun_workflowRunProperties :: Lens.Lens' WorkflowRun (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
workflowRun_workflowRunProperties :: Lens' WorkflowRun (Maybe (HashMap Text Text))
workflowRun_workflowRunProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkflowRun' {Maybe (HashMap Text Text)
workflowRunProperties :: Maybe (HashMap Text Text)
$sel:workflowRunProperties:WorkflowRun' :: WorkflowRun -> Maybe (HashMap Text Text)
workflowRunProperties} -> Maybe (HashMap Text Text)
workflowRunProperties) (\s :: WorkflowRun
s@WorkflowRun' {} Maybe (HashMap Text Text)
a -> WorkflowRun
s {$sel:workflowRunProperties:WorkflowRun' :: Maybe (HashMap Text Text)
workflowRunProperties = Maybe (HashMap Text Text)
a} :: WorkflowRun) 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

instance Data.FromJSON WorkflowRun where
  parseJSON :: Value -> Parser WorkflowRun
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"WorkflowRun"
      ( \Object
x ->
          Maybe POSIX
-> Maybe Text
-> Maybe WorkflowGraph
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe StartingEventBatchCondition
-> Maybe WorkflowRunStatistics
-> Maybe WorkflowRunStatus
-> Maybe Text
-> Maybe (HashMap Text Text)
-> WorkflowRun
WorkflowRun'
            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
"CompletedOn")
            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
"ErrorMessage")
            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
"Graph")
            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
"Name")
            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
"PreviousRunId")
            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
"StartedOn")
            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
"StartingEventBatchCondition")
            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
"Statistics")
            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
"Status")
            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
"WorkflowRunId")
            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
"WorkflowRunProperties"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable WorkflowRun where
  hashWithSalt :: Int -> WorkflowRun -> Int
hashWithSalt Int
_salt WorkflowRun' {Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe StartingEventBatchCondition
Maybe WorkflowGraph
Maybe WorkflowRunStatistics
Maybe WorkflowRunStatus
workflowRunProperties :: Maybe (HashMap Text Text)
workflowRunId :: Maybe Text
status :: Maybe WorkflowRunStatus
statistics :: Maybe WorkflowRunStatistics
startingEventBatchCondition :: Maybe StartingEventBatchCondition
startedOn :: Maybe POSIX
previousRunId :: Maybe Text
name :: Maybe Text
graph :: Maybe WorkflowGraph
errorMessage :: Maybe Text
completedOn :: Maybe POSIX
$sel:workflowRunProperties:WorkflowRun' :: WorkflowRun -> Maybe (HashMap Text Text)
$sel:workflowRunId:WorkflowRun' :: WorkflowRun -> Maybe Text
$sel:status:WorkflowRun' :: WorkflowRun -> Maybe WorkflowRunStatus
$sel:statistics:WorkflowRun' :: WorkflowRun -> Maybe WorkflowRunStatistics
$sel:startingEventBatchCondition:WorkflowRun' :: WorkflowRun -> Maybe StartingEventBatchCondition
$sel:startedOn:WorkflowRun' :: WorkflowRun -> Maybe POSIX
$sel:previousRunId:WorkflowRun' :: WorkflowRun -> Maybe Text
$sel:name:WorkflowRun' :: WorkflowRun -> Maybe Text
$sel:graph:WorkflowRun' :: WorkflowRun -> Maybe WorkflowGraph
$sel:errorMessage:WorkflowRun' :: WorkflowRun -> Maybe Text
$sel:completedOn:WorkflowRun' :: WorkflowRun -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
completedOn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
errorMessage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkflowGraph
graph
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
previousRunId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startedOn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StartingEventBatchCondition
startingEventBatchCondition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkflowRunStatistics
statistics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkflowRunStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
workflowRunId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
workflowRunProperties

instance Prelude.NFData WorkflowRun where
  rnf :: WorkflowRun -> ()
rnf WorkflowRun' {Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe StartingEventBatchCondition
Maybe WorkflowGraph
Maybe WorkflowRunStatistics
Maybe WorkflowRunStatus
workflowRunProperties :: Maybe (HashMap Text Text)
workflowRunId :: Maybe Text
status :: Maybe WorkflowRunStatus
statistics :: Maybe WorkflowRunStatistics
startingEventBatchCondition :: Maybe StartingEventBatchCondition
startedOn :: Maybe POSIX
previousRunId :: Maybe Text
name :: Maybe Text
graph :: Maybe WorkflowGraph
errorMessage :: Maybe Text
completedOn :: Maybe POSIX
$sel:workflowRunProperties:WorkflowRun' :: WorkflowRun -> Maybe (HashMap Text Text)
$sel:workflowRunId:WorkflowRun' :: WorkflowRun -> Maybe Text
$sel:status:WorkflowRun' :: WorkflowRun -> Maybe WorkflowRunStatus
$sel:statistics:WorkflowRun' :: WorkflowRun -> Maybe WorkflowRunStatistics
$sel:startingEventBatchCondition:WorkflowRun' :: WorkflowRun -> Maybe StartingEventBatchCondition
$sel:startedOn:WorkflowRun' :: WorkflowRun -> Maybe POSIX
$sel:previousRunId:WorkflowRun' :: WorkflowRun -> Maybe Text
$sel:name:WorkflowRun' :: WorkflowRun -> Maybe Text
$sel:graph:WorkflowRun' :: WorkflowRun -> Maybe WorkflowGraph
$sel:errorMessage:WorkflowRun' :: WorkflowRun -> Maybe Text
$sel:completedOn:WorkflowRun' :: WorkflowRun -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
completedOn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
errorMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowGraph
graph
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
previousRunId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startedOn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StartingEventBatchCondition
startingEventBatchCondition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowRunStatistics
statistics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowRunStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
workflowRunId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
workflowRunProperties