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

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.CostExplorer.Types.DateInterval
import Amazonka.CostExplorer.Types.Group
import Amazonka.CostExplorer.Types.MetricValue
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | The result that\'s associated with a time period.
--
-- /See:/ 'newResultByTime' smart constructor.
data ResultByTime = ResultByTime'
  { -- | Determines whether the result is estimated.
    ResultByTime -> Maybe Bool
estimated :: Prelude.Maybe Prelude.Bool,
    -- | The groups that this time period includes.
    ResultByTime -> Maybe [Group]
groups :: Prelude.Maybe [Group],
    -- | The time period that the result covers.
    ResultByTime -> Maybe DateInterval
timePeriod :: Prelude.Maybe DateInterval,
    -- | The total amount of cost or usage accrued during the time period.
    ResultByTime -> Maybe (HashMap Text MetricValue)
total :: Prelude.Maybe (Prelude.HashMap Prelude.Text MetricValue)
  }
  deriving (ResultByTime -> ResultByTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultByTime -> ResultByTime -> Bool
$c/= :: ResultByTime -> ResultByTime -> Bool
== :: ResultByTime -> ResultByTime -> Bool
$c== :: ResultByTime -> ResultByTime -> Bool
Prelude.Eq, ReadPrec [ResultByTime]
ReadPrec ResultByTime
Int -> ReadS ResultByTime
ReadS [ResultByTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResultByTime]
$creadListPrec :: ReadPrec [ResultByTime]
readPrec :: ReadPrec ResultByTime
$creadPrec :: ReadPrec ResultByTime
readList :: ReadS [ResultByTime]
$creadList :: ReadS [ResultByTime]
readsPrec :: Int -> ReadS ResultByTime
$creadsPrec :: Int -> ReadS ResultByTime
Prelude.Read, Int -> ResultByTime -> ShowS
[ResultByTime] -> ShowS
ResultByTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultByTime] -> ShowS
$cshowList :: [ResultByTime] -> ShowS
show :: ResultByTime -> String
$cshow :: ResultByTime -> String
showsPrec :: Int -> ResultByTime -> ShowS
$cshowsPrec :: Int -> ResultByTime -> ShowS
Prelude.Show, forall x. Rep ResultByTime x -> ResultByTime
forall x. ResultByTime -> Rep ResultByTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResultByTime x -> ResultByTime
$cfrom :: forall x. ResultByTime -> Rep ResultByTime x
Prelude.Generic)

-- |
-- Create a value of 'ResultByTime' 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:
--
-- 'estimated', 'resultByTime_estimated' - Determines whether the result is estimated.
--
-- 'groups', 'resultByTime_groups' - The groups that this time period includes.
--
-- 'timePeriod', 'resultByTime_timePeriod' - The time period that the result covers.
--
-- 'total', 'resultByTime_total' - The total amount of cost or usage accrued during the time period.
newResultByTime ::
  ResultByTime
newResultByTime :: ResultByTime
newResultByTime =
  ResultByTime'
    { $sel:estimated:ResultByTime' :: Maybe Bool
estimated = forall a. Maybe a
Prelude.Nothing,
      $sel:groups:ResultByTime' :: Maybe [Group]
groups = forall a. Maybe a
Prelude.Nothing,
      $sel:timePeriod:ResultByTime' :: Maybe DateInterval
timePeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:total:ResultByTime' :: Maybe (HashMap Text MetricValue)
total = forall a. Maybe a
Prelude.Nothing
    }

-- | Determines whether the result is estimated.
resultByTime_estimated :: Lens.Lens' ResultByTime (Prelude.Maybe Prelude.Bool)
resultByTime_estimated :: Lens' ResultByTime (Maybe Bool)
resultByTime_estimated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResultByTime' {Maybe Bool
estimated :: Maybe Bool
$sel:estimated:ResultByTime' :: ResultByTime -> Maybe Bool
estimated} -> Maybe Bool
estimated) (\s :: ResultByTime
s@ResultByTime' {} Maybe Bool
a -> ResultByTime
s {$sel:estimated:ResultByTime' :: Maybe Bool
estimated = Maybe Bool
a} :: ResultByTime)

-- | The groups that this time period includes.
resultByTime_groups :: Lens.Lens' ResultByTime (Prelude.Maybe [Group])
resultByTime_groups :: Lens' ResultByTime (Maybe [Group])
resultByTime_groups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResultByTime' {Maybe [Group]
groups :: Maybe [Group]
$sel:groups:ResultByTime' :: ResultByTime -> Maybe [Group]
groups} -> Maybe [Group]
groups) (\s :: ResultByTime
s@ResultByTime' {} Maybe [Group]
a -> ResultByTime
s {$sel:groups:ResultByTime' :: Maybe [Group]
groups = Maybe [Group]
a} :: ResultByTime) 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 time period that the result covers.
resultByTime_timePeriod :: Lens.Lens' ResultByTime (Prelude.Maybe DateInterval)
resultByTime_timePeriod :: Lens' ResultByTime (Maybe DateInterval)
resultByTime_timePeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResultByTime' {Maybe DateInterval
timePeriod :: Maybe DateInterval
$sel:timePeriod:ResultByTime' :: ResultByTime -> Maybe DateInterval
timePeriod} -> Maybe DateInterval
timePeriod) (\s :: ResultByTime
s@ResultByTime' {} Maybe DateInterval
a -> ResultByTime
s {$sel:timePeriod:ResultByTime' :: Maybe DateInterval
timePeriod = Maybe DateInterval
a} :: ResultByTime)

-- | The total amount of cost or usage accrued during the time period.
resultByTime_total :: Lens.Lens' ResultByTime (Prelude.Maybe (Prelude.HashMap Prelude.Text MetricValue))
resultByTime_total :: Lens' ResultByTime (Maybe (HashMap Text MetricValue))
resultByTime_total = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResultByTime' {Maybe (HashMap Text MetricValue)
total :: Maybe (HashMap Text MetricValue)
$sel:total:ResultByTime' :: ResultByTime -> Maybe (HashMap Text MetricValue)
total} -> Maybe (HashMap Text MetricValue)
total) (\s :: ResultByTime
s@ResultByTime' {} Maybe (HashMap Text MetricValue)
a -> ResultByTime
s {$sel:total:ResultByTime' :: Maybe (HashMap Text MetricValue)
total = Maybe (HashMap Text MetricValue)
a} :: ResultByTime) 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

instance Data.FromJSON ResultByTime where
  parseJSON :: Value -> Parser ResultByTime
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ResultByTime"
      ( \Object
x ->
          Maybe Bool
-> Maybe [Group]
-> Maybe DateInterval
-> Maybe (HashMap Text MetricValue)
-> ResultByTime
ResultByTime'
            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
"Estimated")
            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
"Groups" 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
"TimePeriod")
            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
"Total" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ResultByTime where
  hashWithSalt :: Int -> ResultByTime -> Int
hashWithSalt Int
_salt ResultByTime' {Maybe Bool
Maybe [Group]
Maybe (HashMap Text MetricValue)
Maybe DateInterval
total :: Maybe (HashMap Text MetricValue)
timePeriod :: Maybe DateInterval
groups :: Maybe [Group]
estimated :: Maybe Bool
$sel:total:ResultByTime' :: ResultByTime -> Maybe (HashMap Text MetricValue)
$sel:timePeriod:ResultByTime' :: ResultByTime -> Maybe DateInterval
$sel:groups:ResultByTime' :: ResultByTime -> Maybe [Group]
$sel:estimated:ResultByTime' :: ResultByTime -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
estimated
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Group]
groups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DateInterval
timePeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text MetricValue)
total

instance Prelude.NFData ResultByTime where
  rnf :: ResultByTime -> ()
rnf ResultByTime' {Maybe Bool
Maybe [Group]
Maybe (HashMap Text MetricValue)
Maybe DateInterval
total :: Maybe (HashMap Text MetricValue)
timePeriod :: Maybe DateInterval
groups :: Maybe [Group]
estimated :: Maybe Bool
$sel:total:ResultByTime' :: ResultByTime -> Maybe (HashMap Text MetricValue)
$sel:timePeriod:ResultByTime' :: ResultByTime -> Maybe DateInterval
$sel:groups:ResultByTime' :: ResultByTime -> Maybe [Group]
$sel:estimated:ResultByTime' :: ResultByTime -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
estimated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Group]
groups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DateInterval
timePeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text MetricValue)
total