{-# 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.DetectEntitiesV2
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Inspects the clinical text for a variety of medical entities and returns
-- specific information about them such as entity category, location, and
-- confidence score on that information. Amazon Comprehend Medical only
-- detects medical entities in English language texts.
--
-- The @DetectEntitiesV2@ operation replaces the DetectEntities operation.
-- This new action uses a different model for determining the entities in
-- your medical text and changes the way that some entities are returned in
-- the output. You should use the @DetectEntitiesV2@ operation in all new
-- applications.
--
-- The @DetectEntitiesV2@ operation returns the @Acuity@ and @Direction@
-- entities as attributes instead of types.
module Amazonka.ComprehendMedical.DetectEntitiesV2
  ( -- * Creating a Request
    DetectEntitiesV2 (..),
    newDetectEntitiesV2,

    -- * Request Lenses
    detectEntitiesV2_text,

    -- * Destructuring the Response
    DetectEntitiesV2Response (..),
    newDetectEntitiesV2Response,

    -- * Response Lenses
    detectEntitiesV2Response_paginationToken,
    detectEntitiesV2Response_unmappedAttributes,
    detectEntitiesV2Response_httpStatus,
    detectEntitiesV2Response_entities,
    detectEntitiesV2Response_modelVersion,
  )
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:/ 'newDetectEntitiesV2' smart constructor.
data DetectEntitiesV2 = DetectEntitiesV2'
  { -- | A UTF-8 string containing the clinical content being examined for
    -- entities. Each string must contain fewer than 20,000 bytes of
    -- characters.
    DetectEntitiesV2 -> Text
text :: Prelude.Text
  }
  deriving (DetectEntitiesV2 -> DetectEntitiesV2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectEntitiesV2 -> DetectEntitiesV2 -> Bool
$c/= :: DetectEntitiesV2 -> DetectEntitiesV2 -> Bool
== :: DetectEntitiesV2 -> DetectEntitiesV2 -> Bool
$c== :: DetectEntitiesV2 -> DetectEntitiesV2 -> Bool
Prelude.Eq, ReadPrec [DetectEntitiesV2]
ReadPrec DetectEntitiesV2
Int -> ReadS DetectEntitiesV2
ReadS [DetectEntitiesV2]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetectEntitiesV2]
$creadListPrec :: ReadPrec [DetectEntitiesV2]
readPrec :: ReadPrec DetectEntitiesV2
$creadPrec :: ReadPrec DetectEntitiesV2
readList :: ReadS [DetectEntitiesV2]
$creadList :: ReadS [DetectEntitiesV2]
readsPrec :: Int -> ReadS DetectEntitiesV2
$creadsPrec :: Int -> ReadS DetectEntitiesV2
Prelude.Read, Int -> DetectEntitiesV2 -> ShowS
[DetectEntitiesV2] -> ShowS
DetectEntitiesV2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectEntitiesV2] -> ShowS
$cshowList :: [DetectEntitiesV2] -> ShowS
show :: DetectEntitiesV2 -> String
$cshow :: DetectEntitiesV2 -> String
showsPrec :: Int -> DetectEntitiesV2 -> ShowS
$cshowsPrec :: Int -> DetectEntitiesV2 -> ShowS
Prelude.Show, forall x. Rep DetectEntitiesV2 x -> DetectEntitiesV2
forall x. DetectEntitiesV2 -> Rep DetectEntitiesV2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectEntitiesV2 x -> DetectEntitiesV2
$cfrom :: forall x. DetectEntitiesV2 -> Rep DetectEntitiesV2 x
Prelude.Generic)

-- |
-- Create a value of 'DetectEntitiesV2' 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', 'detectEntitiesV2_text' - A UTF-8 string containing the clinical content being examined for
-- entities. Each string must contain fewer than 20,000 bytes of
-- characters.
newDetectEntitiesV2 ::
  -- | 'text'
  Prelude.Text ->
  DetectEntitiesV2
newDetectEntitiesV2 :: Text -> DetectEntitiesV2
newDetectEntitiesV2 Text
pText_ =
  DetectEntitiesV2' {$sel:text:DetectEntitiesV2' :: Text
text = Text
pText_}

-- | A UTF-8 string containing the clinical content being examined for
-- entities. Each string must contain fewer than 20,000 bytes of
-- characters.
detectEntitiesV2_text :: Lens.Lens' DetectEntitiesV2 Prelude.Text
detectEntitiesV2_text :: Lens' DetectEntitiesV2 Text
detectEntitiesV2_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntitiesV2' {Text
text :: Text
$sel:text:DetectEntitiesV2' :: DetectEntitiesV2 -> Text
text} -> Text
text) (\s :: DetectEntitiesV2
s@DetectEntitiesV2' {} Text
a -> DetectEntitiesV2
s {$sel:text:DetectEntitiesV2' :: Text
text = Text
a} :: DetectEntitiesV2)

instance Core.AWSRequest DetectEntitiesV2 where
  type
    AWSResponse DetectEntitiesV2 =
      DetectEntitiesV2Response
  request :: (Service -> Service)
-> DetectEntitiesV2 -> Request DetectEntitiesV2
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 DetectEntitiesV2
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DetectEntitiesV2)))
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 [UnmappedAttribute]
-> Int
-> [Entity]
-> Text
-> DetectEntitiesV2Response
DetectEntitiesV2Response'
            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
"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
"UnmappedAttributes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ModelVersion")
      )

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

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

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

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

-- | /See:/ 'newDetectEntitiesV2Response' smart constructor.
data DetectEntitiesV2Response = DetectEntitiesV2Response'
  { -- | If the result to the @DetectEntitiesV2@ operation was truncated, include
    -- the @PaginationToken@ to fetch the next page of entities.
    DetectEntitiesV2Response -> Maybe Text
paginationToken :: Prelude.Maybe Prelude.Text,
    -- | Attributes extracted from the input text that couldn\'t be related to an
    -- entity.
    DetectEntitiesV2Response -> Maybe [UnmappedAttribute]
unmappedAttributes :: Prelude.Maybe [UnmappedAttribute],
    -- | The response's http status code.
    DetectEntitiesV2Response -> Int
httpStatus :: Prelude.Int,
    -- | The collection of medical 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 in the detection and analysis. Attributes
    -- and traits of the entity are also returned.
    DetectEntitiesV2Response -> [Entity]
entities :: [Entity],
    -- | The version of the model used to analyze the documents. The version
    -- number looks like X.X.X. You can use this information to track the model
    -- used for a particular batch of documents.
    DetectEntitiesV2Response -> Text
modelVersion :: Prelude.Text
  }
  deriving (DetectEntitiesV2Response -> DetectEntitiesV2Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectEntitiesV2Response -> DetectEntitiesV2Response -> Bool
$c/= :: DetectEntitiesV2Response -> DetectEntitiesV2Response -> Bool
== :: DetectEntitiesV2Response -> DetectEntitiesV2Response -> Bool
$c== :: DetectEntitiesV2Response -> DetectEntitiesV2Response -> Bool
Prelude.Eq, ReadPrec [DetectEntitiesV2Response]
ReadPrec DetectEntitiesV2Response
Int -> ReadS DetectEntitiesV2Response
ReadS [DetectEntitiesV2Response]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetectEntitiesV2Response]
$creadListPrec :: ReadPrec [DetectEntitiesV2Response]
readPrec :: ReadPrec DetectEntitiesV2Response
$creadPrec :: ReadPrec DetectEntitiesV2Response
readList :: ReadS [DetectEntitiesV2Response]
$creadList :: ReadS [DetectEntitiesV2Response]
readsPrec :: Int -> ReadS DetectEntitiesV2Response
$creadsPrec :: Int -> ReadS DetectEntitiesV2Response
Prelude.Read, Int -> DetectEntitiesV2Response -> ShowS
[DetectEntitiesV2Response] -> ShowS
DetectEntitiesV2Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectEntitiesV2Response] -> ShowS
$cshowList :: [DetectEntitiesV2Response] -> ShowS
show :: DetectEntitiesV2Response -> String
$cshow :: DetectEntitiesV2Response -> String
showsPrec :: Int -> DetectEntitiesV2Response -> ShowS
$cshowsPrec :: Int -> DetectEntitiesV2Response -> ShowS
Prelude.Show, forall x.
Rep DetectEntitiesV2Response x -> DetectEntitiesV2Response
forall x.
DetectEntitiesV2Response -> Rep DetectEntitiesV2Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DetectEntitiesV2Response x -> DetectEntitiesV2Response
$cfrom :: forall x.
DetectEntitiesV2Response -> Rep DetectEntitiesV2Response x
Prelude.Generic)

-- |
-- Create a value of 'DetectEntitiesV2Response' 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:
--
-- 'paginationToken', 'detectEntitiesV2Response_paginationToken' - If the result to the @DetectEntitiesV2@ operation was truncated, include
-- the @PaginationToken@ to fetch the next page of entities.
--
-- 'unmappedAttributes', 'detectEntitiesV2Response_unmappedAttributes' - Attributes extracted from the input text that couldn\'t be related to an
-- entity.
--
-- 'httpStatus', 'detectEntitiesV2Response_httpStatus' - The response's http status code.
--
-- 'entities', 'detectEntitiesV2Response_entities' - The collection of medical 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 in the detection and analysis. Attributes
-- and traits of the entity are also returned.
--
-- 'modelVersion', 'detectEntitiesV2Response_modelVersion' - The version of the model used to analyze the documents. The version
-- number looks like X.X.X. You can use this information to track the model
-- used for a particular batch of documents.
newDetectEntitiesV2Response ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'modelVersion'
  Prelude.Text ->
  DetectEntitiesV2Response
newDetectEntitiesV2Response :: Int -> Text -> DetectEntitiesV2Response
newDetectEntitiesV2Response
  Int
pHttpStatus_
  Text
pModelVersion_ =
    DetectEntitiesV2Response'
      { $sel:paginationToken:DetectEntitiesV2Response' :: Maybe Text
paginationToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:unmappedAttributes:DetectEntitiesV2Response' :: Maybe [UnmappedAttribute]
unmappedAttributes = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DetectEntitiesV2Response' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:entities:DetectEntitiesV2Response' :: [Entity]
entities = forall a. Monoid a => a
Prelude.mempty,
        $sel:modelVersion:DetectEntitiesV2Response' :: Text
modelVersion = Text
pModelVersion_
      }

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

-- | Attributes extracted from the input text that couldn\'t be related to an
-- entity.
detectEntitiesV2Response_unmappedAttributes :: Lens.Lens' DetectEntitiesV2Response (Prelude.Maybe [UnmappedAttribute])
detectEntitiesV2Response_unmappedAttributes :: Lens' DetectEntitiesV2Response (Maybe [UnmappedAttribute])
detectEntitiesV2Response_unmappedAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntitiesV2Response' {Maybe [UnmappedAttribute]
unmappedAttributes :: Maybe [UnmappedAttribute]
$sel:unmappedAttributes:DetectEntitiesV2Response' :: DetectEntitiesV2Response -> Maybe [UnmappedAttribute]
unmappedAttributes} -> Maybe [UnmappedAttribute]
unmappedAttributes) (\s :: DetectEntitiesV2Response
s@DetectEntitiesV2Response' {} Maybe [UnmappedAttribute]
a -> DetectEntitiesV2Response
s {$sel:unmappedAttributes:DetectEntitiesV2Response' :: Maybe [UnmappedAttribute]
unmappedAttributes = Maybe [UnmappedAttribute]
a} :: DetectEntitiesV2Response) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

-- | The collection of medical 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 in the detection and analysis. Attributes
-- and traits of the entity are also returned.
detectEntitiesV2Response_entities :: Lens.Lens' DetectEntitiesV2Response [Entity]
detectEntitiesV2Response_entities :: Lens' DetectEntitiesV2Response [Entity]
detectEntitiesV2Response_entities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntitiesV2Response' {[Entity]
entities :: [Entity]
$sel:entities:DetectEntitiesV2Response' :: DetectEntitiesV2Response -> [Entity]
entities} -> [Entity]
entities) (\s :: DetectEntitiesV2Response
s@DetectEntitiesV2Response' {} [Entity]
a -> DetectEntitiesV2Response
s {$sel:entities:DetectEntitiesV2Response' :: [Entity]
entities = [Entity]
a} :: DetectEntitiesV2Response) 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

-- | The version of the model used to analyze the documents. The version
-- number looks like X.X.X. You can use this information to track the model
-- used for a particular batch of documents.
detectEntitiesV2Response_modelVersion :: Lens.Lens' DetectEntitiesV2Response Prelude.Text
detectEntitiesV2Response_modelVersion :: Lens' DetectEntitiesV2Response Text
detectEntitiesV2Response_modelVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntitiesV2Response' {Text
modelVersion :: Text
$sel:modelVersion:DetectEntitiesV2Response' :: DetectEntitiesV2Response -> Text
modelVersion} -> Text
modelVersion) (\s :: DetectEntitiesV2Response
s@DetectEntitiesV2Response' {} Text
a -> DetectEntitiesV2Response
s {$sel:modelVersion:DetectEntitiesV2Response' :: Text
modelVersion = Text
a} :: DetectEntitiesV2Response)

instance Prelude.NFData DetectEntitiesV2Response where
  rnf :: DetectEntitiesV2Response -> ()
rnf DetectEntitiesV2Response' {Int
[Entity]
Maybe [UnmappedAttribute]
Maybe Text
Text
modelVersion :: Text
entities :: [Entity]
httpStatus :: Int
unmappedAttributes :: Maybe [UnmappedAttribute]
paginationToken :: Maybe Text
$sel:modelVersion:DetectEntitiesV2Response' :: DetectEntitiesV2Response -> Text
$sel:entities:DetectEntitiesV2Response' :: DetectEntitiesV2Response -> [Entity]
$sel:httpStatus:DetectEntitiesV2Response' :: DetectEntitiesV2Response -> Int
$sel:unmappedAttributes:DetectEntitiesV2Response' :: DetectEntitiesV2Response -> Maybe [UnmappedAttribute]
$sel:paginationToken:DetectEntitiesV2Response' :: DetectEntitiesV2Response -> Maybe Text
..} =
    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 [UnmappedAttribute]
unmappedAttributes
      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 [Entity]
entities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
modelVersion