{-# 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 #-}
module Amazonka.Evidently.Types.FeatureSummary where
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Evidently.Types.EvaluationRule
import Amazonka.Evidently.Types.FeatureEvaluationStrategy
import Amazonka.Evidently.Types.FeatureStatus
import qualified Amazonka.Prelude as Prelude
data FeatureSummary = FeatureSummary'
{
FeatureSummary -> Maybe Text
defaultVariation :: Prelude.Maybe Prelude.Text,
FeatureSummary -> Maybe [EvaluationRule]
evaluationRules :: Prelude.Maybe [EvaluationRule],
FeatureSummary -> Maybe Text
project :: Prelude.Maybe Prelude.Text,
FeatureSummary -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
FeatureSummary -> Text
arn :: Prelude.Text,
FeatureSummary -> POSIX
createdTime :: Data.POSIX,
FeatureSummary -> FeatureEvaluationStrategy
evaluationStrategy :: FeatureEvaluationStrategy,
FeatureSummary -> POSIX
lastUpdatedTime :: Data.POSIX,
FeatureSummary -> Text
name :: Prelude.Text,
FeatureSummary -> FeatureStatus
status :: FeatureStatus
}
deriving (FeatureSummary -> FeatureSummary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FeatureSummary -> FeatureSummary -> Bool
$c/= :: FeatureSummary -> FeatureSummary -> Bool
== :: FeatureSummary -> FeatureSummary -> Bool
$c== :: FeatureSummary -> FeatureSummary -> Bool
Prelude.Eq, ReadPrec [FeatureSummary]
ReadPrec FeatureSummary
Int -> ReadS FeatureSummary
ReadS [FeatureSummary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FeatureSummary]
$creadListPrec :: ReadPrec [FeatureSummary]
readPrec :: ReadPrec FeatureSummary
$creadPrec :: ReadPrec FeatureSummary
readList :: ReadS [FeatureSummary]
$creadList :: ReadS [FeatureSummary]
readsPrec :: Int -> ReadS FeatureSummary
$creadsPrec :: Int -> ReadS FeatureSummary
Prelude.Read, Int -> FeatureSummary -> ShowS
[FeatureSummary] -> ShowS
FeatureSummary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FeatureSummary] -> ShowS
$cshowList :: [FeatureSummary] -> ShowS
show :: FeatureSummary -> String
$cshow :: FeatureSummary -> String
showsPrec :: Int -> FeatureSummary -> ShowS
$cshowsPrec :: Int -> FeatureSummary -> ShowS
Prelude.Show, forall x. Rep FeatureSummary x -> FeatureSummary
forall x. FeatureSummary -> Rep FeatureSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FeatureSummary x -> FeatureSummary
$cfrom :: forall x. FeatureSummary -> Rep FeatureSummary x
Prelude.Generic)
newFeatureSummary ::
Prelude.Text ->
Prelude.UTCTime ->
FeatureEvaluationStrategy ->
Prelude.UTCTime ->
Prelude.Text ->
FeatureStatus ->
FeatureSummary
newFeatureSummary :: Text
-> UTCTime
-> FeatureEvaluationStrategy
-> UTCTime
-> Text
-> FeatureStatus
-> FeatureSummary
newFeatureSummary
Text
pArn_
UTCTime
pCreatedTime_
FeatureEvaluationStrategy
pEvaluationStrategy_
UTCTime
pLastUpdatedTime_
Text
pName_
FeatureStatus
pStatus_ =
FeatureSummary'
{ $sel:defaultVariation:FeatureSummary' :: Maybe Text
defaultVariation = forall a. Maybe a
Prelude.Nothing,
$sel:evaluationRules:FeatureSummary' :: Maybe [EvaluationRule]
evaluationRules = forall a. Maybe a
Prelude.Nothing,
$sel:project:FeatureSummary' :: Maybe Text
project = forall a. Maybe a
Prelude.Nothing,
$sel:tags:FeatureSummary' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
$sel:arn:FeatureSummary' :: Text
arn = Text
pArn_,
$sel:createdTime:FeatureSummary' :: POSIX
createdTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedTime_,
$sel:evaluationStrategy:FeatureSummary' :: FeatureEvaluationStrategy
evaluationStrategy = FeatureEvaluationStrategy
pEvaluationStrategy_,
$sel:lastUpdatedTime:FeatureSummary' :: POSIX
lastUpdatedTime =
forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastUpdatedTime_,
$sel:name:FeatureSummary' :: Text
name = Text
pName_,
$sel:status:FeatureSummary' :: FeatureStatus
status = FeatureStatus
pStatus_
}
featureSummary_defaultVariation :: Lens.Lens' FeatureSummary (Prelude.Maybe Prelude.Text)
featureSummary_defaultVariation :: Lens' FeatureSummary (Maybe Text)
featureSummary_defaultVariation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FeatureSummary' {Maybe Text
defaultVariation :: Maybe Text
$sel:defaultVariation:FeatureSummary' :: FeatureSummary -> Maybe Text
defaultVariation} -> Maybe Text
defaultVariation) (\s :: FeatureSummary
s@FeatureSummary' {} Maybe Text
a -> FeatureSummary
s {$sel:defaultVariation:FeatureSummary' :: Maybe Text
defaultVariation = Maybe Text
a} :: FeatureSummary)
featureSummary_evaluationRules :: Lens.Lens' FeatureSummary (Prelude.Maybe [EvaluationRule])
featureSummary_evaluationRules :: Lens' FeatureSummary (Maybe [EvaluationRule])
featureSummary_evaluationRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FeatureSummary' {Maybe [EvaluationRule]
evaluationRules :: Maybe [EvaluationRule]
$sel:evaluationRules:FeatureSummary' :: FeatureSummary -> Maybe [EvaluationRule]
evaluationRules} -> Maybe [EvaluationRule]
evaluationRules) (\s :: FeatureSummary
s@FeatureSummary' {} Maybe [EvaluationRule]
a -> FeatureSummary
s {$sel:evaluationRules:FeatureSummary' :: Maybe [EvaluationRule]
evaluationRules = Maybe [EvaluationRule]
a} :: FeatureSummary) 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
featureSummary_project :: Lens.Lens' FeatureSummary (Prelude.Maybe Prelude.Text)
featureSummary_project :: Lens' FeatureSummary (Maybe Text)
featureSummary_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FeatureSummary' {Maybe Text
project :: Maybe Text
$sel:project:FeatureSummary' :: FeatureSummary -> Maybe Text
project} -> Maybe Text
project) (\s :: FeatureSummary
s@FeatureSummary' {} Maybe Text
a -> FeatureSummary
s {$sel:project:FeatureSummary' :: Maybe Text
project = Maybe Text
a} :: FeatureSummary)
featureSummary_tags :: Lens.Lens' FeatureSummary (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
featureSummary_tags :: Lens' FeatureSummary (Maybe (HashMap Text Text))
featureSummary_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FeatureSummary' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:FeatureSummary' :: FeatureSummary -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: FeatureSummary
s@FeatureSummary' {} Maybe (HashMap Text Text)
a -> FeatureSummary
s {$sel:tags:FeatureSummary' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: FeatureSummary) 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
featureSummary_arn :: Lens.Lens' FeatureSummary Prelude.Text
featureSummary_arn :: Lens' FeatureSummary Text
featureSummary_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FeatureSummary' {Text
arn :: Text
$sel:arn:FeatureSummary' :: FeatureSummary -> Text
arn} -> Text
arn) (\s :: FeatureSummary
s@FeatureSummary' {} Text
a -> FeatureSummary
s {$sel:arn:FeatureSummary' :: Text
arn = Text
a} :: FeatureSummary)
featureSummary_createdTime :: Lens.Lens' FeatureSummary Prelude.UTCTime
featureSummary_createdTime :: Lens' FeatureSummary UTCTime
featureSummary_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FeatureSummary' {POSIX
createdTime :: POSIX
$sel:createdTime:FeatureSummary' :: FeatureSummary -> POSIX
createdTime} -> POSIX
createdTime) (\s :: FeatureSummary
s@FeatureSummary' {} POSIX
a -> FeatureSummary
s {$sel:createdTime:FeatureSummary' :: POSIX
createdTime = POSIX
a} :: FeatureSummary) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time
featureSummary_evaluationStrategy :: Lens.Lens' FeatureSummary FeatureEvaluationStrategy
featureSummary_evaluationStrategy :: Lens' FeatureSummary FeatureEvaluationStrategy
featureSummary_evaluationStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FeatureSummary' {FeatureEvaluationStrategy
evaluationStrategy :: FeatureEvaluationStrategy
$sel:evaluationStrategy:FeatureSummary' :: FeatureSummary -> FeatureEvaluationStrategy
evaluationStrategy} -> FeatureEvaluationStrategy
evaluationStrategy) (\s :: FeatureSummary
s@FeatureSummary' {} FeatureEvaluationStrategy
a -> FeatureSummary
s {$sel:evaluationStrategy:FeatureSummary' :: FeatureEvaluationStrategy
evaluationStrategy = FeatureEvaluationStrategy
a} :: FeatureSummary)
featureSummary_lastUpdatedTime :: Lens.Lens' FeatureSummary Prelude.UTCTime
featureSummary_lastUpdatedTime :: Lens' FeatureSummary UTCTime
featureSummary_lastUpdatedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FeatureSummary' {POSIX
lastUpdatedTime :: POSIX
$sel:lastUpdatedTime:FeatureSummary' :: FeatureSummary -> POSIX
lastUpdatedTime} -> POSIX
lastUpdatedTime) (\s :: FeatureSummary
s@FeatureSummary' {} POSIX
a -> FeatureSummary
s {$sel:lastUpdatedTime:FeatureSummary' :: POSIX
lastUpdatedTime = POSIX
a} :: FeatureSummary) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time
featureSummary_name :: Lens.Lens' FeatureSummary Prelude.Text
featureSummary_name :: Lens' FeatureSummary Text
featureSummary_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FeatureSummary' {Text
name :: Text
$sel:name:FeatureSummary' :: FeatureSummary -> Text
name} -> Text
name) (\s :: FeatureSummary
s@FeatureSummary' {} Text
a -> FeatureSummary
s {$sel:name:FeatureSummary' :: Text
name = Text
a} :: FeatureSummary)
featureSummary_status :: Lens.Lens' FeatureSummary FeatureStatus
featureSummary_status :: Lens' FeatureSummary FeatureStatus
featureSummary_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FeatureSummary' {FeatureStatus
status :: FeatureStatus
$sel:status:FeatureSummary' :: FeatureSummary -> FeatureStatus
status} -> FeatureStatus
status) (\s :: FeatureSummary
s@FeatureSummary' {} FeatureStatus
a -> FeatureSummary
s {$sel:status:FeatureSummary' :: FeatureStatus
status = FeatureStatus
a} :: FeatureSummary)
instance Data.FromJSON FeatureSummary where
parseJSON :: Value -> Parser FeatureSummary
parseJSON =
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
String
"FeatureSummary"
( \Object
x ->
Maybe Text
-> Maybe [EvaluationRule]
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Text
-> POSIX
-> FeatureEvaluationStrategy
-> POSIX
-> Text
-> FeatureStatus
-> FeatureSummary
FeatureSummary'
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
"defaultVariation")
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
"evaluationRules"
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
"project")
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
"tags" 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
"arn")
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
"createdTime")
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
"evaluationStrategy")
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
"lastUpdatedTime")
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
"name")
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
"status")
)
instance Prelude.Hashable FeatureSummary where
hashWithSalt :: Int -> FeatureSummary -> Int
hashWithSalt Int
_salt FeatureSummary' {Maybe [EvaluationRule]
Maybe Text
Maybe (HashMap Text Text)
Text
POSIX
FeatureEvaluationStrategy
FeatureStatus
status :: FeatureStatus
name :: Text
lastUpdatedTime :: POSIX
evaluationStrategy :: FeatureEvaluationStrategy
createdTime :: POSIX
arn :: Text
tags :: Maybe (HashMap Text Text)
project :: Maybe Text
evaluationRules :: Maybe [EvaluationRule]
defaultVariation :: Maybe Text
$sel:status:FeatureSummary' :: FeatureSummary -> FeatureStatus
$sel:name:FeatureSummary' :: FeatureSummary -> Text
$sel:lastUpdatedTime:FeatureSummary' :: FeatureSummary -> POSIX
$sel:evaluationStrategy:FeatureSummary' :: FeatureSummary -> FeatureEvaluationStrategy
$sel:createdTime:FeatureSummary' :: FeatureSummary -> POSIX
$sel:arn:FeatureSummary' :: FeatureSummary -> Text
$sel:tags:FeatureSummary' :: FeatureSummary -> Maybe (HashMap Text Text)
$sel:project:FeatureSummary' :: FeatureSummary -> Maybe Text
$sel:evaluationRules:FeatureSummary' :: FeatureSummary -> Maybe [EvaluationRule]
$sel:defaultVariation:FeatureSummary' :: FeatureSummary -> Maybe Text
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultVariation
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EvaluationRule]
evaluationRules
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
project
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
createdTime
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FeatureEvaluationStrategy
evaluationStrategy
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
lastUpdatedTime
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FeatureStatus
status
instance Prelude.NFData FeatureSummary where
rnf :: FeatureSummary -> ()
rnf FeatureSummary' {Maybe [EvaluationRule]
Maybe Text
Maybe (HashMap Text Text)
Text
POSIX
FeatureEvaluationStrategy
FeatureStatus
status :: FeatureStatus
name :: Text
lastUpdatedTime :: POSIX
evaluationStrategy :: FeatureEvaluationStrategy
createdTime :: POSIX
arn :: Text
tags :: Maybe (HashMap Text Text)
project :: Maybe Text
evaluationRules :: Maybe [EvaluationRule]
defaultVariation :: Maybe Text
$sel:status:FeatureSummary' :: FeatureSummary -> FeatureStatus
$sel:name:FeatureSummary' :: FeatureSummary -> Text
$sel:lastUpdatedTime:FeatureSummary' :: FeatureSummary -> POSIX
$sel:evaluationStrategy:FeatureSummary' :: FeatureSummary -> FeatureEvaluationStrategy
$sel:createdTime:FeatureSummary' :: FeatureSummary -> POSIX
$sel:arn:FeatureSummary' :: FeatureSummary -> Text
$sel:tags:FeatureSummary' :: FeatureSummary -> Maybe (HashMap Text Text)
$sel:project:FeatureSummary' :: FeatureSummary -> Maybe Text
$sel:evaluationRules:FeatureSummary' :: FeatureSummary -> Maybe [EvaluationRule]
$sel:defaultVariation:FeatureSummary' :: FeatureSummary -> Maybe Text
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultVariation
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [EvaluationRule]
evaluationRules
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
project
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
createdTime
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FeatureEvaluationStrategy
evaluationStrategy
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastUpdatedTime
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FeatureStatus
status