{-# 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.Pinpoint.Types.SegmentDimensions
-- 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.Pinpoint.Types.SegmentDimensions where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Pinpoint.Types.AttributeDimension
import Amazonka.Pinpoint.Types.MetricDimension
import Amazonka.Pinpoint.Types.SegmentBehaviors
import Amazonka.Pinpoint.Types.SegmentDemographics
import Amazonka.Pinpoint.Types.SegmentLocation
import qualified Amazonka.Prelude as Prelude

-- | Specifies the dimension settings for a segment.
--
-- /See:/ 'newSegmentDimensions' smart constructor.
data SegmentDimensions = SegmentDimensions'
  { -- | One or more custom attributes to use as criteria for the segment.
    SegmentDimensions -> Maybe (HashMap Text AttributeDimension)
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeDimension),
    -- | The behavior-based criteria, such as how recently users have used your
    -- app, for the segment.
    SegmentDimensions -> Maybe SegmentBehaviors
behavior :: Prelude.Maybe SegmentBehaviors,
    -- | The demographic-based criteria, such as device platform, for the
    -- segment.
    SegmentDimensions -> Maybe SegmentDemographics
demographic :: Prelude.Maybe SegmentDemographics,
    -- | The location-based criteria, such as region or GPS coordinates, for the
    -- segment.
    SegmentDimensions -> Maybe SegmentLocation
location :: Prelude.Maybe SegmentLocation,
    -- | One or more custom metrics to use as criteria for the segment.
    SegmentDimensions -> Maybe (HashMap Text MetricDimension)
metrics :: Prelude.Maybe (Prelude.HashMap Prelude.Text MetricDimension),
    -- | One or more custom user attributes to use as criteria for the segment.
    SegmentDimensions -> Maybe (HashMap Text AttributeDimension)
userAttributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeDimension)
  }
  deriving (SegmentDimensions -> SegmentDimensions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegmentDimensions -> SegmentDimensions -> Bool
$c/= :: SegmentDimensions -> SegmentDimensions -> Bool
== :: SegmentDimensions -> SegmentDimensions -> Bool
$c== :: SegmentDimensions -> SegmentDimensions -> Bool
Prelude.Eq, ReadPrec [SegmentDimensions]
ReadPrec SegmentDimensions
Int -> ReadS SegmentDimensions
ReadS [SegmentDimensions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SegmentDimensions]
$creadListPrec :: ReadPrec [SegmentDimensions]
readPrec :: ReadPrec SegmentDimensions
$creadPrec :: ReadPrec SegmentDimensions
readList :: ReadS [SegmentDimensions]
$creadList :: ReadS [SegmentDimensions]
readsPrec :: Int -> ReadS SegmentDimensions
$creadsPrec :: Int -> ReadS SegmentDimensions
Prelude.Read, Int -> SegmentDimensions -> ShowS
[SegmentDimensions] -> ShowS
SegmentDimensions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SegmentDimensions] -> ShowS
$cshowList :: [SegmentDimensions] -> ShowS
show :: SegmentDimensions -> String
$cshow :: SegmentDimensions -> String
showsPrec :: Int -> SegmentDimensions -> ShowS
$cshowsPrec :: Int -> SegmentDimensions -> ShowS
Prelude.Show, forall x. Rep SegmentDimensions x -> SegmentDimensions
forall x. SegmentDimensions -> Rep SegmentDimensions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SegmentDimensions x -> SegmentDimensions
$cfrom :: forall x. SegmentDimensions -> Rep SegmentDimensions x
Prelude.Generic)

-- |
-- Create a value of 'SegmentDimensions' 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:
--
-- 'attributes', 'segmentDimensions_attributes' - One or more custom attributes to use as criteria for the segment.
--
-- 'behavior', 'segmentDimensions_behavior' - The behavior-based criteria, such as how recently users have used your
-- app, for the segment.
--
-- 'demographic', 'segmentDimensions_demographic' - The demographic-based criteria, such as device platform, for the
-- segment.
--
-- 'location', 'segmentDimensions_location' - The location-based criteria, such as region or GPS coordinates, for the
-- segment.
--
-- 'metrics', 'segmentDimensions_metrics' - One or more custom metrics to use as criteria for the segment.
--
-- 'userAttributes', 'segmentDimensions_userAttributes' - One or more custom user attributes to use as criteria for the segment.
newSegmentDimensions ::
  SegmentDimensions
newSegmentDimensions :: SegmentDimensions
newSegmentDimensions =
  SegmentDimensions'
    { $sel:attributes:SegmentDimensions' :: Maybe (HashMap Text AttributeDimension)
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:behavior:SegmentDimensions' :: Maybe SegmentBehaviors
behavior = forall a. Maybe a
Prelude.Nothing,
      $sel:demographic:SegmentDimensions' :: Maybe SegmentDemographics
demographic = forall a. Maybe a
Prelude.Nothing,
      $sel:location:SegmentDimensions' :: Maybe SegmentLocation
location = forall a. Maybe a
Prelude.Nothing,
      $sel:metrics:SegmentDimensions' :: Maybe (HashMap Text MetricDimension)
metrics = forall a. Maybe a
Prelude.Nothing,
      $sel:userAttributes:SegmentDimensions' :: Maybe (HashMap Text AttributeDimension)
userAttributes = forall a. Maybe a
Prelude.Nothing
    }

-- | One or more custom attributes to use as criteria for the segment.
segmentDimensions_attributes :: Lens.Lens' SegmentDimensions (Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeDimension))
segmentDimensions_attributes :: Lens' SegmentDimensions (Maybe (HashMap Text AttributeDimension))
segmentDimensions_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDimensions' {Maybe (HashMap Text AttributeDimension)
attributes :: Maybe (HashMap Text AttributeDimension)
$sel:attributes:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text AttributeDimension)
attributes} -> Maybe (HashMap Text AttributeDimension)
attributes) (\s :: SegmentDimensions
s@SegmentDimensions' {} Maybe (HashMap Text AttributeDimension)
a -> SegmentDimensions
s {$sel:attributes:SegmentDimensions' :: Maybe (HashMap Text AttributeDimension)
attributes = Maybe (HashMap Text AttributeDimension)
a} :: SegmentDimensions) 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 behavior-based criteria, such as how recently users have used your
-- app, for the segment.
segmentDimensions_behavior :: Lens.Lens' SegmentDimensions (Prelude.Maybe SegmentBehaviors)
segmentDimensions_behavior :: Lens' SegmentDimensions (Maybe SegmentBehaviors)
segmentDimensions_behavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDimensions' {Maybe SegmentBehaviors
behavior :: Maybe SegmentBehaviors
$sel:behavior:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentBehaviors
behavior} -> Maybe SegmentBehaviors
behavior) (\s :: SegmentDimensions
s@SegmentDimensions' {} Maybe SegmentBehaviors
a -> SegmentDimensions
s {$sel:behavior:SegmentDimensions' :: Maybe SegmentBehaviors
behavior = Maybe SegmentBehaviors
a} :: SegmentDimensions)

-- | The demographic-based criteria, such as device platform, for the
-- segment.
segmentDimensions_demographic :: Lens.Lens' SegmentDimensions (Prelude.Maybe SegmentDemographics)
segmentDimensions_demographic :: Lens' SegmentDimensions (Maybe SegmentDemographics)
segmentDimensions_demographic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDimensions' {Maybe SegmentDemographics
demographic :: Maybe SegmentDemographics
$sel:demographic:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentDemographics
demographic} -> Maybe SegmentDemographics
demographic) (\s :: SegmentDimensions
s@SegmentDimensions' {} Maybe SegmentDemographics
a -> SegmentDimensions
s {$sel:demographic:SegmentDimensions' :: Maybe SegmentDemographics
demographic = Maybe SegmentDemographics
a} :: SegmentDimensions)

-- | The location-based criteria, such as region or GPS coordinates, for the
-- segment.
segmentDimensions_location :: Lens.Lens' SegmentDimensions (Prelude.Maybe SegmentLocation)
segmentDimensions_location :: Lens' SegmentDimensions (Maybe SegmentLocation)
segmentDimensions_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDimensions' {Maybe SegmentLocation
location :: Maybe SegmentLocation
$sel:location:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentLocation
location} -> Maybe SegmentLocation
location) (\s :: SegmentDimensions
s@SegmentDimensions' {} Maybe SegmentLocation
a -> SegmentDimensions
s {$sel:location:SegmentDimensions' :: Maybe SegmentLocation
location = Maybe SegmentLocation
a} :: SegmentDimensions)

-- | One or more custom metrics to use as criteria for the segment.
segmentDimensions_metrics :: Lens.Lens' SegmentDimensions (Prelude.Maybe (Prelude.HashMap Prelude.Text MetricDimension))
segmentDimensions_metrics :: Lens' SegmentDimensions (Maybe (HashMap Text MetricDimension))
segmentDimensions_metrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDimensions' {Maybe (HashMap Text MetricDimension)
metrics :: Maybe (HashMap Text MetricDimension)
$sel:metrics:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text MetricDimension)
metrics} -> Maybe (HashMap Text MetricDimension)
metrics) (\s :: SegmentDimensions
s@SegmentDimensions' {} Maybe (HashMap Text MetricDimension)
a -> SegmentDimensions
s {$sel:metrics:SegmentDimensions' :: Maybe (HashMap Text MetricDimension)
metrics = Maybe (HashMap Text MetricDimension)
a} :: SegmentDimensions) 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

-- | One or more custom user attributes to use as criteria for the segment.
segmentDimensions_userAttributes :: Lens.Lens' SegmentDimensions (Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeDimension))
segmentDimensions_userAttributes :: Lens' SegmentDimensions (Maybe (HashMap Text AttributeDimension))
segmentDimensions_userAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDimensions' {Maybe (HashMap Text AttributeDimension)
userAttributes :: Maybe (HashMap Text AttributeDimension)
$sel:userAttributes:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text AttributeDimension)
userAttributes} -> Maybe (HashMap Text AttributeDimension)
userAttributes) (\s :: SegmentDimensions
s@SegmentDimensions' {} Maybe (HashMap Text AttributeDimension)
a -> SegmentDimensions
s {$sel:userAttributes:SegmentDimensions' :: Maybe (HashMap Text AttributeDimension)
userAttributes = Maybe (HashMap Text AttributeDimension)
a} :: SegmentDimensions) 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

instance Data.FromJSON SegmentDimensions where
  parseJSON :: Value -> Parser SegmentDimensions
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SegmentDimensions"
      ( \Object
x ->
          Maybe (HashMap Text AttributeDimension)
-> Maybe SegmentBehaviors
-> Maybe SegmentDemographics
-> Maybe SegmentLocation
-> Maybe (HashMap Text MetricDimension)
-> Maybe (HashMap Text AttributeDimension)
-> SegmentDimensions
SegmentDimensions'
            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
"Attributes" 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
"Behavior")
            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
"Demographic")
            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
"Location")
            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
"Metrics" 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
"UserAttributes"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable SegmentDimensions where
  hashWithSalt :: Int -> SegmentDimensions -> Int
hashWithSalt Int
_salt SegmentDimensions' {Maybe (HashMap Text AttributeDimension)
Maybe (HashMap Text MetricDimension)
Maybe SegmentBehaviors
Maybe SegmentLocation
Maybe SegmentDemographics
userAttributes :: Maybe (HashMap Text AttributeDimension)
metrics :: Maybe (HashMap Text MetricDimension)
location :: Maybe SegmentLocation
demographic :: Maybe SegmentDemographics
behavior :: Maybe SegmentBehaviors
attributes :: Maybe (HashMap Text AttributeDimension)
$sel:userAttributes:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text AttributeDimension)
$sel:metrics:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text MetricDimension)
$sel:location:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentLocation
$sel:demographic:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentDemographics
$sel:behavior:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentBehaviors
$sel:attributes:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text AttributeDimension)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text AttributeDimension)
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SegmentBehaviors
behavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SegmentDemographics
demographic
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SegmentLocation
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text MetricDimension)
metrics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text AttributeDimension)
userAttributes

instance Prelude.NFData SegmentDimensions where
  rnf :: SegmentDimensions -> ()
rnf SegmentDimensions' {Maybe (HashMap Text AttributeDimension)
Maybe (HashMap Text MetricDimension)
Maybe SegmentBehaviors
Maybe SegmentLocation
Maybe SegmentDemographics
userAttributes :: Maybe (HashMap Text AttributeDimension)
metrics :: Maybe (HashMap Text MetricDimension)
location :: Maybe SegmentLocation
demographic :: Maybe SegmentDemographics
behavior :: Maybe SegmentBehaviors
attributes :: Maybe (HashMap Text AttributeDimension)
$sel:userAttributes:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text AttributeDimension)
$sel:metrics:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text MetricDimension)
$sel:location:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentLocation
$sel:demographic:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentDemographics
$sel:behavior:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentBehaviors
$sel:attributes:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text AttributeDimension)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text AttributeDimension)
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SegmentBehaviors
behavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SegmentDemographics
demographic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SegmentLocation
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text MetricDimension)
metrics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text AttributeDimension)
userAttributes

instance Data.ToJSON SegmentDimensions where
  toJSON :: SegmentDimensions -> Value
toJSON SegmentDimensions' {Maybe (HashMap Text AttributeDimension)
Maybe (HashMap Text MetricDimension)
Maybe SegmentBehaviors
Maybe SegmentLocation
Maybe SegmentDemographics
userAttributes :: Maybe (HashMap Text AttributeDimension)
metrics :: Maybe (HashMap Text MetricDimension)
location :: Maybe SegmentLocation
demographic :: Maybe SegmentDemographics
behavior :: Maybe SegmentBehaviors
attributes :: Maybe (HashMap Text AttributeDimension)
$sel:userAttributes:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text AttributeDimension)
$sel:metrics:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text MetricDimension)
$sel:location:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentLocation
$sel:demographic:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentDemographics
$sel:behavior:SegmentDimensions' :: SegmentDimensions -> Maybe SegmentBehaviors
$sel:attributes:SegmentDimensions' :: SegmentDimensions -> Maybe (HashMap Text AttributeDimension)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Attributes" 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 (HashMap Text AttributeDimension)
attributes,
            (Key
"Behavior" 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 SegmentBehaviors
behavior,
            (Key
"Demographic" 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 SegmentDemographics
demographic,
            (Key
"Location" 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 SegmentLocation
location,
            (Key
"Metrics" 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 (HashMap Text MetricDimension)
metrics,
            (Key
"UserAttributes" 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 (HashMap Text AttributeDimension)
userAttributes
          ]
      )