{-# 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.Budgets.Types.BudgetPerformanceHistory
-- 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.Budgets.Types.BudgetPerformanceHistory where

import Amazonka.Budgets.Types.BudgetType
import Amazonka.Budgets.Types.BudgetedAndActualAmounts
import Amazonka.Budgets.Types.CostTypes
import Amazonka.Budgets.Types.TimeUnit
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

-- | A history of the state of a budget at the end of the budget\'s specified
-- time period.
--
-- /See:/ 'newBudgetPerformanceHistory' smart constructor.
data BudgetPerformanceHistory = BudgetPerformanceHistory'
  { BudgetPerformanceHistory -> Maybe Text
budgetName :: Prelude.Maybe Prelude.Text,
    BudgetPerformanceHistory -> Maybe BudgetType
budgetType :: Prelude.Maybe BudgetType,
    -- | A list of amounts of cost or usage that you created budgets for, which
    -- are compared to your actual costs or usage.
    BudgetPerformanceHistory -> Maybe [BudgetedAndActualAmounts]
budgetedAndActualAmountsList :: Prelude.Maybe [BudgetedAndActualAmounts],
    -- | The history of the cost filters for a budget during the specified time
    -- period.
    BudgetPerformanceHistory -> Maybe (HashMap Text [Text])
costFilters :: Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]),
    -- | The history of the cost types for a budget during the specified time
    -- period.
    BudgetPerformanceHistory -> Maybe CostTypes
costTypes :: Prelude.Maybe CostTypes,
    BudgetPerformanceHistory -> Maybe TimeUnit
timeUnit :: Prelude.Maybe TimeUnit
  }
  deriving (BudgetPerformanceHistory -> BudgetPerformanceHistory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BudgetPerformanceHistory -> BudgetPerformanceHistory -> Bool
$c/= :: BudgetPerformanceHistory -> BudgetPerformanceHistory -> Bool
== :: BudgetPerformanceHistory -> BudgetPerformanceHistory -> Bool
$c== :: BudgetPerformanceHistory -> BudgetPerformanceHistory -> Bool
Prelude.Eq, ReadPrec [BudgetPerformanceHistory]
ReadPrec BudgetPerformanceHistory
Int -> ReadS BudgetPerformanceHistory
ReadS [BudgetPerformanceHistory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BudgetPerformanceHistory]
$creadListPrec :: ReadPrec [BudgetPerformanceHistory]
readPrec :: ReadPrec BudgetPerformanceHistory
$creadPrec :: ReadPrec BudgetPerformanceHistory
readList :: ReadS [BudgetPerformanceHistory]
$creadList :: ReadS [BudgetPerformanceHistory]
readsPrec :: Int -> ReadS BudgetPerformanceHistory
$creadsPrec :: Int -> ReadS BudgetPerformanceHistory
Prelude.Read, Int -> BudgetPerformanceHistory -> ShowS
[BudgetPerformanceHistory] -> ShowS
BudgetPerformanceHistory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BudgetPerformanceHistory] -> ShowS
$cshowList :: [BudgetPerformanceHistory] -> ShowS
show :: BudgetPerformanceHistory -> String
$cshow :: BudgetPerformanceHistory -> String
showsPrec :: Int -> BudgetPerformanceHistory -> ShowS
$cshowsPrec :: Int -> BudgetPerformanceHistory -> ShowS
Prelude.Show, forall x.
Rep BudgetPerformanceHistory x -> BudgetPerformanceHistory
forall x.
BudgetPerformanceHistory -> Rep BudgetPerformanceHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BudgetPerformanceHistory x -> BudgetPerformanceHistory
$cfrom :: forall x.
BudgetPerformanceHistory -> Rep BudgetPerformanceHistory x
Prelude.Generic)

-- |
-- Create a value of 'BudgetPerformanceHistory' 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:
--
-- 'budgetName', 'budgetPerformanceHistory_budgetName' - Undocumented member.
--
-- 'budgetType', 'budgetPerformanceHistory_budgetType' - Undocumented member.
--
-- 'budgetedAndActualAmountsList', 'budgetPerformanceHistory_budgetedAndActualAmountsList' - A list of amounts of cost or usage that you created budgets for, which
-- are compared to your actual costs or usage.
--
-- 'costFilters', 'budgetPerformanceHistory_costFilters' - The history of the cost filters for a budget during the specified time
-- period.
--
-- 'costTypes', 'budgetPerformanceHistory_costTypes' - The history of the cost types for a budget during the specified time
-- period.
--
-- 'timeUnit', 'budgetPerformanceHistory_timeUnit' - Undocumented member.
newBudgetPerformanceHistory ::
  BudgetPerformanceHistory
newBudgetPerformanceHistory :: BudgetPerformanceHistory
newBudgetPerformanceHistory =
  BudgetPerformanceHistory'
    { $sel:budgetName:BudgetPerformanceHistory' :: Maybe Text
budgetName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:budgetType:BudgetPerformanceHistory' :: Maybe BudgetType
budgetType = forall a. Maybe a
Prelude.Nothing,
      $sel:budgetedAndActualAmountsList:BudgetPerformanceHistory' :: Maybe [BudgetedAndActualAmounts]
budgetedAndActualAmountsList = forall a. Maybe a
Prelude.Nothing,
      $sel:costFilters:BudgetPerformanceHistory' :: Maybe (HashMap Text [Text])
costFilters = forall a. Maybe a
Prelude.Nothing,
      $sel:costTypes:BudgetPerformanceHistory' :: Maybe CostTypes
costTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:timeUnit:BudgetPerformanceHistory' :: Maybe TimeUnit
timeUnit = forall a. Maybe a
Prelude.Nothing
    }

-- | Undocumented member.
budgetPerformanceHistory_budgetName :: Lens.Lens' BudgetPerformanceHistory (Prelude.Maybe Prelude.Text)
budgetPerformanceHistory_budgetName :: Lens' BudgetPerformanceHistory (Maybe Text)
budgetPerformanceHistory_budgetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BudgetPerformanceHistory' {Maybe Text
budgetName :: Maybe Text
$sel:budgetName:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe Text
budgetName} -> Maybe Text
budgetName) (\s :: BudgetPerformanceHistory
s@BudgetPerformanceHistory' {} Maybe Text
a -> BudgetPerformanceHistory
s {$sel:budgetName:BudgetPerformanceHistory' :: Maybe Text
budgetName = Maybe Text
a} :: BudgetPerformanceHistory)

-- | Undocumented member.
budgetPerformanceHistory_budgetType :: Lens.Lens' BudgetPerformanceHistory (Prelude.Maybe BudgetType)
budgetPerformanceHistory_budgetType :: Lens' BudgetPerformanceHistory (Maybe BudgetType)
budgetPerformanceHistory_budgetType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BudgetPerformanceHistory' {Maybe BudgetType
budgetType :: Maybe BudgetType
$sel:budgetType:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe BudgetType
budgetType} -> Maybe BudgetType
budgetType) (\s :: BudgetPerformanceHistory
s@BudgetPerformanceHistory' {} Maybe BudgetType
a -> BudgetPerformanceHistory
s {$sel:budgetType:BudgetPerformanceHistory' :: Maybe BudgetType
budgetType = Maybe BudgetType
a} :: BudgetPerformanceHistory)

-- | A list of amounts of cost or usage that you created budgets for, which
-- are compared to your actual costs or usage.
budgetPerformanceHistory_budgetedAndActualAmountsList :: Lens.Lens' BudgetPerformanceHistory (Prelude.Maybe [BudgetedAndActualAmounts])
budgetPerformanceHistory_budgetedAndActualAmountsList :: Lens' BudgetPerformanceHistory (Maybe [BudgetedAndActualAmounts])
budgetPerformanceHistory_budgetedAndActualAmountsList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BudgetPerformanceHistory' {Maybe [BudgetedAndActualAmounts]
budgetedAndActualAmountsList :: Maybe [BudgetedAndActualAmounts]
$sel:budgetedAndActualAmountsList:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe [BudgetedAndActualAmounts]
budgetedAndActualAmountsList} -> Maybe [BudgetedAndActualAmounts]
budgetedAndActualAmountsList) (\s :: BudgetPerformanceHistory
s@BudgetPerformanceHistory' {} Maybe [BudgetedAndActualAmounts]
a -> BudgetPerformanceHistory
s {$sel:budgetedAndActualAmountsList:BudgetPerformanceHistory' :: Maybe [BudgetedAndActualAmounts]
budgetedAndActualAmountsList = Maybe [BudgetedAndActualAmounts]
a} :: BudgetPerformanceHistory) 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 history of the cost filters for a budget during the specified time
-- period.
budgetPerformanceHistory_costFilters :: Lens.Lens' BudgetPerformanceHistory (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
budgetPerformanceHistory_costFilters :: Lens' BudgetPerformanceHistory (Maybe (HashMap Text [Text]))
budgetPerformanceHistory_costFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BudgetPerformanceHistory' {Maybe (HashMap Text [Text])
costFilters :: Maybe (HashMap Text [Text])
$sel:costFilters:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe (HashMap Text [Text])
costFilters} -> Maybe (HashMap Text [Text])
costFilters) (\s :: BudgetPerformanceHistory
s@BudgetPerformanceHistory' {} Maybe (HashMap Text [Text])
a -> BudgetPerformanceHistory
s {$sel:costFilters:BudgetPerformanceHistory' :: Maybe (HashMap Text [Text])
costFilters = Maybe (HashMap Text [Text])
a} :: BudgetPerformanceHistory) 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 history of the cost types for a budget during the specified time
-- period.
budgetPerformanceHistory_costTypes :: Lens.Lens' BudgetPerformanceHistory (Prelude.Maybe CostTypes)
budgetPerformanceHistory_costTypes :: Lens' BudgetPerformanceHistory (Maybe CostTypes)
budgetPerformanceHistory_costTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BudgetPerformanceHistory' {Maybe CostTypes
costTypes :: Maybe CostTypes
$sel:costTypes:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe CostTypes
costTypes} -> Maybe CostTypes
costTypes) (\s :: BudgetPerformanceHistory
s@BudgetPerformanceHistory' {} Maybe CostTypes
a -> BudgetPerformanceHistory
s {$sel:costTypes:BudgetPerformanceHistory' :: Maybe CostTypes
costTypes = Maybe CostTypes
a} :: BudgetPerformanceHistory)

-- | Undocumented member.
budgetPerformanceHistory_timeUnit :: Lens.Lens' BudgetPerformanceHistory (Prelude.Maybe TimeUnit)
budgetPerformanceHistory_timeUnit :: Lens' BudgetPerformanceHistory (Maybe TimeUnit)
budgetPerformanceHistory_timeUnit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BudgetPerformanceHistory' {Maybe TimeUnit
timeUnit :: Maybe TimeUnit
$sel:timeUnit:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe TimeUnit
timeUnit} -> Maybe TimeUnit
timeUnit) (\s :: BudgetPerformanceHistory
s@BudgetPerformanceHistory' {} Maybe TimeUnit
a -> BudgetPerformanceHistory
s {$sel:timeUnit:BudgetPerformanceHistory' :: Maybe TimeUnit
timeUnit = Maybe TimeUnit
a} :: BudgetPerformanceHistory)

instance Data.FromJSON BudgetPerformanceHistory where
  parseJSON :: Value -> Parser BudgetPerformanceHistory
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"BudgetPerformanceHistory"
      ( \Object
x ->
          Maybe Text
-> Maybe BudgetType
-> Maybe [BudgetedAndActualAmounts]
-> Maybe (HashMap Text [Text])
-> Maybe CostTypes
-> Maybe TimeUnit
-> BudgetPerformanceHistory
BudgetPerformanceHistory'
            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
"BudgetName")
            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
"BudgetType")
            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
"BudgetedAndActualAmountsList"
                            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 (Maybe a)
Data..:? Key
"CostFilters" 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 (Maybe a)
Data..:? Key
"CostTypes")
            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
"TimeUnit")
      )

instance Prelude.Hashable BudgetPerformanceHistory where
  hashWithSalt :: Int -> BudgetPerformanceHistory -> Int
hashWithSalt Int
_salt BudgetPerformanceHistory' {Maybe [BudgetedAndActualAmounts]
Maybe Text
Maybe (HashMap Text [Text])
Maybe BudgetType
Maybe CostTypes
Maybe TimeUnit
timeUnit :: Maybe TimeUnit
costTypes :: Maybe CostTypes
costFilters :: Maybe (HashMap Text [Text])
budgetedAndActualAmountsList :: Maybe [BudgetedAndActualAmounts]
budgetType :: Maybe BudgetType
budgetName :: Maybe Text
$sel:timeUnit:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe TimeUnit
$sel:costTypes:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe CostTypes
$sel:costFilters:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe (HashMap Text [Text])
$sel:budgetedAndActualAmountsList:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe [BudgetedAndActualAmounts]
$sel:budgetType:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe BudgetType
$sel:budgetName:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
budgetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BudgetType
budgetType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [BudgetedAndActualAmounts]
budgetedAndActualAmountsList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text [Text])
costFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CostTypes
costTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimeUnit
timeUnit

instance Prelude.NFData BudgetPerformanceHistory where
  rnf :: BudgetPerformanceHistory -> ()
rnf BudgetPerformanceHistory' {Maybe [BudgetedAndActualAmounts]
Maybe Text
Maybe (HashMap Text [Text])
Maybe BudgetType
Maybe CostTypes
Maybe TimeUnit
timeUnit :: Maybe TimeUnit
costTypes :: Maybe CostTypes
costFilters :: Maybe (HashMap Text [Text])
budgetedAndActualAmountsList :: Maybe [BudgetedAndActualAmounts]
budgetType :: Maybe BudgetType
budgetName :: Maybe Text
$sel:timeUnit:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe TimeUnit
$sel:costTypes:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe CostTypes
$sel:costFilters:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe (HashMap Text [Text])
$sel:budgetedAndActualAmountsList:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe [BudgetedAndActualAmounts]
$sel:budgetType:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe BudgetType
$sel:budgetName:BudgetPerformanceHistory' :: BudgetPerformanceHistory -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
budgetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BudgetType
budgetType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [BudgetedAndActualAmounts]
budgetedAndActualAmountsList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [Text])
costFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CostTypes
costTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TimeUnit
timeUnit