{-# 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.CreateForecast
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a forecast for each item in the @TARGET_TIME_SERIES@ dataset
-- that was used to train the predictor. This is known as inference. To
-- retrieve the forecast for a single item at low latency, use the
-- operation. To export the complete forecast into your Amazon Simple
-- Storage Service (Amazon S3) bucket, use the CreateForecastExportJob
-- operation.
--
-- The range of the forecast is determined by the @ForecastHorizon@ value,
-- which you specify in the CreatePredictor request. When you query a
-- forecast, you can request a specific date range within the forecast.
--
-- To get a list of all your forecasts, use the ListForecasts operation.
--
-- The forecasts generated by Amazon Forecast are in the same time zone as
-- the dataset that was used to create the predictor.
--
-- For more information, see howitworks-forecast.
--
-- The @Status@ of the forecast must be @ACTIVE@ before you can query or
-- export the forecast. Use the DescribeForecast operation to get the
-- status.
--
-- By default, a forecast includes predictions for every item (@item_id@)
-- in the dataset group that was used to train the predictor. However, you
-- can use the @TimeSeriesSelector@ object to generate a forecast on a
-- subset of time series. Forecast creation is skipped for any time series
-- that you specify that are not in the input dataset. The forecast export
-- file will not contain these time series or their forecasted values.
module Amazonka.Forecast.CreateForecast
  ( -- * Creating a Request
    CreateForecast (..),
    newCreateForecast,

    -- * Request Lenses
    createForecast_forecastTypes,
    createForecast_tags,
    createForecast_timeSeriesSelector,
    createForecast_forecastName,
    createForecast_predictorArn,

    -- * Destructuring the Response
    CreateForecastResponse (..),
    newCreateForecastResponse,

    -- * Response Lenses
    createForecastResponse_forecastArn,
    createForecastResponse_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:/ 'newCreateForecast' smart constructor.
data CreateForecast = CreateForecast'
  { -- | The quantiles at which probabilistic forecasts are generated. __You can
    -- currently specify up to 5 quantiles per forecast__. Accepted values
    -- include @0.01 to 0.99@ (increments of .01 only) and @mean@. The mean
    -- forecast is different from the median (0.50) when the distribution is
    -- not symmetric (for example, Beta and Negative Binomial).
    --
    -- The default quantiles are the quantiles you specified during predictor
    -- creation. If you didn\'t specify quantiles, the default values are
    -- @[\"0.1\", \"0.5\", \"0.9\"]@.
    CreateForecast -> Maybe (NonEmpty Text)
forecastTypes :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The optional metadata that you apply to the forecast to help you
    -- categorize and organize them. Each tag consists of a key and an optional
    -- value, both of which you define.
    --
    -- The following basic restrictions apply to tags:
    --
    -- -   Maximum number of tags per resource - 50.
    --
    -- -   For each resource, each tag key must be unique, and each tag key can
    --     have only one value.
    --
    -- -   Maximum key length - 128 Unicode characters in UTF-8.
    --
    -- -   Maximum value length - 256 Unicode characters in UTF-8.
    --
    -- -   If your tagging schema is used across multiple services and
    --     resources, remember that other services may have restrictions on
    --     allowed characters. Generally allowed characters are: letters,
    --     numbers, and spaces representable in UTF-8, and the following
    --     characters: + - = . _ : \/ \@.
    --
    -- -   Tag keys and values are case sensitive.
    --
    -- -   Do not use @aws:@, @AWS:@, or any upper or lowercase combination of
    --     such as a prefix for keys as it is reserved for AWS use. You cannot
    --     edit or delete tag keys with this prefix. Values can have this
    --     prefix. If a tag value has @aws@ as its prefix but the key does not,
    --     then 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.
    CreateForecast -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Defines the set of time series that are used to create the forecasts in
    -- a @TimeSeriesIdentifiers@ object.
    --
    -- The @TimeSeriesIdentifiers@ object needs the following information:
    --
    -- -   @DataSource@
    --
    -- -   @Format@
    --
    -- -   @Schema@
    CreateForecast -> Maybe TimeSeriesSelector
timeSeriesSelector :: Prelude.Maybe TimeSeriesSelector,
    -- | A name for the forecast.
    CreateForecast -> Text
forecastName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the predictor to use to generate the
    -- forecast.
    CreateForecast -> Text
predictorArn :: Prelude.Text
  }
  deriving (CreateForecast -> CreateForecast -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateForecast -> CreateForecast -> Bool
$c/= :: CreateForecast -> CreateForecast -> Bool
== :: CreateForecast -> CreateForecast -> Bool
$c== :: CreateForecast -> CreateForecast -> Bool
Prelude.Eq, Int -> CreateForecast -> ShowS
[CreateForecast] -> ShowS
CreateForecast -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateForecast] -> ShowS
$cshowList :: [CreateForecast] -> ShowS
show :: CreateForecast -> String
$cshow :: CreateForecast -> String
showsPrec :: Int -> CreateForecast -> ShowS
$cshowsPrec :: Int -> CreateForecast -> ShowS
Prelude.Show, forall x. Rep CreateForecast x -> CreateForecast
forall x. CreateForecast -> Rep CreateForecast x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateForecast x -> CreateForecast
$cfrom :: forall x. CreateForecast -> Rep CreateForecast x
Prelude.Generic)

-- |
-- Create a value of 'CreateForecast' 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:
--
-- 'forecastTypes', 'createForecast_forecastTypes' - The quantiles at which probabilistic forecasts are generated. __You can
-- currently specify up to 5 quantiles per forecast__. Accepted values
-- include @0.01 to 0.99@ (increments of .01 only) and @mean@. The mean
-- forecast is different from the median (0.50) when the distribution is
-- not symmetric (for example, Beta and Negative Binomial).
--
-- The default quantiles are the quantiles you specified during predictor
-- creation. If you didn\'t specify quantiles, the default values are
-- @[\"0.1\", \"0.5\", \"0.9\"]@.
--
-- 'tags', 'createForecast_tags' - The optional metadata that you apply to the forecast to help you
-- categorize and organize them. Each tag consists of a key and an optional
-- value, both of which you define.
--
-- The following basic restrictions apply to tags:
--
-- -   Maximum number of tags per resource - 50.
--
-- -   For each resource, each tag key must be unique, and each tag key can
--     have only one value.
--
-- -   Maximum key length - 128 Unicode characters in UTF-8.
--
-- -   Maximum value length - 256 Unicode characters in UTF-8.
--
-- -   If your tagging schema is used across multiple services and
--     resources, remember that other services may have restrictions on
--     allowed characters. Generally allowed characters are: letters,
--     numbers, and spaces representable in UTF-8, and the following
--     characters: + - = . _ : \/ \@.
--
-- -   Tag keys and values are case sensitive.
--
-- -   Do not use @aws:@, @AWS:@, or any upper or lowercase combination of
--     such as a prefix for keys as it is reserved for AWS use. You cannot
--     edit or delete tag keys with this prefix. Values can have this
--     prefix. If a tag value has @aws@ as its prefix but the key does not,
--     then 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.
--
-- 'timeSeriesSelector', 'createForecast_timeSeriesSelector' - Defines the set of time series that are used to create the forecasts in
-- a @TimeSeriesIdentifiers@ object.
--
-- The @TimeSeriesIdentifiers@ object needs the following information:
--
-- -   @DataSource@
--
-- -   @Format@
--
-- -   @Schema@
--
-- 'forecastName', 'createForecast_forecastName' - A name for the forecast.
--
-- 'predictorArn', 'createForecast_predictorArn' - The Amazon Resource Name (ARN) of the predictor to use to generate the
-- forecast.
newCreateForecast ::
  -- | 'forecastName'
  Prelude.Text ->
  -- | 'predictorArn'
  Prelude.Text ->
  CreateForecast
newCreateForecast :: Text -> Text -> CreateForecast
newCreateForecast Text
pForecastName_ Text
pPredictorArn_ =
  CreateForecast'
    { $sel:forecastTypes:CreateForecast' :: Maybe (NonEmpty Text)
forecastTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateForecast' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:timeSeriesSelector:CreateForecast' :: Maybe TimeSeriesSelector
timeSeriesSelector = forall a. Maybe a
Prelude.Nothing,
      $sel:forecastName:CreateForecast' :: Text
forecastName = Text
pForecastName_,
      $sel:predictorArn:CreateForecast' :: Text
predictorArn = Text
pPredictorArn_
    }

-- | The quantiles at which probabilistic forecasts are generated. __You can
-- currently specify up to 5 quantiles per forecast__. Accepted values
-- include @0.01 to 0.99@ (increments of .01 only) and @mean@. The mean
-- forecast is different from the median (0.50) when the distribution is
-- not symmetric (for example, Beta and Negative Binomial).
--
-- The default quantiles are the quantiles you specified during predictor
-- creation. If you didn\'t specify quantiles, the default values are
-- @[\"0.1\", \"0.5\", \"0.9\"]@.
createForecast_forecastTypes :: Lens.Lens' CreateForecast (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
createForecast_forecastTypes :: Lens' CreateForecast (Maybe (NonEmpty Text))
createForecast_forecastTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateForecast' {Maybe (NonEmpty Text)
forecastTypes :: Maybe (NonEmpty Text)
$sel:forecastTypes:CreateForecast' :: CreateForecast -> Maybe (NonEmpty Text)
forecastTypes} -> Maybe (NonEmpty Text)
forecastTypes) (\s :: CreateForecast
s@CreateForecast' {} Maybe (NonEmpty Text)
a -> CreateForecast
s {$sel:forecastTypes:CreateForecast' :: Maybe (NonEmpty Text)
forecastTypes = Maybe (NonEmpty Text)
a} :: CreateForecast) 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 optional metadata that you apply to the forecast to help you
-- categorize and organize them. Each tag consists of a key and an optional
-- value, both of which you define.
--
-- The following basic restrictions apply to tags:
--
-- -   Maximum number of tags per resource - 50.
--
-- -   For each resource, each tag key must be unique, and each tag key can
--     have only one value.
--
-- -   Maximum key length - 128 Unicode characters in UTF-8.
--
-- -   Maximum value length - 256 Unicode characters in UTF-8.
--
-- -   If your tagging schema is used across multiple services and
--     resources, remember that other services may have restrictions on
--     allowed characters. Generally allowed characters are: letters,
--     numbers, and spaces representable in UTF-8, and the following
--     characters: + - = . _ : \/ \@.
--
-- -   Tag keys and values are case sensitive.
--
-- -   Do not use @aws:@, @AWS:@, or any upper or lowercase combination of
--     such as a prefix for keys as it is reserved for AWS use. You cannot
--     edit or delete tag keys with this prefix. Values can have this
--     prefix. If a tag value has @aws@ as its prefix but the key does not,
--     then 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.
createForecast_tags :: Lens.Lens' CreateForecast (Prelude.Maybe [Tag])
createForecast_tags :: Lens' CreateForecast (Maybe [Tag])
createForecast_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateForecast' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateForecast' :: CreateForecast -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateForecast
s@CreateForecast' {} Maybe [Tag]
a -> CreateForecast
s {$sel:tags:CreateForecast' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateForecast) 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

-- | Defines the set of time series that are used to create the forecasts in
-- a @TimeSeriesIdentifiers@ object.
--
-- The @TimeSeriesIdentifiers@ object needs the following information:
--
-- -   @DataSource@
--
-- -   @Format@
--
-- -   @Schema@
createForecast_timeSeriesSelector :: Lens.Lens' CreateForecast (Prelude.Maybe TimeSeriesSelector)
createForecast_timeSeriesSelector :: Lens' CreateForecast (Maybe TimeSeriesSelector)
createForecast_timeSeriesSelector = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateForecast' {Maybe TimeSeriesSelector
timeSeriesSelector :: Maybe TimeSeriesSelector
$sel:timeSeriesSelector:CreateForecast' :: CreateForecast -> Maybe TimeSeriesSelector
timeSeriesSelector} -> Maybe TimeSeriesSelector
timeSeriesSelector) (\s :: CreateForecast
s@CreateForecast' {} Maybe TimeSeriesSelector
a -> CreateForecast
s {$sel:timeSeriesSelector:CreateForecast' :: Maybe TimeSeriesSelector
timeSeriesSelector = Maybe TimeSeriesSelector
a} :: CreateForecast)

-- | A name for the forecast.
createForecast_forecastName :: Lens.Lens' CreateForecast Prelude.Text
createForecast_forecastName :: Lens' CreateForecast Text
createForecast_forecastName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateForecast' {Text
forecastName :: Text
$sel:forecastName:CreateForecast' :: CreateForecast -> Text
forecastName} -> Text
forecastName) (\s :: CreateForecast
s@CreateForecast' {} Text
a -> CreateForecast
s {$sel:forecastName:CreateForecast' :: Text
forecastName = Text
a} :: CreateForecast)

-- | The Amazon Resource Name (ARN) of the predictor to use to generate the
-- forecast.
createForecast_predictorArn :: Lens.Lens' CreateForecast Prelude.Text
createForecast_predictorArn :: Lens' CreateForecast Text
createForecast_predictorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateForecast' {Text
predictorArn :: Text
$sel:predictorArn:CreateForecast' :: CreateForecast -> Text
predictorArn} -> Text
predictorArn) (\s :: CreateForecast
s@CreateForecast' {} Text
a -> CreateForecast
s {$sel:predictorArn:CreateForecast' :: Text
predictorArn = Text
a} :: CreateForecast)

instance Core.AWSRequest CreateForecast where
  type
    AWSResponse CreateForecast =
      CreateForecastResponse
  request :: (Service -> Service) -> CreateForecast -> Request CreateForecast
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 CreateForecast
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateForecast)))
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 -> CreateForecastResponse
CreateForecastResponse'
            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
"ForecastArn")
            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 CreateForecast where
  hashWithSalt :: Int -> CreateForecast -> Int
hashWithSalt Int
_salt CreateForecast' {Maybe [Tag]
Maybe (NonEmpty Text)
Maybe TimeSeriesSelector
Text
predictorArn :: Text
forecastName :: Text
timeSeriesSelector :: Maybe TimeSeriesSelector
tags :: Maybe [Tag]
forecastTypes :: Maybe (NonEmpty Text)
$sel:predictorArn:CreateForecast' :: CreateForecast -> Text
$sel:forecastName:CreateForecast' :: CreateForecast -> Text
$sel:timeSeriesSelector:CreateForecast' :: CreateForecast -> Maybe TimeSeriesSelector
$sel:tags:CreateForecast' :: CreateForecast -> Maybe [Tag]
$sel:forecastTypes:CreateForecast' :: CreateForecast -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
forecastTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimeSeriesSelector
timeSeriesSelector
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
forecastName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
predictorArn

instance Prelude.NFData CreateForecast where
  rnf :: CreateForecast -> ()
rnf CreateForecast' {Maybe [Tag]
Maybe (NonEmpty Text)
Maybe TimeSeriesSelector
Text
predictorArn :: Text
forecastName :: Text
timeSeriesSelector :: Maybe TimeSeriesSelector
tags :: Maybe [Tag]
forecastTypes :: Maybe (NonEmpty Text)
$sel:predictorArn:CreateForecast' :: CreateForecast -> Text
$sel:forecastName:CreateForecast' :: CreateForecast -> Text
$sel:timeSeriesSelector:CreateForecast' :: CreateForecast -> Maybe TimeSeriesSelector
$sel:tags:CreateForecast' :: CreateForecast -> Maybe [Tag]
$sel:forecastTypes:CreateForecast' :: CreateForecast -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
forecastTypes
      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 Maybe TimeSeriesSelector
timeSeriesSelector
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
forecastName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
predictorArn

instance Data.ToHeaders CreateForecast where
  toHeaders :: CreateForecast -> 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.CreateForecast" ::
                          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 CreateForecast where
  toJSON :: CreateForecast -> Value
toJSON CreateForecast' {Maybe [Tag]
Maybe (NonEmpty Text)
Maybe TimeSeriesSelector
Text
predictorArn :: Text
forecastName :: Text
timeSeriesSelector :: Maybe TimeSeriesSelector
tags :: Maybe [Tag]
forecastTypes :: Maybe (NonEmpty Text)
$sel:predictorArn:CreateForecast' :: CreateForecast -> Text
$sel:forecastName:CreateForecast' :: CreateForecast -> Text
$sel:timeSeriesSelector:CreateForecast' :: CreateForecast -> Maybe TimeSeriesSelector
$sel:tags:CreateForecast' :: CreateForecast -> Maybe [Tag]
$sel:forecastTypes:CreateForecast' :: CreateForecast -> Maybe (NonEmpty Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ForecastTypes" 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 (NonEmpty Text)
forecastTypes,
            (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,
            (Key
"TimeSeriesSelector" 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 TimeSeriesSelector
timeSeriesSelector,
            forall a. a -> Maybe a
Prelude.Just (Key
"ForecastName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
forecastName),
            forall a. a -> Maybe a
Prelude.Just (Key
"PredictorArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
predictorArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateForecastResponse' 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:
--
-- 'forecastArn', 'createForecastResponse_forecastArn' - The Amazon Resource Name (ARN) of the forecast.
--
-- 'httpStatus', 'createForecastResponse_httpStatus' - The response's http status code.
newCreateForecastResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateForecastResponse
newCreateForecastResponse :: Int -> CreateForecastResponse
newCreateForecastResponse Int
pHttpStatus_ =
  CreateForecastResponse'
    { $sel:forecastArn:CreateForecastResponse' :: Maybe Text
forecastArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateForecastResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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