{-# 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.Transcribe.DeleteMedicalVocabulary
-- 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 custom medical vocabulary. To use this operation, specify the
-- name of the custom vocabulary you want to delete using @VocabularyName@.
-- Custom vocabulary names are case sensitive.
module Amazonka.Transcribe.DeleteMedicalVocabulary
  ( -- * Creating a Request
    DeleteMedicalVocabulary (..),
    newDeleteMedicalVocabulary,

    -- * Request Lenses
    deleteMedicalVocabulary_vocabularyName,

    -- * Destructuring the Response
    DeleteMedicalVocabularyResponse (..),
    newDeleteMedicalVocabularyResponse,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Transcribe.Types

-- | /See:/ 'newDeleteMedicalVocabulary' smart constructor.
data DeleteMedicalVocabulary = DeleteMedicalVocabulary'
  { -- | The name of the custom medical vocabulary you want to delete. Custom
    -- medical vocabulary names are case sensitive.
    DeleteMedicalVocabulary -> Text
vocabularyName :: Prelude.Text
  }
  deriving (DeleteMedicalVocabulary -> DeleteMedicalVocabulary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteMedicalVocabulary -> DeleteMedicalVocabulary -> Bool
$c/= :: DeleteMedicalVocabulary -> DeleteMedicalVocabulary -> Bool
== :: DeleteMedicalVocabulary -> DeleteMedicalVocabulary -> Bool
$c== :: DeleteMedicalVocabulary -> DeleteMedicalVocabulary -> Bool
Prelude.Eq, ReadPrec [DeleteMedicalVocabulary]
ReadPrec DeleteMedicalVocabulary
Int -> ReadS DeleteMedicalVocabulary
ReadS [DeleteMedicalVocabulary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteMedicalVocabulary]
$creadListPrec :: ReadPrec [DeleteMedicalVocabulary]
readPrec :: ReadPrec DeleteMedicalVocabulary
$creadPrec :: ReadPrec DeleteMedicalVocabulary
readList :: ReadS [DeleteMedicalVocabulary]
$creadList :: ReadS [DeleteMedicalVocabulary]
readsPrec :: Int -> ReadS DeleteMedicalVocabulary
$creadsPrec :: Int -> ReadS DeleteMedicalVocabulary
Prelude.Read, Int -> DeleteMedicalVocabulary -> ShowS
[DeleteMedicalVocabulary] -> ShowS
DeleteMedicalVocabulary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteMedicalVocabulary] -> ShowS
$cshowList :: [DeleteMedicalVocabulary] -> ShowS
show :: DeleteMedicalVocabulary -> String
$cshow :: DeleteMedicalVocabulary -> String
showsPrec :: Int -> DeleteMedicalVocabulary -> ShowS
$cshowsPrec :: Int -> DeleteMedicalVocabulary -> ShowS
Prelude.Show, forall x. Rep DeleteMedicalVocabulary x -> DeleteMedicalVocabulary
forall x. DeleteMedicalVocabulary -> Rep DeleteMedicalVocabulary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteMedicalVocabulary x -> DeleteMedicalVocabulary
$cfrom :: forall x. DeleteMedicalVocabulary -> Rep DeleteMedicalVocabulary x
Prelude.Generic)

-- |
-- Create a value of 'DeleteMedicalVocabulary' 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:
--
-- 'vocabularyName', 'deleteMedicalVocabulary_vocabularyName' - The name of the custom medical vocabulary you want to delete. Custom
-- medical vocabulary names are case sensitive.
newDeleteMedicalVocabulary ::
  -- | 'vocabularyName'
  Prelude.Text ->
  DeleteMedicalVocabulary
newDeleteMedicalVocabulary :: Text -> DeleteMedicalVocabulary
newDeleteMedicalVocabulary Text
pVocabularyName_ =
  DeleteMedicalVocabulary'
    { $sel:vocabularyName:DeleteMedicalVocabulary' :: Text
vocabularyName =
        Text
pVocabularyName_
    }

-- | The name of the custom medical vocabulary you want to delete. Custom
-- medical vocabulary names are case sensitive.
deleteMedicalVocabulary_vocabularyName :: Lens.Lens' DeleteMedicalVocabulary Prelude.Text
deleteMedicalVocabulary_vocabularyName :: Lens' DeleteMedicalVocabulary Text
deleteMedicalVocabulary_vocabularyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteMedicalVocabulary' {Text
vocabularyName :: Text
$sel:vocabularyName:DeleteMedicalVocabulary' :: DeleteMedicalVocabulary -> Text
vocabularyName} -> Text
vocabularyName) (\s :: DeleteMedicalVocabulary
s@DeleteMedicalVocabulary' {} Text
a -> DeleteMedicalVocabulary
s {$sel:vocabularyName:DeleteMedicalVocabulary' :: Text
vocabularyName = Text
a} :: DeleteMedicalVocabulary)

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

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

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

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

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

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

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

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

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