{-# 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.DeleteWhatIfForecastExport
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a what-if forecast export created using the
-- CreateWhatIfForecastExport operation. You can delete only what-if
-- forecast exports that have a status of @ACTIVE@ or @CREATE_FAILED@. To
-- get the status, use the DescribeWhatIfForecastExport operation.
module Amazonka.Forecast.DeleteWhatIfForecastExport
  ( -- * Creating a Request
    DeleteWhatIfForecastExport (..),
    newDeleteWhatIfForecastExport,

    -- * Request Lenses
    deleteWhatIfForecastExport_whatIfForecastExportArn,

    -- * Destructuring the Response
    DeleteWhatIfForecastExportResponse (..),
    newDeleteWhatIfForecastExportResponse,
  )
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:/ 'newDeleteWhatIfForecastExport' smart constructor.
data DeleteWhatIfForecastExport = DeleteWhatIfForecastExport'
  { -- | The Amazon Resource Name (ARN) of the what-if forecast export that you
    -- want to delete.
    DeleteWhatIfForecastExport -> Text
whatIfForecastExportArn :: Prelude.Text
  }
  deriving (DeleteWhatIfForecastExport -> DeleteWhatIfForecastExport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteWhatIfForecastExport -> DeleteWhatIfForecastExport -> Bool
$c/= :: DeleteWhatIfForecastExport -> DeleteWhatIfForecastExport -> Bool
== :: DeleteWhatIfForecastExport -> DeleteWhatIfForecastExport -> Bool
$c== :: DeleteWhatIfForecastExport -> DeleteWhatIfForecastExport -> Bool
Prelude.Eq, ReadPrec [DeleteWhatIfForecastExport]
ReadPrec DeleteWhatIfForecastExport
Int -> ReadS DeleteWhatIfForecastExport
ReadS [DeleteWhatIfForecastExport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteWhatIfForecastExport]
$creadListPrec :: ReadPrec [DeleteWhatIfForecastExport]
readPrec :: ReadPrec DeleteWhatIfForecastExport
$creadPrec :: ReadPrec DeleteWhatIfForecastExport
readList :: ReadS [DeleteWhatIfForecastExport]
$creadList :: ReadS [DeleteWhatIfForecastExport]
readsPrec :: Int -> ReadS DeleteWhatIfForecastExport
$creadsPrec :: Int -> ReadS DeleteWhatIfForecastExport
Prelude.Read, Int -> DeleteWhatIfForecastExport -> ShowS
[DeleteWhatIfForecastExport] -> ShowS
DeleteWhatIfForecastExport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteWhatIfForecastExport] -> ShowS
$cshowList :: [DeleteWhatIfForecastExport] -> ShowS
show :: DeleteWhatIfForecastExport -> String
$cshow :: DeleteWhatIfForecastExport -> String
showsPrec :: Int -> DeleteWhatIfForecastExport -> ShowS
$cshowsPrec :: Int -> DeleteWhatIfForecastExport -> ShowS
Prelude.Show, forall x.
Rep DeleteWhatIfForecastExport x -> DeleteWhatIfForecastExport
forall x.
DeleteWhatIfForecastExport -> Rep DeleteWhatIfForecastExport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteWhatIfForecastExport x -> DeleteWhatIfForecastExport
$cfrom :: forall x.
DeleteWhatIfForecastExport -> Rep DeleteWhatIfForecastExport x
Prelude.Generic)

-- |
-- Create a value of 'DeleteWhatIfForecastExport' 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:
--
-- 'whatIfForecastExportArn', 'deleteWhatIfForecastExport_whatIfForecastExportArn' - The Amazon Resource Name (ARN) of the what-if forecast export that you
-- want to delete.
newDeleteWhatIfForecastExport ::
  -- | 'whatIfForecastExportArn'
  Prelude.Text ->
  DeleteWhatIfForecastExport
newDeleteWhatIfForecastExport :: Text -> DeleteWhatIfForecastExport
newDeleteWhatIfForecastExport
  Text
pWhatIfForecastExportArn_ =
    DeleteWhatIfForecastExport'
      { $sel:whatIfForecastExportArn:DeleteWhatIfForecastExport' :: Text
whatIfForecastExportArn =
          Text
pWhatIfForecastExportArn_
      }

-- | The Amazon Resource Name (ARN) of the what-if forecast export that you
-- want to delete.
deleteWhatIfForecastExport_whatIfForecastExportArn :: Lens.Lens' DeleteWhatIfForecastExport Prelude.Text
deleteWhatIfForecastExport_whatIfForecastExportArn :: Lens' DeleteWhatIfForecastExport Text
deleteWhatIfForecastExport_whatIfForecastExportArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteWhatIfForecastExport' {Text
whatIfForecastExportArn :: Text
$sel:whatIfForecastExportArn:DeleteWhatIfForecastExport' :: DeleteWhatIfForecastExport -> Text
whatIfForecastExportArn} -> Text
whatIfForecastExportArn) (\s :: DeleteWhatIfForecastExport
s@DeleteWhatIfForecastExport' {} Text
a -> DeleteWhatIfForecastExport
s {$sel:whatIfForecastExportArn:DeleteWhatIfForecastExport' :: Text
whatIfForecastExportArn = Text
a} :: DeleteWhatIfForecastExport)

instance Core.AWSRequest DeleteWhatIfForecastExport where
  type
    AWSResponse DeleteWhatIfForecastExport =
      DeleteWhatIfForecastExportResponse
  request :: (Service -> Service)
-> DeleteWhatIfForecastExport -> Request DeleteWhatIfForecastExport
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 DeleteWhatIfForecastExport
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteWhatIfForecastExport)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteWhatIfForecastExportResponse
DeleteWhatIfForecastExportResponse'

instance Prelude.Hashable DeleteWhatIfForecastExport where
  hashWithSalt :: Int -> DeleteWhatIfForecastExport -> Int
hashWithSalt Int
_salt DeleteWhatIfForecastExport' {Text
whatIfForecastExportArn :: Text
$sel:whatIfForecastExportArn:DeleteWhatIfForecastExport' :: DeleteWhatIfForecastExport -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
whatIfForecastExportArn

instance Prelude.NFData DeleteWhatIfForecastExport where
  rnf :: DeleteWhatIfForecastExport -> ()
rnf DeleteWhatIfForecastExport' {Text
whatIfForecastExportArn :: Text
$sel:whatIfForecastExportArn:DeleteWhatIfForecastExport' :: DeleteWhatIfForecastExport -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
whatIfForecastExportArn

instance Data.ToHeaders DeleteWhatIfForecastExport where
  toHeaders :: DeleteWhatIfForecastExport -> [Header]
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 -> [Header]
Data.=# ( ByteString
"AmazonForecast.DeleteWhatIfForecastExport" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeleteWhatIfForecastExport where
  toJSON :: DeleteWhatIfForecastExport -> Value
toJSON DeleteWhatIfForecastExport' {Text
whatIfForecastExportArn :: Text
$sel:whatIfForecastExportArn:DeleteWhatIfForecastExport' :: DeleteWhatIfForecastExport -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"WhatIfForecastExportArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
whatIfForecastExportArn
              )
          ]
      )

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

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

-- | /See:/ 'newDeleteWhatIfForecastExportResponse' smart constructor.
data DeleteWhatIfForecastExportResponse = DeleteWhatIfForecastExportResponse'
  {
  }
  deriving (DeleteWhatIfForecastExportResponse
-> DeleteWhatIfForecastExportResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteWhatIfForecastExportResponse
-> DeleteWhatIfForecastExportResponse -> Bool
$c/= :: DeleteWhatIfForecastExportResponse
-> DeleteWhatIfForecastExportResponse -> Bool
== :: DeleteWhatIfForecastExportResponse
-> DeleteWhatIfForecastExportResponse -> Bool
$c== :: DeleteWhatIfForecastExportResponse
-> DeleteWhatIfForecastExportResponse -> Bool
Prelude.Eq, ReadPrec [DeleteWhatIfForecastExportResponse]
ReadPrec DeleteWhatIfForecastExportResponse
Int -> ReadS DeleteWhatIfForecastExportResponse
ReadS [DeleteWhatIfForecastExportResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteWhatIfForecastExportResponse]
$creadListPrec :: ReadPrec [DeleteWhatIfForecastExportResponse]
readPrec :: ReadPrec DeleteWhatIfForecastExportResponse
$creadPrec :: ReadPrec DeleteWhatIfForecastExportResponse
readList :: ReadS [DeleteWhatIfForecastExportResponse]
$creadList :: ReadS [DeleteWhatIfForecastExportResponse]
readsPrec :: Int -> ReadS DeleteWhatIfForecastExportResponse
$creadsPrec :: Int -> ReadS DeleteWhatIfForecastExportResponse
Prelude.Read, Int -> DeleteWhatIfForecastExportResponse -> ShowS
[DeleteWhatIfForecastExportResponse] -> ShowS
DeleteWhatIfForecastExportResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteWhatIfForecastExportResponse] -> ShowS
$cshowList :: [DeleteWhatIfForecastExportResponse] -> ShowS
show :: DeleteWhatIfForecastExportResponse -> String
$cshow :: DeleteWhatIfForecastExportResponse -> String
showsPrec :: Int -> DeleteWhatIfForecastExportResponse -> ShowS
$cshowsPrec :: Int -> DeleteWhatIfForecastExportResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteWhatIfForecastExportResponse x
-> DeleteWhatIfForecastExportResponse
forall x.
DeleteWhatIfForecastExportResponse
-> Rep DeleteWhatIfForecastExportResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteWhatIfForecastExportResponse x
-> DeleteWhatIfForecastExportResponse
$cfrom :: forall x.
DeleteWhatIfForecastExportResponse
-> Rep DeleteWhatIfForecastExportResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteWhatIfForecastExportResponse' 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.
newDeleteWhatIfForecastExportResponse ::
  DeleteWhatIfForecastExportResponse
newDeleteWhatIfForecastExportResponse :: DeleteWhatIfForecastExportResponse
newDeleteWhatIfForecastExportResponse =
  DeleteWhatIfForecastExportResponse
DeleteWhatIfForecastExportResponse'

instance
  Prelude.NFData
    DeleteWhatIfForecastExportResponse
  where
  rnf :: DeleteWhatIfForecastExportResponse -> ()
rnf DeleteWhatIfForecastExportResponse
_ = ()