{-# 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.LookoutMetrics.Types.InterMetricImpactDetails
-- 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.LookoutMetrics.Types.InterMetricImpactDetails where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.LookoutMetrics.Types.RelationshipType
import qualified Amazonka.Prelude as Prelude

-- | Aggregated details about the measures contributing to the anomaly group,
-- and the measures potentially impacted by the anomaly group.
--
-- /See:/ 'newInterMetricImpactDetails' smart constructor.
data InterMetricImpactDetails = InterMetricImpactDetails'
  { -- | The ID of the anomaly group.
    InterMetricImpactDetails -> Maybe Text
anomalyGroupId :: Prelude.Maybe Prelude.Text,
    -- | For potential causes (@CAUSE_OF_INPUT_ANOMALY_GROUP@), the percentage
    -- contribution the measure has in causing the anomalies.
    InterMetricImpactDetails -> Maybe Double
contributionPercentage :: Prelude.Maybe Prelude.Double,
    -- | The name of the measure.
    InterMetricImpactDetails -> Maybe Text
metricName :: Prelude.Maybe Prelude.Text,
    -- | Whether a measure is a potential cause of the anomaly group
    -- (@CAUSE_OF_INPUT_ANOMALY_GROUP@), or whether the measure is impacted by
    -- the anomaly group (@EFFECT_OF_INPUT_ANOMALY_GROUP@).
    InterMetricImpactDetails -> Maybe RelationshipType
relationshipType :: Prelude.Maybe RelationshipType
  }
  deriving (InterMetricImpactDetails -> InterMetricImpactDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InterMetricImpactDetails -> InterMetricImpactDetails -> Bool
$c/= :: InterMetricImpactDetails -> InterMetricImpactDetails -> Bool
== :: InterMetricImpactDetails -> InterMetricImpactDetails -> Bool
$c== :: InterMetricImpactDetails -> InterMetricImpactDetails -> Bool
Prelude.Eq, ReadPrec [InterMetricImpactDetails]
ReadPrec InterMetricImpactDetails
Int -> ReadS InterMetricImpactDetails
ReadS [InterMetricImpactDetails]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InterMetricImpactDetails]
$creadListPrec :: ReadPrec [InterMetricImpactDetails]
readPrec :: ReadPrec InterMetricImpactDetails
$creadPrec :: ReadPrec InterMetricImpactDetails
readList :: ReadS [InterMetricImpactDetails]
$creadList :: ReadS [InterMetricImpactDetails]
readsPrec :: Int -> ReadS InterMetricImpactDetails
$creadsPrec :: Int -> ReadS InterMetricImpactDetails
Prelude.Read, Int -> InterMetricImpactDetails -> ShowS
[InterMetricImpactDetails] -> ShowS
InterMetricImpactDetails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InterMetricImpactDetails] -> ShowS
$cshowList :: [InterMetricImpactDetails] -> ShowS
show :: InterMetricImpactDetails -> String
$cshow :: InterMetricImpactDetails -> String
showsPrec :: Int -> InterMetricImpactDetails -> ShowS
$cshowsPrec :: Int -> InterMetricImpactDetails -> ShowS
Prelude.Show, forall x.
Rep InterMetricImpactDetails x -> InterMetricImpactDetails
forall x.
InterMetricImpactDetails -> Rep InterMetricImpactDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep InterMetricImpactDetails x -> InterMetricImpactDetails
$cfrom :: forall x.
InterMetricImpactDetails -> Rep InterMetricImpactDetails x
Prelude.Generic)

-- |
-- Create a value of 'InterMetricImpactDetails' 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:
--
-- 'anomalyGroupId', 'interMetricImpactDetails_anomalyGroupId' - The ID of the anomaly group.
--
-- 'contributionPercentage', 'interMetricImpactDetails_contributionPercentage' - For potential causes (@CAUSE_OF_INPUT_ANOMALY_GROUP@), the percentage
-- contribution the measure has in causing the anomalies.
--
-- 'metricName', 'interMetricImpactDetails_metricName' - The name of the measure.
--
-- 'relationshipType', 'interMetricImpactDetails_relationshipType' - Whether a measure is a potential cause of the anomaly group
-- (@CAUSE_OF_INPUT_ANOMALY_GROUP@), or whether the measure is impacted by
-- the anomaly group (@EFFECT_OF_INPUT_ANOMALY_GROUP@).
newInterMetricImpactDetails ::
  InterMetricImpactDetails
newInterMetricImpactDetails :: InterMetricImpactDetails
newInterMetricImpactDetails =
  InterMetricImpactDetails'
    { $sel:anomalyGroupId:InterMetricImpactDetails' :: Maybe Text
anomalyGroupId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:contributionPercentage:InterMetricImpactDetails' :: Maybe Double
contributionPercentage = forall a. Maybe a
Prelude.Nothing,
      $sel:metricName:InterMetricImpactDetails' :: Maybe Text
metricName = forall a. Maybe a
Prelude.Nothing,
      $sel:relationshipType:InterMetricImpactDetails' :: Maybe RelationshipType
relationshipType = forall a. Maybe a
Prelude.Nothing
    }

-- | The ID of the anomaly group.
interMetricImpactDetails_anomalyGroupId :: Lens.Lens' InterMetricImpactDetails (Prelude.Maybe Prelude.Text)
interMetricImpactDetails_anomalyGroupId :: Lens' InterMetricImpactDetails (Maybe Text)
interMetricImpactDetails_anomalyGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InterMetricImpactDetails' {Maybe Text
anomalyGroupId :: Maybe Text
$sel:anomalyGroupId:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe Text
anomalyGroupId} -> Maybe Text
anomalyGroupId) (\s :: InterMetricImpactDetails
s@InterMetricImpactDetails' {} Maybe Text
a -> InterMetricImpactDetails
s {$sel:anomalyGroupId:InterMetricImpactDetails' :: Maybe Text
anomalyGroupId = Maybe Text
a} :: InterMetricImpactDetails)

-- | For potential causes (@CAUSE_OF_INPUT_ANOMALY_GROUP@), the percentage
-- contribution the measure has in causing the anomalies.
interMetricImpactDetails_contributionPercentage :: Lens.Lens' InterMetricImpactDetails (Prelude.Maybe Prelude.Double)
interMetricImpactDetails_contributionPercentage :: Lens' InterMetricImpactDetails (Maybe Double)
interMetricImpactDetails_contributionPercentage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InterMetricImpactDetails' {Maybe Double
contributionPercentage :: Maybe Double
$sel:contributionPercentage:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe Double
contributionPercentage} -> Maybe Double
contributionPercentage) (\s :: InterMetricImpactDetails
s@InterMetricImpactDetails' {} Maybe Double
a -> InterMetricImpactDetails
s {$sel:contributionPercentage:InterMetricImpactDetails' :: Maybe Double
contributionPercentage = Maybe Double
a} :: InterMetricImpactDetails)

-- | The name of the measure.
interMetricImpactDetails_metricName :: Lens.Lens' InterMetricImpactDetails (Prelude.Maybe Prelude.Text)
interMetricImpactDetails_metricName :: Lens' InterMetricImpactDetails (Maybe Text)
interMetricImpactDetails_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InterMetricImpactDetails' {Maybe Text
metricName :: Maybe Text
$sel:metricName:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe Text
metricName} -> Maybe Text
metricName) (\s :: InterMetricImpactDetails
s@InterMetricImpactDetails' {} Maybe Text
a -> InterMetricImpactDetails
s {$sel:metricName:InterMetricImpactDetails' :: Maybe Text
metricName = Maybe Text
a} :: InterMetricImpactDetails)

-- | Whether a measure is a potential cause of the anomaly group
-- (@CAUSE_OF_INPUT_ANOMALY_GROUP@), or whether the measure is impacted by
-- the anomaly group (@EFFECT_OF_INPUT_ANOMALY_GROUP@).
interMetricImpactDetails_relationshipType :: Lens.Lens' InterMetricImpactDetails (Prelude.Maybe RelationshipType)
interMetricImpactDetails_relationshipType :: Lens' InterMetricImpactDetails (Maybe RelationshipType)
interMetricImpactDetails_relationshipType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InterMetricImpactDetails' {Maybe RelationshipType
relationshipType :: Maybe RelationshipType
$sel:relationshipType:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe RelationshipType
relationshipType} -> Maybe RelationshipType
relationshipType) (\s :: InterMetricImpactDetails
s@InterMetricImpactDetails' {} Maybe RelationshipType
a -> InterMetricImpactDetails
s {$sel:relationshipType:InterMetricImpactDetails' :: Maybe RelationshipType
relationshipType = Maybe RelationshipType
a} :: InterMetricImpactDetails)

instance Data.FromJSON InterMetricImpactDetails where
  parseJSON :: Value -> Parser InterMetricImpactDetails
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"InterMetricImpactDetails"
      ( \Object
x ->
          Maybe Text
-> Maybe Double
-> Maybe Text
-> Maybe RelationshipType
-> InterMetricImpactDetails
InterMetricImpactDetails'
            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
"AnomalyGroupId")
            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
"ContributionPercentage")
            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
"MetricName")
            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
"RelationshipType")
      )

instance Prelude.Hashable InterMetricImpactDetails where
  hashWithSalt :: Int -> InterMetricImpactDetails -> Int
hashWithSalt Int
_salt InterMetricImpactDetails' {Maybe Double
Maybe Text
Maybe RelationshipType
relationshipType :: Maybe RelationshipType
metricName :: Maybe Text
contributionPercentage :: Maybe Double
anomalyGroupId :: Maybe Text
$sel:relationshipType:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe RelationshipType
$sel:metricName:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe Text
$sel:contributionPercentage:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe Double
$sel:anomalyGroupId:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
anomalyGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
contributionPercentage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
metricName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RelationshipType
relationshipType

instance Prelude.NFData InterMetricImpactDetails where
  rnf :: InterMetricImpactDetails -> ()
rnf InterMetricImpactDetails' {Maybe Double
Maybe Text
Maybe RelationshipType
relationshipType :: Maybe RelationshipType
metricName :: Maybe Text
contributionPercentage :: Maybe Double
anomalyGroupId :: Maybe Text
$sel:relationshipType:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe RelationshipType
$sel:metricName:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe Text
$sel:contributionPercentage:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe Double
$sel:anomalyGroupId:InterMetricImpactDetails' :: InterMetricImpactDetails -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
anomalyGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
contributionPercentage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
metricName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RelationshipType
relationshipType