{-# 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.ComprehendMedical.InferICD10CM
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- InferICD10CM detects medical conditions as entities listed in a patient
-- record and links those entities to normalized concept identifiers in the
-- ICD-10-CM knowledge base from the Centers for Disease Control. Amazon
-- Comprehend Medical only detects medical entities in English language
-- texts.
module Amazonka.ComprehendMedical.InferICD10CM
  ( -- * Creating a Request
    InferICD10CM (..),
    newInferICD10CM,

    -- * Request Lenses
    inferICD10CM_text,

    -- * Destructuring the Response
    InferICD10CMResponse (..),
    newInferICD10CMResponse,

    -- * Response Lenses
    inferICD10CMResponse_modelVersion,
    inferICD10CMResponse_paginationToken,
    inferICD10CMResponse_httpStatus,
    inferICD10CMResponse_entities,
  )
where

import Amazonka.ComprehendMedical.Types
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

-- | /See:/ 'newInferICD10CM' smart constructor.
data InferICD10CM = InferICD10CM'
  { -- | The input text used for analysis. The input for InferICD10CM is a string
    -- from 1 to 10000 characters.
    InferICD10CM -> Text
text :: Prelude.Text
  }
  deriving (InferICD10CM -> InferICD10CM -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InferICD10CM -> InferICD10CM -> Bool
$c/= :: InferICD10CM -> InferICD10CM -> Bool
== :: InferICD10CM -> InferICD10CM -> Bool
$c== :: InferICD10CM -> InferICD10CM -> Bool
Prelude.Eq, ReadPrec [InferICD10CM]
ReadPrec InferICD10CM
Int -> ReadS InferICD10CM
ReadS [InferICD10CM]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InferICD10CM]
$creadListPrec :: ReadPrec [InferICD10CM]
readPrec :: ReadPrec InferICD10CM
$creadPrec :: ReadPrec InferICD10CM
readList :: ReadS [InferICD10CM]
$creadList :: ReadS [InferICD10CM]
readsPrec :: Int -> ReadS InferICD10CM
$creadsPrec :: Int -> ReadS InferICD10CM
Prelude.Read, Int -> InferICD10CM -> ShowS
[InferICD10CM] -> ShowS
InferICD10CM -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InferICD10CM] -> ShowS
$cshowList :: [InferICD10CM] -> ShowS
show :: InferICD10CM -> String
$cshow :: InferICD10CM -> String
showsPrec :: Int -> InferICD10CM -> ShowS
$cshowsPrec :: Int -> InferICD10CM -> ShowS
Prelude.Show, forall x. Rep InferICD10CM x -> InferICD10CM
forall x. InferICD10CM -> Rep InferICD10CM x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InferICD10CM x -> InferICD10CM
$cfrom :: forall x. InferICD10CM -> Rep InferICD10CM x
Prelude.Generic)

-- |
-- Create a value of 'InferICD10CM' 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:
--
-- 'text', 'inferICD10CM_text' - The input text used for analysis. The input for InferICD10CM is a string
-- from 1 to 10000 characters.
newInferICD10CM ::
  -- | 'text'
  Prelude.Text ->
  InferICD10CM
newInferICD10CM :: Text -> InferICD10CM
newInferICD10CM Text
pText_ = InferICD10CM' {$sel:text:InferICD10CM' :: Text
text = Text
pText_}

-- | The input text used for analysis. The input for InferICD10CM is a string
-- from 1 to 10000 characters.
inferICD10CM_text :: Lens.Lens' InferICD10CM Prelude.Text
inferICD10CM_text :: Lens' InferICD10CM Text
inferICD10CM_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferICD10CM' {Text
text :: Text
$sel:text:InferICD10CM' :: InferICD10CM -> Text
text} -> Text
text) (\s :: InferICD10CM
s@InferICD10CM' {} Text
a -> InferICD10CM
s {$sel:text:InferICD10CM' :: Text
text = Text
a} :: InferICD10CM)

instance Core.AWSRequest InferICD10CM where
  type AWSResponse InferICD10CM = InferICD10CMResponse
  request :: (Service -> Service) -> InferICD10CM -> Request InferICD10CM
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 InferICD10CM
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse InferICD10CM)))
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 -> Int -> [ICD10CMEntity] -> InferICD10CMResponse
InferICD10CMResponse'
            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
"ModelVersion")
            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
"PaginationToken")
            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))
            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
"Entities" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

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

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

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

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

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

-- | /See:/ 'newInferICD10CMResponse' smart constructor.
data InferICD10CMResponse = InferICD10CMResponse'
  { -- | The version of the model used to analyze the documents, in the format
    -- /n/./n/./n/ You can use this information to track the model used for a
    -- particular batch of documents.
    InferICD10CMResponse -> Maybe Text
modelVersion :: Prelude.Maybe Prelude.Text,
    -- | If the result of the previous request to @InferICD10CM@ was truncated,
    -- include the @PaginationToken@ to fetch the next page of medical
    -- condition entities.
    InferICD10CMResponse -> Maybe Text
paginationToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    InferICD10CMResponse -> Int
httpStatus :: Prelude.Int,
    -- | The medical conditions detected in the text linked to ICD-10-CM
    -- concepts. If the action is successful, the service sends back an HTTP
    -- 200 response, as well as the entities detected.
    InferICD10CMResponse -> [ICD10CMEntity]
entities :: [ICD10CMEntity]
  }
  deriving (InferICD10CMResponse -> InferICD10CMResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InferICD10CMResponse -> InferICD10CMResponse -> Bool
$c/= :: InferICD10CMResponse -> InferICD10CMResponse -> Bool
== :: InferICD10CMResponse -> InferICD10CMResponse -> Bool
$c== :: InferICD10CMResponse -> InferICD10CMResponse -> Bool
Prelude.Eq, ReadPrec [InferICD10CMResponse]
ReadPrec InferICD10CMResponse
Int -> ReadS InferICD10CMResponse
ReadS [InferICD10CMResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InferICD10CMResponse]
$creadListPrec :: ReadPrec [InferICD10CMResponse]
readPrec :: ReadPrec InferICD10CMResponse
$creadPrec :: ReadPrec InferICD10CMResponse
readList :: ReadS [InferICD10CMResponse]
$creadList :: ReadS [InferICD10CMResponse]
readsPrec :: Int -> ReadS InferICD10CMResponse
$creadsPrec :: Int -> ReadS InferICD10CMResponse
Prelude.Read, Int -> InferICD10CMResponse -> ShowS
[InferICD10CMResponse] -> ShowS
InferICD10CMResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InferICD10CMResponse] -> ShowS
$cshowList :: [InferICD10CMResponse] -> ShowS
show :: InferICD10CMResponse -> String
$cshow :: InferICD10CMResponse -> String
showsPrec :: Int -> InferICD10CMResponse -> ShowS
$cshowsPrec :: Int -> InferICD10CMResponse -> ShowS
Prelude.Show, forall x. Rep InferICD10CMResponse x -> InferICD10CMResponse
forall x. InferICD10CMResponse -> Rep InferICD10CMResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InferICD10CMResponse x -> InferICD10CMResponse
$cfrom :: forall x. InferICD10CMResponse -> Rep InferICD10CMResponse x
Prelude.Generic)

-- |
-- Create a value of 'InferICD10CMResponse' 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:
--
-- 'modelVersion', 'inferICD10CMResponse_modelVersion' - The version of the model used to analyze the documents, in the format
-- /n/./n/./n/ You can use this information to track the model used for a
-- particular batch of documents.
--
-- 'paginationToken', 'inferICD10CMResponse_paginationToken' - If the result of the previous request to @InferICD10CM@ was truncated,
-- include the @PaginationToken@ to fetch the next page of medical
-- condition entities.
--
-- 'httpStatus', 'inferICD10CMResponse_httpStatus' - The response's http status code.
--
-- 'entities', 'inferICD10CMResponse_entities' - The medical conditions detected in the text linked to ICD-10-CM
-- concepts. If the action is successful, the service sends back an HTTP
-- 200 response, as well as the entities detected.
newInferICD10CMResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  InferICD10CMResponse
newInferICD10CMResponse :: Int -> InferICD10CMResponse
newInferICD10CMResponse Int
pHttpStatus_ =
  InferICD10CMResponse'
    { $sel:modelVersion:InferICD10CMResponse' :: Maybe Text
modelVersion =
        forall a. Maybe a
Prelude.Nothing,
      $sel:paginationToken:InferICD10CMResponse' :: Maybe Text
paginationToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:InferICD10CMResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:entities:InferICD10CMResponse' :: [ICD10CMEntity]
entities = forall a. Monoid a => a
Prelude.mempty
    }

-- | The version of the model used to analyze the documents, in the format
-- /n/./n/./n/ You can use this information to track the model used for a
-- particular batch of documents.
inferICD10CMResponse_modelVersion :: Lens.Lens' InferICD10CMResponse (Prelude.Maybe Prelude.Text)
inferICD10CMResponse_modelVersion :: Lens' InferICD10CMResponse (Maybe Text)
inferICD10CMResponse_modelVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferICD10CMResponse' {Maybe Text
modelVersion :: Maybe Text
$sel:modelVersion:InferICD10CMResponse' :: InferICD10CMResponse -> Maybe Text
modelVersion} -> Maybe Text
modelVersion) (\s :: InferICD10CMResponse
s@InferICD10CMResponse' {} Maybe Text
a -> InferICD10CMResponse
s {$sel:modelVersion:InferICD10CMResponse' :: Maybe Text
modelVersion = Maybe Text
a} :: InferICD10CMResponse)

-- | If the result of the previous request to @InferICD10CM@ was truncated,
-- include the @PaginationToken@ to fetch the next page of medical
-- condition entities.
inferICD10CMResponse_paginationToken :: Lens.Lens' InferICD10CMResponse (Prelude.Maybe Prelude.Text)
inferICD10CMResponse_paginationToken :: Lens' InferICD10CMResponse (Maybe Text)
inferICD10CMResponse_paginationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferICD10CMResponse' {Maybe Text
paginationToken :: Maybe Text
$sel:paginationToken:InferICD10CMResponse' :: InferICD10CMResponse -> Maybe Text
paginationToken} -> Maybe Text
paginationToken) (\s :: InferICD10CMResponse
s@InferICD10CMResponse' {} Maybe Text
a -> InferICD10CMResponse
s {$sel:paginationToken:InferICD10CMResponse' :: Maybe Text
paginationToken = Maybe Text
a} :: InferICD10CMResponse)

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

-- | The medical conditions detected in the text linked to ICD-10-CM
-- concepts. If the action is successful, the service sends back an HTTP
-- 200 response, as well as the entities detected.
inferICD10CMResponse_entities :: Lens.Lens' InferICD10CMResponse [ICD10CMEntity]
inferICD10CMResponse_entities :: Lens' InferICD10CMResponse [ICD10CMEntity]
inferICD10CMResponse_entities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferICD10CMResponse' {[ICD10CMEntity]
entities :: [ICD10CMEntity]
$sel:entities:InferICD10CMResponse' :: InferICD10CMResponse -> [ICD10CMEntity]
entities} -> [ICD10CMEntity]
entities) (\s :: InferICD10CMResponse
s@InferICD10CMResponse' {} [ICD10CMEntity]
a -> InferICD10CMResponse
s {$sel:entities:InferICD10CMResponse' :: [ICD10CMEntity]
entities = [ICD10CMEntity]
a} :: InferICD10CMResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData InferICD10CMResponse where
  rnf :: InferICD10CMResponse -> ()
rnf InferICD10CMResponse' {Int
[ICD10CMEntity]
Maybe Text
entities :: [ICD10CMEntity]
httpStatus :: Int
paginationToken :: Maybe Text
modelVersion :: Maybe Text
$sel:entities:InferICD10CMResponse' :: InferICD10CMResponse -> [ICD10CMEntity]
$sel:httpStatus:InferICD10CMResponse' :: InferICD10CMResponse -> Int
$sel:paginationToken:InferICD10CMResponse' :: InferICD10CMResponse -> Maybe Text
$sel:modelVersion:InferICD10CMResponse' :: InferICD10CMResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
paginationToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ICD10CMEntity]
entities