{-# 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.Personalize.Types.SolutionConfig
-- 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.Personalize.Types.SolutionConfig where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Personalize.Types.AutoMLConfig
import Amazonka.Personalize.Types.HPOConfig
import Amazonka.Personalize.Types.OptimizationObjective
import qualified Amazonka.Prelude as Prelude

-- | Describes the configuration properties for the solution.
--
-- /See:/ 'newSolutionConfig' smart constructor.
data SolutionConfig = SolutionConfig'
  { -- | Lists the hyperparameter names and ranges.
    SolutionConfig -> Maybe (HashMap Text Text)
algorithmHyperParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The
    -- <https://docs.aws.amazon.com/personalize/latest/dg/API_AutoMLConfig.html AutoMLConfig>
    -- object containing a list of recipes to search when AutoML is performed.
    SolutionConfig -> Maybe AutoMLConfig
autoMLConfig :: Prelude.Maybe AutoMLConfig,
    -- | Only events with a value greater than or equal to this threshold are
    -- used for training a model.
    SolutionConfig -> Maybe Text
eventValueThreshold :: Prelude.Maybe Prelude.Text,
    -- | Lists the feature transformation parameters.
    SolutionConfig -> Maybe (HashMap Text Text)
featureTransformationParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Describes the properties for hyperparameter optimization (HPO).
    SolutionConfig -> Maybe HPOConfig
hpoConfig :: Prelude.Maybe HPOConfig,
    -- | Describes the additional objective for the solution, such as maximizing
    -- streaming minutes or increasing revenue. For more information see
    -- <https://docs.aws.amazon.com/personalize/latest/dg/optimizing-solution-for-objective.html Optimizing a solution>.
    SolutionConfig -> Maybe OptimizationObjective
optimizationObjective :: Prelude.Maybe OptimizationObjective
  }
  deriving (SolutionConfig -> SolutionConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolutionConfig -> SolutionConfig -> Bool
$c/= :: SolutionConfig -> SolutionConfig -> Bool
== :: SolutionConfig -> SolutionConfig -> Bool
$c== :: SolutionConfig -> SolutionConfig -> Bool
Prelude.Eq, ReadPrec [SolutionConfig]
ReadPrec SolutionConfig
Int -> ReadS SolutionConfig
ReadS [SolutionConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SolutionConfig]
$creadListPrec :: ReadPrec [SolutionConfig]
readPrec :: ReadPrec SolutionConfig
$creadPrec :: ReadPrec SolutionConfig
readList :: ReadS [SolutionConfig]
$creadList :: ReadS [SolutionConfig]
readsPrec :: Int -> ReadS SolutionConfig
$creadsPrec :: Int -> ReadS SolutionConfig
Prelude.Read, Int -> SolutionConfig -> ShowS
[SolutionConfig] -> ShowS
SolutionConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SolutionConfig] -> ShowS
$cshowList :: [SolutionConfig] -> ShowS
show :: SolutionConfig -> String
$cshow :: SolutionConfig -> String
showsPrec :: Int -> SolutionConfig -> ShowS
$cshowsPrec :: Int -> SolutionConfig -> ShowS
Prelude.Show, forall x. Rep SolutionConfig x -> SolutionConfig
forall x. SolutionConfig -> Rep SolutionConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SolutionConfig x -> SolutionConfig
$cfrom :: forall x. SolutionConfig -> Rep SolutionConfig x
Prelude.Generic)

-- |
-- Create a value of 'SolutionConfig' 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:
--
-- 'algorithmHyperParameters', 'solutionConfig_algorithmHyperParameters' - Lists the hyperparameter names and ranges.
--
-- 'autoMLConfig', 'solutionConfig_autoMLConfig' - The
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_AutoMLConfig.html AutoMLConfig>
-- object containing a list of recipes to search when AutoML is performed.
--
-- 'eventValueThreshold', 'solutionConfig_eventValueThreshold' - Only events with a value greater than or equal to this threshold are
-- used for training a model.
--
-- 'featureTransformationParameters', 'solutionConfig_featureTransformationParameters' - Lists the feature transformation parameters.
--
-- 'hpoConfig', 'solutionConfig_hpoConfig' - Describes the properties for hyperparameter optimization (HPO).
--
-- 'optimizationObjective', 'solutionConfig_optimizationObjective' - Describes the additional objective for the solution, such as maximizing
-- streaming minutes or increasing revenue. For more information see
-- <https://docs.aws.amazon.com/personalize/latest/dg/optimizing-solution-for-objective.html Optimizing a solution>.
newSolutionConfig ::
  SolutionConfig
newSolutionConfig :: SolutionConfig
newSolutionConfig =
  SolutionConfig'
    { $sel:algorithmHyperParameters:SolutionConfig' :: Maybe (HashMap Text Text)
algorithmHyperParameters =
        forall a. Maybe a
Prelude.Nothing,
      $sel:autoMLConfig:SolutionConfig' :: Maybe AutoMLConfig
autoMLConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:eventValueThreshold:SolutionConfig' :: Maybe Text
eventValueThreshold = forall a. Maybe a
Prelude.Nothing,
      $sel:featureTransformationParameters:SolutionConfig' :: Maybe (HashMap Text Text)
featureTransformationParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:hpoConfig:SolutionConfig' :: Maybe HPOConfig
hpoConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:optimizationObjective:SolutionConfig' :: Maybe OptimizationObjective
optimizationObjective = forall a. Maybe a
Prelude.Nothing
    }

-- | Lists the hyperparameter names and ranges.
solutionConfig_algorithmHyperParameters :: Lens.Lens' SolutionConfig (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
solutionConfig_algorithmHyperParameters :: Lens' SolutionConfig (Maybe (HashMap Text Text))
solutionConfig_algorithmHyperParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SolutionConfig' {Maybe (HashMap Text Text)
algorithmHyperParameters :: Maybe (HashMap Text Text)
$sel:algorithmHyperParameters:SolutionConfig' :: SolutionConfig -> Maybe (HashMap Text Text)
algorithmHyperParameters} -> Maybe (HashMap Text Text)
algorithmHyperParameters) (\s :: SolutionConfig
s@SolutionConfig' {} Maybe (HashMap Text Text)
a -> SolutionConfig
s {$sel:algorithmHyperParameters:SolutionConfig' :: Maybe (HashMap Text Text)
algorithmHyperParameters = Maybe (HashMap Text Text)
a} :: SolutionConfig) 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
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_AutoMLConfig.html AutoMLConfig>
-- object containing a list of recipes to search when AutoML is performed.
solutionConfig_autoMLConfig :: Lens.Lens' SolutionConfig (Prelude.Maybe AutoMLConfig)
solutionConfig_autoMLConfig :: Lens' SolutionConfig (Maybe AutoMLConfig)
solutionConfig_autoMLConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SolutionConfig' {Maybe AutoMLConfig
autoMLConfig :: Maybe AutoMLConfig
$sel:autoMLConfig:SolutionConfig' :: SolutionConfig -> Maybe AutoMLConfig
autoMLConfig} -> Maybe AutoMLConfig
autoMLConfig) (\s :: SolutionConfig
s@SolutionConfig' {} Maybe AutoMLConfig
a -> SolutionConfig
s {$sel:autoMLConfig:SolutionConfig' :: Maybe AutoMLConfig
autoMLConfig = Maybe AutoMLConfig
a} :: SolutionConfig)

-- | Only events with a value greater than or equal to this threshold are
-- used for training a model.
solutionConfig_eventValueThreshold :: Lens.Lens' SolutionConfig (Prelude.Maybe Prelude.Text)
solutionConfig_eventValueThreshold :: Lens' SolutionConfig (Maybe Text)
solutionConfig_eventValueThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SolutionConfig' {Maybe Text
eventValueThreshold :: Maybe Text
$sel:eventValueThreshold:SolutionConfig' :: SolutionConfig -> Maybe Text
eventValueThreshold} -> Maybe Text
eventValueThreshold) (\s :: SolutionConfig
s@SolutionConfig' {} Maybe Text
a -> SolutionConfig
s {$sel:eventValueThreshold:SolutionConfig' :: Maybe Text
eventValueThreshold = Maybe Text
a} :: SolutionConfig)

-- | Lists the feature transformation parameters.
solutionConfig_featureTransformationParameters :: Lens.Lens' SolutionConfig (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
solutionConfig_featureTransformationParameters :: Lens' SolutionConfig (Maybe (HashMap Text Text))
solutionConfig_featureTransformationParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SolutionConfig' {Maybe (HashMap Text Text)
featureTransformationParameters :: Maybe (HashMap Text Text)
$sel:featureTransformationParameters:SolutionConfig' :: SolutionConfig -> Maybe (HashMap Text Text)
featureTransformationParameters} -> Maybe (HashMap Text Text)
featureTransformationParameters) (\s :: SolutionConfig
s@SolutionConfig' {} Maybe (HashMap Text Text)
a -> SolutionConfig
s {$sel:featureTransformationParameters:SolutionConfig' :: Maybe (HashMap Text Text)
featureTransformationParameters = Maybe (HashMap Text Text)
a} :: SolutionConfig) 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

-- | Describes the properties for hyperparameter optimization (HPO).
solutionConfig_hpoConfig :: Lens.Lens' SolutionConfig (Prelude.Maybe HPOConfig)
solutionConfig_hpoConfig :: Lens' SolutionConfig (Maybe HPOConfig)
solutionConfig_hpoConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SolutionConfig' {Maybe HPOConfig
hpoConfig :: Maybe HPOConfig
$sel:hpoConfig:SolutionConfig' :: SolutionConfig -> Maybe HPOConfig
hpoConfig} -> Maybe HPOConfig
hpoConfig) (\s :: SolutionConfig
s@SolutionConfig' {} Maybe HPOConfig
a -> SolutionConfig
s {$sel:hpoConfig:SolutionConfig' :: Maybe HPOConfig
hpoConfig = Maybe HPOConfig
a} :: SolutionConfig)

-- | Describes the additional objective for the solution, such as maximizing
-- streaming minutes or increasing revenue. For more information see
-- <https://docs.aws.amazon.com/personalize/latest/dg/optimizing-solution-for-objective.html Optimizing a solution>.
solutionConfig_optimizationObjective :: Lens.Lens' SolutionConfig (Prelude.Maybe OptimizationObjective)
solutionConfig_optimizationObjective :: Lens' SolutionConfig (Maybe OptimizationObjective)
solutionConfig_optimizationObjective = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SolutionConfig' {Maybe OptimizationObjective
optimizationObjective :: Maybe OptimizationObjective
$sel:optimizationObjective:SolutionConfig' :: SolutionConfig -> Maybe OptimizationObjective
optimizationObjective} -> Maybe OptimizationObjective
optimizationObjective) (\s :: SolutionConfig
s@SolutionConfig' {} Maybe OptimizationObjective
a -> SolutionConfig
s {$sel:optimizationObjective:SolutionConfig' :: Maybe OptimizationObjective
optimizationObjective = Maybe OptimizationObjective
a} :: SolutionConfig)

instance Data.FromJSON SolutionConfig where
  parseJSON :: Value -> Parser SolutionConfig
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SolutionConfig"
      ( \Object
x ->
          Maybe (HashMap Text Text)
-> Maybe AutoMLConfig
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe HPOConfig
-> Maybe OptimizationObjective
-> SolutionConfig
SolutionConfig'
            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
"algorithmHyperParameters"
                            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
"autoMLConfig")
            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
"eventValueThreshold")
            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
"featureTransformationParameters"
                            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
"hpoConfig")
            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
"optimizationObjective")
      )

instance Prelude.Hashable SolutionConfig where
  hashWithSalt :: Int -> SolutionConfig -> Int
hashWithSalt Int
_salt SolutionConfig' {Maybe Text
Maybe (HashMap Text Text)
Maybe AutoMLConfig
Maybe HPOConfig
Maybe OptimizationObjective
optimizationObjective :: Maybe OptimizationObjective
hpoConfig :: Maybe HPOConfig
featureTransformationParameters :: Maybe (HashMap Text Text)
eventValueThreshold :: Maybe Text
autoMLConfig :: Maybe AutoMLConfig
algorithmHyperParameters :: Maybe (HashMap Text Text)
$sel:optimizationObjective:SolutionConfig' :: SolutionConfig -> Maybe OptimizationObjective
$sel:hpoConfig:SolutionConfig' :: SolutionConfig -> Maybe HPOConfig
$sel:featureTransformationParameters:SolutionConfig' :: SolutionConfig -> Maybe (HashMap Text Text)
$sel:eventValueThreshold:SolutionConfig' :: SolutionConfig -> Maybe Text
$sel:autoMLConfig:SolutionConfig' :: SolutionConfig -> Maybe AutoMLConfig
$sel:algorithmHyperParameters:SolutionConfig' :: SolutionConfig -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
algorithmHyperParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoMLConfig
autoMLConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eventValueThreshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
featureTransformationParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HPOConfig
hpoConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OptimizationObjective
optimizationObjective

instance Prelude.NFData SolutionConfig where
  rnf :: SolutionConfig -> ()
rnf SolutionConfig' {Maybe Text
Maybe (HashMap Text Text)
Maybe AutoMLConfig
Maybe HPOConfig
Maybe OptimizationObjective
optimizationObjective :: Maybe OptimizationObjective
hpoConfig :: Maybe HPOConfig
featureTransformationParameters :: Maybe (HashMap Text Text)
eventValueThreshold :: Maybe Text
autoMLConfig :: Maybe AutoMLConfig
algorithmHyperParameters :: Maybe (HashMap Text Text)
$sel:optimizationObjective:SolutionConfig' :: SolutionConfig -> Maybe OptimizationObjective
$sel:hpoConfig:SolutionConfig' :: SolutionConfig -> Maybe HPOConfig
$sel:featureTransformationParameters:SolutionConfig' :: SolutionConfig -> Maybe (HashMap Text Text)
$sel:eventValueThreshold:SolutionConfig' :: SolutionConfig -> Maybe Text
$sel:autoMLConfig:SolutionConfig' :: SolutionConfig -> Maybe AutoMLConfig
$sel:algorithmHyperParameters:SolutionConfig' :: SolutionConfig -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
algorithmHyperParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoMLConfig
autoMLConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eventValueThreshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
featureTransformationParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HPOConfig
hpoConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OptimizationObjective
optimizationObjective

instance Data.ToJSON SolutionConfig where
  toJSON :: SolutionConfig -> Value
toJSON SolutionConfig' {Maybe Text
Maybe (HashMap Text Text)
Maybe AutoMLConfig
Maybe HPOConfig
Maybe OptimizationObjective
optimizationObjective :: Maybe OptimizationObjective
hpoConfig :: Maybe HPOConfig
featureTransformationParameters :: Maybe (HashMap Text Text)
eventValueThreshold :: Maybe Text
autoMLConfig :: Maybe AutoMLConfig
algorithmHyperParameters :: Maybe (HashMap Text Text)
$sel:optimizationObjective:SolutionConfig' :: SolutionConfig -> Maybe OptimizationObjective
$sel:hpoConfig:SolutionConfig' :: SolutionConfig -> Maybe HPOConfig
$sel:featureTransformationParameters:SolutionConfig' :: SolutionConfig -> Maybe (HashMap Text Text)
$sel:eventValueThreshold:SolutionConfig' :: SolutionConfig -> Maybe Text
$sel:autoMLConfig:SolutionConfig' :: SolutionConfig -> Maybe AutoMLConfig
$sel:algorithmHyperParameters:SolutionConfig' :: SolutionConfig -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"algorithmHyperParameters" 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 Text)
algorithmHyperParameters,
            (Key
"autoMLConfig" 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 AutoMLConfig
autoMLConfig,
            (Key
"eventValueThreshold" 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
eventValueThreshold,
            (Key
"featureTransformationParameters" 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 Text)
featureTransformationParameters,
            (Key
"hpoConfig" 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 HPOConfig
hpoConfig,
            (Key
"optimizationObjective" 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 OptimizationObjective
optimizationObjective
          ]
      )