{-# 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.Impact
-- 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.Impact where

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

-- | The dollar value of the anomaly.
--
-- /See:/ 'newImpact' smart constructor.
data Impact = Impact'
  { -- | The cumulative dollar amount that was actually spent during the anomaly.
    Impact -> Maybe Double
totalActualSpend :: Prelude.Maybe Prelude.Double,
    -- | The cumulative dollar amount that was expected to be spent during the
    -- anomaly. It is calculated using advanced machine learning models to
    -- determine the typical spending pattern based on historical data for a
    -- customer.
    Impact -> Maybe Double
totalExpectedSpend :: Prelude.Maybe Prelude.Double,
    -- | The cumulative dollar difference between the total actual spend and
    -- total expected spend. It is calculated as
    -- @TotalActualSpend - TotalExpectedSpend@.
    Impact -> Maybe Double
totalImpact :: Prelude.Maybe Prelude.Double,
    -- | The cumulative percentage difference between the total actual spend and
    -- total expected spend. It is calculated as
    -- @(TotalImpact \/ TotalExpectedSpend) * 100@. When @TotalExpectedSpend@
    -- is zero, this field is omitted. Expected spend can be zero in situations
    -- such as when you start to use a service for the first time.
    Impact -> Maybe Double
totalImpactPercentage :: Prelude.Maybe Prelude.Double,
    -- | The maximum dollar value that\'s observed for an anomaly.
    Impact -> Double
maxImpact :: Prelude.Double
  }
  deriving (Impact -> Impact -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Impact -> Impact -> Bool
$c/= :: Impact -> Impact -> Bool
== :: Impact -> Impact -> Bool
$c== :: Impact -> Impact -> Bool
Prelude.Eq, ReadPrec [Impact]
ReadPrec Impact
Int -> ReadS Impact
ReadS [Impact]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Impact]
$creadListPrec :: ReadPrec [Impact]
readPrec :: ReadPrec Impact
$creadPrec :: ReadPrec Impact
readList :: ReadS [Impact]
$creadList :: ReadS [Impact]
readsPrec :: Int -> ReadS Impact
$creadsPrec :: Int -> ReadS Impact
Prelude.Read, Int -> Impact -> ShowS
[Impact] -> ShowS
Impact -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Impact] -> ShowS
$cshowList :: [Impact] -> ShowS
show :: Impact -> String
$cshow :: Impact -> String
showsPrec :: Int -> Impact -> ShowS
$cshowsPrec :: Int -> Impact -> ShowS
Prelude.Show, forall x. Rep Impact x -> Impact
forall x. Impact -> Rep Impact x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Impact x -> Impact
$cfrom :: forall x. Impact -> Rep Impact x
Prelude.Generic)

-- |
-- Create a value of 'Impact' 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:
--
-- 'totalActualSpend', 'impact_totalActualSpend' - The cumulative dollar amount that was actually spent during the anomaly.
--
-- 'totalExpectedSpend', 'impact_totalExpectedSpend' - The cumulative dollar amount that was expected to be spent during the
-- anomaly. It is calculated using advanced machine learning models to
-- determine the typical spending pattern based on historical data for a
-- customer.
--
-- 'totalImpact', 'impact_totalImpact' - The cumulative dollar difference between the total actual spend and
-- total expected spend. It is calculated as
-- @TotalActualSpend - TotalExpectedSpend@.
--
-- 'totalImpactPercentage', 'impact_totalImpactPercentage' - The cumulative percentage difference between the total actual spend and
-- total expected spend. It is calculated as
-- @(TotalImpact \/ TotalExpectedSpend) * 100@. When @TotalExpectedSpend@
-- is zero, this field is omitted. Expected spend can be zero in situations
-- such as when you start to use a service for the first time.
--
-- 'maxImpact', 'impact_maxImpact' - The maximum dollar value that\'s observed for an anomaly.
newImpact ::
  -- | 'maxImpact'
  Prelude.Double ->
  Impact
newImpact :: Double -> Impact
newImpact Double
pMaxImpact_ =
  Impact'
    { $sel:totalActualSpend:Impact' :: Maybe Double
totalActualSpend = forall a. Maybe a
Prelude.Nothing,
      $sel:totalExpectedSpend:Impact' :: Maybe Double
totalExpectedSpend = forall a. Maybe a
Prelude.Nothing,
      $sel:totalImpact:Impact' :: Maybe Double
totalImpact = forall a. Maybe a
Prelude.Nothing,
      $sel:totalImpactPercentage:Impact' :: Maybe Double
totalImpactPercentage = forall a. Maybe a
Prelude.Nothing,
      $sel:maxImpact:Impact' :: Double
maxImpact = Double
pMaxImpact_
    }

-- | The cumulative dollar amount that was actually spent during the anomaly.
impact_totalActualSpend :: Lens.Lens' Impact (Prelude.Maybe Prelude.Double)
impact_totalActualSpend :: Lens' Impact (Maybe Double)
impact_totalActualSpend = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Impact' {Maybe Double
totalActualSpend :: Maybe Double
$sel:totalActualSpend:Impact' :: Impact -> Maybe Double
totalActualSpend} -> Maybe Double
totalActualSpend) (\s :: Impact
s@Impact' {} Maybe Double
a -> Impact
s {$sel:totalActualSpend:Impact' :: Maybe Double
totalActualSpend = Maybe Double
a} :: Impact)

-- | The cumulative dollar amount that was expected to be spent during the
-- anomaly. It is calculated using advanced machine learning models to
-- determine the typical spending pattern based on historical data for a
-- customer.
impact_totalExpectedSpend :: Lens.Lens' Impact (Prelude.Maybe Prelude.Double)
impact_totalExpectedSpend :: Lens' Impact (Maybe Double)
impact_totalExpectedSpend = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Impact' {Maybe Double
totalExpectedSpend :: Maybe Double
$sel:totalExpectedSpend:Impact' :: Impact -> Maybe Double
totalExpectedSpend} -> Maybe Double
totalExpectedSpend) (\s :: Impact
s@Impact' {} Maybe Double
a -> Impact
s {$sel:totalExpectedSpend:Impact' :: Maybe Double
totalExpectedSpend = Maybe Double
a} :: Impact)

-- | The cumulative dollar difference between the total actual spend and
-- total expected spend. It is calculated as
-- @TotalActualSpend - TotalExpectedSpend@.
impact_totalImpact :: Lens.Lens' Impact (Prelude.Maybe Prelude.Double)
impact_totalImpact :: Lens' Impact (Maybe Double)
impact_totalImpact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Impact' {Maybe Double
totalImpact :: Maybe Double
$sel:totalImpact:Impact' :: Impact -> Maybe Double
totalImpact} -> Maybe Double
totalImpact) (\s :: Impact
s@Impact' {} Maybe Double
a -> Impact
s {$sel:totalImpact:Impact' :: Maybe Double
totalImpact = Maybe Double
a} :: Impact)

-- | The cumulative percentage difference between the total actual spend and
-- total expected spend. It is calculated as
-- @(TotalImpact \/ TotalExpectedSpend) * 100@. When @TotalExpectedSpend@
-- is zero, this field is omitted. Expected spend can be zero in situations
-- such as when you start to use a service for the first time.
impact_totalImpactPercentage :: Lens.Lens' Impact (Prelude.Maybe Prelude.Double)
impact_totalImpactPercentage :: Lens' Impact (Maybe Double)
impact_totalImpactPercentage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Impact' {Maybe Double
totalImpactPercentage :: Maybe Double
$sel:totalImpactPercentage:Impact' :: Impact -> Maybe Double
totalImpactPercentage} -> Maybe Double
totalImpactPercentage) (\s :: Impact
s@Impact' {} Maybe Double
a -> Impact
s {$sel:totalImpactPercentage:Impact' :: Maybe Double
totalImpactPercentage = Maybe Double
a} :: Impact)

-- | The maximum dollar value that\'s observed for an anomaly.
impact_maxImpact :: Lens.Lens' Impact Prelude.Double
impact_maxImpact :: Lens' Impact Double
impact_maxImpact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Impact' {Double
maxImpact :: Double
$sel:maxImpact:Impact' :: Impact -> Double
maxImpact} -> Double
maxImpact) (\s :: Impact
s@Impact' {} Double
a -> Impact
s {$sel:maxImpact:Impact' :: Double
maxImpact = Double
a} :: Impact)

instance Data.FromJSON Impact where
  parseJSON :: Value -> Parser Impact
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Impact"
      ( \Object
x ->
          Maybe Double
-> Maybe Double -> Maybe Double -> Maybe Double -> Double -> Impact
Impact'
            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
"TotalActualSpend")
            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
"TotalExpectedSpend")
            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
"TotalImpact")
            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
"TotalImpactPercentage")
            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
"MaxImpact")
      )

instance Prelude.Hashable Impact where
  hashWithSalt :: Int -> Impact -> Int
hashWithSalt Int
_salt Impact' {Double
Maybe Double
maxImpact :: Double
totalImpactPercentage :: Maybe Double
totalImpact :: Maybe Double
totalExpectedSpend :: Maybe Double
totalActualSpend :: Maybe Double
$sel:maxImpact:Impact' :: Impact -> Double
$sel:totalImpactPercentage:Impact' :: Impact -> Maybe Double
$sel:totalImpact:Impact' :: Impact -> Maybe Double
$sel:totalExpectedSpend:Impact' :: Impact -> Maybe Double
$sel:totalActualSpend:Impact' :: Impact -> Maybe Double
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
totalActualSpend
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
totalExpectedSpend
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
totalImpact
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
totalImpactPercentage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Double
maxImpact

instance Prelude.NFData Impact where
  rnf :: Impact -> ()
rnf Impact' {Double
Maybe Double
maxImpact :: Double
totalImpactPercentage :: Maybe Double
totalImpact :: Maybe Double
totalExpectedSpend :: Maybe Double
totalActualSpend :: Maybe Double
$sel:maxImpact:Impact' :: Impact -> Double
$sel:totalImpactPercentage:Impact' :: Impact -> Maybe Double
$sel:totalImpact:Impact' :: Impact -> Maybe Double
$sel:totalExpectedSpend:Impact' :: Impact -> Maybe Double
$sel:totalActualSpend:Impact' :: Impact -> Maybe Double
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
totalActualSpend
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
totalExpectedSpend
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
totalImpact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
totalImpactPercentage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Double
maxImpact