{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Forecast.CreateExplainability
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Explainability is only available for Forecasts and Predictors generated
-- from an AutoPredictor (CreateAutoPredictor)
--
-- Creates an Amazon Forecast Explainability.
--
-- Explainability helps you better understand how the attributes in your
-- datasets impact forecast. Amazon Forecast uses a metric called Impact
-- scores to quantify the relative impact of each attribute and determine
-- whether they increase or decrease forecast values.
--
-- To enable Forecast Explainability, your predictor must include at least
-- one of the following: related time series, item metadata, or additional
-- datasets like Holidays and the Weather Index.
--
-- CreateExplainability accepts either a Predictor ARN or Forecast ARN. To
-- receive aggregated Impact scores for all time series and time points in
-- your datasets, provide a Predictor ARN. To receive Impact scores for
-- specific time series and time points, provide a Forecast ARN.
--
-- __CreateExplainability with a Predictor ARN__
--
-- You can only have one Explainability resource per predictor. If you
-- already enabled @ExplainPredictor@ in CreateAutoPredictor, that
-- predictor already has an Explainability resource.
--
-- The following parameters are required when providing a Predictor ARN:
--
-- -   @ExplainabilityName@ - A unique name for the Explainability.
--
-- -   @ResourceArn@ - The Arn of the predictor.
--
-- -   @TimePointGranularity@ - Must be set to “ALL”.
--
-- -   @TimeSeriesGranularity@ - Must be set to “ALL”.
--
-- Do not specify a value for the following parameters:
--
-- -   @DataSource@ - Only valid when TimeSeriesGranularity is “SPECIFIC”.
--
-- -   @Schema@ - Only valid when TimeSeriesGranularity is “SPECIFIC”.
--
-- -   @StartDateTime@ - Only valid when TimePointGranularity is
--     “SPECIFIC”.
--
-- -   @EndDateTime@ - Only valid when TimePointGranularity is “SPECIFIC”.
--
-- __CreateExplainability with a Forecast ARN__
--
-- You can specify a maximum of 50 time series and 500 time points.
--
-- The following parameters are required when providing a Predictor ARN:
--
-- -   @ExplainabilityName@ - A unique name for the Explainability.
--
-- -   @ResourceArn@ - The Arn of the forecast.
--
-- -   @TimePointGranularity@ - Either “ALL” or “SPECIFIC”.
--
-- -   @TimeSeriesGranularity@ - Either “ALL” or “SPECIFIC”.
--
-- If you set TimeSeriesGranularity to “SPECIFIC”, you must also provide
-- the following:
--
-- -   @DataSource@ - The S3 location of the CSV file specifying your time
--     series.
--
-- -   @Schema@ - The Schema defines the attributes and attribute types
--     listed in the Data Source.
--
-- If you set TimePointGranularity to “SPECIFIC”, you must also provide the
-- following:
--
-- -   @StartDateTime@ - The first timestamp in the range of time points.
--
-- -   @EndDateTime@ - The last timestamp in the range of time points.
module Amazonka.Forecast.CreateExplainability
  ( -- * Creating a Request
    CreateExplainability (..),
    newCreateExplainability,

    -- * Request Lenses
    createExplainability_dataSource,
    createExplainability_enableVisualization,
    createExplainability_endDateTime,
    createExplainability_schema,
    createExplainability_startDateTime,
    createExplainability_tags,
    createExplainability_explainabilityName,
    createExplainability_resourceArn,
    createExplainability_explainabilityConfig,

    -- * Destructuring the Response
    CreateExplainabilityResponse (..),
    newCreateExplainabilityResponse,

    -- * Response Lenses
    createExplainabilityResponse_explainabilityArn,
    createExplainabilityResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Forecast.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateExplainability' smart constructor.
data CreateExplainability = CreateExplainability'
  { CreateExplainability -> Maybe DataSource
dataSource :: Prelude.Maybe DataSource,
    -- | Create an Explainability visualization that is viewable within the AWS
    -- console.
    CreateExplainability -> Maybe Bool
enableVisualization :: Prelude.Maybe Prelude.Bool,
    -- | If @TimePointGranularity@ is set to @SPECIFIC@, define the last time
    -- point for the Explainability.
    --
    -- Use the following timestamp format: yyyy-MM-ddTHH:mm:ss (example:
    -- 2015-01-01T20:00:00)
    CreateExplainability -> Maybe Text
endDateTime :: Prelude.Maybe Prelude.Text,
    CreateExplainability -> Maybe Schema
schema :: Prelude.Maybe Schema,
    -- | If @TimePointGranularity@ is set to @SPECIFIC@, define the first point
    -- for the Explainability.
    --
    -- Use the following timestamp format: yyyy-MM-ddTHH:mm:ss (example:
    -- 2015-01-01T20:00:00)
    CreateExplainability -> Maybe Text
startDateTime :: Prelude.Maybe Prelude.Text,
    -- | Optional metadata to help you categorize and organize your resources.
    -- Each tag consists of a key and an optional value, both of which you
    -- define. Tag keys and values are case sensitive.
    --
    -- The following restrictions apply to tags:
    --
    -- -   For each resource, each tag key must be unique and each tag key must
    --     have one value.
    --
    -- -   Maximum number of tags per resource: 50.
    --
    -- -   Maximum key length: 128 Unicode characters in UTF-8.
    --
    -- -   Maximum value length: 256 Unicode characters in UTF-8.
    --
    -- -   Accepted characters: all letters and numbers, spaces representable
    --     in UTF-8, and + - = . _ : \/ \@. If your tagging schema is used
    --     across other services and resources, the character restrictions of
    --     those services also apply.
    --
    -- -   Key prefixes cannot include any upper or lowercase combination of
    --     @aws:@ or @AWS:@. Values can have this prefix. If a tag value has
    --     @aws@ as its prefix but the key does not, Forecast considers it to
    --     be a user tag and will count against the limit of 50 tags. Tags with
    --     only the key prefix of @aws@ do not count against your tags per
    --     resource limit. You cannot edit or delete tag keys with this prefix.
    CreateExplainability -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A unique name for the Explainability.
    CreateExplainability -> Text
explainabilityName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Predictor or Forecast used to
    -- create the Explainability.
    CreateExplainability -> Text
resourceArn :: Prelude.Text,
    -- | The configuration settings that define the granularity of time series
    -- and time points for the Explainability.
    CreateExplainability -> ExplainabilityConfig
explainabilityConfig :: ExplainabilityConfig
  }
  deriving (CreateExplainability -> CreateExplainability -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateExplainability -> CreateExplainability -> Bool
$c/= :: CreateExplainability -> CreateExplainability -> Bool
== :: CreateExplainability -> CreateExplainability -> Bool
$c== :: CreateExplainability -> CreateExplainability -> Bool
Prelude.Eq, Int -> CreateExplainability -> ShowS
[CreateExplainability] -> ShowS
CreateExplainability -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateExplainability] -> ShowS
$cshowList :: [CreateExplainability] -> ShowS
show :: CreateExplainability -> String
$cshow :: CreateExplainability -> String
showsPrec :: Int -> CreateExplainability -> ShowS
$cshowsPrec :: Int -> CreateExplainability -> ShowS
Prelude.Show, forall x. Rep CreateExplainability x -> CreateExplainability
forall x. CreateExplainability -> Rep CreateExplainability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateExplainability x -> CreateExplainability
$cfrom :: forall x. CreateExplainability -> Rep CreateExplainability x
Prelude.Generic)

-- |
-- Create a value of 'CreateExplainability' 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:
--
-- 'dataSource', 'createExplainability_dataSource' - Undocumented member.
--
-- 'enableVisualization', 'createExplainability_enableVisualization' - Create an Explainability visualization that is viewable within the AWS
-- console.
--
-- 'endDateTime', 'createExplainability_endDateTime' - If @TimePointGranularity@ is set to @SPECIFIC@, define the last time
-- point for the Explainability.
--
-- Use the following timestamp format: yyyy-MM-ddTHH:mm:ss (example:
-- 2015-01-01T20:00:00)
--
-- 'schema', 'createExplainability_schema' - Undocumented member.
--
-- 'startDateTime', 'createExplainability_startDateTime' - If @TimePointGranularity@ is set to @SPECIFIC@, define the first point
-- for the Explainability.
--
-- Use the following timestamp format: yyyy-MM-ddTHH:mm:ss (example:
-- 2015-01-01T20:00:00)
--
-- 'tags', 'createExplainability_tags' - Optional metadata to help you categorize and organize your resources.
-- Each tag consists of a key and an optional value, both of which you
-- define. Tag keys and values are case sensitive.
--
-- The following restrictions apply to tags:
--
-- -   For each resource, each tag key must be unique and each tag key must
--     have one value.
--
-- -   Maximum number of tags per resource: 50.
--
-- -   Maximum key length: 128 Unicode characters in UTF-8.
--
-- -   Maximum value length: 256 Unicode characters in UTF-8.
--
-- -   Accepted characters: all letters and numbers, spaces representable
--     in UTF-8, and + - = . _ : \/ \@. If your tagging schema is used
--     across other services and resources, the character restrictions of
--     those services also apply.
--
-- -   Key prefixes cannot include any upper or lowercase combination of
--     @aws:@ or @AWS:@. Values can have this prefix. If a tag value has
--     @aws@ as its prefix but the key does not, Forecast considers it to
--     be a user tag and will count against the limit of 50 tags. Tags with
--     only the key prefix of @aws@ do not count against your tags per
--     resource limit. You cannot edit or delete tag keys with this prefix.
--
-- 'explainabilityName', 'createExplainability_explainabilityName' - A unique name for the Explainability.
--
-- 'resourceArn', 'createExplainability_resourceArn' - The Amazon Resource Name (ARN) of the Predictor or Forecast used to
-- create the Explainability.
--
-- 'explainabilityConfig', 'createExplainability_explainabilityConfig' - The configuration settings that define the granularity of time series
-- and time points for the Explainability.
newCreateExplainability ::
  -- | 'explainabilityName'
  Prelude.Text ->
  -- | 'resourceArn'
  Prelude.Text ->
  -- | 'explainabilityConfig'
  ExplainabilityConfig ->
  CreateExplainability
newCreateExplainability :: Text -> Text -> ExplainabilityConfig -> CreateExplainability
newCreateExplainability
  Text
pExplainabilityName_
  Text
pResourceArn_
  ExplainabilityConfig
pExplainabilityConfig_ =
    CreateExplainability'
      { $sel:dataSource:CreateExplainability' :: Maybe DataSource
dataSource = forall a. Maybe a
Prelude.Nothing,
        $sel:enableVisualization:CreateExplainability' :: Maybe Bool
enableVisualization = forall a. Maybe a
Prelude.Nothing,
        $sel:endDateTime:CreateExplainability' :: Maybe Text
endDateTime = forall a. Maybe a
Prelude.Nothing,
        $sel:schema:CreateExplainability' :: Maybe Schema
schema = forall a. Maybe a
Prelude.Nothing,
        $sel:startDateTime:CreateExplainability' :: Maybe Text
startDateTime = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateExplainability' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:explainabilityName:CreateExplainability' :: Text
explainabilityName = Text
pExplainabilityName_,
        $sel:resourceArn:CreateExplainability' :: Text
resourceArn = Text
pResourceArn_,
        $sel:explainabilityConfig:CreateExplainability' :: ExplainabilityConfig
explainabilityConfig = ExplainabilityConfig
pExplainabilityConfig_
      }

-- | Undocumented member.
createExplainability_dataSource :: Lens.Lens' CreateExplainability (Prelude.Maybe DataSource)
createExplainability_dataSource :: Lens' CreateExplainability (Maybe DataSource)
createExplainability_dataSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExplainability' {Maybe DataSource
dataSource :: Maybe DataSource
$sel:dataSource:CreateExplainability' :: CreateExplainability -> Maybe DataSource
dataSource} -> Maybe DataSource
dataSource) (\s :: CreateExplainability
s@CreateExplainability' {} Maybe DataSource
a -> CreateExplainability
s {$sel:dataSource:CreateExplainability' :: Maybe DataSource
dataSource = Maybe DataSource
a} :: CreateExplainability)

-- | Create an Explainability visualization that is viewable within the AWS
-- console.
createExplainability_enableVisualization :: Lens.Lens' CreateExplainability (Prelude.Maybe Prelude.Bool)
createExplainability_enableVisualization :: Lens' CreateExplainability (Maybe Bool)
createExplainability_enableVisualization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExplainability' {Maybe Bool
enableVisualization :: Maybe Bool
$sel:enableVisualization:CreateExplainability' :: CreateExplainability -> Maybe Bool
enableVisualization} -> Maybe Bool
enableVisualization) (\s :: CreateExplainability
s@CreateExplainability' {} Maybe Bool
a -> CreateExplainability
s {$sel:enableVisualization:CreateExplainability' :: Maybe Bool
enableVisualization = Maybe Bool
a} :: CreateExplainability)

-- | If @TimePointGranularity@ is set to @SPECIFIC@, define the last time
-- point for the Explainability.
--
-- Use the following timestamp format: yyyy-MM-ddTHH:mm:ss (example:
-- 2015-01-01T20:00:00)
createExplainability_endDateTime :: Lens.Lens' CreateExplainability (Prelude.Maybe Prelude.Text)
createExplainability_endDateTime :: Lens' CreateExplainability (Maybe Text)
createExplainability_endDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExplainability' {Maybe Text
endDateTime :: Maybe Text
$sel:endDateTime:CreateExplainability' :: CreateExplainability -> Maybe Text
endDateTime} -> Maybe Text
endDateTime) (\s :: CreateExplainability
s@CreateExplainability' {} Maybe Text
a -> CreateExplainability
s {$sel:endDateTime:CreateExplainability' :: Maybe Text
endDateTime = Maybe Text
a} :: CreateExplainability)

-- | Undocumented member.
createExplainability_schema :: Lens.Lens' CreateExplainability (Prelude.Maybe Schema)
createExplainability_schema :: Lens' CreateExplainability (Maybe Schema)
createExplainability_schema = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExplainability' {Maybe Schema
schema :: Maybe Schema
$sel:schema:CreateExplainability' :: CreateExplainability -> Maybe Schema
schema} -> Maybe Schema
schema) (\s :: CreateExplainability
s@CreateExplainability' {} Maybe Schema
a -> CreateExplainability
s {$sel:schema:CreateExplainability' :: Maybe Schema
schema = Maybe Schema
a} :: CreateExplainability)

-- | If @TimePointGranularity@ is set to @SPECIFIC@, define the first point
-- for the Explainability.
--
-- Use the following timestamp format: yyyy-MM-ddTHH:mm:ss (example:
-- 2015-01-01T20:00:00)
createExplainability_startDateTime :: Lens.Lens' CreateExplainability (Prelude.Maybe Prelude.Text)
createExplainability_startDateTime :: Lens' CreateExplainability (Maybe Text)
createExplainability_startDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExplainability' {Maybe Text
startDateTime :: Maybe Text
$sel:startDateTime:CreateExplainability' :: CreateExplainability -> Maybe Text
startDateTime} -> Maybe Text
startDateTime) (\s :: CreateExplainability
s@CreateExplainability' {} Maybe Text
a -> CreateExplainability
s {$sel:startDateTime:CreateExplainability' :: Maybe Text
startDateTime = Maybe Text
a} :: CreateExplainability)

-- | Optional metadata to help you categorize and organize your resources.
-- Each tag consists of a key and an optional value, both of which you
-- define. Tag keys and values are case sensitive.
--
-- The following restrictions apply to tags:
--
-- -   For each resource, each tag key must be unique and each tag key must
--     have one value.
--
-- -   Maximum number of tags per resource: 50.
--
-- -   Maximum key length: 128 Unicode characters in UTF-8.
--
-- -   Maximum value length: 256 Unicode characters in UTF-8.
--
-- -   Accepted characters: all letters and numbers, spaces representable
--     in UTF-8, and + - = . _ : \/ \@. If your tagging schema is used
--     across other services and resources, the character restrictions of
--     those services also apply.
--
-- -   Key prefixes cannot include any upper or lowercase combination of
--     @aws:@ or @AWS:@. Values can have this prefix. If a tag value has
--     @aws@ as its prefix but the key does not, Forecast considers it to
--     be a user tag and will count against the limit of 50 tags. Tags with
--     only the key prefix of @aws@ do not count against your tags per
--     resource limit. You cannot edit or delete tag keys with this prefix.
createExplainability_tags :: Lens.Lens' CreateExplainability (Prelude.Maybe [Tag])
createExplainability_tags :: Lens' CreateExplainability (Maybe [Tag])
createExplainability_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExplainability' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateExplainability' :: CreateExplainability -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateExplainability
s@CreateExplainability' {} Maybe [Tag]
a -> CreateExplainability
s {$sel:tags:CreateExplainability' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateExplainability) 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

-- | A unique name for the Explainability.
createExplainability_explainabilityName :: Lens.Lens' CreateExplainability Prelude.Text
createExplainability_explainabilityName :: Lens' CreateExplainability Text
createExplainability_explainabilityName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExplainability' {Text
explainabilityName :: Text
$sel:explainabilityName:CreateExplainability' :: CreateExplainability -> Text
explainabilityName} -> Text
explainabilityName) (\s :: CreateExplainability
s@CreateExplainability' {} Text
a -> CreateExplainability
s {$sel:explainabilityName:CreateExplainability' :: Text
explainabilityName = Text
a} :: CreateExplainability)

-- | The Amazon Resource Name (ARN) of the Predictor or Forecast used to
-- create the Explainability.
createExplainability_resourceArn :: Lens.Lens' CreateExplainability Prelude.Text
createExplainability_resourceArn :: Lens' CreateExplainability Text
createExplainability_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExplainability' {Text
resourceArn :: Text
$sel:resourceArn:CreateExplainability' :: CreateExplainability -> Text
resourceArn} -> Text
resourceArn) (\s :: CreateExplainability
s@CreateExplainability' {} Text
a -> CreateExplainability
s {$sel:resourceArn:CreateExplainability' :: Text
resourceArn = Text
a} :: CreateExplainability)

-- | The configuration settings that define the granularity of time series
-- and time points for the Explainability.
createExplainability_explainabilityConfig :: Lens.Lens' CreateExplainability ExplainabilityConfig
createExplainability_explainabilityConfig :: Lens' CreateExplainability ExplainabilityConfig
createExplainability_explainabilityConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExplainability' {ExplainabilityConfig
explainabilityConfig :: ExplainabilityConfig
$sel:explainabilityConfig:CreateExplainability' :: CreateExplainability -> ExplainabilityConfig
explainabilityConfig} -> ExplainabilityConfig
explainabilityConfig) (\s :: CreateExplainability
s@CreateExplainability' {} ExplainabilityConfig
a -> CreateExplainability
s {$sel:explainabilityConfig:CreateExplainability' :: ExplainabilityConfig
explainabilityConfig = ExplainabilityConfig
a} :: CreateExplainability)

instance Core.AWSRequest CreateExplainability where
  type
    AWSResponse CreateExplainability =
      CreateExplainabilityResponse
  request :: (Service -> Service)
-> CreateExplainability -> Request CreateExplainability
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateExplainability
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateExplainability)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> CreateExplainabilityResponse
CreateExplainabilityResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ExplainabilityArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateExplainability where
  hashWithSalt :: Int -> CreateExplainability -> Int
hashWithSalt Int
_salt CreateExplainability' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe DataSource
Maybe Schema
Text
ExplainabilityConfig
explainabilityConfig :: ExplainabilityConfig
resourceArn :: Text
explainabilityName :: Text
tags :: Maybe [Tag]
startDateTime :: Maybe Text
schema :: Maybe Schema
endDateTime :: Maybe Text
enableVisualization :: Maybe Bool
dataSource :: Maybe DataSource
$sel:explainabilityConfig:CreateExplainability' :: CreateExplainability -> ExplainabilityConfig
$sel:resourceArn:CreateExplainability' :: CreateExplainability -> Text
$sel:explainabilityName:CreateExplainability' :: CreateExplainability -> Text
$sel:tags:CreateExplainability' :: CreateExplainability -> Maybe [Tag]
$sel:startDateTime:CreateExplainability' :: CreateExplainability -> Maybe Text
$sel:schema:CreateExplainability' :: CreateExplainability -> Maybe Schema
$sel:endDateTime:CreateExplainability' :: CreateExplainability -> Maybe Text
$sel:enableVisualization:CreateExplainability' :: CreateExplainability -> Maybe Bool
$sel:dataSource:CreateExplainability' :: CreateExplainability -> Maybe DataSource
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataSource
dataSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableVisualization
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
endDateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Schema
schema
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
startDateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
explainabilityName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ExplainabilityConfig
explainabilityConfig

instance Prelude.NFData CreateExplainability where
  rnf :: CreateExplainability -> ()
rnf CreateExplainability' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe DataSource
Maybe Schema
Text
ExplainabilityConfig
explainabilityConfig :: ExplainabilityConfig
resourceArn :: Text
explainabilityName :: Text
tags :: Maybe [Tag]
startDateTime :: Maybe Text
schema :: Maybe Schema
endDateTime :: Maybe Text
enableVisualization :: Maybe Bool
dataSource :: Maybe DataSource
$sel:explainabilityConfig:CreateExplainability' :: CreateExplainability -> ExplainabilityConfig
$sel:resourceArn:CreateExplainability' :: CreateExplainability -> Text
$sel:explainabilityName:CreateExplainability' :: CreateExplainability -> Text
$sel:tags:CreateExplainability' :: CreateExplainability -> Maybe [Tag]
$sel:startDateTime:CreateExplainability' :: CreateExplainability -> Maybe Text
$sel:schema:CreateExplainability' :: CreateExplainability -> Maybe Schema
$sel:endDateTime:CreateExplainability' :: CreateExplainability -> Maybe Text
$sel:enableVisualization:CreateExplainability' :: CreateExplainability -> Maybe Bool
$sel:dataSource:CreateExplainability' :: CreateExplainability -> Maybe DataSource
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DataSource
dataSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableVisualization
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Schema
schema
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
startDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
explainabilityName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ExplainabilityConfig
explainabilityConfig

instance Data.ToHeaders CreateExplainability where
  toHeaders :: CreateExplainability -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AmazonForecast.CreateExplainability" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateExplainability where
  toJSON :: CreateExplainability -> Value
toJSON CreateExplainability' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe DataSource
Maybe Schema
Text
ExplainabilityConfig
explainabilityConfig :: ExplainabilityConfig
resourceArn :: Text
explainabilityName :: Text
tags :: Maybe [Tag]
startDateTime :: Maybe Text
schema :: Maybe Schema
endDateTime :: Maybe Text
enableVisualization :: Maybe Bool
dataSource :: Maybe DataSource
$sel:explainabilityConfig:CreateExplainability' :: CreateExplainability -> ExplainabilityConfig
$sel:resourceArn:CreateExplainability' :: CreateExplainability -> Text
$sel:explainabilityName:CreateExplainability' :: CreateExplainability -> Text
$sel:tags:CreateExplainability' :: CreateExplainability -> Maybe [Tag]
$sel:startDateTime:CreateExplainability' :: CreateExplainability -> Maybe Text
$sel:schema:CreateExplainability' :: CreateExplainability -> Maybe Schema
$sel:endDateTime:CreateExplainability' :: CreateExplainability -> Maybe Text
$sel:enableVisualization:CreateExplainability' :: CreateExplainability -> Maybe Bool
$sel:dataSource:CreateExplainability' :: CreateExplainability -> Maybe DataSource
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DataSource" 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 DataSource
dataSource,
            (Key
"EnableVisualization" 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 Bool
enableVisualization,
            (Key
"EndDateTime" 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
endDateTime,
            (Key
"Schema" 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 Schema
schema,
            (Key
"StartDateTime" 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
startDateTime,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ExplainabilityName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
explainabilityName),
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceArn),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ExplainabilityConfig"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ExplainabilityConfig
explainabilityConfig
              )
          ]
      )

instance Data.ToPath CreateExplainability where
  toPath :: CreateExplainability -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery CreateExplainability where
  toQuery :: CreateExplainability -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateExplainabilityResponse' smart constructor.
data CreateExplainabilityResponse = CreateExplainabilityResponse'
  { -- | The Amazon Resource Name (ARN) of the Explainability.
    CreateExplainabilityResponse -> Maybe Text
explainabilityArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateExplainabilityResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateExplainabilityResponse
-> CreateExplainabilityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateExplainabilityResponse
-> CreateExplainabilityResponse -> Bool
$c/= :: CreateExplainabilityResponse
-> CreateExplainabilityResponse -> Bool
== :: CreateExplainabilityResponse
-> CreateExplainabilityResponse -> Bool
$c== :: CreateExplainabilityResponse
-> CreateExplainabilityResponse -> Bool
Prelude.Eq, ReadPrec [CreateExplainabilityResponse]
ReadPrec CreateExplainabilityResponse
Int -> ReadS CreateExplainabilityResponse
ReadS [CreateExplainabilityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateExplainabilityResponse]
$creadListPrec :: ReadPrec [CreateExplainabilityResponse]
readPrec :: ReadPrec CreateExplainabilityResponse
$creadPrec :: ReadPrec CreateExplainabilityResponse
readList :: ReadS [CreateExplainabilityResponse]
$creadList :: ReadS [CreateExplainabilityResponse]
readsPrec :: Int -> ReadS CreateExplainabilityResponse
$creadsPrec :: Int -> ReadS CreateExplainabilityResponse
Prelude.Read, Int -> CreateExplainabilityResponse -> ShowS
[CreateExplainabilityResponse] -> ShowS
CreateExplainabilityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateExplainabilityResponse] -> ShowS
$cshowList :: [CreateExplainabilityResponse] -> ShowS
show :: CreateExplainabilityResponse -> String
$cshow :: CreateExplainabilityResponse -> String
showsPrec :: Int -> CreateExplainabilityResponse -> ShowS
$cshowsPrec :: Int -> CreateExplainabilityResponse -> ShowS
Prelude.Show, forall x.
Rep CreateExplainabilityResponse x -> CreateExplainabilityResponse
forall x.
CreateExplainabilityResponse -> Rep CreateExplainabilityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateExplainabilityResponse x -> CreateExplainabilityResponse
$cfrom :: forall x.
CreateExplainabilityResponse -> Rep CreateExplainabilityResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateExplainabilityResponse' 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:
--
-- 'explainabilityArn', 'createExplainabilityResponse_explainabilityArn' - The Amazon Resource Name (ARN) of the Explainability.
--
-- 'httpStatus', 'createExplainabilityResponse_httpStatus' - The response's http status code.
newCreateExplainabilityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateExplainabilityResponse
newCreateExplainabilityResponse :: Int -> CreateExplainabilityResponse
newCreateExplainabilityResponse Int
pHttpStatus_ =
  CreateExplainabilityResponse'
    { $sel:explainabilityArn:CreateExplainabilityResponse' :: Maybe Text
explainabilityArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateExplainabilityResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the Explainability.
createExplainabilityResponse_explainabilityArn :: Lens.Lens' CreateExplainabilityResponse (Prelude.Maybe Prelude.Text)
createExplainabilityResponse_explainabilityArn :: Lens' CreateExplainabilityResponse (Maybe Text)
createExplainabilityResponse_explainabilityArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExplainabilityResponse' {Maybe Text
explainabilityArn :: Maybe Text
$sel:explainabilityArn:CreateExplainabilityResponse' :: CreateExplainabilityResponse -> Maybe Text
explainabilityArn} -> Maybe Text
explainabilityArn) (\s :: CreateExplainabilityResponse
s@CreateExplainabilityResponse' {} Maybe Text
a -> CreateExplainabilityResponse
s {$sel:explainabilityArn:CreateExplainabilityResponse' :: Maybe Text
explainabilityArn = Maybe Text
a} :: CreateExplainabilityResponse)

-- | The response's http status code.
createExplainabilityResponse_httpStatus :: Lens.Lens' CreateExplainabilityResponse Prelude.Int
createExplainabilityResponse_httpStatus :: Lens' CreateExplainabilityResponse Int
createExplainabilityResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExplainabilityResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateExplainabilityResponse' :: CreateExplainabilityResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateExplainabilityResponse
s@CreateExplainabilityResponse' {} Int
a -> CreateExplainabilityResponse
s {$sel:httpStatus:CreateExplainabilityResponse' :: Int
httpStatus = Int
a} :: CreateExplainabilityResponse)

instance Prelude.NFData CreateExplainabilityResponse where
  rnf :: CreateExplainabilityResponse -> ()
rnf CreateExplainabilityResponse' {Int
Maybe Text
httpStatus :: Int
explainabilityArn :: Maybe Text
$sel:httpStatus:CreateExplainabilityResponse' :: CreateExplainabilityResponse -> Int
$sel:explainabilityArn:CreateExplainabilityResponse' :: CreateExplainabilityResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
explainabilityArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus