{-# 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.IoTSiteWise.Types.Metric
-- 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.IoTSiteWise.Types.Metric where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTSiteWise.Types.ExpressionVariable
import Amazonka.IoTSiteWise.Types.MetricProcessingConfig
import Amazonka.IoTSiteWise.Types.MetricWindow
import qualified Amazonka.Prelude as Prelude

-- | Contains an asset metric property. With metrics, you can calculate
-- aggregate functions, such as an average, maximum, or minimum, as
-- specified through an expression. A metric maps several values to a
-- single value (such as a sum).
--
-- The maximum number of dependent\/cascading variables used in any one
-- metric calculation is 10. Therefore, a /root/ metric can have up to 10
-- cascading metrics in its computational dependency tree. Additionally, a
-- metric can only have a data type of @DOUBLE@ and consume properties with
-- data types of @INTEGER@ or @DOUBLE@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/asset-properties.html#metrics Metrics>
-- in the /IoT SiteWise User Guide/.
--
-- /See:/ 'newMetric' smart constructor.
data Metric = Metric'
  { -- | The processing configuration for the given metric property. You can
    -- configure metrics to be computed at the edge or in the Amazon Web
    -- Services Cloud. By default, metrics are forwarded to the cloud.
    Metric -> Maybe MetricProcessingConfig
processingConfig :: Prelude.Maybe MetricProcessingConfig,
    -- | The mathematical expression that defines the metric aggregation
    -- function. You can specify up to 10 variables per expression. You can
    -- specify up to 10 functions per expression.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/quotas.html Quotas>
    -- in the /IoT SiteWise User Guide/.
    Metric -> Text
expression :: Prelude.Text,
    -- | The list of variables used in the expression.
    Metric -> [ExpressionVariable]
variables :: [ExpressionVariable],
    -- | The window (time interval) over which IoT SiteWise computes the
    -- metric\'s aggregation expression. IoT SiteWise computes one data point
    -- per @window@.
    Metric -> MetricWindow
window :: MetricWindow
  }
  deriving (Metric -> Metric -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metric -> Metric -> Bool
$c/= :: Metric -> Metric -> Bool
== :: Metric -> Metric -> Bool
$c== :: Metric -> Metric -> Bool
Prelude.Eq, ReadPrec [Metric]
ReadPrec Metric
Int -> ReadS Metric
ReadS [Metric]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Metric]
$creadListPrec :: ReadPrec [Metric]
readPrec :: ReadPrec Metric
$creadPrec :: ReadPrec Metric
readList :: ReadS [Metric]
$creadList :: ReadS [Metric]
readsPrec :: Int -> ReadS Metric
$creadsPrec :: Int -> ReadS Metric
Prelude.Read, Int -> Metric -> ShowS
[Metric] -> ShowS
Metric -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metric] -> ShowS
$cshowList :: [Metric] -> ShowS
show :: Metric -> String
$cshow :: Metric -> String
showsPrec :: Int -> Metric -> ShowS
$cshowsPrec :: Int -> Metric -> ShowS
Prelude.Show, forall x. Rep Metric x -> Metric
forall x. Metric -> Rep Metric x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Metric x -> Metric
$cfrom :: forall x. Metric -> Rep Metric x
Prelude.Generic)

-- |
-- Create a value of 'Metric' 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:
--
-- 'processingConfig', 'metric_processingConfig' - The processing configuration for the given metric property. You can
-- configure metrics to be computed at the edge or in the Amazon Web
-- Services Cloud. By default, metrics are forwarded to the cloud.
--
-- 'expression', 'metric_expression' - The mathematical expression that defines the metric aggregation
-- function. You can specify up to 10 variables per expression. You can
-- specify up to 10 functions per expression.
--
-- For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/quotas.html Quotas>
-- in the /IoT SiteWise User Guide/.
--
-- 'variables', 'metric_variables' - The list of variables used in the expression.
--
-- 'window', 'metric_window' - The window (time interval) over which IoT SiteWise computes the
-- metric\'s aggregation expression. IoT SiteWise computes one data point
-- per @window@.
newMetric ::
  -- | 'expression'
  Prelude.Text ->
  -- | 'window'
  MetricWindow ->
  Metric
newMetric :: Text -> MetricWindow -> Metric
newMetric Text
pExpression_ MetricWindow
pWindow_ =
  Metric'
    { $sel:processingConfig:Metric' :: Maybe MetricProcessingConfig
processingConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:expression:Metric' :: Text
expression = Text
pExpression_,
      $sel:variables:Metric' :: [ExpressionVariable]
variables = forall a. Monoid a => a
Prelude.mempty,
      $sel:window:Metric' :: MetricWindow
window = MetricWindow
pWindow_
    }

-- | The processing configuration for the given metric property. You can
-- configure metrics to be computed at the edge or in the Amazon Web
-- Services Cloud. By default, metrics are forwarded to the cloud.
metric_processingConfig :: Lens.Lens' Metric (Prelude.Maybe MetricProcessingConfig)
metric_processingConfig :: Lens' Metric (Maybe MetricProcessingConfig)
metric_processingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Metric' {Maybe MetricProcessingConfig
processingConfig :: Maybe MetricProcessingConfig
$sel:processingConfig:Metric' :: Metric -> Maybe MetricProcessingConfig
processingConfig} -> Maybe MetricProcessingConfig
processingConfig) (\s :: Metric
s@Metric' {} Maybe MetricProcessingConfig
a -> Metric
s {$sel:processingConfig:Metric' :: Maybe MetricProcessingConfig
processingConfig = Maybe MetricProcessingConfig
a} :: Metric)

-- | The mathematical expression that defines the metric aggregation
-- function. You can specify up to 10 variables per expression. You can
-- specify up to 10 functions per expression.
--
-- For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/quotas.html Quotas>
-- in the /IoT SiteWise User Guide/.
metric_expression :: Lens.Lens' Metric Prelude.Text
metric_expression :: Lens' Metric Text
metric_expression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Metric' {Text
expression :: Text
$sel:expression:Metric' :: Metric -> Text
expression} -> Text
expression) (\s :: Metric
s@Metric' {} Text
a -> Metric
s {$sel:expression:Metric' :: Text
expression = Text
a} :: Metric)

-- | The list of variables used in the expression.
metric_variables :: Lens.Lens' Metric [ExpressionVariable]
metric_variables :: Lens' Metric [ExpressionVariable]
metric_variables = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Metric' {[ExpressionVariable]
variables :: [ExpressionVariable]
$sel:variables:Metric' :: Metric -> [ExpressionVariable]
variables} -> [ExpressionVariable]
variables) (\s :: Metric
s@Metric' {} [ExpressionVariable]
a -> Metric
s {$sel:variables:Metric' :: [ExpressionVariable]
variables = [ExpressionVariable]
a} :: Metric) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The window (time interval) over which IoT SiteWise computes the
-- metric\'s aggregation expression. IoT SiteWise computes one data point
-- per @window@.
metric_window :: Lens.Lens' Metric MetricWindow
metric_window :: Lens' Metric MetricWindow
metric_window = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Metric' {MetricWindow
window :: MetricWindow
$sel:window:Metric' :: Metric -> MetricWindow
window} -> MetricWindow
window) (\s :: Metric
s@Metric' {} MetricWindow
a -> Metric
s {$sel:window:Metric' :: MetricWindow
window = MetricWindow
a} :: Metric)

instance Data.FromJSON Metric where
  parseJSON :: Value -> Parser Metric
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Metric"
      ( \Object
x ->
          Maybe MetricProcessingConfig
-> Text -> [ExpressionVariable] -> MetricWindow -> Metric
Metric'
            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
"processingConfig")
            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
"expression")
            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
"variables" 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 a
Data..: Key
"window")
      )

instance Prelude.Hashable Metric where
  hashWithSalt :: Int -> Metric -> Int
hashWithSalt Int
_salt Metric' {[ExpressionVariable]
Maybe MetricProcessingConfig
Text
MetricWindow
window :: MetricWindow
variables :: [ExpressionVariable]
expression :: Text
processingConfig :: Maybe MetricProcessingConfig
$sel:window:Metric' :: Metric -> MetricWindow
$sel:variables:Metric' :: Metric -> [ExpressionVariable]
$sel:expression:Metric' :: Metric -> Text
$sel:processingConfig:Metric' :: Metric -> Maybe MetricProcessingConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MetricProcessingConfig
processingConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
expression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [ExpressionVariable]
variables
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MetricWindow
window

instance Prelude.NFData Metric where
  rnf :: Metric -> ()
rnf Metric' {[ExpressionVariable]
Maybe MetricProcessingConfig
Text
MetricWindow
window :: MetricWindow
variables :: [ExpressionVariable]
expression :: Text
processingConfig :: Maybe MetricProcessingConfig
$sel:window:Metric' :: Metric -> MetricWindow
$sel:variables:Metric' :: Metric -> [ExpressionVariable]
$sel:expression:Metric' :: Metric -> Text
$sel:processingConfig:Metric' :: Metric -> Maybe MetricProcessingConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe MetricProcessingConfig
processingConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
expression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ExpressionVariable]
variables
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MetricWindow
window

instance Data.ToJSON Metric where
  toJSON :: Metric -> Value
toJSON Metric' {[ExpressionVariable]
Maybe MetricProcessingConfig
Text
MetricWindow
window :: MetricWindow
variables :: [ExpressionVariable]
expression :: Text
processingConfig :: Maybe MetricProcessingConfig
$sel:window:Metric' :: Metric -> MetricWindow
$sel:variables:Metric' :: Metric -> [ExpressionVariable]
$sel:expression:Metric' :: Metric -> Text
$sel:processingConfig:Metric' :: Metric -> Maybe MetricProcessingConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"processingConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MetricProcessingConfig
processingConfig,
            forall a. a -> Maybe a
Prelude.Just (Key
"expression" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
expression),
            forall a. a -> Maybe a
Prelude.Just (Key
"variables" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [ExpressionVariable]
variables),
            forall a. a -> Maybe a
Prelude.Just (Key
"window" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MetricWindow
window)
          ]
      )