{-# 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.CostExplorer.Types.GenerationSummary
-- 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.CostExplorer.Types.GenerationSummary where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.CostExplorer.Types.GenerationStatus
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | The summary of the Savings Plans recommendation generation.
--
-- /See:/ 'newGenerationSummary' smart constructor.
data GenerationSummary = GenerationSummary'
  { -- | Indicates the estimated time for when the recommendation generation will
    -- complete.
    GenerationSummary -> Maybe Text
estimatedCompletionTime :: Prelude.Maybe Prelude.Text,
    -- | Indicates the completion time of the recommendation generation.
    GenerationSummary -> Maybe Text
generationCompletionTime :: Prelude.Maybe Prelude.Text,
    -- | Indicates the start time of the recommendation generation.
    GenerationSummary -> Maybe Text
generationStartedTime :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the recommendation generation succeeded, is
    -- processing, or failed.
    GenerationSummary -> Maybe GenerationStatus
generationStatus :: Prelude.Maybe GenerationStatus,
    -- | Indicates the ID for this specific recommendation.
    GenerationSummary -> Maybe Text
recommendationId :: Prelude.Maybe Prelude.Text
  }
  deriving (GenerationSummary -> GenerationSummary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenerationSummary -> GenerationSummary -> Bool
$c/= :: GenerationSummary -> GenerationSummary -> Bool
== :: GenerationSummary -> GenerationSummary -> Bool
$c== :: GenerationSummary -> GenerationSummary -> Bool
Prelude.Eq, ReadPrec [GenerationSummary]
ReadPrec GenerationSummary
Int -> ReadS GenerationSummary
ReadS [GenerationSummary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GenerationSummary]
$creadListPrec :: ReadPrec [GenerationSummary]
readPrec :: ReadPrec GenerationSummary
$creadPrec :: ReadPrec GenerationSummary
readList :: ReadS [GenerationSummary]
$creadList :: ReadS [GenerationSummary]
readsPrec :: Int -> ReadS GenerationSummary
$creadsPrec :: Int -> ReadS GenerationSummary
Prelude.Read, Int -> GenerationSummary -> ShowS
[GenerationSummary] -> ShowS
GenerationSummary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenerationSummary] -> ShowS
$cshowList :: [GenerationSummary] -> ShowS
show :: GenerationSummary -> String
$cshow :: GenerationSummary -> String
showsPrec :: Int -> GenerationSummary -> ShowS
$cshowsPrec :: Int -> GenerationSummary -> ShowS
Prelude.Show, forall x. Rep GenerationSummary x -> GenerationSummary
forall x. GenerationSummary -> Rep GenerationSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GenerationSummary x -> GenerationSummary
$cfrom :: forall x. GenerationSummary -> Rep GenerationSummary x
Prelude.Generic)

-- |
-- Create a value of 'GenerationSummary' 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:
--
-- 'estimatedCompletionTime', 'generationSummary_estimatedCompletionTime' - Indicates the estimated time for when the recommendation generation will
-- complete.
--
-- 'generationCompletionTime', 'generationSummary_generationCompletionTime' - Indicates the completion time of the recommendation generation.
--
-- 'generationStartedTime', 'generationSummary_generationStartedTime' - Indicates the start time of the recommendation generation.
--
-- 'generationStatus', 'generationSummary_generationStatus' - Indicates whether the recommendation generation succeeded, is
-- processing, or failed.
--
-- 'recommendationId', 'generationSummary_recommendationId' - Indicates the ID for this specific recommendation.
newGenerationSummary ::
  GenerationSummary
newGenerationSummary :: GenerationSummary
newGenerationSummary =
  GenerationSummary'
    { $sel:estimatedCompletionTime:GenerationSummary' :: Maybe Text
estimatedCompletionTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:generationCompletionTime:GenerationSummary' :: Maybe Text
generationCompletionTime = forall a. Maybe a
Prelude.Nothing,
      $sel:generationStartedTime:GenerationSummary' :: Maybe Text
generationStartedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:generationStatus:GenerationSummary' :: Maybe GenerationStatus
generationStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:recommendationId:GenerationSummary' :: Maybe Text
recommendationId = forall a. Maybe a
Prelude.Nothing
    }

-- | Indicates the estimated time for when the recommendation generation will
-- complete.
generationSummary_estimatedCompletionTime :: Lens.Lens' GenerationSummary (Prelude.Maybe Prelude.Text)
generationSummary_estimatedCompletionTime :: Lens' GenerationSummary (Maybe Text)
generationSummary_estimatedCompletionTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerationSummary' {Maybe Text
estimatedCompletionTime :: Maybe Text
$sel:estimatedCompletionTime:GenerationSummary' :: GenerationSummary -> Maybe Text
estimatedCompletionTime} -> Maybe Text
estimatedCompletionTime) (\s :: GenerationSummary
s@GenerationSummary' {} Maybe Text
a -> GenerationSummary
s {$sel:estimatedCompletionTime:GenerationSummary' :: Maybe Text
estimatedCompletionTime = Maybe Text
a} :: GenerationSummary)

-- | Indicates the completion time of the recommendation generation.
generationSummary_generationCompletionTime :: Lens.Lens' GenerationSummary (Prelude.Maybe Prelude.Text)
generationSummary_generationCompletionTime :: Lens' GenerationSummary (Maybe Text)
generationSummary_generationCompletionTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerationSummary' {Maybe Text
generationCompletionTime :: Maybe Text
$sel:generationCompletionTime:GenerationSummary' :: GenerationSummary -> Maybe Text
generationCompletionTime} -> Maybe Text
generationCompletionTime) (\s :: GenerationSummary
s@GenerationSummary' {} Maybe Text
a -> GenerationSummary
s {$sel:generationCompletionTime:GenerationSummary' :: Maybe Text
generationCompletionTime = Maybe Text
a} :: GenerationSummary)

-- | Indicates the start time of the recommendation generation.
generationSummary_generationStartedTime :: Lens.Lens' GenerationSummary (Prelude.Maybe Prelude.Text)
generationSummary_generationStartedTime :: Lens' GenerationSummary (Maybe Text)
generationSummary_generationStartedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerationSummary' {Maybe Text
generationStartedTime :: Maybe Text
$sel:generationStartedTime:GenerationSummary' :: GenerationSummary -> Maybe Text
generationStartedTime} -> Maybe Text
generationStartedTime) (\s :: GenerationSummary
s@GenerationSummary' {} Maybe Text
a -> GenerationSummary
s {$sel:generationStartedTime:GenerationSummary' :: Maybe Text
generationStartedTime = Maybe Text
a} :: GenerationSummary)

-- | Indicates whether the recommendation generation succeeded, is
-- processing, or failed.
generationSummary_generationStatus :: Lens.Lens' GenerationSummary (Prelude.Maybe GenerationStatus)
generationSummary_generationStatus :: Lens' GenerationSummary (Maybe GenerationStatus)
generationSummary_generationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerationSummary' {Maybe GenerationStatus
generationStatus :: Maybe GenerationStatus
$sel:generationStatus:GenerationSummary' :: GenerationSummary -> Maybe GenerationStatus
generationStatus} -> Maybe GenerationStatus
generationStatus) (\s :: GenerationSummary
s@GenerationSummary' {} Maybe GenerationStatus
a -> GenerationSummary
s {$sel:generationStatus:GenerationSummary' :: Maybe GenerationStatus
generationStatus = Maybe GenerationStatus
a} :: GenerationSummary)

-- | Indicates the ID for this specific recommendation.
generationSummary_recommendationId :: Lens.Lens' GenerationSummary (Prelude.Maybe Prelude.Text)
generationSummary_recommendationId :: Lens' GenerationSummary (Maybe Text)
generationSummary_recommendationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerationSummary' {Maybe Text
recommendationId :: Maybe Text
$sel:recommendationId:GenerationSummary' :: GenerationSummary -> Maybe Text
recommendationId} -> Maybe Text
recommendationId) (\s :: GenerationSummary
s@GenerationSummary' {} Maybe Text
a -> GenerationSummary
s {$sel:recommendationId:GenerationSummary' :: Maybe Text
recommendationId = Maybe Text
a} :: GenerationSummary)

instance Data.FromJSON GenerationSummary where
  parseJSON :: Value -> Parser GenerationSummary
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"GenerationSummary"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe GenerationStatus
-> Maybe Text
-> GenerationSummary
GenerationSummary'
            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
"EstimatedCompletionTime")
            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
"GenerationCompletionTime")
            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
"GenerationStartedTime")
            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
"GenerationStatus")
            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
"RecommendationId")
      )

instance Prelude.Hashable GenerationSummary where
  hashWithSalt :: Int -> GenerationSummary -> Int
hashWithSalt Int
_salt GenerationSummary' {Maybe Text
Maybe GenerationStatus
recommendationId :: Maybe Text
generationStatus :: Maybe GenerationStatus
generationStartedTime :: Maybe Text
generationCompletionTime :: Maybe Text
estimatedCompletionTime :: Maybe Text
$sel:recommendationId:GenerationSummary' :: GenerationSummary -> Maybe Text
$sel:generationStatus:GenerationSummary' :: GenerationSummary -> Maybe GenerationStatus
$sel:generationStartedTime:GenerationSummary' :: GenerationSummary -> Maybe Text
$sel:generationCompletionTime:GenerationSummary' :: GenerationSummary -> Maybe Text
$sel:estimatedCompletionTime:GenerationSummary' :: GenerationSummary -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
estimatedCompletionTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
generationCompletionTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
generationStartedTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GenerationStatus
generationStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
recommendationId

instance Prelude.NFData GenerationSummary where
  rnf :: GenerationSummary -> ()
rnf GenerationSummary' {Maybe Text
Maybe GenerationStatus
recommendationId :: Maybe Text
generationStatus :: Maybe GenerationStatus
generationStartedTime :: Maybe Text
generationCompletionTime :: Maybe Text
estimatedCompletionTime :: Maybe Text
$sel:recommendationId:GenerationSummary' :: GenerationSummary -> Maybe Text
$sel:generationStatus:GenerationSummary' :: GenerationSummary -> Maybe GenerationStatus
$sel:generationStartedTime:GenerationSummary' :: GenerationSummary -> Maybe Text
$sel:generationCompletionTime:GenerationSummary' :: GenerationSummary -> Maybe Text
$sel:estimatedCompletionTime:GenerationSummary' :: GenerationSummary -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
estimatedCompletionTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
generationCompletionTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
generationStartedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GenerationStatus
generationStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
recommendationId