{-# 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.SageMaker.Types.LabelingJobAlgorithmsConfig
-- 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.SageMaker.Types.LabelingJobAlgorithmsConfig 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
import Amazonka.SageMaker.Types.LabelingJobResourceConfig

-- | Provides configuration information for auto-labeling of your data
-- objects. A @LabelingJobAlgorithmsConfig@ object must be supplied in
-- order to use auto-labeling.
--
-- /See:/ 'newLabelingJobAlgorithmsConfig' smart constructor.
data LabelingJobAlgorithmsConfig = LabelingJobAlgorithmsConfig'
  { -- | At the end of an auto-label job Ground Truth sends the Amazon Resource
    -- Name (ARN) of the final model used for auto-labeling. You can use this
    -- model as the starting point for subsequent similar jobs by providing the
    -- ARN of the model here.
    LabelingJobAlgorithmsConfig -> Maybe Text
initialActiveLearningModelArn :: Prelude.Maybe Prelude.Text,
    -- | Provides configuration information for a labeling job.
    LabelingJobAlgorithmsConfig -> Maybe LabelingJobResourceConfig
labelingJobResourceConfig :: Prelude.Maybe LabelingJobResourceConfig,
    -- | Specifies the Amazon Resource Name (ARN) of the algorithm used for
    -- auto-labeling. You must select one of the following ARNs:
    --
    -- -   /Image classification/
    --
    --     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/image-classification@
    --
    -- -   /Text classification/
    --
    --     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/text-classification@
    --
    -- -   /Object detection/
    --
    --     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/object-detection@
    --
    -- -   /Semantic Segmentation/
    --
    --     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/semantic-segmentation@
    LabelingJobAlgorithmsConfig -> Text
labelingJobAlgorithmSpecificationArn :: Prelude.Text
  }
  deriving (LabelingJobAlgorithmsConfig -> LabelingJobAlgorithmsConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LabelingJobAlgorithmsConfig -> LabelingJobAlgorithmsConfig -> Bool
$c/= :: LabelingJobAlgorithmsConfig -> LabelingJobAlgorithmsConfig -> Bool
== :: LabelingJobAlgorithmsConfig -> LabelingJobAlgorithmsConfig -> Bool
$c== :: LabelingJobAlgorithmsConfig -> LabelingJobAlgorithmsConfig -> Bool
Prelude.Eq, ReadPrec [LabelingJobAlgorithmsConfig]
ReadPrec LabelingJobAlgorithmsConfig
Int -> ReadS LabelingJobAlgorithmsConfig
ReadS [LabelingJobAlgorithmsConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LabelingJobAlgorithmsConfig]
$creadListPrec :: ReadPrec [LabelingJobAlgorithmsConfig]
readPrec :: ReadPrec LabelingJobAlgorithmsConfig
$creadPrec :: ReadPrec LabelingJobAlgorithmsConfig
readList :: ReadS [LabelingJobAlgorithmsConfig]
$creadList :: ReadS [LabelingJobAlgorithmsConfig]
readsPrec :: Int -> ReadS LabelingJobAlgorithmsConfig
$creadsPrec :: Int -> ReadS LabelingJobAlgorithmsConfig
Prelude.Read, Int -> LabelingJobAlgorithmsConfig -> ShowS
[LabelingJobAlgorithmsConfig] -> ShowS
LabelingJobAlgorithmsConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelingJobAlgorithmsConfig] -> ShowS
$cshowList :: [LabelingJobAlgorithmsConfig] -> ShowS
show :: LabelingJobAlgorithmsConfig -> String
$cshow :: LabelingJobAlgorithmsConfig -> String
showsPrec :: Int -> LabelingJobAlgorithmsConfig -> ShowS
$cshowsPrec :: Int -> LabelingJobAlgorithmsConfig -> ShowS
Prelude.Show, forall x.
Rep LabelingJobAlgorithmsConfig x -> LabelingJobAlgorithmsConfig
forall x.
LabelingJobAlgorithmsConfig -> Rep LabelingJobAlgorithmsConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep LabelingJobAlgorithmsConfig x -> LabelingJobAlgorithmsConfig
$cfrom :: forall x.
LabelingJobAlgorithmsConfig -> Rep LabelingJobAlgorithmsConfig x
Prelude.Generic)

-- |
-- Create a value of 'LabelingJobAlgorithmsConfig' 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:
--
-- 'initialActiveLearningModelArn', 'labelingJobAlgorithmsConfig_initialActiveLearningModelArn' - At the end of an auto-label job Ground Truth sends the Amazon Resource
-- Name (ARN) of the final model used for auto-labeling. You can use this
-- model as the starting point for subsequent similar jobs by providing the
-- ARN of the model here.
--
-- 'labelingJobResourceConfig', 'labelingJobAlgorithmsConfig_labelingJobResourceConfig' - Provides configuration information for a labeling job.
--
-- 'labelingJobAlgorithmSpecificationArn', 'labelingJobAlgorithmsConfig_labelingJobAlgorithmSpecificationArn' - Specifies the Amazon Resource Name (ARN) of the algorithm used for
-- auto-labeling. You must select one of the following ARNs:
--
-- -   /Image classification/
--
--     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/image-classification@
--
-- -   /Text classification/
--
--     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/text-classification@
--
-- -   /Object detection/
--
--     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/object-detection@
--
-- -   /Semantic Segmentation/
--
--     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/semantic-segmentation@
newLabelingJobAlgorithmsConfig ::
  -- | 'labelingJobAlgorithmSpecificationArn'
  Prelude.Text ->
  LabelingJobAlgorithmsConfig
newLabelingJobAlgorithmsConfig :: Text -> LabelingJobAlgorithmsConfig
newLabelingJobAlgorithmsConfig
  Text
pLabelingJobAlgorithmSpecificationArn_ =
    LabelingJobAlgorithmsConfig'
      { $sel:initialActiveLearningModelArn:LabelingJobAlgorithmsConfig' :: Maybe Text
initialActiveLearningModelArn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:labelingJobResourceConfig:LabelingJobAlgorithmsConfig' :: Maybe LabelingJobResourceConfig
labelingJobResourceConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:labelingJobAlgorithmSpecificationArn:LabelingJobAlgorithmsConfig' :: Text
labelingJobAlgorithmSpecificationArn =
          Text
pLabelingJobAlgorithmSpecificationArn_
      }

-- | At the end of an auto-label job Ground Truth sends the Amazon Resource
-- Name (ARN) of the final model used for auto-labeling. You can use this
-- model as the starting point for subsequent similar jobs by providing the
-- ARN of the model here.
labelingJobAlgorithmsConfig_initialActiveLearningModelArn :: Lens.Lens' LabelingJobAlgorithmsConfig (Prelude.Maybe Prelude.Text)
labelingJobAlgorithmsConfig_initialActiveLearningModelArn :: Lens' LabelingJobAlgorithmsConfig (Maybe Text)
labelingJobAlgorithmsConfig_initialActiveLearningModelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LabelingJobAlgorithmsConfig' {Maybe Text
initialActiveLearningModelArn :: Maybe Text
$sel:initialActiveLearningModelArn:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Maybe Text
initialActiveLearningModelArn} -> Maybe Text
initialActiveLearningModelArn) (\s :: LabelingJobAlgorithmsConfig
s@LabelingJobAlgorithmsConfig' {} Maybe Text
a -> LabelingJobAlgorithmsConfig
s {$sel:initialActiveLearningModelArn:LabelingJobAlgorithmsConfig' :: Maybe Text
initialActiveLearningModelArn = Maybe Text
a} :: LabelingJobAlgorithmsConfig)

-- | Provides configuration information for a labeling job.
labelingJobAlgorithmsConfig_labelingJobResourceConfig :: Lens.Lens' LabelingJobAlgorithmsConfig (Prelude.Maybe LabelingJobResourceConfig)
labelingJobAlgorithmsConfig_labelingJobResourceConfig :: Lens' LabelingJobAlgorithmsConfig (Maybe LabelingJobResourceConfig)
labelingJobAlgorithmsConfig_labelingJobResourceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LabelingJobAlgorithmsConfig' {Maybe LabelingJobResourceConfig
labelingJobResourceConfig :: Maybe LabelingJobResourceConfig
$sel:labelingJobResourceConfig:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Maybe LabelingJobResourceConfig
labelingJobResourceConfig} -> Maybe LabelingJobResourceConfig
labelingJobResourceConfig) (\s :: LabelingJobAlgorithmsConfig
s@LabelingJobAlgorithmsConfig' {} Maybe LabelingJobResourceConfig
a -> LabelingJobAlgorithmsConfig
s {$sel:labelingJobResourceConfig:LabelingJobAlgorithmsConfig' :: Maybe LabelingJobResourceConfig
labelingJobResourceConfig = Maybe LabelingJobResourceConfig
a} :: LabelingJobAlgorithmsConfig)

-- | Specifies the Amazon Resource Name (ARN) of the algorithm used for
-- auto-labeling. You must select one of the following ARNs:
--
-- -   /Image classification/
--
--     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/image-classification@
--
-- -   /Text classification/
--
--     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/text-classification@
--
-- -   /Object detection/
--
--     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/object-detection@
--
-- -   /Semantic Segmentation/
--
--     @arn:aws:sagemaker:@/@region@/@:027400017018:labeling-job-algorithm-specification\/semantic-segmentation@
labelingJobAlgorithmsConfig_labelingJobAlgorithmSpecificationArn :: Lens.Lens' LabelingJobAlgorithmsConfig Prelude.Text
labelingJobAlgorithmsConfig_labelingJobAlgorithmSpecificationArn :: Lens' LabelingJobAlgorithmsConfig Text
labelingJobAlgorithmsConfig_labelingJobAlgorithmSpecificationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LabelingJobAlgorithmsConfig' {Text
labelingJobAlgorithmSpecificationArn :: Text
$sel:labelingJobAlgorithmSpecificationArn:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Text
labelingJobAlgorithmSpecificationArn} -> Text
labelingJobAlgorithmSpecificationArn) (\s :: LabelingJobAlgorithmsConfig
s@LabelingJobAlgorithmsConfig' {} Text
a -> LabelingJobAlgorithmsConfig
s {$sel:labelingJobAlgorithmSpecificationArn:LabelingJobAlgorithmsConfig' :: Text
labelingJobAlgorithmSpecificationArn = Text
a} :: LabelingJobAlgorithmsConfig)

instance Data.FromJSON LabelingJobAlgorithmsConfig where
  parseJSON :: Value -> Parser LabelingJobAlgorithmsConfig
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"LabelingJobAlgorithmsConfig"
      ( \Object
x ->
          Maybe Text
-> Maybe LabelingJobResourceConfig
-> Text
-> LabelingJobAlgorithmsConfig
LabelingJobAlgorithmsConfig'
            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
"InitialActiveLearningModelArn")
            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
"LabelingJobResourceConfig")
            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
"LabelingJobAlgorithmSpecificationArn")
      )

instance Prelude.Hashable LabelingJobAlgorithmsConfig where
  hashWithSalt :: Int -> LabelingJobAlgorithmsConfig -> Int
hashWithSalt Int
_salt LabelingJobAlgorithmsConfig' {Maybe Text
Maybe LabelingJobResourceConfig
Text
labelingJobAlgorithmSpecificationArn :: Text
labelingJobResourceConfig :: Maybe LabelingJobResourceConfig
initialActiveLearningModelArn :: Maybe Text
$sel:labelingJobAlgorithmSpecificationArn:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Text
$sel:labelingJobResourceConfig:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Maybe LabelingJobResourceConfig
$sel:initialActiveLearningModelArn:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
initialActiveLearningModelArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LabelingJobResourceConfig
labelingJobResourceConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
labelingJobAlgorithmSpecificationArn

instance Prelude.NFData LabelingJobAlgorithmsConfig where
  rnf :: LabelingJobAlgorithmsConfig -> ()
rnf LabelingJobAlgorithmsConfig' {Maybe Text
Maybe LabelingJobResourceConfig
Text
labelingJobAlgorithmSpecificationArn :: Text
labelingJobResourceConfig :: Maybe LabelingJobResourceConfig
initialActiveLearningModelArn :: Maybe Text
$sel:labelingJobAlgorithmSpecificationArn:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Text
$sel:labelingJobResourceConfig:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Maybe LabelingJobResourceConfig
$sel:initialActiveLearningModelArn:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
initialActiveLearningModelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LabelingJobResourceConfig
labelingJobResourceConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
labelingJobAlgorithmSpecificationArn

instance Data.ToJSON LabelingJobAlgorithmsConfig where
  toJSON :: LabelingJobAlgorithmsConfig -> Value
toJSON LabelingJobAlgorithmsConfig' {Maybe Text
Maybe LabelingJobResourceConfig
Text
labelingJobAlgorithmSpecificationArn :: Text
labelingJobResourceConfig :: Maybe LabelingJobResourceConfig
initialActiveLearningModelArn :: Maybe Text
$sel:labelingJobAlgorithmSpecificationArn:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Text
$sel:labelingJobResourceConfig:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Maybe LabelingJobResourceConfig
$sel:initialActiveLearningModelArn:LabelingJobAlgorithmsConfig' :: LabelingJobAlgorithmsConfig -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"InitialActiveLearningModelArn" 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
initialActiveLearningModelArn,
            (Key
"LabelingJobResourceConfig" 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 LabelingJobResourceConfig
labelingJobResourceConfig,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"LabelingJobAlgorithmSpecificationArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
labelingJobAlgorithmSpecificationArn
              )
          ]
      )