{-# 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.InferSNOMEDCT
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- InferSNOMEDCT detects possible medical concepts as entities and links
-- them to codes from the Systematized Nomenclature of Medicine, Clinical
-- Terms (SNOMED-CT) ontology
module Amazonka.ComprehendMedical.InferSNOMEDCT
  ( -- * Creating a Request
    InferSNOMEDCT (..),
    newInferSNOMEDCT,

    -- * Request Lenses
    inferSNOMEDCT_text,

    -- * Destructuring the Response
    InferSNOMEDCTResponse (..),
    newInferSNOMEDCTResponse,

    -- * Response Lenses
    inferSNOMEDCTResponse_characters,
    inferSNOMEDCTResponse_modelVersion,
    inferSNOMEDCTResponse_paginationToken,
    inferSNOMEDCTResponse_sNOMEDCTDetails,
    inferSNOMEDCTResponse_httpStatus,
    inferSNOMEDCTResponse_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:/ 'newInferSNOMEDCT' smart constructor.
data InferSNOMEDCT = InferSNOMEDCT'
  { -- | The input text to be analyzed using InferSNOMEDCT. The text should be a
    -- string with 1 to 10000 characters.
    InferSNOMEDCT -> Text
text :: Prelude.Text
  }
  deriving (InferSNOMEDCT -> InferSNOMEDCT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InferSNOMEDCT -> InferSNOMEDCT -> Bool
$c/= :: InferSNOMEDCT -> InferSNOMEDCT -> Bool
== :: InferSNOMEDCT -> InferSNOMEDCT -> Bool
$c== :: InferSNOMEDCT -> InferSNOMEDCT -> Bool
Prelude.Eq, ReadPrec [InferSNOMEDCT]
ReadPrec InferSNOMEDCT
Int -> ReadS InferSNOMEDCT
ReadS [InferSNOMEDCT]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InferSNOMEDCT]
$creadListPrec :: ReadPrec [InferSNOMEDCT]
readPrec :: ReadPrec InferSNOMEDCT
$creadPrec :: ReadPrec InferSNOMEDCT
readList :: ReadS [InferSNOMEDCT]
$creadList :: ReadS [InferSNOMEDCT]
readsPrec :: Int -> ReadS InferSNOMEDCT
$creadsPrec :: Int -> ReadS InferSNOMEDCT
Prelude.Read, Int -> InferSNOMEDCT -> ShowS
[InferSNOMEDCT] -> ShowS
InferSNOMEDCT -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InferSNOMEDCT] -> ShowS
$cshowList :: [InferSNOMEDCT] -> ShowS
show :: InferSNOMEDCT -> String
$cshow :: InferSNOMEDCT -> String
showsPrec :: Int -> InferSNOMEDCT -> ShowS
$cshowsPrec :: Int -> InferSNOMEDCT -> ShowS
Prelude.Show, forall x. Rep InferSNOMEDCT x -> InferSNOMEDCT
forall x. InferSNOMEDCT -> Rep InferSNOMEDCT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InferSNOMEDCT x -> InferSNOMEDCT
$cfrom :: forall x. InferSNOMEDCT -> Rep InferSNOMEDCT x
Prelude.Generic)

-- |
-- Create a value of 'InferSNOMEDCT' 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', 'inferSNOMEDCT_text' - The input text to be analyzed using InferSNOMEDCT. The text should be a
-- string with 1 to 10000 characters.
newInferSNOMEDCT ::
  -- | 'text'
  Prelude.Text ->
  InferSNOMEDCT
newInferSNOMEDCT :: Text -> InferSNOMEDCT
newInferSNOMEDCT Text
pText_ =
  InferSNOMEDCT' {$sel:text:InferSNOMEDCT' :: Text
text = Text
pText_}

-- | The input text to be analyzed using InferSNOMEDCT. The text should be a
-- string with 1 to 10000 characters.
inferSNOMEDCT_text :: Lens.Lens' InferSNOMEDCT Prelude.Text
inferSNOMEDCT_text :: Lens' InferSNOMEDCT Text
inferSNOMEDCT_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferSNOMEDCT' {Text
text :: Text
$sel:text:InferSNOMEDCT' :: InferSNOMEDCT -> Text
text} -> Text
text) (\s :: InferSNOMEDCT
s@InferSNOMEDCT' {} Text
a -> InferSNOMEDCT
s {$sel:text:InferSNOMEDCT' :: Text
text = Text
a} :: InferSNOMEDCT)

instance Core.AWSRequest InferSNOMEDCT where
  type
    AWSResponse InferSNOMEDCT =
      InferSNOMEDCTResponse
  request :: (Service -> Service) -> InferSNOMEDCT -> Request InferSNOMEDCT
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 InferSNOMEDCT
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse InferSNOMEDCT)))
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 Characters
-> Maybe Text
-> Maybe Text
-> Maybe SNOMEDCTDetails
-> Int
-> [SNOMEDCTEntity]
-> InferSNOMEDCTResponse
InferSNOMEDCTResponse'
            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
"Characters")
            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
"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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SNOMEDCTDetails")
            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 InferSNOMEDCT where
  hashWithSalt :: Int -> InferSNOMEDCT -> Int
hashWithSalt Int
_salt InferSNOMEDCT' {Text
text :: Text
$sel:text:InferSNOMEDCT' :: InferSNOMEDCT -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
text

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

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

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

-- | /See:/ 'newInferSNOMEDCTResponse' smart constructor.
data InferSNOMEDCTResponse = InferSNOMEDCTResponse'
  { -- | The number of characters in the input request documentation.
    InferSNOMEDCTResponse -> Maybe Characters
characters :: Prelude.Maybe Characters,
    -- | 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.
    InferSNOMEDCTResponse -> Maybe Text
modelVersion :: Prelude.Maybe Prelude.Text,
    -- | If the result of the request is truncated, the pagination token can be
    -- used to fetch the next page of entities.
    InferSNOMEDCTResponse -> Maybe Text
paginationToken :: Prelude.Maybe Prelude.Text,
    -- | The details of the SNOMED-CT revision, including the edition, language,
    -- and version date.
    InferSNOMEDCTResponse -> Maybe SNOMEDCTDetails
sNOMEDCTDetails :: Prelude.Maybe SNOMEDCTDetails,
    -- | The response's http status code.
    InferSNOMEDCTResponse -> Int
httpStatus :: Prelude.Int,
    -- | The collection of medical concept entities extracted from the input text
    -- and their associated information. For each entity, the response provides
    -- the entity text, the entity category, where the entity text begins and
    -- ends, and the level of confidence that Comprehend Medical has in the
    -- detection and analysis. Attributes and traits of the entity are also
    -- returned.
    InferSNOMEDCTResponse -> [SNOMEDCTEntity]
entities :: [SNOMEDCTEntity]
  }
  deriving (InferSNOMEDCTResponse -> InferSNOMEDCTResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InferSNOMEDCTResponse -> InferSNOMEDCTResponse -> Bool
$c/= :: InferSNOMEDCTResponse -> InferSNOMEDCTResponse -> Bool
== :: InferSNOMEDCTResponse -> InferSNOMEDCTResponse -> Bool
$c== :: InferSNOMEDCTResponse -> InferSNOMEDCTResponse -> Bool
Prelude.Eq, ReadPrec [InferSNOMEDCTResponse]
ReadPrec InferSNOMEDCTResponse
Int -> ReadS InferSNOMEDCTResponse
ReadS [InferSNOMEDCTResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InferSNOMEDCTResponse]
$creadListPrec :: ReadPrec [InferSNOMEDCTResponse]
readPrec :: ReadPrec InferSNOMEDCTResponse
$creadPrec :: ReadPrec InferSNOMEDCTResponse
readList :: ReadS [InferSNOMEDCTResponse]
$creadList :: ReadS [InferSNOMEDCTResponse]
readsPrec :: Int -> ReadS InferSNOMEDCTResponse
$creadsPrec :: Int -> ReadS InferSNOMEDCTResponse
Prelude.Read, Int -> InferSNOMEDCTResponse -> ShowS
[InferSNOMEDCTResponse] -> ShowS
InferSNOMEDCTResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InferSNOMEDCTResponse] -> ShowS
$cshowList :: [InferSNOMEDCTResponse] -> ShowS
show :: InferSNOMEDCTResponse -> String
$cshow :: InferSNOMEDCTResponse -> String
showsPrec :: Int -> InferSNOMEDCTResponse -> ShowS
$cshowsPrec :: Int -> InferSNOMEDCTResponse -> ShowS
Prelude.Show, forall x. Rep InferSNOMEDCTResponse x -> InferSNOMEDCTResponse
forall x. InferSNOMEDCTResponse -> Rep InferSNOMEDCTResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InferSNOMEDCTResponse x -> InferSNOMEDCTResponse
$cfrom :: forall x. InferSNOMEDCTResponse -> Rep InferSNOMEDCTResponse x
Prelude.Generic)

-- |
-- Create a value of 'InferSNOMEDCTResponse' 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:
--
-- 'characters', 'inferSNOMEDCTResponse_characters' - The number of characters in the input request documentation.
--
-- 'modelVersion', 'inferSNOMEDCTResponse_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', 'inferSNOMEDCTResponse_paginationToken' - If the result of the request is truncated, the pagination token can be
-- used to fetch the next page of entities.
--
-- 'sNOMEDCTDetails', 'inferSNOMEDCTResponse_sNOMEDCTDetails' - The details of the SNOMED-CT revision, including the edition, language,
-- and version date.
--
-- 'httpStatus', 'inferSNOMEDCTResponse_httpStatus' - The response's http status code.
--
-- 'entities', 'inferSNOMEDCTResponse_entities' - The collection of medical concept entities extracted from the input text
-- and their associated information. For each entity, the response provides
-- the entity text, the entity category, where the entity text begins and
-- ends, and the level of confidence that Comprehend Medical has in the
-- detection and analysis. Attributes and traits of the entity are also
-- returned.
newInferSNOMEDCTResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  InferSNOMEDCTResponse
newInferSNOMEDCTResponse :: Int -> InferSNOMEDCTResponse
newInferSNOMEDCTResponse Int
pHttpStatus_ =
  InferSNOMEDCTResponse'
    { $sel:characters:InferSNOMEDCTResponse' :: Maybe Characters
characters =
        forall a. Maybe a
Prelude.Nothing,
      $sel:modelVersion:InferSNOMEDCTResponse' :: Maybe Text
modelVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:paginationToken:InferSNOMEDCTResponse' :: Maybe Text
paginationToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sNOMEDCTDetails:InferSNOMEDCTResponse' :: Maybe SNOMEDCTDetails
sNOMEDCTDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:InferSNOMEDCTResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:entities:InferSNOMEDCTResponse' :: [SNOMEDCTEntity]
entities = forall a. Monoid a => a
Prelude.mempty
    }

-- | The number of characters in the input request documentation.
inferSNOMEDCTResponse_characters :: Lens.Lens' InferSNOMEDCTResponse (Prelude.Maybe Characters)
inferSNOMEDCTResponse_characters :: Lens' InferSNOMEDCTResponse (Maybe Characters)
inferSNOMEDCTResponse_characters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferSNOMEDCTResponse' {Maybe Characters
characters :: Maybe Characters
$sel:characters:InferSNOMEDCTResponse' :: InferSNOMEDCTResponse -> Maybe Characters
characters} -> Maybe Characters
characters) (\s :: InferSNOMEDCTResponse
s@InferSNOMEDCTResponse' {} Maybe Characters
a -> InferSNOMEDCTResponse
s {$sel:characters:InferSNOMEDCTResponse' :: Maybe Characters
characters = Maybe Characters
a} :: InferSNOMEDCTResponse)

-- | 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.
inferSNOMEDCTResponse_modelVersion :: Lens.Lens' InferSNOMEDCTResponse (Prelude.Maybe Prelude.Text)
inferSNOMEDCTResponse_modelVersion :: Lens' InferSNOMEDCTResponse (Maybe Text)
inferSNOMEDCTResponse_modelVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferSNOMEDCTResponse' {Maybe Text
modelVersion :: Maybe Text
$sel:modelVersion:InferSNOMEDCTResponse' :: InferSNOMEDCTResponse -> Maybe Text
modelVersion} -> Maybe Text
modelVersion) (\s :: InferSNOMEDCTResponse
s@InferSNOMEDCTResponse' {} Maybe Text
a -> InferSNOMEDCTResponse
s {$sel:modelVersion:InferSNOMEDCTResponse' :: Maybe Text
modelVersion = Maybe Text
a} :: InferSNOMEDCTResponse)

-- | If the result of the request is truncated, the pagination token can be
-- used to fetch the next page of entities.
inferSNOMEDCTResponse_paginationToken :: Lens.Lens' InferSNOMEDCTResponse (Prelude.Maybe Prelude.Text)
inferSNOMEDCTResponse_paginationToken :: Lens' InferSNOMEDCTResponse (Maybe Text)
inferSNOMEDCTResponse_paginationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferSNOMEDCTResponse' {Maybe Text
paginationToken :: Maybe Text
$sel:paginationToken:InferSNOMEDCTResponse' :: InferSNOMEDCTResponse -> Maybe Text
paginationToken} -> Maybe Text
paginationToken) (\s :: InferSNOMEDCTResponse
s@InferSNOMEDCTResponse' {} Maybe Text
a -> InferSNOMEDCTResponse
s {$sel:paginationToken:InferSNOMEDCTResponse' :: Maybe Text
paginationToken = Maybe Text
a} :: InferSNOMEDCTResponse)

-- | The details of the SNOMED-CT revision, including the edition, language,
-- and version date.
inferSNOMEDCTResponse_sNOMEDCTDetails :: Lens.Lens' InferSNOMEDCTResponse (Prelude.Maybe SNOMEDCTDetails)
inferSNOMEDCTResponse_sNOMEDCTDetails :: Lens' InferSNOMEDCTResponse (Maybe SNOMEDCTDetails)
inferSNOMEDCTResponse_sNOMEDCTDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferSNOMEDCTResponse' {Maybe SNOMEDCTDetails
sNOMEDCTDetails :: Maybe SNOMEDCTDetails
$sel:sNOMEDCTDetails:InferSNOMEDCTResponse' :: InferSNOMEDCTResponse -> Maybe SNOMEDCTDetails
sNOMEDCTDetails} -> Maybe SNOMEDCTDetails
sNOMEDCTDetails) (\s :: InferSNOMEDCTResponse
s@InferSNOMEDCTResponse' {} Maybe SNOMEDCTDetails
a -> InferSNOMEDCTResponse
s {$sel:sNOMEDCTDetails:InferSNOMEDCTResponse' :: Maybe SNOMEDCTDetails
sNOMEDCTDetails = Maybe SNOMEDCTDetails
a} :: InferSNOMEDCTResponse)

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

-- | The collection of medical concept entities extracted from the input text
-- and their associated information. For each entity, the response provides
-- the entity text, the entity category, where the entity text begins and
-- ends, and the level of confidence that Comprehend Medical has in the
-- detection and analysis. Attributes and traits of the entity are also
-- returned.
inferSNOMEDCTResponse_entities :: Lens.Lens' InferSNOMEDCTResponse [SNOMEDCTEntity]
inferSNOMEDCTResponse_entities :: Lens' InferSNOMEDCTResponse [SNOMEDCTEntity]
inferSNOMEDCTResponse_entities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferSNOMEDCTResponse' {[SNOMEDCTEntity]
entities :: [SNOMEDCTEntity]
$sel:entities:InferSNOMEDCTResponse' :: InferSNOMEDCTResponse -> [SNOMEDCTEntity]
entities} -> [SNOMEDCTEntity]
entities) (\s :: InferSNOMEDCTResponse
s@InferSNOMEDCTResponse' {} [SNOMEDCTEntity]
a -> InferSNOMEDCTResponse
s {$sel:entities:InferSNOMEDCTResponse' :: [SNOMEDCTEntity]
entities = [SNOMEDCTEntity]
a} :: InferSNOMEDCTResponse) 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 InferSNOMEDCTResponse where
  rnf :: InferSNOMEDCTResponse -> ()
rnf InferSNOMEDCTResponse' {Int
[SNOMEDCTEntity]
Maybe Text
Maybe Characters
Maybe SNOMEDCTDetails
entities :: [SNOMEDCTEntity]
httpStatus :: Int
sNOMEDCTDetails :: Maybe SNOMEDCTDetails
paginationToken :: Maybe Text
modelVersion :: Maybe Text
characters :: Maybe Characters
$sel:entities:InferSNOMEDCTResponse' :: InferSNOMEDCTResponse -> [SNOMEDCTEntity]
$sel:httpStatus:InferSNOMEDCTResponse' :: InferSNOMEDCTResponse -> Int
$sel:sNOMEDCTDetails:InferSNOMEDCTResponse' :: InferSNOMEDCTResponse -> Maybe SNOMEDCTDetails
$sel:paginationToken:InferSNOMEDCTResponse' :: InferSNOMEDCTResponse -> Maybe Text
$sel:modelVersion:InferSNOMEDCTResponse' :: InferSNOMEDCTResponse -> Maybe Text
$sel:characters:InferSNOMEDCTResponse' :: InferSNOMEDCTResponse -> Maybe Characters
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Characters
characters
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe SNOMEDCTDetails
sNOMEDCTDetails
      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 [SNOMEDCTEntity]
entities