{-# 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.DeleteExplainability
-- 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 an Explainability resource.
--
-- You can delete only predictor that have a status of @ACTIVE@ or
-- @CREATE_FAILED@. To get the status, use the DescribeExplainability
-- operation.
module Amazonka.Forecast.DeleteExplainability
  ( -- * Creating a Request
    DeleteExplainability (..),
    newDeleteExplainability,

    -- * Request Lenses
    deleteExplainability_explainabilityArn,

    -- * Destructuring the Response
    DeleteExplainabilityResponse (..),
    newDeleteExplainabilityResponse,
  )
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:/ 'newDeleteExplainability' smart constructor.
data DeleteExplainability = DeleteExplainability'
  { -- | The Amazon Resource Name (ARN) of the Explainability resource to delete.
    DeleteExplainability -> Text
explainabilityArn :: Prelude.Text
  }
  deriving (DeleteExplainability -> DeleteExplainability -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteExplainability -> DeleteExplainability -> Bool
$c/= :: DeleteExplainability -> DeleteExplainability -> Bool
== :: DeleteExplainability -> DeleteExplainability -> Bool
$c== :: DeleteExplainability -> DeleteExplainability -> Bool
Prelude.Eq, ReadPrec [DeleteExplainability]
ReadPrec DeleteExplainability
Int -> ReadS DeleteExplainability
ReadS [DeleteExplainability]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteExplainability]
$creadListPrec :: ReadPrec [DeleteExplainability]
readPrec :: ReadPrec DeleteExplainability
$creadPrec :: ReadPrec DeleteExplainability
readList :: ReadS [DeleteExplainability]
$creadList :: ReadS [DeleteExplainability]
readsPrec :: Int -> ReadS DeleteExplainability
$creadsPrec :: Int -> ReadS DeleteExplainability
Prelude.Read, Int -> DeleteExplainability -> ShowS
[DeleteExplainability] -> ShowS
DeleteExplainability -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteExplainability] -> ShowS
$cshowList :: [DeleteExplainability] -> ShowS
show :: DeleteExplainability -> String
$cshow :: DeleteExplainability -> String
showsPrec :: Int -> DeleteExplainability -> ShowS
$cshowsPrec :: Int -> DeleteExplainability -> ShowS
Prelude.Show, forall x. Rep DeleteExplainability x -> DeleteExplainability
forall x. DeleteExplainability -> Rep DeleteExplainability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteExplainability x -> DeleteExplainability
$cfrom :: forall x. DeleteExplainability -> Rep DeleteExplainability x
Prelude.Generic)

-- |
-- Create a value of 'DeleteExplainability' 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', 'deleteExplainability_explainabilityArn' - The Amazon Resource Name (ARN) of the Explainability resource to delete.
newDeleteExplainability ::
  -- | 'explainabilityArn'
  Prelude.Text ->
  DeleteExplainability
newDeleteExplainability :: Text -> DeleteExplainability
newDeleteExplainability Text
pExplainabilityArn_ =
  DeleteExplainability'
    { $sel:explainabilityArn:DeleteExplainability' :: Text
explainabilityArn =
        Text
pExplainabilityArn_
    }

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

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

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

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

instance Data.ToHeaders DeleteExplainability where
  toHeaders :: DeleteExplainability -> [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.DeleteExplainability" ::
                          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 DeleteExplainability where
  toJSON :: DeleteExplainability -> Value
toJSON DeleteExplainability' {Text
explainabilityArn :: Text
$sel:explainabilityArn:DeleteExplainability' :: DeleteExplainability -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ExplainabilityArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
explainabilityArn)
          ]
      )

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

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

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

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

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