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

import Amazonka.CloudWatch.Types.Dimension
import Amazonka.CloudWatch.Types.StandardUnit
import Amazonka.CloudWatch.Types.StatisticSet
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 information sent to either create a metric or add new
-- values to be aggregated into an existing metric.
--
-- /See:/ 'newMetricDatum' smart constructor.
data MetricDatum = MetricDatum'
  { -- | Array of numbers that is used along with the @Values@ array. Each number
    -- in the @Count@ array is the number of times the corresponding value in
    -- the @Values@ array occurred during the period.
    --
    -- If you omit the @Counts@ array, the default of 1 is used as the value
    -- for each count. If you include a @Counts@ array, it must include the
    -- same amount of values as the @Values@ array.
    MetricDatum -> Maybe [Double]
counts :: Prelude.Maybe [Prelude.Double],
    -- | The dimensions associated with the metric.
    MetricDatum -> Maybe [Dimension]
dimensions :: Prelude.Maybe [Dimension],
    -- | The statistical values for the metric.
    MetricDatum -> Maybe StatisticSet
statisticValues :: Prelude.Maybe StatisticSet,
    -- | Valid values are 1 and 60. Setting this to 1 specifies this metric as a
    -- high-resolution metric, so that CloudWatch stores the metric with
    -- sub-minute resolution down to one second. Setting this to 60 specifies
    -- this metric as a regular-resolution metric, which CloudWatch stores at
    -- 1-minute resolution. Currently, high resolution is available only for
    -- custom metrics. For more information about high-resolution metrics, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/publishingMetrics.html#high-resolution-metrics High-Resolution Metrics>
    -- in the /Amazon CloudWatch User Guide/.
    --
    -- This field is optional, if you do not specify it the default of 60 is
    -- used.
    MetricDatum -> Maybe Natural
storageResolution :: Prelude.Maybe Prelude.Natural,
    -- | The time the metric data was received, expressed as the number of
    -- milliseconds since Jan 1, 1970 00:00:00 UTC.
    MetricDatum -> Maybe ISO8601
timestamp :: Prelude.Maybe Data.ISO8601,
    -- | When you are using a @Put@ operation, this defines what unit you want to
    -- use when storing the metric.
    --
    -- In a @Get@ operation, this displays the unit that is used for the
    -- metric.
    MetricDatum -> Maybe StandardUnit
unit :: Prelude.Maybe StandardUnit,
    -- | The value for the metric.
    --
    -- Although the parameter accepts numbers of type Double, CloudWatch
    -- rejects values that are either too small or too large. Values must be in
    -- the range of -2^360 to 2^360. In addition, special values (for example,
    -- NaN, +Infinity, -Infinity) are not supported.
    MetricDatum -> Maybe Double
value :: Prelude.Maybe Prelude.Double,
    -- | Array of numbers representing the values for the metric during the
    -- period. Each unique value is listed just once in this array, and the
    -- corresponding number in the @Counts@ array specifies the number of times
    -- that value occurred during the period. You can include up to 150 unique
    -- values in each @PutMetricData@ action that specifies a @Values@ array.
    --
    -- Although the @Values@ array accepts numbers of type @Double@, CloudWatch
    -- rejects values that are either too small or too large. Values must be in
    -- the range of -2^360 to 2^360. In addition, special values (for example,
    -- NaN, +Infinity, -Infinity) are not supported.
    MetricDatum -> Maybe [Double]
values :: Prelude.Maybe [Prelude.Double],
    -- | The name of the metric.
    MetricDatum -> Text
metricName :: Prelude.Text
  }
  deriving (MetricDatum -> MetricDatum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetricDatum -> MetricDatum -> Bool
$c/= :: MetricDatum -> MetricDatum -> Bool
== :: MetricDatum -> MetricDatum -> Bool
$c== :: MetricDatum -> MetricDatum -> Bool
Prelude.Eq, ReadPrec [MetricDatum]
ReadPrec MetricDatum
Int -> ReadS MetricDatum
ReadS [MetricDatum]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MetricDatum]
$creadListPrec :: ReadPrec [MetricDatum]
readPrec :: ReadPrec MetricDatum
$creadPrec :: ReadPrec MetricDatum
readList :: ReadS [MetricDatum]
$creadList :: ReadS [MetricDatum]
readsPrec :: Int -> ReadS MetricDatum
$creadsPrec :: Int -> ReadS MetricDatum
Prelude.Read, Int -> MetricDatum -> ShowS
[MetricDatum] -> ShowS
MetricDatum -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetricDatum] -> ShowS
$cshowList :: [MetricDatum] -> ShowS
show :: MetricDatum -> String
$cshow :: MetricDatum -> String
showsPrec :: Int -> MetricDatum -> ShowS
$cshowsPrec :: Int -> MetricDatum -> ShowS
Prelude.Show, forall x. Rep MetricDatum x -> MetricDatum
forall x. MetricDatum -> Rep MetricDatum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetricDatum x -> MetricDatum
$cfrom :: forall x. MetricDatum -> Rep MetricDatum x
Prelude.Generic)

-- |
-- Create a value of 'MetricDatum' 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:
--
-- 'counts', 'metricDatum_counts' - Array of numbers that is used along with the @Values@ array. Each number
-- in the @Count@ array is the number of times the corresponding value in
-- the @Values@ array occurred during the period.
--
-- If you omit the @Counts@ array, the default of 1 is used as the value
-- for each count. If you include a @Counts@ array, it must include the
-- same amount of values as the @Values@ array.
--
-- 'dimensions', 'metricDatum_dimensions' - The dimensions associated with the metric.
--
-- 'statisticValues', 'metricDatum_statisticValues' - The statistical values for the metric.
--
-- 'storageResolution', 'metricDatum_storageResolution' - Valid values are 1 and 60. Setting this to 1 specifies this metric as a
-- high-resolution metric, so that CloudWatch stores the metric with
-- sub-minute resolution down to one second. Setting this to 60 specifies
-- this metric as a regular-resolution metric, which CloudWatch stores at
-- 1-minute resolution. Currently, high resolution is available only for
-- custom metrics. For more information about high-resolution metrics, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/publishingMetrics.html#high-resolution-metrics High-Resolution Metrics>
-- in the /Amazon CloudWatch User Guide/.
--
-- This field is optional, if you do not specify it the default of 60 is
-- used.
--
-- 'timestamp', 'metricDatum_timestamp' - The time the metric data was received, expressed as the number of
-- milliseconds since Jan 1, 1970 00:00:00 UTC.
--
-- 'unit', 'metricDatum_unit' - When you are using a @Put@ operation, this defines what unit you want to
-- use when storing the metric.
--
-- In a @Get@ operation, this displays the unit that is used for the
-- metric.
--
-- 'value', 'metricDatum_value' - The value for the metric.
--
-- Although the parameter accepts numbers of type Double, CloudWatch
-- rejects values that are either too small or too large. Values must be in
-- the range of -2^360 to 2^360. In addition, special values (for example,
-- NaN, +Infinity, -Infinity) are not supported.
--
-- 'values', 'metricDatum_values' - Array of numbers representing the values for the metric during the
-- period. Each unique value is listed just once in this array, and the
-- corresponding number in the @Counts@ array specifies the number of times
-- that value occurred during the period. You can include up to 150 unique
-- values in each @PutMetricData@ action that specifies a @Values@ array.
--
-- Although the @Values@ array accepts numbers of type @Double@, CloudWatch
-- rejects values that are either too small or too large. Values must be in
-- the range of -2^360 to 2^360. In addition, special values (for example,
-- NaN, +Infinity, -Infinity) are not supported.
--
-- 'metricName', 'metricDatum_metricName' - The name of the metric.
newMetricDatum ::
  -- | 'metricName'
  Prelude.Text ->
  MetricDatum
newMetricDatum :: Text -> MetricDatum
newMetricDatum Text
pMetricName_ =
  MetricDatum'
    { $sel:counts:MetricDatum' :: Maybe [Double]
counts = forall a. Maybe a
Prelude.Nothing,
      $sel:dimensions:MetricDatum' :: Maybe [Dimension]
dimensions = forall a. Maybe a
Prelude.Nothing,
      $sel:statisticValues:MetricDatum' :: Maybe StatisticSet
statisticValues = forall a. Maybe a
Prelude.Nothing,
      $sel:storageResolution:MetricDatum' :: Maybe Natural
storageResolution = forall a. Maybe a
Prelude.Nothing,
      $sel:timestamp:MetricDatum' :: Maybe ISO8601
timestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:unit:MetricDatum' :: Maybe StandardUnit
unit = forall a. Maybe a
Prelude.Nothing,
      $sel:value:MetricDatum' :: Maybe Double
value = forall a. Maybe a
Prelude.Nothing,
      $sel:values:MetricDatum' :: Maybe [Double]
values = forall a. Maybe a
Prelude.Nothing,
      $sel:metricName:MetricDatum' :: Text
metricName = Text
pMetricName_
    }

-- | Array of numbers that is used along with the @Values@ array. Each number
-- in the @Count@ array is the number of times the corresponding value in
-- the @Values@ array occurred during the period.
--
-- If you omit the @Counts@ array, the default of 1 is used as the value
-- for each count. If you include a @Counts@ array, it must include the
-- same amount of values as the @Values@ array.
metricDatum_counts :: Lens.Lens' MetricDatum (Prelude.Maybe [Prelude.Double])
metricDatum_counts :: Lens' MetricDatum (Maybe [Double])
metricDatum_counts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe [Double]
counts :: Maybe [Double]
$sel:counts:MetricDatum' :: MetricDatum -> Maybe [Double]
counts} -> Maybe [Double]
counts) (\s :: MetricDatum
s@MetricDatum' {} Maybe [Double]
a -> MetricDatum
s {$sel:counts:MetricDatum' :: Maybe [Double]
counts = Maybe [Double]
a} :: MetricDatum) 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 dimensions associated with the metric.
metricDatum_dimensions :: Lens.Lens' MetricDatum (Prelude.Maybe [Dimension])
metricDatum_dimensions :: Lens' MetricDatum (Maybe [Dimension])
metricDatum_dimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe [Dimension]
dimensions :: Maybe [Dimension]
$sel:dimensions:MetricDatum' :: MetricDatum -> Maybe [Dimension]
dimensions} -> Maybe [Dimension]
dimensions) (\s :: MetricDatum
s@MetricDatum' {} Maybe [Dimension]
a -> MetricDatum
s {$sel:dimensions:MetricDatum' :: Maybe [Dimension]
dimensions = Maybe [Dimension]
a} :: MetricDatum) 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 statistical values for the metric.
metricDatum_statisticValues :: Lens.Lens' MetricDatum (Prelude.Maybe StatisticSet)
metricDatum_statisticValues :: Lens' MetricDatum (Maybe StatisticSet)
metricDatum_statisticValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe StatisticSet
statisticValues :: Maybe StatisticSet
$sel:statisticValues:MetricDatum' :: MetricDatum -> Maybe StatisticSet
statisticValues} -> Maybe StatisticSet
statisticValues) (\s :: MetricDatum
s@MetricDatum' {} Maybe StatisticSet
a -> MetricDatum
s {$sel:statisticValues:MetricDatum' :: Maybe StatisticSet
statisticValues = Maybe StatisticSet
a} :: MetricDatum)

-- | Valid values are 1 and 60. Setting this to 1 specifies this metric as a
-- high-resolution metric, so that CloudWatch stores the metric with
-- sub-minute resolution down to one second. Setting this to 60 specifies
-- this metric as a regular-resolution metric, which CloudWatch stores at
-- 1-minute resolution. Currently, high resolution is available only for
-- custom metrics. For more information about high-resolution metrics, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/publishingMetrics.html#high-resolution-metrics High-Resolution Metrics>
-- in the /Amazon CloudWatch User Guide/.
--
-- This field is optional, if you do not specify it the default of 60 is
-- used.
metricDatum_storageResolution :: Lens.Lens' MetricDatum (Prelude.Maybe Prelude.Natural)
metricDatum_storageResolution :: Lens' MetricDatum (Maybe Natural)
metricDatum_storageResolution = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe Natural
storageResolution :: Maybe Natural
$sel:storageResolution:MetricDatum' :: MetricDatum -> Maybe Natural
storageResolution} -> Maybe Natural
storageResolution) (\s :: MetricDatum
s@MetricDatum' {} Maybe Natural
a -> MetricDatum
s {$sel:storageResolution:MetricDatum' :: Maybe Natural
storageResolution = Maybe Natural
a} :: MetricDatum)

-- | The time the metric data was received, expressed as the number of
-- milliseconds since Jan 1, 1970 00:00:00 UTC.
metricDatum_timestamp :: Lens.Lens' MetricDatum (Prelude.Maybe Prelude.UTCTime)
metricDatum_timestamp :: Lens' MetricDatum (Maybe UTCTime)
metricDatum_timestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe ISO8601
timestamp :: Maybe ISO8601
$sel:timestamp:MetricDatum' :: MetricDatum -> Maybe ISO8601
timestamp} -> Maybe ISO8601
timestamp) (\s :: MetricDatum
s@MetricDatum' {} Maybe ISO8601
a -> MetricDatum
s {$sel:timestamp:MetricDatum' :: Maybe ISO8601
timestamp = Maybe ISO8601
a} :: MetricDatum) 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

-- | When you are using a @Put@ operation, this defines what unit you want to
-- use when storing the metric.
--
-- In a @Get@ operation, this displays the unit that is used for the
-- metric.
metricDatum_unit :: Lens.Lens' MetricDatum (Prelude.Maybe StandardUnit)
metricDatum_unit :: Lens' MetricDatum (Maybe StandardUnit)
metricDatum_unit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe StandardUnit
unit :: Maybe StandardUnit
$sel:unit:MetricDatum' :: MetricDatum -> Maybe StandardUnit
unit} -> Maybe StandardUnit
unit) (\s :: MetricDatum
s@MetricDatum' {} Maybe StandardUnit
a -> MetricDatum
s {$sel:unit:MetricDatum' :: Maybe StandardUnit
unit = Maybe StandardUnit
a} :: MetricDatum)

-- | The value for the metric.
--
-- Although the parameter accepts numbers of type Double, CloudWatch
-- rejects values that are either too small or too large. Values must be in
-- the range of -2^360 to 2^360. In addition, special values (for example,
-- NaN, +Infinity, -Infinity) are not supported.
metricDatum_value :: Lens.Lens' MetricDatum (Prelude.Maybe Prelude.Double)
metricDatum_value :: Lens' MetricDatum (Maybe Double)
metricDatum_value = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe Double
value :: Maybe Double
$sel:value:MetricDatum' :: MetricDatum -> Maybe Double
value} -> Maybe Double
value) (\s :: MetricDatum
s@MetricDatum' {} Maybe Double
a -> MetricDatum
s {$sel:value:MetricDatum' :: Maybe Double
value = Maybe Double
a} :: MetricDatum)

-- | Array of numbers representing the values for the metric during the
-- period. Each unique value is listed just once in this array, and the
-- corresponding number in the @Counts@ array specifies the number of times
-- that value occurred during the period. You can include up to 150 unique
-- values in each @PutMetricData@ action that specifies a @Values@ array.
--
-- Although the @Values@ array accepts numbers of type @Double@, CloudWatch
-- rejects values that are either too small or too large. Values must be in
-- the range of -2^360 to 2^360. In addition, special values (for example,
-- NaN, +Infinity, -Infinity) are not supported.
metricDatum_values :: Lens.Lens' MetricDatum (Prelude.Maybe [Prelude.Double])
metricDatum_values :: Lens' MetricDatum (Maybe [Double])
metricDatum_values = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Maybe [Double]
values :: Maybe [Double]
$sel:values:MetricDatum' :: MetricDatum -> Maybe [Double]
values} -> Maybe [Double]
values) (\s :: MetricDatum
s@MetricDatum' {} Maybe [Double]
a -> MetricDatum
s {$sel:values:MetricDatum' :: Maybe [Double]
values = Maybe [Double]
a} :: MetricDatum) 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 name of the metric.
metricDatum_metricName :: Lens.Lens' MetricDatum Prelude.Text
metricDatum_metricName :: Lens' MetricDatum Text
metricDatum_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MetricDatum' {Text
metricName :: Text
$sel:metricName:MetricDatum' :: MetricDatum -> Text
metricName} -> Text
metricName) (\s :: MetricDatum
s@MetricDatum' {} Text
a -> MetricDatum
s {$sel:metricName:MetricDatum' :: Text
metricName = Text
a} :: MetricDatum)

instance Prelude.Hashable MetricDatum where
  hashWithSalt :: Int -> MetricDatum -> Int
hashWithSalt Int
_salt MetricDatum' {Maybe Double
Maybe Natural
Maybe [Double]
Maybe [Dimension]
Maybe ISO8601
Maybe StandardUnit
Maybe StatisticSet
Text
metricName :: Text
values :: Maybe [Double]
value :: Maybe Double
unit :: Maybe StandardUnit
timestamp :: Maybe ISO8601
storageResolution :: Maybe Natural
statisticValues :: Maybe StatisticSet
dimensions :: Maybe [Dimension]
counts :: Maybe [Double]
$sel:metricName:MetricDatum' :: MetricDatum -> Text
$sel:values:MetricDatum' :: MetricDatum -> Maybe [Double]
$sel:value:MetricDatum' :: MetricDatum -> Maybe Double
$sel:unit:MetricDatum' :: MetricDatum -> Maybe StandardUnit
$sel:timestamp:MetricDatum' :: MetricDatum -> Maybe ISO8601
$sel:storageResolution:MetricDatum' :: MetricDatum -> Maybe Natural
$sel:statisticValues:MetricDatum' :: MetricDatum -> Maybe StatisticSet
$sel:dimensions:MetricDatum' :: MetricDatum -> Maybe [Dimension]
$sel:counts:MetricDatum' :: MetricDatum -> Maybe [Double]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Double]
counts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Dimension]
dimensions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StatisticSet
statisticValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
storageResolution
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
timestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StandardUnit
unit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
value
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Double]
values
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
metricName

instance Prelude.NFData MetricDatum where
  rnf :: MetricDatum -> ()
rnf MetricDatum' {Maybe Double
Maybe Natural
Maybe [Double]
Maybe [Dimension]
Maybe ISO8601
Maybe StandardUnit
Maybe StatisticSet
Text
metricName :: Text
values :: Maybe [Double]
value :: Maybe Double
unit :: Maybe StandardUnit
timestamp :: Maybe ISO8601
storageResolution :: Maybe Natural
statisticValues :: Maybe StatisticSet
dimensions :: Maybe [Dimension]
counts :: Maybe [Double]
$sel:metricName:MetricDatum' :: MetricDatum -> Text
$sel:values:MetricDatum' :: MetricDatum -> Maybe [Double]
$sel:value:MetricDatum' :: MetricDatum -> Maybe Double
$sel:unit:MetricDatum' :: MetricDatum -> Maybe StandardUnit
$sel:timestamp:MetricDatum' :: MetricDatum -> Maybe ISO8601
$sel:storageResolution:MetricDatum' :: MetricDatum -> Maybe Natural
$sel:statisticValues:MetricDatum' :: MetricDatum -> Maybe StatisticSet
$sel:dimensions:MetricDatum' :: MetricDatum -> Maybe [Dimension]
$sel:counts:MetricDatum' :: MetricDatum -> Maybe [Double]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Double]
counts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Dimension]
dimensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StatisticSet
statisticValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
storageResolution
      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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
value
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Double]
values
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
metricName

instance Data.ToQuery MetricDatum where
  toQuery :: MetricDatum -> QueryString
toQuery MetricDatum' {Maybe Double
Maybe Natural
Maybe [Double]
Maybe [Dimension]
Maybe ISO8601
Maybe StandardUnit
Maybe StatisticSet
Text
metricName :: Text
values :: Maybe [Double]
value :: Maybe Double
unit :: Maybe StandardUnit
timestamp :: Maybe ISO8601
storageResolution :: Maybe Natural
statisticValues :: Maybe StatisticSet
dimensions :: Maybe [Dimension]
counts :: Maybe [Double]
$sel:metricName:MetricDatum' :: MetricDatum -> Text
$sel:values:MetricDatum' :: MetricDatum -> Maybe [Double]
$sel:value:MetricDatum' :: MetricDatum -> Maybe Double
$sel:unit:MetricDatum' :: MetricDatum -> Maybe StandardUnit
$sel:timestamp:MetricDatum' :: MetricDatum -> Maybe ISO8601
$sel:storageResolution:MetricDatum' :: MetricDatum -> Maybe Natural
$sel:statisticValues:MetricDatum' :: MetricDatum -> Maybe StatisticSet
$sel:dimensions:MetricDatum' :: MetricDatum -> Maybe [Dimension]
$sel:counts:MetricDatum' :: MetricDatum -> Maybe [Double]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Counts"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Double]
counts),
        ByteString
"Dimensions"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Dimension]
dimensions),
        ByteString
"StatisticValues" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe StatisticSet
statisticValues,
        ByteString
"StorageResolution" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
storageResolution,
        ByteString
"Timestamp" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
timestamp,
        ByteString
"Unit" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe StandardUnit
unit,
        ByteString
"Value" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Double
value,
        ByteString
"Values"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Double]
values),
        ByteString
"MetricName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
metricName
      ]