{-# 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.PersonalizeRuntime.Types.Promotion
-- 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.PersonalizeRuntime.Types.Promotion where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | Contains information on a promotion. A promotion defines additional
-- business rules that apply to a configurable subset of recommended items.
--
-- /See:/ 'newPromotion' smart constructor.
data Promotion = Promotion'
  { -- | The Amazon Resource Name (ARN) of the filter used by the promotion. This
    -- filter defines the criteria for promoted items. For more information,
    -- see
    -- <https://docs.aws.amazon.com/personalize/latest/dg/promoting-items.html#promotion-filters Promotion filters>.
    Promotion -> Maybe Text
filterArn :: Prelude.Maybe Prelude.Text,
    -- | The values to use when promoting items. For each placeholder parameter
    -- in your promotion\'s filter expression, provide the parameter name (in
    -- matching case) as a key and the filter value(s) as the corresponding
    -- value. Separate multiple values for one parameter with a comma.
    --
    -- For filter expressions that use an @INCLUDE@ element to include items,
    -- you must provide values for all parameters that are defined in the
    -- expression. For filters with expressions that use an @EXCLUDE@ element
    -- to exclude items, you can omit the @filter-values@. In this case, Amazon
    -- Personalize doesn\'t use that portion of the expression to filter
    -- recommendations.
    --
    -- For more information on creating filters, see
    -- <https://docs.aws.amazon.com/personalize/latest/dg/filter.html Filtering recommendations and user segments>.
    Promotion -> Maybe (HashMap Text (Sensitive Text))
filterValues :: Prelude.Maybe (Prelude.HashMap Prelude.Text (Data.Sensitive Prelude.Text)),
    -- | The name of the promotion.
    Promotion -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The percentage of recommended items to apply the promotion to.
    Promotion -> Maybe Natural
percentPromotedItems :: Prelude.Maybe Prelude.Natural
  }
  deriving (Promotion -> Promotion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Promotion -> Promotion -> Bool
$c/= :: Promotion -> Promotion -> Bool
== :: Promotion -> Promotion -> Bool
$c== :: Promotion -> Promotion -> Bool
Prelude.Eq, Int -> Promotion -> ShowS
[Promotion] -> ShowS
Promotion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Promotion] -> ShowS
$cshowList :: [Promotion] -> ShowS
show :: Promotion -> String
$cshow :: Promotion -> String
showsPrec :: Int -> Promotion -> ShowS
$cshowsPrec :: Int -> Promotion -> ShowS
Prelude.Show, forall x. Rep Promotion x -> Promotion
forall x. Promotion -> Rep Promotion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Promotion x -> Promotion
$cfrom :: forall x. Promotion -> Rep Promotion x
Prelude.Generic)

-- |
-- Create a value of 'Promotion' 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:
--
-- 'filterArn', 'promotion_filterArn' - The Amazon Resource Name (ARN) of the filter used by the promotion. This
-- filter defines the criteria for promoted items. For more information,
-- see
-- <https://docs.aws.amazon.com/personalize/latest/dg/promoting-items.html#promotion-filters Promotion filters>.
--
-- 'filterValues', 'promotion_filterValues' - The values to use when promoting items. For each placeholder parameter
-- in your promotion\'s filter expression, provide the parameter name (in
-- matching case) as a key and the filter value(s) as the corresponding
-- value. Separate multiple values for one parameter with a comma.
--
-- For filter expressions that use an @INCLUDE@ element to include items,
-- you must provide values for all parameters that are defined in the
-- expression. For filters with expressions that use an @EXCLUDE@ element
-- to exclude items, you can omit the @filter-values@. In this case, Amazon
-- Personalize doesn\'t use that portion of the expression to filter
-- recommendations.
--
-- For more information on creating filters, see
-- <https://docs.aws.amazon.com/personalize/latest/dg/filter.html Filtering recommendations and user segments>.
--
-- 'name', 'promotion_name' - The name of the promotion.
--
-- 'percentPromotedItems', 'promotion_percentPromotedItems' - The percentage of recommended items to apply the promotion to.
newPromotion ::
  Promotion
newPromotion :: Promotion
newPromotion =
  Promotion'
    { $sel:filterArn:Promotion' :: Maybe Text
filterArn = forall a. Maybe a
Prelude.Nothing,
      $sel:filterValues:Promotion' :: Maybe (HashMap Text (Sensitive Text))
filterValues = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Promotion' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:percentPromotedItems:Promotion' :: Maybe Natural
percentPromotedItems = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) of the filter used by the promotion. This
-- filter defines the criteria for promoted items. For more information,
-- see
-- <https://docs.aws.amazon.com/personalize/latest/dg/promoting-items.html#promotion-filters Promotion filters>.
promotion_filterArn :: Lens.Lens' Promotion (Prelude.Maybe Prelude.Text)
promotion_filterArn :: Lens' Promotion (Maybe Text)
promotion_filterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Promotion' {Maybe Text
filterArn :: Maybe Text
$sel:filterArn:Promotion' :: Promotion -> Maybe Text
filterArn} -> Maybe Text
filterArn) (\s :: Promotion
s@Promotion' {} Maybe Text
a -> Promotion
s {$sel:filterArn:Promotion' :: Maybe Text
filterArn = Maybe Text
a} :: Promotion)

-- | The values to use when promoting items. For each placeholder parameter
-- in your promotion\'s filter expression, provide the parameter name (in
-- matching case) as a key and the filter value(s) as the corresponding
-- value. Separate multiple values for one parameter with a comma.
--
-- For filter expressions that use an @INCLUDE@ element to include items,
-- you must provide values for all parameters that are defined in the
-- expression. For filters with expressions that use an @EXCLUDE@ element
-- to exclude items, you can omit the @filter-values@. In this case, Amazon
-- Personalize doesn\'t use that portion of the expression to filter
-- recommendations.
--
-- For more information on creating filters, see
-- <https://docs.aws.amazon.com/personalize/latest/dg/filter.html Filtering recommendations and user segments>.
promotion_filterValues :: Lens.Lens' Promotion (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
promotion_filterValues :: Lens' Promotion (Maybe (HashMap Text Text))
promotion_filterValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Promotion' {Maybe (HashMap Text (Sensitive Text))
filterValues :: Maybe (HashMap Text (Sensitive Text))
$sel:filterValues:Promotion' :: Promotion -> Maybe (HashMap Text (Sensitive Text))
filterValues} -> Maybe (HashMap Text (Sensitive Text))
filterValues) (\s :: Promotion
s@Promotion' {} Maybe (HashMap Text (Sensitive Text))
a -> Promotion
s {$sel:filterValues:Promotion' :: Maybe (HashMap Text (Sensitive Text))
filterValues = Maybe (HashMap Text (Sensitive Text))
a} :: Promotion) 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 name of the promotion.
promotion_name :: Lens.Lens' Promotion (Prelude.Maybe Prelude.Text)
promotion_name :: Lens' Promotion (Maybe Text)
promotion_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Promotion' {Maybe Text
name :: Maybe Text
$sel:name:Promotion' :: Promotion -> Maybe Text
name} -> Maybe Text
name) (\s :: Promotion
s@Promotion' {} Maybe Text
a -> Promotion
s {$sel:name:Promotion' :: Maybe Text
name = Maybe Text
a} :: Promotion)

-- | The percentage of recommended items to apply the promotion to.
promotion_percentPromotedItems :: Lens.Lens' Promotion (Prelude.Maybe Prelude.Natural)
promotion_percentPromotedItems :: Lens' Promotion (Maybe Natural)
promotion_percentPromotedItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Promotion' {Maybe Natural
percentPromotedItems :: Maybe Natural
$sel:percentPromotedItems:Promotion' :: Promotion -> Maybe Natural
percentPromotedItems} -> Maybe Natural
percentPromotedItems) (\s :: Promotion
s@Promotion' {} Maybe Natural
a -> Promotion
s {$sel:percentPromotedItems:Promotion' :: Maybe Natural
percentPromotedItems = Maybe Natural
a} :: Promotion)

instance Prelude.Hashable Promotion where
  hashWithSalt :: Int -> Promotion -> Int
hashWithSalt Int
_salt Promotion' {Maybe Natural
Maybe Text
Maybe (HashMap Text (Sensitive Text))
percentPromotedItems :: Maybe Natural
name :: Maybe Text
filterValues :: Maybe (HashMap Text (Sensitive Text))
filterArn :: Maybe Text
$sel:percentPromotedItems:Promotion' :: Promotion -> Maybe Natural
$sel:name:Promotion' :: Promotion -> Maybe Text
$sel:filterValues:Promotion' :: Promotion -> Maybe (HashMap Text (Sensitive Text))
$sel:filterArn:Promotion' :: Promotion -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
filterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text (Sensitive Text))
filterValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
percentPromotedItems

instance Prelude.NFData Promotion where
  rnf :: Promotion -> ()
rnf Promotion' {Maybe Natural
Maybe Text
Maybe (HashMap Text (Sensitive Text))
percentPromotedItems :: Maybe Natural
name :: Maybe Text
filterValues :: Maybe (HashMap Text (Sensitive Text))
filterArn :: Maybe Text
$sel:percentPromotedItems:Promotion' :: Promotion -> Maybe Natural
$sel:name:Promotion' :: Promotion -> Maybe Text
$sel:filterValues:Promotion' :: Promotion -> Maybe (HashMap Text (Sensitive Text))
$sel:filterArn:Promotion' :: Promotion -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
filterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text (Sensitive Text))
filterValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
percentPromotedItems

instance Data.ToJSON Promotion where
  toJSON :: Promotion -> Value
toJSON Promotion' {Maybe Natural
Maybe Text
Maybe (HashMap Text (Sensitive Text))
percentPromotedItems :: Maybe Natural
name :: Maybe Text
filterValues :: Maybe (HashMap Text (Sensitive Text))
filterArn :: Maybe Text
$sel:percentPromotedItems:Promotion' :: Promotion -> Maybe Natural
$sel:name:Promotion' :: Promotion -> Maybe Text
$sel:filterValues:Promotion' :: Promotion -> Maybe (HashMap Text (Sensitive Text))
$sel:filterArn:Promotion' :: Promotion -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"filterArn" 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 Text
filterArn,
            (Key
"filterValues" 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 (Sensitive Text))
filterValues,
            (Key
"name" 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 Text
name,
            (Key
"percentPromotedItems" 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 Natural
percentPromotedItems
          ]
      )