{-# 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.Comprehend.DetectEntities
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Detects named entities in input text when you use the pre-trained model.
-- Detects custom entities if you have a custom entity recognition model.
--
-- When detecting named entities using the pre-trained model, use plain
-- text as the input. For more information about named entities, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/how-entities.html Entities>
-- in the Comprehend Developer Guide.
--
-- When you use a custom entity recognition model, you can input plain text
-- or you can upload a single-page input document (text, PDF, Word, or
-- image).
--
-- If the system detects errors while processing a page in the input
-- document, the API response includes an entry in @Errors@ for each error.
--
-- If the system detects a document-level error in your input document, the
-- API returns an @InvalidRequestException@ error response. For details
-- about this exception, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/idp-inputs-sync-err.html Errors in semi-structured documents>
-- in the Comprehend Developer Guide.
module Amazonka.Comprehend.DetectEntities
  ( -- * Creating a Request
    DetectEntities (..),
    newDetectEntities,

    -- * Request Lenses
    detectEntities_bytes,
    detectEntities_documentReaderConfig,
    detectEntities_endpointArn,
    detectEntities_languageCode,
    detectEntities_text,

    -- * Destructuring the Response
    DetectEntitiesResponse (..),
    newDetectEntitiesResponse,

    -- * Response Lenses
    detectEntitiesResponse_blocks,
    detectEntitiesResponse_documentMetadata,
    detectEntitiesResponse_documentType,
    detectEntitiesResponse_entities,
    detectEntitiesResponse_errors,
    detectEntitiesResponse_httpStatus,
  )
where

import Amazonka.Comprehend.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:/ 'newDetectEntities' smart constructor.
data DetectEntities = DetectEntities'
  { -- | This field applies only when you use a custom entity recognition model
    -- that was trained with PDF annotations. For other cases, enter your text
    -- input in the @Text@ field.
    --
    -- Use the @Bytes@ parameter to input a text, PDF, Word or image file.
    -- Using a plain-text file in the @Bytes@ parameter is equivelent to using
    -- the @Text@ parameter (the @Entities@ field in the response is
    -- identical).
    --
    -- You can also use the @Bytes@ parameter to input an Amazon Textract
    -- @DetectDocumentText@ or @AnalyzeDocument@ output file.
    --
    -- Provide the input document as a sequence of base64-encoded bytes. If
    -- your code uses an Amazon Web Services SDK to detect entities, the SDK
    -- may encode the document file bytes for you.
    --
    -- The maximum length of this field depends on the input document type. For
    -- details, see
    -- <https://docs.aws.amazon.com/comprehend/latest/dg/idp-inputs-sync.html Inputs for real-time custom analysis>
    -- in the Comprehend Developer Guide.
    --
    -- If you use the @Bytes@ parameter, do not use the @Text@ parameter.
    DetectEntities -> Maybe Base64
bytes :: Prelude.Maybe Data.Base64,
    -- | Provides configuration parameters to override the default actions for
    -- extracting text from PDF documents and image files.
    DetectEntities -> Maybe DocumentReaderConfig
documentReaderConfig :: Prelude.Maybe DocumentReaderConfig,
    -- | The Amazon Resource Name of an endpoint that is associated with a custom
    -- entity recognition model. Provide an endpoint if you want to detect
    -- entities by using your own custom model instead of the default model
    -- that is used by Amazon Comprehend.
    --
    -- If you specify an endpoint, Amazon Comprehend uses the language of your
    -- custom model, and it ignores any language code that you provide in your
    -- request.
    --
    -- For information about endpoints, see
    -- <https://docs.aws.amazon.com/comprehend/latest/dg/manage-endpoints.html Managing endpoints>.
    DetectEntities -> Maybe Text
endpointArn :: Prelude.Maybe Prelude.Text,
    -- | The language of the input documents. You can specify any of the primary
    -- languages supported by Amazon Comprehend. If your request includes the
    -- endpoint for a custom entity recognition model, Amazon Comprehend uses
    -- the language of your custom model, and it ignores any language code that
    -- you specify here.
    --
    -- All input documents must be in the same language.
    DetectEntities -> Maybe LanguageCode
languageCode :: Prelude.Maybe LanguageCode,
    -- | A UTF-8 text string. The maximum string size is 100 KB. If you enter
    -- text using this parameter, do not use the @Bytes@ parameter.
    DetectEntities -> Maybe (Sensitive Text)
text :: Prelude.Maybe (Data.Sensitive Prelude.Text)
  }
  deriving (DetectEntities -> DetectEntities -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectEntities -> DetectEntities -> Bool
$c/= :: DetectEntities -> DetectEntities -> Bool
== :: DetectEntities -> DetectEntities -> Bool
$c== :: DetectEntities -> DetectEntities -> Bool
Prelude.Eq, Int -> DetectEntities -> ShowS
[DetectEntities] -> ShowS
DetectEntities -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectEntities] -> ShowS
$cshowList :: [DetectEntities] -> ShowS
show :: DetectEntities -> String
$cshow :: DetectEntities -> String
showsPrec :: Int -> DetectEntities -> ShowS
$cshowsPrec :: Int -> DetectEntities -> ShowS
Prelude.Show, forall x. Rep DetectEntities x -> DetectEntities
forall x. DetectEntities -> Rep DetectEntities x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectEntities x -> DetectEntities
$cfrom :: forall x. DetectEntities -> Rep DetectEntities x
Prelude.Generic)

-- |
-- Create a value of 'DetectEntities' 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:
--
-- 'bytes', 'detectEntities_bytes' - This field applies only when you use a custom entity recognition model
-- that was trained with PDF annotations. For other cases, enter your text
-- input in the @Text@ field.
--
-- Use the @Bytes@ parameter to input a text, PDF, Word or image file.
-- Using a plain-text file in the @Bytes@ parameter is equivelent to using
-- the @Text@ parameter (the @Entities@ field in the response is
-- identical).
--
-- You can also use the @Bytes@ parameter to input an Amazon Textract
-- @DetectDocumentText@ or @AnalyzeDocument@ output file.
--
-- Provide the input document as a sequence of base64-encoded bytes. If
-- your code uses an Amazon Web Services SDK to detect entities, the SDK
-- may encode the document file bytes for you.
--
-- The maximum length of this field depends on the input document type. For
-- details, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/idp-inputs-sync.html Inputs for real-time custom analysis>
-- in the Comprehend Developer Guide.
--
-- If you use the @Bytes@ parameter, do not use the @Text@ parameter.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'documentReaderConfig', 'detectEntities_documentReaderConfig' - Provides configuration parameters to override the default actions for
-- extracting text from PDF documents and image files.
--
-- 'endpointArn', 'detectEntities_endpointArn' - The Amazon Resource Name of an endpoint that is associated with a custom
-- entity recognition model. Provide an endpoint if you want to detect
-- entities by using your own custom model instead of the default model
-- that is used by Amazon Comprehend.
--
-- If you specify an endpoint, Amazon Comprehend uses the language of your
-- custom model, and it ignores any language code that you provide in your
-- request.
--
-- For information about endpoints, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/manage-endpoints.html Managing endpoints>.
--
-- 'languageCode', 'detectEntities_languageCode' - The language of the input documents. You can specify any of the primary
-- languages supported by Amazon Comprehend. If your request includes the
-- endpoint for a custom entity recognition model, Amazon Comprehend uses
-- the language of your custom model, and it ignores any language code that
-- you specify here.
--
-- All input documents must be in the same language.
--
-- 'text', 'detectEntities_text' - A UTF-8 text string. The maximum string size is 100 KB. If you enter
-- text using this parameter, do not use the @Bytes@ parameter.
newDetectEntities ::
  DetectEntities
newDetectEntities :: DetectEntities
newDetectEntities =
  DetectEntities'
    { $sel:bytes:DetectEntities' :: Maybe Base64
bytes = forall a. Maybe a
Prelude.Nothing,
      $sel:documentReaderConfig:DetectEntities' :: Maybe DocumentReaderConfig
documentReaderConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:endpointArn:DetectEntities' :: Maybe Text
endpointArn = forall a. Maybe a
Prelude.Nothing,
      $sel:languageCode:DetectEntities' :: Maybe LanguageCode
languageCode = forall a. Maybe a
Prelude.Nothing,
      $sel:text:DetectEntities' :: Maybe (Sensitive Text)
text = forall a. Maybe a
Prelude.Nothing
    }

-- | This field applies only when you use a custom entity recognition model
-- that was trained with PDF annotations. For other cases, enter your text
-- input in the @Text@ field.
--
-- Use the @Bytes@ parameter to input a text, PDF, Word or image file.
-- Using a plain-text file in the @Bytes@ parameter is equivelent to using
-- the @Text@ parameter (the @Entities@ field in the response is
-- identical).
--
-- You can also use the @Bytes@ parameter to input an Amazon Textract
-- @DetectDocumentText@ or @AnalyzeDocument@ output file.
--
-- Provide the input document as a sequence of base64-encoded bytes. If
-- your code uses an Amazon Web Services SDK to detect entities, the SDK
-- may encode the document file bytes for you.
--
-- The maximum length of this field depends on the input document type. For
-- details, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/idp-inputs-sync.html Inputs for real-time custom analysis>
-- in the Comprehend Developer Guide.
--
-- If you use the @Bytes@ parameter, do not use the @Text@ parameter.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
detectEntities_bytes :: Lens.Lens' DetectEntities (Prelude.Maybe Prelude.ByteString)
detectEntities_bytes :: Lens' DetectEntities (Maybe ByteString)
detectEntities_bytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntities' {Maybe Base64
bytes :: Maybe Base64
$sel:bytes:DetectEntities' :: DetectEntities -> Maybe Base64
bytes} -> Maybe Base64
bytes) (\s :: DetectEntities
s@DetectEntities' {} Maybe Base64
a -> DetectEntities
s {$sel:bytes:DetectEntities' :: Maybe Base64
bytes = Maybe Base64
a} :: DetectEntities) 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 Iso' Base64 ByteString
Data._Base64

-- | Provides configuration parameters to override the default actions for
-- extracting text from PDF documents and image files.
detectEntities_documentReaderConfig :: Lens.Lens' DetectEntities (Prelude.Maybe DocumentReaderConfig)
detectEntities_documentReaderConfig :: Lens' DetectEntities (Maybe DocumentReaderConfig)
detectEntities_documentReaderConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntities' {Maybe DocumentReaderConfig
documentReaderConfig :: Maybe DocumentReaderConfig
$sel:documentReaderConfig:DetectEntities' :: DetectEntities -> Maybe DocumentReaderConfig
documentReaderConfig} -> Maybe DocumentReaderConfig
documentReaderConfig) (\s :: DetectEntities
s@DetectEntities' {} Maybe DocumentReaderConfig
a -> DetectEntities
s {$sel:documentReaderConfig:DetectEntities' :: Maybe DocumentReaderConfig
documentReaderConfig = Maybe DocumentReaderConfig
a} :: DetectEntities)

-- | The Amazon Resource Name of an endpoint that is associated with a custom
-- entity recognition model. Provide an endpoint if you want to detect
-- entities by using your own custom model instead of the default model
-- that is used by Amazon Comprehend.
--
-- If you specify an endpoint, Amazon Comprehend uses the language of your
-- custom model, and it ignores any language code that you provide in your
-- request.
--
-- For information about endpoints, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/manage-endpoints.html Managing endpoints>.
detectEntities_endpointArn :: Lens.Lens' DetectEntities (Prelude.Maybe Prelude.Text)
detectEntities_endpointArn :: Lens' DetectEntities (Maybe Text)
detectEntities_endpointArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntities' {Maybe Text
endpointArn :: Maybe Text
$sel:endpointArn:DetectEntities' :: DetectEntities -> Maybe Text
endpointArn} -> Maybe Text
endpointArn) (\s :: DetectEntities
s@DetectEntities' {} Maybe Text
a -> DetectEntities
s {$sel:endpointArn:DetectEntities' :: Maybe Text
endpointArn = Maybe Text
a} :: DetectEntities)

-- | The language of the input documents. You can specify any of the primary
-- languages supported by Amazon Comprehend. If your request includes the
-- endpoint for a custom entity recognition model, Amazon Comprehend uses
-- the language of your custom model, and it ignores any language code that
-- you specify here.
--
-- All input documents must be in the same language.
detectEntities_languageCode :: Lens.Lens' DetectEntities (Prelude.Maybe LanguageCode)
detectEntities_languageCode :: Lens' DetectEntities (Maybe LanguageCode)
detectEntities_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntities' {Maybe LanguageCode
languageCode :: Maybe LanguageCode
$sel:languageCode:DetectEntities' :: DetectEntities -> Maybe LanguageCode
languageCode} -> Maybe LanguageCode
languageCode) (\s :: DetectEntities
s@DetectEntities' {} Maybe LanguageCode
a -> DetectEntities
s {$sel:languageCode:DetectEntities' :: Maybe LanguageCode
languageCode = Maybe LanguageCode
a} :: DetectEntities)

-- | A UTF-8 text string. The maximum string size is 100 KB. If you enter
-- text using this parameter, do not use the @Bytes@ parameter.
detectEntities_text :: Lens.Lens' DetectEntities (Prelude.Maybe Prelude.Text)
detectEntities_text :: Lens' DetectEntities (Maybe Text)
detectEntities_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntities' {Maybe (Sensitive Text)
text :: Maybe (Sensitive Text)
$sel:text:DetectEntities' :: DetectEntities -> Maybe (Sensitive Text)
text} -> Maybe (Sensitive Text)
text) (\s :: DetectEntities
s@DetectEntities' {} Maybe (Sensitive Text)
a -> DetectEntities
s {$sel:text:DetectEntities' :: Maybe (Sensitive Text)
text = Maybe (Sensitive Text)
a} :: DetectEntities) 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. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest DetectEntities where
  type
    AWSResponse DetectEntities =
      DetectEntitiesResponse
  request :: (Service -> Service) -> DetectEntities -> Request DetectEntities
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 DetectEntities
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DetectEntities)))
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 [Block]
-> Maybe DocumentMetadata
-> Maybe [DocumentTypeListItem]
-> Maybe [Entity]
-> Maybe [ErrorsListItem]
-> Int
-> DetectEntitiesResponse
DetectEntitiesResponse'
            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
"Blocks" 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 (Maybe a)
Data..?> Key
"DocumentMetadata")
            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
"DocumentType" 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 (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 (Maybe a)
Data..?> Key
"Errors" 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))
      )

instance Prelude.Hashable DetectEntities where
  hashWithSalt :: Int -> DetectEntities -> Int
hashWithSalt Int
_salt DetectEntities' {Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Maybe DocumentReaderConfig
Maybe LanguageCode
text :: Maybe (Sensitive Text)
languageCode :: Maybe LanguageCode
endpointArn :: Maybe Text
documentReaderConfig :: Maybe DocumentReaderConfig
bytes :: Maybe Base64
$sel:text:DetectEntities' :: DetectEntities -> Maybe (Sensitive Text)
$sel:languageCode:DetectEntities' :: DetectEntities -> Maybe LanguageCode
$sel:endpointArn:DetectEntities' :: DetectEntities -> Maybe Text
$sel:documentReaderConfig:DetectEntities' :: DetectEntities -> Maybe DocumentReaderConfig
$sel:bytes:DetectEntities' :: DetectEntities -> Maybe Base64
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Base64
bytes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DocumentReaderConfig
documentReaderConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
endpointArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LanguageCode
languageCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
text

instance Prelude.NFData DetectEntities where
  rnf :: DetectEntities -> ()
rnf DetectEntities' {Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Maybe DocumentReaderConfig
Maybe LanguageCode
text :: Maybe (Sensitive Text)
languageCode :: Maybe LanguageCode
endpointArn :: Maybe Text
documentReaderConfig :: Maybe DocumentReaderConfig
bytes :: Maybe Base64
$sel:text:DetectEntities' :: DetectEntities -> Maybe (Sensitive Text)
$sel:languageCode:DetectEntities' :: DetectEntities -> Maybe LanguageCode
$sel:endpointArn:DetectEntities' :: DetectEntities -> Maybe Text
$sel:documentReaderConfig:DetectEntities' :: DetectEntities -> Maybe DocumentReaderConfig
$sel:bytes:DetectEntities' :: DetectEntities -> Maybe Base64
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Base64
bytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DocumentReaderConfig
documentReaderConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endpointArn
      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 (Sensitive Text)
text

instance Data.ToHeaders DetectEntities where
  toHeaders :: DetectEntities -> 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
"Comprehend_20171127.DetectEntities" ::
                          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 DetectEntities where
  toJSON :: DetectEntities -> Value
toJSON DetectEntities' {Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Maybe DocumentReaderConfig
Maybe LanguageCode
text :: Maybe (Sensitive Text)
languageCode :: Maybe LanguageCode
endpointArn :: Maybe Text
documentReaderConfig :: Maybe DocumentReaderConfig
bytes :: Maybe Base64
$sel:text:DetectEntities' :: DetectEntities -> Maybe (Sensitive Text)
$sel:languageCode:DetectEntities' :: DetectEntities -> Maybe LanguageCode
$sel:endpointArn:DetectEntities' :: DetectEntities -> Maybe Text
$sel:documentReaderConfig:DetectEntities' :: DetectEntities -> Maybe DocumentReaderConfig
$sel:bytes:DetectEntities' :: DetectEntities -> Maybe Base64
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Bytes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Base64
bytes,
            (Key
"DocumentReaderConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe DocumentReaderConfig
documentReaderConfig,
            (Key
"EndpointArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
endpointArn,
            (Key
"LanguageCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe LanguageCode
languageCode,
            (Key
"Text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Sensitive Text)
text
          ]
      )

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

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

-- | /See:/ 'newDetectEntitiesResponse' smart constructor.
data DetectEntitiesResponse = DetectEntitiesResponse'
  { -- | Information about each block of text in the input document. Blocks are
    -- nested. A page block contains a block for each line of text, which
    -- contains a block for each word.
    --
    -- The @Block@ content for a Word input document does not include a
    -- @Geometry@ field.
    --
    -- The @Block@ field is not present in the response for plain-text inputs.
    DetectEntitiesResponse -> Maybe [Block]
blocks :: Prelude.Maybe [Block],
    -- | Information about the document, discovered during text extraction. This
    -- field is present in the response only if your request used the @Byte@
    -- parameter.
    DetectEntitiesResponse -> Maybe DocumentMetadata
documentMetadata :: Prelude.Maybe DocumentMetadata,
    -- | The document type for each page in the input document. This field is
    -- present in the response only if your request used the @Byte@ parameter.
    DetectEntitiesResponse -> Maybe [DocumentTypeListItem]
documentType :: Prelude.Maybe [DocumentTypeListItem],
    -- | A collection of entities identified in the input text. For each entity,
    -- the response provides the entity text, entity type, where the entity
    -- text begins and ends, and the level of confidence that Amazon Comprehend
    -- has in the detection.
    --
    -- If your request uses a custom entity recognition model, Amazon
    -- Comprehend detects the entities that the model is trained to recognize.
    -- Otherwise, it detects the default entity types. For a list of default
    -- entity types, see
    -- <https://docs.aws.amazon.com/comprehend/latest/dg/how-entities.html Entities>
    -- in the Comprehend Developer Guide.
    DetectEntitiesResponse -> Maybe [Entity]
entities :: Prelude.Maybe [Entity],
    -- | Page-level errors that the system detected while processing the input
    -- document. The field is empty if the system encountered no errors.
    DetectEntitiesResponse -> Maybe [ErrorsListItem]
errors :: Prelude.Maybe [ErrorsListItem],
    -- | The response's http status code.
    DetectEntitiesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DetectEntitiesResponse -> DetectEntitiesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectEntitiesResponse -> DetectEntitiesResponse -> Bool
$c/= :: DetectEntitiesResponse -> DetectEntitiesResponse -> Bool
== :: DetectEntitiesResponse -> DetectEntitiesResponse -> Bool
$c== :: DetectEntitiesResponse -> DetectEntitiesResponse -> Bool
Prelude.Eq, Int -> DetectEntitiesResponse -> ShowS
[DetectEntitiesResponse] -> ShowS
DetectEntitiesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectEntitiesResponse] -> ShowS
$cshowList :: [DetectEntitiesResponse] -> ShowS
show :: DetectEntitiesResponse -> String
$cshow :: DetectEntitiesResponse -> String
showsPrec :: Int -> DetectEntitiesResponse -> ShowS
$cshowsPrec :: Int -> DetectEntitiesResponse -> ShowS
Prelude.Show, forall x. Rep DetectEntitiesResponse x -> DetectEntitiesResponse
forall x. DetectEntitiesResponse -> Rep DetectEntitiesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectEntitiesResponse x -> DetectEntitiesResponse
$cfrom :: forall x. DetectEntitiesResponse -> Rep DetectEntitiesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DetectEntitiesResponse' 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:
--
-- 'blocks', 'detectEntitiesResponse_blocks' - Information about each block of text in the input document. Blocks are
-- nested. A page block contains a block for each line of text, which
-- contains a block for each word.
--
-- The @Block@ content for a Word input document does not include a
-- @Geometry@ field.
--
-- The @Block@ field is not present in the response for plain-text inputs.
--
-- 'documentMetadata', 'detectEntitiesResponse_documentMetadata' - Information about the document, discovered during text extraction. This
-- field is present in the response only if your request used the @Byte@
-- parameter.
--
-- 'documentType', 'detectEntitiesResponse_documentType' - The document type for each page in the input document. This field is
-- present in the response only if your request used the @Byte@ parameter.
--
-- 'entities', 'detectEntitiesResponse_entities' - A collection of entities identified in the input text. For each entity,
-- the response provides the entity text, entity type, where the entity
-- text begins and ends, and the level of confidence that Amazon Comprehend
-- has in the detection.
--
-- If your request uses a custom entity recognition model, Amazon
-- Comprehend detects the entities that the model is trained to recognize.
-- Otherwise, it detects the default entity types. For a list of default
-- entity types, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/how-entities.html Entities>
-- in the Comprehend Developer Guide.
--
-- 'errors', 'detectEntitiesResponse_errors' - Page-level errors that the system detected while processing the input
-- document. The field is empty if the system encountered no errors.
--
-- 'httpStatus', 'detectEntitiesResponse_httpStatus' - The response's http status code.
newDetectEntitiesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DetectEntitiesResponse
newDetectEntitiesResponse :: Int -> DetectEntitiesResponse
newDetectEntitiesResponse Int
pHttpStatus_ =
  DetectEntitiesResponse'
    { $sel:blocks:DetectEntitiesResponse' :: Maybe [Block]
blocks = forall a. Maybe a
Prelude.Nothing,
      $sel:documentMetadata:DetectEntitiesResponse' :: Maybe DocumentMetadata
documentMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:documentType:DetectEntitiesResponse' :: Maybe [DocumentTypeListItem]
documentType = forall a. Maybe a
Prelude.Nothing,
      $sel:entities:DetectEntitiesResponse' :: Maybe [Entity]
entities = forall a. Maybe a
Prelude.Nothing,
      $sel:errors:DetectEntitiesResponse' :: Maybe [ErrorsListItem]
errors = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DetectEntitiesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about each block of text in the input document. Blocks are
-- nested. A page block contains a block for each line of text, which
-- contains a block for each word.
--
-- The @Block@ content for a Word input document does not include a
-- @Geometry@ field.
--
-- The @Block@ field is not present in the response for plain-text inputs.
detectEntitiesResponse_blocks :: Lens.Lens' DetectEntitiesResponse (Prelude.Maybe [Block])
detectEntitiesResponse_blocks :: Lens' DetectEntitiesResponse (Maybe [Block])
detectEntitiesResponse_blocks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntitiesResponse' {Maybe [Block]
blocks :: Maybe [Block]
$sel:blocks:DetectEntitiesResponse' :: DetectEntitiesResponse -> Maybe [Block]
blocks} -> Maybe [Block]
blocks) (\s :: DetectEntitiesResponse
s@DetectEntitiesResponse' {} Maybe [Block]
a -> DetectEntitiesResponse
s {$sel:blocks:DetectEntitiesResponse' :: Maybe [Block]
blocks = Maybe [Block]
a} :: DetectEntitiesResponse) 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

-- | Information about the document, discovered during text extraction. This
-- field is present in the response only if your request used the @Byte@
-- parameter.
detectEntitiesResponse_documentMetadata :: Lens.Lens' DetectEntitiesResponse (Prelude.Maybe DocumentMetadata)
detectEntitiesResponse_documentMetadata :: Lens' DetectEntitiesResponse (Maybe DocumentMetadata)
detectEntitiesResponse_documentMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntitiesResponse' {Maybe DocumentMetadata
documentMetadata :: Maybe DocumentMetadata
$sel:documentMetadata:DetectEntitiesResponse' :: DetectEntitiesResponse -> Maybe DocumentMetadata
documentMetadata} -> Maybe DocumentMetadata
documentMetadata) (\s :: DetectEntitiesResponse
s@DetectEntitiesResponse' {} Maybe DocumentMetadata
a -> DetectEntitiesResponse
s {$sel:documentMetadata:DetectEntitiesResponse' :: Maybe DocumentMetadata
documentMetadata = Maybe DocumentMetadata
a} :: DetectEntitiesResponse)

-- | The document type for each page in the input document. This field is
-- present in the response only if your request used the @Byte@ parameter.
detectEntitiesResponse_documentType :: Lens.Lens' DetectEntitiesResponse (Prelude.Maybe [DocumentTypeListItem])
detectEntitiesResponse_documentType :: Lens' DetectEntitiesResponse (Maybe [DocumentTypeListItem])
detectEntitiesResponse_documentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntitiesResponse' {Maybe [DocumentTypeListItem]
documentType :: Maybe [DocumentTypeListItem]
$sel:documentType:DetectEntitiesResponse' :: DetectEntitiesResponse -> Maybe [DocumentTypeListItem]
documentType} -> Maybe [DocumentTypeListItem]
documentType) (\s :: DetectEntitiesResponse
s@DetectEntitiesResponse' {} Maybe [DocumentTypeListItem]
a -> DetectEntitiesResponse
s {$sel:documentType:DetectEntitiesResponse' :: Maybe [DocumentTypeListItem]
documentType = Maybe [DocumentTypeListItem]
a} :: DetectEntitiesResponse) 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

-- | A collection of entities identified in the input text. For each entity,
-- the response provides the entity text, entity type, where the entity
-- text begins and ends, and the level of confidence that Amazon Comprehend
-- has in the detection.
--
-- If your request uses a custom entity recognition model, Amazon
-- Comprehend detects the entities that the model is trained to recognize.
-- Otherwise, it detects the default entity types. For a list of default
-- entity types, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/how-entities.html Entities>
-- in the Comprehend Developer Guide.
detectEntitiesResponse_entities :: Lens.Lens' DetectEntitiesResponse (Prelude.Maybe [Entity])
detectEntitiesResponse_entities :: Lens' DetectEntitiesResponse (Maybe [Entity])
detectEntitiesResponse_entities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntitiesResponse' {Maybe [Entity]
entities :: Maybe [Entity]
$sel:entities:DetectEntitiesResponse' :: DetectEntitiesResponse -> Maybe [Entity]
entities} -> Maybe [Entity]
entities) (\s :: DetectEntitiesResponse
s@DetectEntitiesResponse' {} Maybe [Entity]
a -> DetectEntitiesResponse
s {$sel:entities:DetectEntitiesResponse' :: Maybe [Entity]
entities = Maybe [Entity]
a} :: DetectEntitiesResponse) 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

-- | Page-level errors that the system detected while processing the input
-- document. The field is empty if the system encountered no errors.
detectEntitiesResponse_errors :: Lens.Lens' DetectEntitiesResponse (Prelude.Maybe [ErrorsListItem])
detectEntitiesResponse_errors :: Lens' DetectEntitiesResponse (Maybe [ErrorsListItem])
detectEntitiesResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntitiesResponse' {Maybe [ErrorsListItem]
errors :: Maybe [ErrorsListItem]
$sel:errors:DetectEntitiesResponse' :: DetectEntitiesResponse -> Maybe [ErrorsListItem]
errors} -> Maybe [ErrorsListItem]
errors) (\s :: DetectEntitiesResponse
s@DetectEntitiesResponse' {} Maybe [ErrorsListItem]
a -> DetectEntitiesResponse
s {$sel:errors:DetectEntitiesResponse' :: Maybe [ErrorsListItem]
errors = Maybe [ErrorsListItem]
a} :: DetectEntitiesResponse) 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.
detectEntitiesResponse_httpStatus :: Lens.Lens' DetectEntitiesResponse Prelude.Int
detectEntitiesResponse_httpStatus :: Lens' DetectEntitiesResponse Int
detectEntitiesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectEntitiesResponse' {Int
httpStatus :: Int
$sel:httpStatus:DetectEntitiesResponse' :: DetectEntitiesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DetectEntitiesResponse
s@DetectEntitiesResponse' {} Int
a -> DetectEntitiesResponse
s {$sel:httpStatus:DetectEntitiesResponse' :: Int
httpStatus = Int
a} :: DetectEntitiesResponse)

instance Prelude.NFData DetectEntitiesResponse where
  rnf :: DetectEntitiesResponse -> ()
rnf DetectEntitiesResponse' {Int
Maybe [DocumentTypeListItem]
Maybe [Entity]
Maybe [ErrorsListItem]
Maybe [Block]
Maybe DocumentMetadata
httpStatus :: Int
errors :: Maybe [ErrorsListItem]
entities :: Maybe [Entity]
documentType :: Maybe [DocumentTypeListItem]
documentMetadata :: Maybe DocumentMetadata
blocks :: Maybe [Block]
$sel:httpStatus:DetectEntitiesResponse' :: DetectEntitiesResponse -> Int
$sel:errors:DetectEntitiesResponse' :: DetectEntitiesResponse -> Maybe [ErrorsListItem]
$sel:entities:DetectEntitiesResponse' :: DetectEntitiesResponse -> Maybe [Entity]
$sel:documentType:DetectEntitiesResponse' :: DetectEntitiesResponse -> Maybe [DocumentTypeListItem]
$sel:documentMetadata:DetectEntitiesResponse' :: DetectEntitiesResponse -> Maybe DocumentMetadata
$sel:blocks:DetectEntitiesResponse' :: DetectEntitiesResponse -> Maybe [Block]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Block]
blocks
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DocumentMetadata
documentMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DocumentTypeListItem]
documentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Entity]
entities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ErrorsListItem]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus