{-# 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.CloudWatch.Types.Datapoint
-- 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.CloudWatch.Types.Datapoint where

import Amazonka.CloudWatch.Types.StandardUnit
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

-- | Encapsulates the statistical data that CloudWatch computes from metric
-- data.
--
-- /See:/ 'newDatapoint' smart constructor.
data Datapoint = Datapoint'
  { -- | The average of the metric values that correspond to the data point.
    Datapoint -> Maybe Double
average :: Prelude.Maybe Prelude.Double,
    -- | The percentile statistic for the data point.
    Datapoint -> Maybe (HashMap Text Double)
extendedStatistics :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Double),
    -- | The maximum metric value for the data point.
    Datapoint -> Maybe Double
maximum :: Prelude.Maybe Prelude.Double,
    -- | The minimum metric value for the data point.
    Datapoint -> Maybe Double
minimum :: Prelude.Maybe Prelude.Double,
    -- | The number of metric values that contributed to the aggregate value of
    -- this data point.
    Datapoint -> Maybe Double
sampleCount :: Prelude.Maybe Prelude.Double,
    -- | The sum of the metric values for the data point.
    Datapoint -> Maybe Double
sum :: Prelude.Maybe Prelude.Double,
    -- | The time stamp used for the data point.
    Datapoint -> Maybe ISO8601
timestamp :: Prelude.Maybe Data.ISO8601,
    -- | The standard unit for the data point.
    Datapoint -> Maybe StandardUnit
unit :: Prelude.Maybe StandardUnit
  }
  deriving (Datapoint -> Datapoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Datapoint -> Datapoint -> Bool
$c/= :: Datapoint -> Datapoint -> Bool
== :: Datapoint -> Datapoint -> Bool
$c== :: Datapoint -> Datapoint -> Bool
Prelude.Eq, ReadPrec [Datapoint]
ReadPrec Datapoint
Int -> ReadS Datapoint
ReadS [Datapoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Datapoint]
$creadListPrec :: ReadPrec [Datapoint]
readPrec :: ReadPrec Datapoint
$creadPrec :: ReadPrec Datapoint
readList :: ReadS [Datapoint]
$creadList :: ReadS [Datapoint]
readsPrec :: Int -> ReadS Datapoint
$creadsPrec :: Int -> ReadS Datapoint
Prelude.Read, Int -> Datapoint -> ShowS
[Datapoint] -> ShowS
Datapoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Datapoint] -> ShowS
$cshowList :: [Datapoint] -> ShowS
show :: Datapoint -> String
$cshow :: Datapoint -> String
showsPrec :: Int -> Datapoint -> ShowS
$cshowsPrec :: Int -> Datapoint -> ShowS
Prelude.Show, forall x. Rep Datapoint x -> Datapoint
forall x. Datapoint -> Rep Datapoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Datapoint x -> Datapoint
$cfrom :: forall x. Datapoint -> Rep Datapoint x
Prelude.Generic)

-- |
-- Create a value of 'Datapoint' 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:
--
-- 'average', 'datapoint_average' - The average of the metric values that correspond to the data point.
--
-- 'extendedStatistics', 'datapoint_extendedStatistics' - The percentile statistic for the data point.
--
-- 'maximum', 'datapoint_maximum' - The maximum metric value for the data point.
--
-- 'minimum', 'datapoint_minimum' - The minimum metric value for the data point.
--
-- 'sampleCount', 'datapoint_sampleCount' - The number of metric values that contributed to the aggregate value of
-- this data point.
--
-- 'sum', 'datapoint_sum' - The sum of the metric values for the data point.
--
-- 'timestamp', 'datapoint_timestamp' - The time stamp used for the data point.
--
-- 'unit', 'datapoint_unit' - The standard unit for the data point.
newDatapoint ::
  Datapoint
newDatapoint :: Datapoint
newDatapoint =
  Datapoint'
    { $sel:average:Datapoint' :: Maybe Double
average = forall a. Maybe a
Prelude.Nothing,
      $sel:extendedStatistics:Datapoint' :: Maybe (HashMap Text Double)
extendedStatistics = forall a. Maybe a
Prelude.Nothing,
      $sel:maximum:Datapoint' :: Maybe Double
maximum = forall a. Maybe a
Prelude.Nothing,
      $sel:minimum:Datapoint' :: Maybe Double
minimum = forall a. Maybe a
Prelude.Nothing,
      $sel:sampleCount:Datapoint' :: Maybe Double
sampleCount = forall a. Maybe a
Prelude.Nothing,
      $sel:sum:Datapoint' :: Maybe Double
sum = forall a. Maybe a
Prelude.Nothing,
      $sel:timestamp:Datapoint' :: Maybe ISO8601
timestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:unit:Datapoint' :: Maybe StandardUnit
unit = forall a. Maybe a
Prelude.Nothing
    }

-- | The average of the metric values that correspond to the data point.
datapoint_average :: Lens.Lens' Datapoint (Prelude.Maybe Prelude.Double)
datapoint_average :: Lens' Datapoint (Maybe Double)
datapoint_average = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Datapoint' {Maybe Double
average :: Maybe Double
$sel:average:Datapoint' :: Datapoint -> Maybe Double
average} -> Maybe Double
average) (\s :: Datapoint
s@Datapoint' {} Maybe Double
a -> Datapoint
s {$sel:average:Datapoint' :: Maybe Double
average = Maybe Double
a} :: Datapoint)

-- | The percentile statistic for the data point.
datapoint_extendedStatistics :: Lens.Lens' Datapoint (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Double))
datapoint_extendedStatistics :: Lens' Datapoint (Maybe (HashMap Text Double))
datapoint_extendedStatistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Datapoint' {Maybe (HashMap Text Double)
extendedStatistics :: Maybe (HashMap Text Double)
$sel:extendedStatistics:Datapoint' :: Datapoint -> Maybe (HashMap Text Double)
extendedStatistics} -> Maybe (HashMap Text Double)
extendedStatistics) (\s :: Datapoint
s@Datapoint' {} Maybe (HashMap Text Double)
a -> Datapoint
s {$sel:extendedStatistics:Datapoint' :: Maybe (HashMap Text Double)
extendedStatistics = Maybe (HashMap Text Double)
a} :: Datapoint) 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 maximum metric value for the data point.
datapoint_maximum :: Lens.Lens' Datapoint (Prelude.Maybe Prelude.Double)
datapoint_maximum :: Lens' Datapoint (Maybe Double)
datapoint_maximum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Datapoint' {Maybe Double
maximum :: Maybe Double
$sel:maximum:Datapoint' :: Datapoint -> Maybe Double
maximum} -> Maybe Double
maximum) (\s :: Datapoint
s@Datapoint' {} Maybe Double
a -> Datapoint
s {$sel:maximum:Datapoint' :: Maybe Double
maximum = Maybe Double
a} :: Datapoint)

-- | The minimum metric value for the data point.
datapoint_minimum :: Lens.Lens' Datapoint (Prelude.Maybe Prelude.Double)
datapoint_minimum :: Lens' Datapoint (Maybe Double)
datapoint_minimum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Datapoint' {Maybe Double
minimum :: Maybe Double
$sel:minimum:Datapoint' :: Datapoint -> Maybe Double
minimum} -> Maybe Double
minimum) (\s :: Datapoint
s@Datapoint' {} Maybe Double
a -> Datapoint
s {$sel:minimum:Datapoint' :: Maybe Double
minimum = Maybe Double
a} :: Datapoint)

-- | The number of metric values that contributed to the aggregate value of
-- this data point.
datapoint_sampleCount :: Lens.Lens' Datapoint (Prelude.Maybe Prelude.Double)
datapoint_sampleCount :: Lens' Datapoint (Maybe Double)
datapoint_sampleCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Datapoint' {Maybe Double
sampleCount :: Maybe Double
$sel:sampleCount:Datapoint' :: Datapoint -> Maybe Double
sampleCount} -> Maybe Double
sampleCount) (\s :: Datapoint
s@Datapoint' {} Maybe Double
a -> Datapoint
s {$sel:sampleCount:Datapoint' :: Maybe Double
sampleCount = Maybe Double
a} :: Datapoint)

-- | The sum of the metric values for the data point.
datapoint_sum :: Lens.Lens' Datapoint (Prelude.Maybe Prelude.Double)
datapoint_sum :: Lens' Datapoint (Maybe Double)
datapoint_sum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Datapoint' {Maybe Double
sum :: Maybe Double
$sel:sum:Datapoint' :: Datapoint -> Maybe Double
sum} -> Maybe Double
sum) (\s :: Datapoint
s@Datapoint' {} Maybe Double
a -> Datapoint
s {$sel:sum:Datapoint' :: Maybe Double
sum = Maybe Double
a} :: Datapoint)

-- | The time stamp used for the data point.
datapoint_timestamp :: Lens.Lens' Datapoint (Prelude.Maybe Prelude.UTCTime)
datapoint_timestamp :: Lens' Datapoint (Maybe UTCTime)
datapoint_timestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Datapoint' {Maybe ISO8601
timestamp :: Maybe ISO8601
$sel:timestamp:Datapoint' :: Datapoint -> Maybe ISO8601
timestamp} -> Maybe ISO8601
timestamp) (\s :: Datapoint
s@Datapoint' {} Maybe ISO8601
a -> Datapoint
s {$sel:timestamp:Datapoint' :: Maybe ISO8601
timestamp = Maybe ISO8601
a} :: Datapoint) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The standard unit for the data point.
datapoint_unit :: Lens.Lens' Datapoint (Prelude.Maybe StandardUnit)
datapoint_unit :: Lens' Datapoint (Maybe StandardUnit)
datapoint_unit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Datapoint' {Maybe StandardUnit
unit :: Maybe StandardUnit
$sel:unit:Datapoint' :: Datapoint -> Maybe StandardUnit
unit} -> Maybe StandardUnit
unit) (\s :: Datapoint
s@Datapoint' {} Maybe StandardUnit
a -> Datapoint
s {$sel:unit:Datapoint' :: Maybe StandardUnit
unit = Maybe StandardUnit
a} :: Datapoint)

instance Data.FromXML Datapoint where
  parseXML :: [Node] -> Either String Datapoint
parseXML [Node]
x =
    Maybe Double
-> Maybe (HashMap Text Double)
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe ISO8601
-> Maybe StandardUnit
-> Datapoint
Datapoint'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Average")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ExtendedStatistics"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall k v.
(Eq k, Hashable k, FromText k, FromXML v) =>
Text -> Text -> Text -> [Node] -> Either String (HashMap k v)
Data.parseXMLMap Text
"entry" Text
"key" Text
"value")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Maximum")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Minimum")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SampleCount")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Sum")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Timestamp")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Unit")

instance Prelude.Hashable Datapoint where
  hashWithSalt :: Int -> Datapoint -> Int
hashWithSalt Int
_salt Datapoint' {Maybe Double
Maybe (HashMap Text Double)
Maybe ISO8601
Maybe StandardUnit
unit :: Maybe StandardUnit
timestamp :: Maybe ISO8601
sum :: Maybe Double
sampleCount :: Maybe Double
minimum :: Maybe Double
maximum :: Maybe Double
extendedStatistics :: Maybe (HashMap Text Double)
average :: Maybe Double
$sel:unit:Datapoint' :: Datapoint -> Maybe StandardUnit
$sel:timestamp:Datapoint' :: Datapoint -> Maybe ISO8601
$sel:sum:Datapoint' :: Datapoint -> Maybe Double
$sel:sampleCount:Datapoint' :: Datapoint -> Maybe Double
$sel:minimum:Datapoint' :: Datapoint -> Maybe Double
$sel:maximum:Datapoint' :: Datapoint -> Maybe Double
$sel:extendedStatistics:Datapoint' :: Datapoint -> Maybe (HashMap Text Double)
$sel:average:Datapoint' :: Datapoint -> Maybe Double
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
average
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Double)
extendedStatistics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
maximum
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
minimum
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
sampleCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
sum
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
timestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StandardUnit
unit

instance Prelude.NFData Datapoint where
  rnf :: Datapoint -> ()
rnf Datapoint' {Maybe Double
Maybe (HashMap Text Double)
Maybe ISO8601
Maybe StandardUnit
unit :: Maybe StandardUnit
timestamp :: Maybe ISO8601
sum :: Maybe Double
sampleCount :: Maybe Double
minimum :: Maybe Double
maximum :: Maybe Double
extendedStatistics :: Maybe (HashMap Text Double)
average :: Maybe Double
$sel:unit:Datapoint' :: Datapoint -> Maybe StandardUnit
$sel:timestamp:Datapoint' :: Datapoint -> Maybe ISO8601
$sel:sum:Datapoint' :: Datapoint -> Maybe Double
$sel:sampleCount:Datapoint' :: Datapoint -> Maybe Double
$sel:minimum:Datapoint' :: Datapoint -> Maybe Double
$sel:maximum:Datapoint' :: Datapoint -> Maybe Double
$sel:extendedStatistics:Datapoint' :: Datapoint -> Maybe (HashMap Text Double)
$sel:average:Datapoint' :: Datapoint -> Maybe Double
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
average
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Double)
extendedStatistics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
maximum
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
minimum
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
sampleCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
sum
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
timestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StandardUnit
unit