{-# 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.InferRxNorm
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- InferRxNorm detects medications as entities listed in a patient record
-- and links to the normalized concept identifiers in the RxNorm database
-- from the National Library of Medicine. Amazon Comprehend Medical only
-- detects medical entities in English language texts.
module Amazonka.ComprehendMedical.InferRxNorm
  ( -- * Creating a Request
    InferRxNorm (..),
    newInferRxNorm,

    -- * Request Lenses
    inferRxNorm_text,

    -- * Destructuring the Response
    InferRxNormResponse (..),
    newInferRxNormResponse,

    -- * Response Lenses
    inferRxNormResponse_modelVersion,
    inferRxNormResponse_paginationToken,
    inferRxNormResponse_httpStatus,
    inferRxNormResponse_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:/ 'newInferRxNorm' smart constructor.
data InferRxNorm = InferRxNorm'
  { -- | The input text used for analysis. The input for InferRxNorm is a string
    -- from 1 to 10000 characters.
    InferRxNorm -> Text
text :: Prelude.Text
  }
  deriving (InferRxNorm -> InferRxNorm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InferRxNorm -> InferRxNorm -> Bool
$c/= :: InferRxNorm -> InferRxNorm -> Bool
== :: InferRxNorm -> InferRxNorm -> Bool
$c== :: InferRxNorm -> InferRxNorm -> Bool
Prelude.Eq, ReadPrec [InferRxNorm]
ReadPrec InferRxNorm
Int -> ReadS InferRxNorm
ReadS [InferRxNorm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InferRxNorm]
$creadListPrec :: ReadPrec [InferRxNorm]
readPrec :: ReadPrec InferRxNorm
$creadPrec :: ReadPrec InferRxNorm
readList :: ReadS [InferRxNorm]
$creadList :: ReadS [InferRxNorm]
readsPrec :: Int -> ReadS InferRxNorm
$creadsPrec :: Int -> ReadS InferRxNorm
Prelude.Read, Int -> InferRxNorm -> ShowS
[InferRxNorm] -> ShowS
InferRxNorm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InferRxNorm] -> ShowS
$cshowList :: [InferRxNorm] -> ShowS
show :: InferRxNorm -> String
$cshow :: InferRxNorm -> String
showsPrec :: Int -> InferRxNorm -> ShowS
$cshowsPrec :: Int -> InferRxNorm -> ShowS
Prelude.Show, forall x. Rep InferRxNorm x -> InferRxNorm
forall x. InferRxNorm -> Rep InferRxNorm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InferRxNorm x -> InferRxNorm
$cfrom :: forall x. InferRxNorm -> Rep InferRxNorm x
Prelude.Generic)

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

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

instance Core.AWSRequest InferRxNorm where
  type AWSResponse InferRxNorm = InferRxNormResponse
  request :: (Service -> Service) -> InferRxNorm -> Request InferRxNorm
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 InferRxNorm
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse InferRxNorm)))
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 -> [RxNormEntity] -> InferRxNormResponse
InferRxNormResponse'
            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 InferRxNorm where
  hashWithSalt :: Int -> InferRxNorm -> Int
hashWithSalt Int
_salt InferRxNorm' {Text
text :: Text
$sel:text:InferRxNorm' :: InferRxNorm -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
text

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

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

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

-- | /See:/ 'newInferRxNormResponse' smart constructor.
data InferRxNormResponse = InferRxNormResponse'
  { -- | 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.
    InferRxNormResponse -> Maybe Text
modelVersion :: Prelude.Maybe Prelude.Text,
    -- | If the result of the previous request to @InferRxNorm@ was truncated,
    -- include the @PaginationToken@ to fetch the next page of medication
    -- entities.
    InferRxNormResponse -> Maybe Text
paginationToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    InferRxNormResponse -> Int
httpStatus :: Prelude.Int,
    -- | The medication entities detected in the text linked to RxNorm concepts.
    -- If the action is successful, the service sends back an HTTP 200
    -- response, as well as the entities detected.
    InferRxNormResponse -> [RxNormEntity]
entities :: [RxNormEntity]
  }
  deriving (InferRxNormResponse -> InferRxNormResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InferRxNormResponse -> InferRxNormResponse -> Bool
$c/= :: InferRxNormResponse -> InferRxNormResponse -> Bool
== :: InferRxNormResponse -> InferRxNormResponse -> Bool
$c== :: InferRxNormResponse -> InferRxNormResponse -> Bool
Prelude.Eq, ReadPrec [InferRxNormResponse]
ReadPrec InferRxNormResponse
Int -> ReadS InferRxNormResponse
ReadS [InferRxNormResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InferRxNormResponse]
$creadListPrec :: ReadPrec [InferRxNormResponse]
readPrec :: ReadPrec InferRxNormResponse
$creadPrec :: ReadPrec InferRxNormResponse
readList :: ReadS [InferRxNormResponse]
$creadList :: ReadS [InferRxNormResponse]
readsPrec :: Int -> ReadS InferRxNormResponse
$creadsPrec :: Int -> ReadS InferRxNormResponse
Prelude.Read, Int -> InferRxNormResponse -> ShowS
[InferRxNormResponse] -> ShowS
InferRxNormResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InferRxNormResponse] -> ShowS
$cshowList :: [InferRxNormResponse] -> ShowS
show :: InferRxNormResponse -> String
$cshow :: InferRxNormResponse -> String
showsPrec :: Int -> InferRxNormResponse -> ShowS
$cshowsPrec :: Int -> InferRxNormResponse -> ShowS
Prelude.Show, forall x. Rep InferRxNormResponse x -> InferRxNormResponse
forall x. InferRxNormResponse -> Rep InferRxNormResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InferRxNormResponse x -> InferRxNormResponse
$cfrom :: forall x. InferRxNormResponse -> Rep InferRxNormResponse x
Prelude.Generic)

-- |
-- Create a value of 'InferRxNormResponse' 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', 'inferRxNormResponse_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', 'inferRxNormResponse_paginationToken' - If the result of the previous request to @InferRxNorm@ was truncated,
-- include the @PaginationToken@ to fetch the next page of medication
-- entities.
--
-- 'httpStatus', 'inferRxNormResponse_httpStatus' - The response's http status code.
--
-- 'entities', 'inferRxNormResponse_entities' - The medication entities detected in the text linked to RxNorm concepts.
-- If the action is successful, the service sends back an HTTP 200
-- response, as well as the entities detected.
newInferRxNormResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  InferRxNormResponse
newInferRxNormResponse :: Int -> InferRxNormResponse
newInferRxNormResponse Int
pHttpStatus_ =
  InferRxNormResponse'
    { $sel:modelVersion:InferRxNormResponse' :: Maybe Text
modelVersion =
        forall a. Maybe a
Prelude.Nothing,
      $sel:paginationToken:InferRxNormResponse' :: Maybe Text
paginationToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:InferRxNormResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:entities:InferRxNormResponse' :: [RxNormEntity]
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.
inferRxNormResponse_modelVersion :: Lens.Lens' InferRxNormResponse (Prelude.Maybe Prelude.Text)
inferRxNormResponse_modelVersion :: Lens' InferRxNormResponse (Maybe Text)
inferRxNormResponse_modelVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferRxNormResponse' {Maybe Text
modelVersion :: Maybe Text
$sel:modelVersion:InferRxNormResponse' :: InferRxNormResponse -> Maybe Text
modelVersion} -> Maybe Text
modelVersion) (\s :: InferRxNormResponse
s@InferRxNormResponse' {} Maybe Text
a -> InferRxNormResponse
s {$sel:modelVersion:InferRxNormResponse' :: Maybe Text
modelVersion = Maybe Text
a} :: InferRxNormResponse)

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

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

-- | The medication entities detected in the text linked to RxNorm concepts.
-- If the action is successful, the service sends back an HTTP 200
-- response, as well as the entities detected.
inferRxNormResponse_entities :: Lens.Lens' InferRxNormResponse [RxNormEntity]
inferRxNormResponse_entities :: Lens' InferRxNormResponse [RxNormEntity]
inferRxNormResponse_entities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferRxNormResponse' {[RxNormEntity]
entities :: [RxNormEntity]
$sel:entities:InferRxNormResponse' :: InferRxNormResponse -> [RxNormEntity]
entities} -> [RxNormEntity]
entities) (\s :: InferRxNormResponse
s@InferRxNormResponse' {} [RxNormEntity]
a -> InferRxNormResponse
s {$sel:entities:InferRxNormResponse' :: [RxNormEntity]
entities = [RxNormEntity]
a} :: InferRxNormResponse) 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 InferRxNormResponse where
  rnf :: InferRxNormResponse -> ()
rnf InferRxNormResponse' {Int
[RxNormEntity]
Maybe Text
entities :: [RxNormEntity]
httpStatus :: Int
paginationToken :: Maybe Text
modelVersion :: Maybe Text
$sel:entities:InferRxNormResponse' :: InferRxNormResponse -> [RxNormEntity]
$sel:httpStatus:InferRxNormResponse' :: InferRxNormResponse -> Int
$sel:paginationToken:InferRxNormResponse' :: InferRxNormResponse -> Maybe Text
$sel:modelVersion:InferRxNormResponse' :: InferRxNormResponse -> 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 [RxNormEntity]
entities