{-# 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.SegmentGroup
-- 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.SegmentGroup 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.SegmentDimensions
import Amazonka.Pinpoint.Types.SegmentReference
import Amazonka.Pinpoint.Types.SourceType
import Amazonka.Pinpoint.Types.Type
import qualified Amazonka.Prelude as Prelude

-- | Specifies the base segments and dimensions for a segment, and the
-- relationships between these base segments and dimensions.
--
-- /See:/ 'newSegmentGroup' smart constructor.
data SegmentGroup = SegmentGroup'
  { -- | An array that defines the dimensions for the segment.
    SegmentGroup -> Maybe [SegmentDimensions]
dimensions :: Prelude.Maybe [SegmentDimensions],
    -- | The base segment to build the segment on. A base segment, also referred
    -- to as a /source segment/, defines the initial population of endpoints
    -- for a segment. When you add dimensions to a segment, Amazon Pinpoint
    -- filters the base segment by using the dimensions that you specify.
    --
    -- You can specify more than one dimensional segment or only one imported
    -- segment. If you specify an imported segment, the Amazon Pinpoint console
    -- displays a segment size estimate that indicates the size of the imported
    -- segment without any filters applied to it.
    SegmentGroup -> Maybe [SegmentReference]
sourceSegments :: Prelude.Maybe [SegmentReference],
    -- | Specifies how to handle multiple base segments for the segment. For
    -- example, if you specify three base segments for the segment, whether the
    -- resulting segment is based on all, any, or none of the base segments.
    SegmentGroup -> Maybe SourceType
sourceType :: Prelude.Maybe SourceType,
    -- | Specifies how to handle multiple dimensions for the segment. For
    -- example, if you specify three dimensions for the segment, whether the
    -- resulting segment includes endpoints that match all, any, or none of the
    -- dimensions.
    SegmentGroup -> Maybe Type
type' :: Prelude.Maybe Type
  }
  deriving (SegmentGroup -> SegmentGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegmentGroup -> SegmentGroup -> Bool
$c/= :: SegmentGroup -> SegmentGroup -> Bool
== :: SegmentGroup -> SegmentGroup -> Bool
$c== :: SegmentGroup -> SegmentGroup -> Bool
Prelude.Eq, ReadPrec [SegmentGroup]
ReadPrec SegmentGroup
Int -> ReadS SegmentGroup
ReadS [SegmentGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SegmentGroup]
$creadListPrec :: ReadPrec [SegmentGroup]
readPrec :: ReadPrec SegmentGroup
$creadPrec :: ReadPrec SegmentGroup
readList :: ReadS [SegmentGroup]
$creadList :: ReadS [SegmentGroup]
readsPrec :: Int -> ReadS SegmentGroup
$creadsPrec :: Int -> ReadS SegmentGroup
Prelude.Read, Int -> SegmentGroup -> ShowS
[SegmentGroup] -> ShowS
SegmentGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SegmentGroup] -> ShowS
$cshowList :: [SegmentGroup] -> ShowS
show :: SegmentGroup -> String
$cshow :: SegmentGroup -> String
showsPrec :: Int -> SegmentGroup -> ShowS
$cshowsPrec :: Int -> SegmentGroup -> ShowS
Prelude.Show, forall x. Rep SegmentGroup x -> SegmentGroup
forall x. SegmentGroup -> Rep SegmentGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SegmentGroup x -> SegmentGroup
$cfrom :: forall x. SegmentGroup -> Rep SegmentGroup x
Prelude.Generic)

-- |
-- Create a value of 'SegmentGroup' 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:
--
-- 'dimensions', 'segmentGroup_dimensions' - An array that defines the dimensions for the segment.
--
-- 'sourceSegments', 'segmentGroup_sourceSegments' - The base segment to build the segment on. A base segment, also referred
-- to as a /source segment/, defines the initial population of endpoints
-- for a segment. When you add dimensions to a segment, Amazon Pinpoint
-- filters the base segment by using the dimensions that you specify.
--
-- You can specify more than one dimensional segment or only one imported
-- segment. If you specify an imported segment, the Amazon Pinpoint console
-- displays a segment size estimate that indicates the size of the imported
-- segment without any filters applied to it.
--
-- 'sourceType', 'segmentGroup_sourceType' - Specifies how to handle multiple base segments for the segment. For
-- example, if you specify three base segments for the segment, whether the
-- resulting segment is based on all, any, or none of the base segments.
--
-- 'type'', 'segmentGroup_type' - Specifies how to handle multiple dimensions for the segment. For
-- example, if you specify three dimensions for the segment, whether the
-- resulting segment includes endpoints that match all, any, or none of the
-- dimensions.
newSegmentGroup ::
  SegmentGroup
newSegmentGroup :: SegmentGroup
newSegmentGroup =
  SegmentGroup'
    { $sel:dimensions:SegmentGroup' :: Maybe [SegmentDimensions]
dimensions = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceSegments:SegmentGroup' :: Maybe [SegmentReference]
sourceSegments = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceType:SegmentGroup' :: Maybe SourceType
sourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:type':SegmentGroup' :: Maybe Type
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | An array that defines the dimensions for the segment.
segmentGroup_dimensions :: Lens.Lens' SegmentGroup (Prelude.Maybe [SegmentDimensions])
segmentGroup_dimensions :: Lens' SegmentGroup (Maybe [SegmentDimensions])
segmentGroup_dimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentGroup' {Maybe [SegmentDimensions]
dimensions :: Maybe [SegmentDimensions]
$sel:dimensions:SegmentGroup' :: SegmentGroup -> Maybe [SegmentDimensions]
dimensions} -> Maybe [SegmentDimensions]
dimensions) (\s :: SegmentGroup
s@SegmentGroup' {} Maybe [SegmentDimensions]
a -> SegmentGroup
s {$sel:dimensions:SegmentGroup' :: Maybe [SegmentDimensions]
dimensions = Maybe [SegmentDimensions]
a} :: SegmentGroup) 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 base segment to build the segment on. A base segment, also referred
-- to as a /source segment/, defines the initial population of endpoints
-- for a segment. When you add dimensions to a segment, Amazon Pinpoint
-- filters the base segment by using the dimensions that you specify.
--
-- You can specify more than one dimensional segment or only one imported
-- segment. If you specify an imported segment, the Amazon Pinpoint console
-- displays a segment size estimate that indicates the size of the imported
-- segment without any filters applied to it.
segmentGroup_sourceSegments :: Lens.Lens' SegmentGroup (Prelude.Maybe [SegmentReference])
segmentGroup_sourceSegments :: Lens' SegmentGroup (Maybe [SegmentReference])
segmentGroup_sourceSegments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentGroup' {Maybe [SegmentReference]
sourceSegments :: Maybe [SegmentReference]
$sel:sourceSegments:SegmentGroup' :: SegmentGroup -> Maybe [SegmentReference]
sourceSegments} -> Maybe [SegmentReference]
sourceSegments) (\s :: SegmentGroup
s@SegmentGroup' {} Maybe [SegmentReference]
a -> SegmentGroup
s {$sel:sourceSegments:SegmentGroup' :: Maybe [SegmentReference]
sourceSegments = Maybe [SegmentReference]
a} :: SegmentGroup) 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

-- | Specifies how to handle multiple base segments for the segment. For
-- example, if you specify three base segments for the segment, whether the
-- resulting segment is based on all, any, or none of the base segments.
segmentGroup_sourceType :: Lens.Lens' SegmentGroup (Prelude.Maybe SourceType)
segmentGroup_sourceType :: Lens' SegmentGroup (Maybe SourceType)
segmentGroup_sourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentGroup' {Maybe SourceType
sourceType :: Maybe SourceType
$sel:sourceType:SegmentGroup' :: SegmentGroup -> Maybe SourceType
sourceType} -> Maybe SourceType
sourceType) (\s :: SegmentGroup
s@SegmentGroup' {} Maybe SourceType
a -> SegmentGroup
s {$sel:sourceType:SegmentGroup' :: Maybe SourceType
sourceType = Maybe SourceType
a} :: SegmentGroup)

-- | Specifies how to handle multiple dimensions for the segment. For
-- example, if you specify three dimensions for the segment, whether the
-- resulting segment includes endpoints that match all, any, or none of the
-- dimensions.
segmentGroup_type :: Lens.Lens' SegmentGroup (Prelude.Maybe Type)
segmentGroup_type :: Lens' SegmentGroup (Maybe Type)
segmentGroup_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentGroup' {Maybe Type
type' :: Maybe Type
$sel:type':SegmentGroup' :: SegmentGroup -> Maybe Type
type'} -> Maybe Type
type') (\s :: SegmentGroup
s@SegmentGroup' {} Maybe Type
a -> SegmentGroup
s {$sel:type':SegmentGroup' :: Maybe Type
type' = Maybe Type
a} :: SegmentGroup)

instance Data.FromJSON SegmentGroup where
  parseJSON :: Value -> Parser SegmentGroup
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SegmentGroup"
      ( \Object
x ->
          Maybe [SegmentDimensions]
-> Maybe [SegmentReference]
-> Maybe SourceType
-> Maybe Type
-> SegmentGroup
SegmentGroup'
            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
"Dimensions" 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
"SourceSegments" 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
"SourceType")
            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
"Type")
      )

instance Prelude.Hashable SegmentGroup where
  hashWithSalt :: Int -> SegmentGroup -> Int
hashWithSalt Int
_salt SegmentGroup' {Maybe [SegmentReference]
Maybe [SegmentDimensions]
Maybe SourceType
Maybe Type
type' :: Maybe Type
sourceType :: Maybe SourceType
sourceSegments :: Maybe [SegmentReference]
dimensions :: Maybe [SegmentDimensions]
$sel:type':SegmentGroup' :: SegmentGroup -> Maybe Type
$sel:sourceType:SegmentGroup' :: SegmentGroup -> Maybe SourceType
$sel:sourceSegments:SegmentGroup' :: SegmentGroup -> Maybe [SegmentReference]
$sel:dimensions:SegmentGroup' :: SegmentGroup -> Maybe [SegmentDimensions]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SegmentDimensions]
dimensions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SegmentReference]
sourceSegments
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SourceType
sourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Type
type'

instance Prelude.NFData SegmentGroup where
  rnf :: SegmentGroup -> ()
rnf SegmentGroup' {Maybe [SegmentReference]
Maybe [SegmentDimensions]
Maybe SourceType
Maybe Type
type' :: Maybe Type
sourceType :: Maybe SourceType
sourceSegments :: Maybe [SegmentReference]
dimensions :: Maybe [SegmentDimensions]
$sel:type':SegmentGroup' :: SegmentGroup -> Maybe Type
$sel:sourceType:SegmentGroup' :: SegmentGroup -> Maybe SourceType
$sel:sourceSegments:SegmentGroup' :: SegmentGroup -> Maybe [SegmentReference]
$sel:dimensions:SegmentGroup' :: SegmentGroup -> Maybe [SegmentDimensions]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [SegmentDimensions]
dimensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SegmentReference]
sourceSegments
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SourceType
sourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Type
type'

instance Data.ToJSON SegmentGroup where
  toJSON :: SegmentGroup -> Value
toJSON SegmentGroup' {Maybe [SegmentReference]
Maybe [SegmentDimensions]
Maybe SourceType
Maybe Type
type' :: Maybe Type
sourceType :: Maybe SourceType
sourceSegments :: Maybe [SegmentReference]
dimensions :: Maybe [SegmentDimensions]
$sel:type':SegmentGroup' :: SegmentGroup -> Maybe Type
$sel:sourceType:SegmentGroup' :: SegmentGroup -> Maybe SourceType
$sel:sourceSegments:SegmentGroup' :: SegmentGroup -> Maybe [SegmentReference]
$sel:dimensions:SegmentGroup' :: SegmentGroup -> Maybe [SegmentDimensions]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Dimensions" 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 [SegmentDimensions]
dimensions,
            (Key
"SourceSegments" 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 [SegmentReference]
sourceSegments,
            (Key
"SourceType" 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 SourceType
sourceType,
            (Key
"Type" 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 Type
type'
          ]
      )