{-# 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.GetMedicalVocabulary
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides information about the specified custom medical vocabulary.
--
-- To view the status of the specified custom medical vocabulary, check the
-- @VocabularyState@ field. If the status is @READY@, your custom
-- vocabulary is available to use. If the status is @FAILED@,
-- @FailureReason@ provides details on why your vocabulary failed.
--
-- To get a list of your custom medical vocabularies, use the operation.
module Amazonka.Transcribe.GetMedicalVocabulary
  ( -- * Creating a Request
    GetMedicalVocabulary (..),
    newGetMedicalVocabulary,

    -- * Request Lenses
    getMedicalVocabulary_vocabularyName,

    -- * Destructuring the Response
    GetMedicalVocabularyResponse (..),
    newGetMedicalVocabularyResponse,

    -- * Response Lenses
    getMedicalVocabularyResponse_downloadUri,
    getMedicalVocabularyResponse_failureReason,
    getMedicalVocabularyResponse_languageCode,
    getMedicalVocabularyResponse_lastModifiedTime,
    getMedicalVocabularyResponse_vocabularyName,
    getMedicalVocabularyResponse_vocabularyState,
    getMedicalVocabularyResponse_httpStatus,
  )
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:/ 'newGetMedicalVocabulary' smart constructor.
data GetMedicalVocabulary = GetMedicalVocabulary'
  { -- | The name of the custom medical vocabulary you want information about.
    -- Custom medical vocabulary names are case sensitive.
    GetMedicalVocabulary -> Text
vocabularyName :: Prelude.Text
  }
  deriving (GetMedicalVocabulary -> GetMedicalVocabulary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMedicalVocabulary -> GetMedicalVocabulary -> Bool
$c/= :: GetMedicalVocabulary -> GetMedicalVocabulary -> Bool
== :: GetMedicalVocabulary -> GetMedicalVocabulary -> Bool
$c== :: GetMedicalVocabulary -> GetMedicalVocabulary -> Bool
Prelude.Eq, ReadPrec [GetMedicalVocabulary]
ReadPrec GetMedicalVocabulary
Int -> ReadS GetMedicalVocabulary
ReadS [GetMedicalVocabulary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMedicalVocabulary]
$creadListPrec :: ReadPrec [GetMedicalVocabulary]
readPrec :: ReadPrec GetMedicalVocabulary
$creadPrec :: ReadPrec GetMedicalVocabulary
readList :: ReadS [GetMedicalVocabulary]
$creadList :: ReadS [GetMedicalVocabulary]
readsPrec :: Int -> ReadS GetMedicalVocabulary
$creadsPrec :: Int -> ReadS GetMedicalVocabulary
Prelude.Read, Int -> GetMedicalVocabulary -> ShowS
[GetMedicalVocabulary] -> ShowS
GetMedicalVocabulary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMedicalVocabulary] -> ShowS
$cshowList :: [GetMedicalVocabulary] -> ShowS
show :: GetMedicalVocabulary -> String
$cshow :: GetMedicalVocabulary -> String
showsPrec :: Int -> GetMedicalVocabulary -> ShowS
$cshowsPrec :: Int -> GetMedicalVocabulary -> ShowS
Prelude.Show, forall x. Rep GetMedicalVocabulary x -> GetMedicalVocabulary
forall x. GetMedicalVocabulary -> Rep GetMedicalVocabulary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMedicalVocabulary x -> GetMedicalVocabulary
$cfrom :: forall x. GetMedicalVocabulary -> Rep GetMedicalVocabulary x
Prelude.Generic)

-- |
-- Create a value of 'GetMedicalVocabulary' 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', 'getMedicalVocabulary_vocabularyName' - The name of the custom medical vocabulary you want information about.
-- Custom medical vocabulary names are case sensitive.
newGetMedicalVocabulary ::
  -- | 'vocabularyName'
  Prelude.Text ->
  GetMedicalVocabulary
newGetMedicalVocabulary :: Text -> GetMedicalVocabulary
newGetMedicalVocabulary Text
pVocabularyName_ =
  GetMedicalVocabulary'
    { $sel:vocabularyName:GetMedicalVocabulary' :: Text
vocabularyName =
        Text
pVocabularyName_
    }

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

instance Core.AWSRequest GetMedicalVocabulary where
  type
    AWSResponse GetMedicalVocabulary =
      GetMedicalVocabularyResponse
  request :: (Service -> Service)
-> GetMedicalVocabulary -> Request GetMedicalVocabulary
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 GetMedicalVocabulary
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetMedicalVocabulary)))
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
-> Maybe Text
-> Maybe LanguageCode
-> Maybe POSIX
-> Maybe Text
-> Maybe VocabularyState
-> Int
-> GetMedicalVocabularyResponse
GetMedicalVocabularyResponse'
            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
"DownloadUri")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FailureReason")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LanguageCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LastModifiedTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VocabularyName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VocabularyState")
            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 GetMedicalVocabulary where
  hashWithSalt :: Int -> GetMedicalVocabulary -> Int
hashWithSalt Int
_salt GetMedicalVocabulary' {Text
vocabularyName :: Text
$sel:vocabularyName:GetMedicalVocabulary' :: GetMedicalVocabulary -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vocabularyName

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

instance Data.ToHeaders GetMedicalVocabulary where
  toHeaders :: GetMedicalVocabulary -> 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
"Transcribe.GetMedicalVocabulary" ::
                          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 GetMedicalVocabulary where
  toJSON :: GetMedicalVocabulary -> Value
toJSON GetMedicalVocabulary' {Text
vocabularyName :: Text
$sel:vocabularyName:GetMedicalVocabulary' :: GetMedicalVocabulary -> 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 GetMedicalVocabulary where
  toPath :: GetMedicalVocabulary -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newGetMedicalVocabularyResponse' smart constructor.
data GetMedicalVocabularyResponse = GetMedicalVocabularyResponse'
  { -- | The S3 location where the specified custom medical vocabulary is stored;
    -- use this URI to view or download the custom vocabulary.
    GetMedicalVocabularyResponse -> Maybe Text
downloadUri :: Prelude.Maybe Prelude.Text,
    -- | If @VocabularyState@ is @FAILED@, @FailureReason@ contains information
    -- about why the custom medical vocabulary request failed. See also:
    -- <https://docs.aws.amazon.com/transcribe/latest/APIReference/CommonErrors.html Common Errors>.
    GetMedicalVocabularyResponse -> Maybe Text
failureReason :: Prelude.Maybe Prelude.Text,
    -- | The language code you selected for your custom medical vocabulary. US
    -- English (@en-US@) is the only language supported with Amazon Transcribe
    -- Medical.
    GetMedicalVocabularyResponse -> Maybe LanguageCode
languageCode :: Prelude.Maybe LanguageCode,
    -- | The date and time the specified custom medical vocabulary was last
    -- modified.
    --
    -- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
    -- example, @2022-05-04T12:32:58.761000-07:00@ represents 12:32 PM UTC-7 on
    -- May 4, 2022.
    GetMedicalVocabularyResponse -> Maybe POSIX
lastModifiedTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the custom medical vocabulary you requested information
    -- about.
    GetMedicalVocabularyResponse -> Maybe Text
vocabularyName :: Prelude.Maybe Prelude.Text,
    -- | The processing state of your custom medical vocabulary. If the state is
    -- @READY@, you can use the custom vocabulary in a
    -- @StartMedicalTranscriptionJob@ request.
    GetMedicalVocabularyResponse -> Maybe VocabularyState
vocabularyState :: Prelude.Maybe VocabularyState,
    -- | The response's http status code.
    GetMedicalVocabularyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetMedicalVocabularyResponse
-> GetMedicalVocabularyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMedicalVocabularyResponse
-> GetMedicalVocabularyResponse -> Bool
$c/= :: GetMedicalVocabularyResponse
-> GetMedicalVocabularyResponse -> Bool
== :: GetMedicalVocabularyResponse
-> GetMedicalVocabularyResponse -> Bool
$c== :: GetMedicalVocabularyResponse
-> GetMedicalVocabularyResponse -> Bool
Prelude.Eq, ReadPrec [GetMedicalVocabularyResponse]
ReadPrec GetMedicalVocabularyResponse
Int -> ReadS GetMedicalVocabularyResponse
ReadS [GetMedicalVocabularyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMedicalVocabularyResponse]
$creadListPrec :: ReadPrec [GetMedicalVocabularyResponse]
readPrec :: ReadPrec GetMedicalVocabularyResponse
$creadPrec :: ReadPrec GetMedicalVocabularyResponse
readList :: ReadS [GetMedicalVocabularyResponse]
$creadList :: ReadS [GetMedicalVocabularyResponse]
readsPrec :: Int -> ReadS GetMedicalVocabularyResponse
$creadsPrec :: Int -> ReadS GetMedicalVocabularyResponse
Prelude.Read, Int -> GetMedicalVocabularyResponse -> ShowS
[GetMedicalVocabularyResponse] -> ShowS
GetMedicalVocabularyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMedicalVocabularyResponse] -> ShowS
$cshowList :: [GetMedicalVocabularyResponse] -> ShowS
show :: GetMedicalVocabularyResponse -> String
$cshow :: GetMedicalVocabularyResponse -> String
showsPrec :: Int -> GetMedicalVocabularyResponse -> ShowS
$cshowsPrec :: Int -> GetMedicalVocabularyResponse -> ShowS
Prelude.Show, forall x.
Rep GetMedicalVocabularyResponse x -> GetMedicalVocabularyResponse
forall x.
GetMedicalVocabularyResponse -> Rep GetMedicalVocabularyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetMedicalVocabularyResponse x -> GetMedicalVocabularyResponse
$cfrom :: forall x.
GetMedicalVocabularyResponse -> Rep GetMedicalVocabularyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMedicalVocabularyResponse' 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:
--
-- 'downloadUri', 'getMedicalVocabularyResponse_downloadUri' - The S3 location where the specified custom medical vocabulary is stored;
-- use this URI to view or download the custom vocabulary.
--
-- 'failureReason', 'getMedicalVocabularyResponse_failureReason' - If @VocabularyState@ is @FAILED@, @FailureReason@ contains information
-- about why the custom medical vocabulary request failed. See also:
-- <https://docs.aws.amazon.com/transcribe/latest/APIReference/CommonErrors.html Common Errors>.
--
-- 'languageCode', 'getMedicalVocabularyResponse_languageCode' - The language code you selected for your custom medical vocabulary. US
-- English (@en-US@) is the only language supported with Amazon Transcribe
-- Medical.
--
-- 'lastModifiedTime', 'getMedicalVocabularyResponse_lastModifiedTime' - The date and time the specified custom medical vocabulary was last
-- modified.
--
-- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
-- example, @2022-05-04T12:32:58.761000-07:00@ represents 12:32 PM UTC-7 on
-- May 4, 2022.
--
-- 'vocabularyName', 'getMedicalVocabularyResponse_vocabularyName' - The name of the custom medical vocabulary you requested information
-- about.
--
-- 'vocabularyState', 'getMedicalVocabularyResponse_vocabularyState' - The processing state of your custom medical vocabulary. If the state is
-- @READY@, you can use the custom vocabulary in a
-- @StartMedicalTranscriptionJob@ request.
--
-- 'httpStatus', 'getMedicalVocabularyResponse_httpStatus' - The response's http status code.
newGetMedicalVocabularyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMedicalVocabularyResponse
newGetMedicalVocabularyResponse :: Int -> GetMedicalVocabularyResponse
newGetMedicalVocabularyResponse Int
pHttpStatus_ =
  GetMedicalVocabularyResponse'
    { $sel:downloadUri:GetMedicalVocabularyResponse' :: Maybe Text
downloadUri =
        forall a. Maybe a
Prelude.Nothing,
      $sel:failureReason:GetMedicalVocabularyResponse' :: Maybe Text
failureReason = forall a. Maybe a
Prelude.Nothing,
      $sel:languageCode:GetMedicalVocabularyResponse' :: Maybe LanguageCode
languageCode = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTime:GetMedicalVocabularyResponse' :: Maybe POSIX
lastModifiedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:vocabularyName:GetMedicalVocabularyResponse' :: Maybe Text
vocabularyName = forall a. Maybe a
Prelude.Nothing,
      $sel:vocabularyState:GetMedicalVocabularyResponse' :: Maybe VocabularyState
vocabularyState = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMedicalVocabularyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The S3 location where the specified custom medical vocabulary is stored;
-- use this URI to view or download the custom vocabulary.
getMedicalVocabularyResponse_downloadUri :: Lens.Lens' GetMedicalVocabularyResponse (Prelude.Maybe Prelude.Text)
getMedicalVocabularyResponse_downloadUri :: Lens' GetMedicalVocabularyResponse (Maybe Text)
getMedicalVocabularyResponse_downloadUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMedicalVocabularyResponse' {Maybe Text
downloadUri :: Maybe Text
$sel:downloadUri:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe Text
downloadUri} -> Maybe Text
downloadUri) (\s :: GetMedicalVocabularyResponse
s@GetMedicalVocabularyResponse' {} Maybe Text
a -> GetMedicalVocabularyResponse
s {$sel:downloadUri:GetMedicalVocabularyResponse' :: Maybe Text
downloadUri = Maybe Text
a} :: GetMedicalVocabularyResponse)

-- | If @VocabularyState@ is @FAILED@, @FailureReason@ contains information
-- about why the custom medical vocabulary request failed. See also:
-- <https://docs.aws.amazon.com/transcribe/latest/APIReference/CommonErrors.html Common Errors>.
getMedicalVocabularyResponse_failureReason :: Lens.Lens' GetMedicalVocabularyResponse (Prelude.Maybe Prelude.Text)
getMedicalVocabularyResponse_failureReason :: Lens' GetMedicalVocabularyResponse (Maybe Text)
getMedicalVocabularyResponse_failureReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMedicalVocabularyResponse' {Maybe Text
failureReason :: Maybe Text
$sel:failureReason:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe Text
failureReason} -> Maybe Text
failureReason) (\s :: GetMedicalVocabularyResponse
s@GetMedicalVocabularyResponse' {} Maybe Text
a -> GetMedicalVocabularyResponse
s {$sel:failureReason:GetMedicalVocabularyResponse' :: Maybe Text
failureReason = Maybe Text
a} :: GetMedicalVocabularyResponse)

-- | The language code you selected for your custom medical vocabulary. US
-- English (@en-US@) is the only language supported with Amazon Transcribe
-- Medical.
getMedicalVocabularyResponse_languageCode :: Lens.Lens' GetMedicalVocabularyResponse (Prelude.Maybe LanguageCode)
getMedicalVocabularyResponse_languageCode :: Lens' GetMedicalVocabularyResponse (Maybe LanguageCode)
getMedicalVocabularyResponse_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMedicalVocabularyResponse' {Maybe LanguageCode
languageCode :: Maybe LanguageCode
$sel:languageCode:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe LanguageCode
languageCode} -> Maybe LanguageCode
languageCode) (\s :: GetMedicalVocabularyResponse
s@GetMedicalVocabularyResponse' {} Maybe LanguageCode
a -> GetMedicalVocabularyResponse
s {$sel:languageCode:GetMedicalVocabularyResponse' :: Maybe LanguageCode
languageCode = Maybe LanguageCode
a} :: GetMedicalVocabularyResponse)

-- | The date and time the specified custom medical vocabulary was last
-- modified.
--
-- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
-- example, @2022-05-04T12:32:58.761000-07:00@ represents 12:32 PM UTC-7 on
-- May 4, 2022.
getMedicalVocabularyResponse_lastModifiedTime :: Lens.Lens' GetMedicalVocabularyResponse (Prelude.Maybe Prelude.UTCTime)
getMedicalVocabularyResponse_lastModifiedTime :: Lens' GetMedicalVocabularyResponse (Maybe UTCTime)
getMedicalVocabularyResponse_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMedicalVocabularyResponse' {Maybe POSIX
lastModifiedTime :: Maybe POSIX
$sel:lastModifiedTime:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe POSIX
lastModifiedTime} -> Maybe POSIX
lastModifiedTime) (\s :: GetMedicalVocabularyResponse
s@GetMedicalVocabularyResponse' {} Maybe POSIX
a -> GetMedicalVocabularyResponse
s {$sel:lastModifiedTime:GetMedicalVocabularyResponse' :: Maybe POSIX
lastModifiedTime = Maybe POSIX
a} :: GetMedicalVocabularyResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The name of the custom medical vocabulary you requested information
-- about.
getMedicalVocabularyResponse_vocabularyName :: Lens.Lens' GetMedicalVocabularyResponse (Prelude.Maybe Prelude.Text)
getMedicalVocabularyResponse_vocabularyName :: Lens' GetMedicalVocabularyResponse (Maybe Text)
getMedicalVocabularyResponse_vocabularyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMedicalVocabularyResponse' {Maybe Text
vocabularyName :: Maybe Text
$sel:vocabularyName:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe Text
vocabularyName} -> Maybe Text
vocabularyName) (\s :: GetMedicalVocabularyResponse
s@GetMedicalVocabularyResponse' {} Maybe Text
a -> GetMedicalVocabularyResponse
s {$sel:vocabularyName:GetMedicalVocabularyResponse' :: Maybe Text
vocabularyName = Maybe Text
a} :: GetMedicalVocabularyResponse)

-- | The processing state of your custom medical vocabulary. If the state is
-- @READY@, you can use the custom vocabulary in a
-- @StartMedicalTranscriptionJob@ request.
getMedicalVocabularyResponse_vocabularyState :: Lens.Lens' GetMedicalVocabularyResponse (Prelude.Maybe VocabularyState)
getMedicalVocabularyResponse_vocabularyState :: Lens' GetMedicalVocabularyResponse (Maybe VocabularyState)
getMedicalVocabularyResponse_vocabularyState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMedicalVocabularyResponse' {Maybe VocabularyState
vocabularyState :: Maybe VocabularyState
$sel:vocabularyState:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe VocabularyState
vocabularyState} -> Maybe VocabularyState
vocabularyState) (\s :: GetMedicalVocabularyResponse
s@GetMedicalVocabularyResponse' {} Maybe VocabularyState
a -> GetMedicalVocabularyResponse
s {$sel:vocabularyState:GetMedicalVocabularyResponse' :: Maybe VocabularyState
vocabularyState = Maybe VocabularyState
a} :: GetMedicalVocabularyResponse)

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

instance Prelude.NFData GetMedicalVocabularyResponse where
  rnf :: GetMedicalVocabularyResponse -> ()
rnf GetMedicalVocabularyResponse' {Int
Maybe Text
Maybe POSIX
Maybe LanguageCode
Maybe VocabularyState
httpStatus :: Int
vocabularyState :: Maybe VocabularyState
vocabularyName :: Maybe Text
lastModifiedTime :: Maybe POSIX
languageCode :: Maybe LanguageCode
failureReason :: Maybe Text
downloadUri :: Maybe Text
$sel:httpStatus:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Int
$sel:vocabularyState:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe VocabularyState
$sel:vocabularyName:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe Text
$sel:lastModifiedTime:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe POSIX
$sel:languageCode:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe LanguageCode
$sel:failureReason:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe Text
$sel:downloadUri:GetMedicalVocabularyResponse' :: GetMedicalVocabularyResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
downloadUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
failureReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LanguageCode
languageCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vocabularyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VocabularyState
vocabularyState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus