{-# 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.Condition
-- 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.Condition 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.CrawlState
import Amazonka.Glue.Types.JobRunState
import Amazonka.Glue.Types.LogicalOperator
import qualified Amazonka.Prelude as Prelude

-- | Defines a condition under which a trigger fires.
--
-- /See:/ 'newCondition' smart constructor.
data Condition = Condition'
  { -- | The state of the crawler to which this condition applies.
    Condition -> Maybe CrawlState
crawlState :: Prelude.Maybe CrawlState,
    -- | The name of the crawler to which this condition applies.
    Condition -> Maybe Text
crawlerName :: Prelude.Maybe Prelude.Text,
    -- | The name of the job whose @JobRuns@ this condition applies to, and on
    -- which this trigger waits.
    Condition -> Maybe Text
jobName :: Prelude.Maybe Prelude.Text,
    -- | A logical operator.
    Condition -> Maybe LogicalOperator
logicalOperator :: Prelude.Maybe LogicalOperator,
    -- | The condition state. Currently, the only job states that a trigger can
    -- listen for are @SUCCEEDED@, @STOPPED@, @FAILED@, and @TIMEOUT@. The only
    -- crawler states that a trigger can listen for are @SUCCEEDED@, @FAILED@,
    -- and @CANCELLED@.
    Condition -> Maybe JobRunState
state :: Prelude.Maybe JobRunState
  }
  deriving (Condition -> Condition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c== :: Condition -> Condition -> Bool
Prelude.Eq, ReadPrec [Condition]
ReadPrec Condition
Int -> ReadS Condition
ReadS [Condition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Condition]
$creadListPrec :: ReadPrec [Condition]
readPrec :: ReadPrec Condition
$creadPrec :: ReadPrec Condition
readList :: ReadS [Condition]
$creadList :: ReadS [Condition]
readsPrec :: Int -> ReadS Condition
$creadsPrec :: Int -> ReadS Condition
Prelude.Read, Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> Condition -> ShowS
Prelude.Show, forall x. Rep Condition x -> Condition
forall x. Condition -> Rep Condition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Condition x -> Condition
$cfrom :: forall x. Condition -> Rep Condition x
Prelude.Generic)

-- |
-- Create a value of 'Condition' 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:
--
-- 'crawlState', 'condition_crawlState' - The state of the crawler to which this condition applies.
--
-- 'crawlerName', 'condition_crawlerName' - The name of the crawler to which this condition applies.
--
-- 'jobName', 'condition_jobName' - The name of the job whose @JobRuns@ this condition applies to, and on
-- which this trigger waits.
--
-- 'logicalOperator', 'condition_logicalOperator' - A logical operator.
--
-- 'state', 'condition_state' - The condition state. Currently, the only job states that a trigger can
-- listen for are @SUCCEEDED@, @STOPPED@, @FAILED@, and @TIMEOUT@. The only
-- crawler states that a trigger can listen for are @SUCCEEDED@, @FAILED@,
-- and @CANCELLED@.
newCondition ::
  Condition
newCondition :: Condition
newCondition =
  Condition'
    { $sel:crawlState:Condition' :: Maybe CrawlState
crawlState = forall a. Maybe a
Prelude.Nothing,
      $sel:crawlerName:Condition' :: Maybe Text
crawlerName = forall a. Maybe a
Prelude.Nothing,
      $sel:jobName:Condition' :: Maybe Text
jobName = forall a. Maybe a
Prelude.Nothing,
      $sel:logicalOperator:Condition' :: Maybe LogicalOperator
logicalOperator = forall a. Maybe a
Prelude.Nothing,
      $sel:state:Condition' :: Maybe JobRunState
state = forall a. Maybe a
Prelude.Nothing
    }

-- | The state of the crawler to which this condition applies.
condition_crawlState :: Lens.Lens' Condition (Prelude.Maybe CrawlState)
condition_crawlState :: Lens' Condition (Maybe CrawlState)
condition_crawlState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Condition' {Maybe CrawlState
crawlState :: Maybe CrawlState
$sel:crawlState:Condition' :: Condition -> Maybe CrawlState
crawlState} -> Maybe CrawlState
crawlState) (\s :: Condition
s@Condition' {} Maybe CrawlState
a -> Condition
s {$sel:crawlState:Condition' :: Maybe CrawlState
crawlState = Maybe CrawlState
a} :: Condition)

-- | The name of the crawler to which this condition applies.
condition_crawlerName :: Lens.Lens' Condition (Prelude.Maybe Prelude.Text)
condition_crawlerName :: Lens' Condition (Maybe Text)
condition_crawlerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Condition' {Maybe Text
crawlerName :: Maybe Text
$sel:crawlerName:Condition' :: Condition -> Maybe Text
crawlerName} -> Maybe Text
crawlerName) (\s :: Condition
s@Condition' {} Maybe Text
a -> Condition
s {$sel:crawlerName:Condition' :: Maybe Text
crawlerName = Maybe Text
a} :: Condition)

-- | The name of the job whose @JobRuns@ this condition applies to, and on
-- which this trigger waits.
condition_jobName :: Lens.Lens' Condition (Prelude.Maybe Prelude.Text)
condition_jobName :: Lens' Condition (Maybe Text)
condition_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Condition' {Maybe Text
jobName :: Maybe Text
$sel:jobName:Condition' :: Condition -> Maybe Text
jobName} -> Maybe Text
jobName) (\s :: Condition
s@Condition' {} Maybe Text
a -> Condition
s {$sel:jobName:Condition' :: Maybe Text
jobName = Maybe Text
a} :: Condition)

-- | A logical operator.
condition_logicalOperator :: Lens.Lens' Condition (Prelude.Maybe LogicalOperator)
condition_logicalOperator :: Lens' Condition (Maybe LogicalOperator)
condition_logicalOperator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Condition' {Maybe LogicalOperator
logicalOperator :: Maybe LogicalOperator
$sel:logicalOperator:Condition' :: Condition -> Maybe LogicalOperator
logicalOperator} -> Maybe LogicalOperator
logicalOperator) (\s :: Condition
s@Condition' {} Maybe LogicalOperator
a -> Condition
s {$sel:logicalOperator:Condition' :: Maybe LogicalOperator
logicalOperator = Maybe LogicalOperator
a} :: Condition)

-- | The condition state. Currently, the only job states that a trigger can
-- listen for are @SUCCEEDED@, @STOPPED@, @FAILED@, and @TIMEOUT@. The only
-- crawler states that a trigger can listen for are @SUCCEEDED@, @FAILED@,
-- and @CANCELLED@.
condition_state :: Lens.Lens' Condition (Prelude.Maybe JobRunState)
condition_state :: Lens' Condition (Maybe JobRunState)
condition_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Condition' {Maybe JobRunState
state :: Maybe JobRunState
$sel:state:Condition' :: Condition -> Maybe JobRunState
state} -> Maybe JobRunState
state) (\s :: Condition
s@Condition' {} Maybe JobRunState
a -> Condition
s {$sel:state:Condition' :: Maybe JobRunState
state = Maybe JobRunState
a} :: Condition)

instance Data.FromJSON Condition where
  parseJSON :: Value -> Parser Condition
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Condition"
      ( \Object
x ->
          Maybe CrawlState
-> Maybe Text
-> Maybe Text
-> Maybe LogicalOperator
-> Maybe JobRunState
-> Condition
Condition'
            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
"CrawlState")
            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
"CrawlerName")
            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
"JobName")
            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
"LogicalOperator")
            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
"State")
      )

instance Prelude.Hashable Condition where
  hashWithSalt :: Int -> Condition -> Int
hashWithSalt Int
_salt Condition' {Maybe Text
Maybe CrawlState
Maybe JobRunState
Maybe LogicalOperator
state :: Maybe JobRunState
logicalOperator :: Maybe LogicalOperator
jobName :: Maybe Text
crawlerName :: Maybe Text
crawlState :: Maybe CrawlState
$sel:state:Condition' :: Condition -> Maybe JobRunState
$sel:logicalOperator:Condition' :: Condition -> Maybe LogicalOperator
$sel:jobName:Condition' :: Condition -> Maybe Text
$sel:crawlerName:Condition' :: Condition -> Maybe Text
$sel:crawlState:Condition' :: Condition -> Maybe CrawlState
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CrawlState
crawlState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
crawlerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LogicalOperator
logicalOperator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobRunState
state

instance Prelude.NFData Condition where
  rnf :: Condition -> ()
rnf Condition' {Maybe Text
Maybe CrawlState
Maybe JobRunState
Maybe LogicalOperator
state :: Maybe JobRunState
logicalOperator :: Maybe LogicalOperator
jobName :: Maybe Text
crawlerName :: Maybe Text
crawlState :: Maybe CrawlState
$sel:state:Condition' :: Condition -> Maybe JobRunState
$sel:logicalOperator:Condition' :: Condition -> Maybe LogicalOperator
$sel:jobName:Condition' :: Condition -> Maybe Text
$sel:crawlerName:Condition' :: Condition -> Maybe Text
$sel:crawlState:Condition' :: Condition -> Maybe CrawlState
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CrawlState
crawlState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
crawlerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LogicalOperator
logicalOperator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobRunState
state

instance Data.ToJSON Condition where
  toJSON :: Condition -> Value
toJSON Condition' {Maybe Text
Maybe CrawlState
Maybe JobRunState
Maybe LogicalOperator
state :: Maybe JobRunState
logicalOperator :: Maybe LogicalOperator
jobName :: Maybe Text
crawlerName :: Maybe Text
crawlState :: Maybe CrawlState
$sel:state:Condition' :: Condition -> Maybe JobRunState
$sel:logicalOperator:Condition' :: Condition -> Maybe LogicalOperator
$sel:jobName:Condition' :: Condition -> Maybe Text
$sel:crawlerName:Condition' :: Condition -> Maybe Text
$sel:crawlState:Condition' :: Condition -> Maybe CrawlState
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CrawlState" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CrawlState
crawlState,
            (Key
"CrawlerName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
crawlerName,
            (Key
"JobName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
jobName,
            (Key
"LogicalOperator" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe LogicalOperator
logicalOperator,
            (Key
"State" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe JobRunState
state
          ]
      )