{-# 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.IoTEvents.Types.State
-- 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.IoTEvents.Types.State where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTEvents.Types.OnEnterLifecycle
import Amazonka.IoTEvents.Types.OnExitLifecycle
import Amazonka.IoTEvents.Types.OnInputLifecycle
import qualified Amazonka.Prelude as Prelude

-- | Information that defines a state of a detector.
--
-- /See:/ 'newState' smart constructor.
data State = State'
  { -- | When entering this state, perform these @actions@ if the @condition@ is
    -- TRUE.
    State -> Maybe OnEnterLifecycle
onEnter :: Prelude.Maybe OnEnterLifecycle,
    -- | When exiting this state, perform these @actions@ if the specified
    -- @condition@ is @TRUE@.
    State -> Maybe OnExitLifecycle
onExit :: Prelude.Maybe OnExitLifecycle,
    -- | When an input is received and the @condition@ is TRUE, perform the
    -- specified @actions@.
    State -> Maybe OnInputLifecycle
onInput :: Prelude.Maybe OnInputLifecycle,
    -- | The name of the state.
    State -> Text
stateName :: Prelude.Text
  }
  deriving (State -> State -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Prelude.Eq, ReadPrec [State]
ReadPrec State
Int -> ReadS State
ReadS [State]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [State]
$creadListPrec :: ReadPrec [State]
readPrec :: ReadPrec State
$creadPrec :: ReadPrec State
readList :: ReadS [State]
$creadList :: ReadS [State]
readsPrec :: Int -> ReadS State
$creadsPrec :: Int -> ReadS State
Prelude.Read, Int -> State -> ShowS
[State] -> ShowS
State -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Prelude.Show, forall x. Rep State x -> State
forall x. State -> Rep State x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep State x -> State
$cfrom :: forall x. State -> Rep State x
Prelude.Generic)

-- |
-- Create a value of 'State' 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:
--
-- 'onEnter', 'state_onEnter' - When entering this state, perform these @actions@ if the @condition@ is
-- TRUE.
--
-- 'onExit', 'state_onExit' - When exiting this state, perform these @actions@ if the specified
-- @condition@ is @TRUE@.
--
-- 'onInput', 'state_onInput' - When an input is received and the @condition@ is TRUE, perform the
-- specified @actions@.
--
-- 'stateName', 'state_stateName' - The name of the state.
newState ::
  -- | 'stateName'
  Prelude.Text ->
  State
newState :: Text -> State
newState Text
pStateName_ =
  State'
    { $sel:onEnter:State' :: Maybe OnEnterLifecycle
onEnter = forall a. Maybe a
Prelude.Nothing,
      $sel:onExit:State' :: Maybe OnExitLifecycle
onExit = forall a. Maybe a
Prelude.Nothing,
      $sel:onInput:State' :: Maybe OnInputLifecycle
onInput = forall a. Maybe a
Prelude.Nothing,
      $sel:stateName:State' :: Text
stateName = Text
pStateName_
    }

-- | When entering this state, perform these @actions@ if the @condition@ is
-- TRUE.
state_onEnter :: Lens.Lens' State (Prelude.Maybe OnEnterLifecycle)
state_onEnter :: Lens' State (Maybe OnEnterLifecycle)
state_onEnter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\State' {Maybe OnEnterLifecycle
onEnter :: Maybe OnEnterLifecycle
$sel:onEnter:State' :: State -> Maybe OnEnterLifecycle
onEnter} -> Maybe OnEnterLifecycle
onEnter) (\s :: State
s@State' {} Maybe OnEnterLifecycle
a -> State
s {$sel:onEnter:State' :: Maybe OnEnterLifecycle
onEnter = Maybe OnEnterLifecycle
a} :: State)

-- | When exiting this state, perform these @actions@ if the specified
-- @condition@ is @TRUE@.
state_onExit :: Lens.Lens' State (Prelude.Maybe OnExitLifecycle)
state_onExit :: Lens' State (Maybe OnExitLifecycle)
state_onExit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\State' {Maybe OnExitLifecycle
onExit :: Maybe OnExitLifecycle
$sel:onExit:State' :: State -> Maybe OnExitLifecycle
onExit} -> Maybe OnExitLifecycle
onExit) (\s :: State
s@State' {} Maybe OnExitLifecycle
a -> State
s {$sel:onExit:State' :: Maybe OnExitLifecycle
onExit = Maybe OnExitLifecycle
a} :: State)

-- | When an input is received and the @condition@ is TRUE, perform the
-- specified @actions@.
state_onInput :: Lens.Lens' State (Prelude.Maybe OnInputLifecycle)
state_onInput :: Lens' State (Maybe OnInputLifecycle)
state_onInput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\State' {Maybe OnInputLifecycle
onInput :: Maybe OnInputLifecycle
$sel:onInput:State' :: State -> Maybe OnInputLifecycle
onInput} -> Maybe OnInputLifecycle
onInput) (\s :: State
s@State' {} Maybe OnInputLifecycle
a -> State
s {$sel:onInput:State' :: Maybe OnInputLifecycle
onInput = Maybe OnInputLifecycle
a} :: State)

-- | The name of the state.
state_stateName :: Lens.Lens' State Prelude.Text
state_stateName :: Lens' State Text
state_stateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\State' {Text
stateName :: Text
$sel:stateName:State' :: State -> Text
stateName} -> Text
stateName) (\s :: State
s@State' {} Text
a -> State
s {$sel:stateName:State' :: Text
stateName = Text
a} :: State)

instance Data.FromJSON State where
  parseJSON :: Value -> Parser State
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"State"
      ( \Object
x ->
          Maybe OnEnterLifecycle
-> Maybe OnExitLifecycle -> Maybe OnInputLifecycle -> Text -> State
State'
            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
"onEnter")
            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
"onExit")
            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
"onInput")
            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
"stateName")
      )

instance Prelude.Hashable State where
  hashWithSalt :: Int -> State -> Int
hashWithSalt Int
_salt State' {Maybe OnExitLifecycle
Maybe OnEnterLifecycle
Maybe OnInputLifecycle
Text
stateName :: Text
onInput :: Maybe OnInputLifecycle
onExit :: Maybe OnExitLifecycle
onEnter :: Maybe OnEnterLifecycle
$sel:stateName:State' :: State -> Text
$sel:onInput:State' :: State -> Maybe OnInputLifecycle
$sel:onExit:State' :: State -> Maybe OnExitLifecycle
$sel:onEnter:State' :: State -> Maybe OnEnterLifecycle
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OnEnterLifecycle
onEnter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OnExitLifecycle
onExit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OnInputLifecycle
onInput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stateName

instance Prelude.NFData State where
  rnf :: State -> ()
rnf State' {Maybe OnExitLifecycle
Maybe OnEnterLifecycle
Maybe OnInputLifecycle
Text
stateName :: Text
onInput :: Maybe OnInputLifecycle
onExit :: Maybe OnExitLifecycle
onEnter :: Maybe OnEnterLifecycle
$sel:stateName:State' :: State -> Text
$sel:onInput:State' :: State -> Maybe OnInputLifecycle
$sel:onExit:State' :: State -> Maybe OnExitLifecycle
$sel:onEnter:State' :: State -> Maybe OnEnterLifecycle
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe OnEnterLifecycle
onEnter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OnExitLifecycle
onExit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OnInputLifecycle
onInput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stateName

instance Data.ToJSON State where
  toJSON :: State -> Value
toJSON State' {Maybe OnExitLifecycle
Maybe OnEnterLifecycle
Maybe OnInputLifecycle
Text
stateName :: Text
onInput :: Maybe OnInputLifecycle
onExit :: Maybe OnExitLifecycle
onEnter :: Maybe OnEnterLifecycle
$sel:stateName:State' :: State -> Text
$sel:onInput:State' :: State -> Maybe OnInputLifecycle
$sel:onExit:State' :: State -> Maybe OnExitLifecycle
$sel:onEnter:State' :: State -> Maybe OnEnterLifecycle
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"onEnter" 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 OnEnterLifecycle
onEnter,
            (Key
"onExit" 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 OnExitLifecycle
onExit,
            (Key
"onInput" 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 OnInputLifecycle
onInput,
            forall a. a -> Maybe a
Prelude.Just (Key
"stateName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stateName)
          ]
      )