{-# 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.ClassifyDocument
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new document classification request to analyze a single
-- document in real-time, using a previously created and trained custom
-- model and an endpoint.
--
-- 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@ that describes
-- the errors.
--
-- 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.ClassifyDocument
  ( -- * Creating a Request
    ClassifyDocument (..),
    newClassifyDocument,

    -- * Request Lenses
    classifyDocument_bytes,
    classifyDocument_documentReaderConfig,
    classifyDocument_text,
    classifyDocument_endpointArn,

    -- * Destructuring the Response
    ClassifyDocumentResponse (..),
    newClassifyDocumentResponse,

    -- * Response Lenses
    classifyDocumentResponse_classes,
    classifyDocumentResponse_documentMetadata,
    classifyDocumentResponse_documentType,
    classifyDocumentResponse_errors,
    classifyDocumentResponse_labels,
    classifyDocumentResponse_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:/ 'newClassifyDocument' smart constructor.
data ClassifyDocument = ClassifyDocument'
  { -- | Use the @Bytes@ parameter to input a text, PDF, Word or image file. 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 classify documents, 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.
    ClassifyDocument -> Maybe Base64
bytes :: Prelude.Maybe Data.Base64,
    -- | Provides configuration parameters to override the default actions for
    -- extracting text from PDF documents and image files.
    ClassifyDocument -> Maybe DocumentReaderConfig
documentReaderConfig :: Prelude.Maybe DocumentReaderConfig,
    -- | The document text to be analyzed. If you enter text using this
    -- parameter, do not use the @Bytes@ parameter.
    ClassifyDocument -> Maybe (Sensitive Text)
text :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The Amazon Resource Number (ARN) of the endpoint. For information about
    -- endpoints, see
    -- <https://docs.aws.amazon.com/comprehend/latest/dg/manage-endpoints.html Managing endpoints>.
    ClassifyDocument -> Text
endpointArn :: Prelude.Text
  }
  deriving (ClassifyDocument -> ClassifyDocument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassifyDocument -> ClassifyDocument -> Bool
$c/= :: ClassifyDocument -> ClassifyDocument -> Bool
== :: ClassifyDocument -> ClassifyDocument -> Bool
$c== :: ClassifyDocument -> ClassifyDocument -> Bool
Prelude.Eq, Int -> ClassifyDocument -> ShowS
[ClassifyDocument] -> ShowS
ClassifyDocument -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClassifyDocument] -> ShowS
$cshowList :: [ClassifyDocument] -> ShowS
show :: ClassifyDocument -> String
$cshow :: ClassifyDocument -> String
showsPrec :: Int -> ClassifyDocument -> ShowS
$cshowsPrec :: Int -> ClassifyDocument -> ShowS
Prelude.Show, forall x. Rep ClassifyDocument x -> ClassifyDocument
forall x. ClassifyDocument -> Rep ClassifyDocument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClassifyDocument x -> ClassifyDocument
$cfrom :: forall x. ClassifyDocument -> Rep ClassifyDocument x
Prelude.Generic)

-- |
-- Create a value of 'ClassifyDocument' 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', 'classifyDocument_bytes' - Use the @Bytes@ parameter to input a text, PDF, Word or image file. 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 classify documents, 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', 'classifyDocument_documentReaderConfig' - Provides configuration parameters to override the default actions for
-- extracting text from PDF documents and image files.
--
-- 'text', 'classifyDocument_text' - The document text to be analyzed. If you enter text using this
-- parameter, do not use the @Bytes@ parameter.
--
-- 'endpointArn', 'classifyDocument_endpointArn' - The Amazon Resource Number (ARN) of the endpoint. For information about
-- endpoints, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/manage-endpoints.html Managing endpoints>.
newClassifyDocument ::
  -- | 'endpointArn'
  Prelude.Text ->
  ClassifyDocument
newClassifyDocument :: Text -> ClassifyDocument
newClassifyDocument Text
pEndpointArn_ =
  ClassifyDocument'
    { $sel:bytes:ClassifyDocument' :: Maybe Base64
bytes = forall a. Maybe a
Prelude.Nothing,
      $sel:documentReaderConfig:ClassifyDocument' :: Maybe DocumentReaderConfig
documentReaderConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:text:ClassifyDocument' :: Maybe (Sensitive Text)
text = forall a. Maybe a
Prelude.Nothing,
      $sel:endpointArn:ClassifyDocument' :: Text
endpointArn = Text
pEndpointArn_
    }

-- | Use the @Bytes@ parameter to input a text, PDF, Word or image file. 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 classify documents, 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.
classifyDocument_bytes :: Lens.Lens' ClassifyDocument (Prelude.Maybe Prelude.ByteString)
classifyDocument_bytes :: Lens' ClassifyDocument (Maybe ByteString)
classifyDocument_bytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClassifyDocument' {Maybe Base64
bytes :: Maybe Base64
$sel:bytes:ClassifyDocument' :: ClassifyDocument -> Maybe Base64
bytes} -> Maybe Base64
bytes) (\s :: ClassifyDocument
s@ClassifyDocument' {} Maybe Base64
a -> ClassifyDocument
s {$sel:bytes:ClassifyDocument' :: Maybe Base64
bytes = Maybe Base64
a} :: ClassifyDocument) 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.
classifyDocument_documentReaderConfig :: Lens.Lens' ClassifyDocument (Prelude.Maybe DocumentReaderConfig)
classifyDocument_documentReaderConfig :: Lens' ClassifyDocument (Maybe DocumentReaderConfig)
classifyDocument_documentReaderConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClassifyDocument' {Maybe DocumentReaderConfig
documentReaderConfig :: Maybe DocumentReaderConfig
$sel:documentReaderConfig:ClassifyDocument' :: ClassifyDocument -> Maybe DocumentReaderConfig
documentReaderConfig} -> Maybe DocumentReaderConfig
documentReaderConfig) (\s :: ClassifyDocument
s@ClassifyDocument' {} Maybe DocumentReaderConfig
a -> ClassifyDocument
s {$sel:documentReaderConfig:ClassifyDocument' :: Maybe DocumentReaderConfig
documentReaderConfig = Maybe DocumentReaderConfig
a} :: ClassifyDocument)

-- | The document text to be analyzed. If you enter text using this
-- parameter, do not use the @Bytes@ parameter.
classifyDocument_text :: Lens.Lens' ClassifyDocument (Prelude.Maybe Prelude.Text)
classifyDocument_text :: Lens' ClassifyDocument (Maybe Text)
classifyDocument_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClassifyDocument' {Maybe (Sensitive Text)
text :: Maybe (Sensitive Text)
$sel:text:ClassifyDocument' :: ClassifyDocument -> Maybe (Sensitive Text)
text} -> Maybe (Sensitive Text)
text) (\s :: ClassifyDocument
s@ClassifyDocument' {} Maybe (Sensitive Text)
a -> ClassifyDocument
s {$sel:text:ClassifyDocument' :: Maybe (Sensitive Text)
text = Maybe (Sensitive Text)
a} :: ClassifyDocument) 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

-- | The Amazon Resource Number (ARN) of the endpoint. For information about
-- endpoints, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/manage-endpoints.html Managing endpoints>.
classifyDocument_endpointArn :: Lens.Lens' ClassifyDocument Prelude.Text
classifyDocument_endpointArn :: Lens' ClassifyDocument Text
classifyDocument_endpointArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClassifyDocument' {Text
endpointArn :: Text
$sel:endpointArn:ClassifyDocument' :: ClassifyDocument -> Text
endpointArn} -> Text
endpointArn) (\s :: ClassifyDocument
s@ClassifyDocument' {} Text
a -> ClassifyDocument
s {$sel:endpointArn:ClassifyDocument' :: Text
endpointArn = Text
a} :: ClassifyDocument)

instance Core.AWSRequest ClassifyDocument where
  type
    AWSResponse ClassifyDocument =
      ClassifyDocumentResponse
  request :: (Service -> Service)
-> ClassifyDocument -> Request ClassifyDocument
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 ClassifyDocument
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ClassifyDocument)))
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 [DocumentClass]
-> Maybe DocumentMetadata
-> Maybe [DocumentTypeListItem]
-> Maybe [ErrorsListItem]
-> Maybe [DocumentLabel]
-> Int
-> ClassifyDocumentResponse
ClassifyDocumentResponse'
            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
"Classes" 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
"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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Labels" 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 ClassifyDocument where
  hashWithSalt :: Int -> ClassifyDocument -> Int
hashWithSalt Int
_salt ClassifyDocument' {Maybe Base64
Maybe (Sensitive Text)
Maybe DocumentReaderConfig
Text
endpointArn :: Text
text :: Maybe (Sensitive Text)
documentReaderConfig :: Maybe DocumentReaderConfig
bytes :: Maybe Base64
$sel:endpointArn:ClassifyDocument' :: ClassifyDocument -> Text
$sel:text:ClassifyDocument' :: ClassifyDocument -> Maybe (Sensitive Text)
$sel:documentReaderConfig:ClassifyDocument' :: ClassifyDocument -> Maybe DocumentReaderConfig
$sel:bytes:ClassifyDocument' :: ClassifyDocument -> 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 (Sensitive Text)
text
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointArn

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

instance Data.ToHeaders ClassifyDocument where
  toHeaders :: ClassifyDocument -> 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.ClassifyDocument" ::
                          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 ClassifyDocument where
  toJSON :: ClassifyDocument -> Value
toJSON ClassifyDocument' {Maybe Base64
Maybe (Sensitive Text)
Maybe DocumentReaderConfig
Text
endpointArn :: Text
text :: Maybe (Sensitive Text)
documentReaderConfig :: Maybe DocumentReaderConfig
bytes :: Maybe Base64
$sel:endpointArn:ClassifyDocument' :: ClassifyDocument -> Text
$sel:text:ClassifyDocument' :: ClassifyDocument -> Maybe (Sensitive Text)
$sel:documentReaderConfig:ClassifyDocument' :: ClassifyDocument -> Maybe DocumentReaderConfig
$sel:bytes:ClassifyDocument' :: ClassifyDocument -> 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
"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,
            forall a. a -> Maybe a
Prelude.Just (Key
"EndpointArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
endpointArn)
          ]
      )

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

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

-- | /See:/ 'newClassifyDocumentResponse' smart constructor.
data ClassifyDocumentResponse = ClassifyDocumentResponse'
  { -- | The classes used by the document being analyzed. These are used for
    -- multi-class trained models. Individual classes are mutually exclusive
    -- and each document is expected to have only a single class assigned to
    -- it. For example, an animal can be a dog or a cat, but not both at the
    -- same time.
    ClassifyDocumentResponse -> Maybe [DocumentClass]
classes :: Prelude.Maybe [DocumentClass],
    -- | Extraction information about the document. This field is present in the
    -- response only if your request includes the @Byte@ parameter.
    ClassifyDocumentResponse -> 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 includes the @Byte@
    -- parameter.
    ClassifyDocumentResponse -> Maybe [DocumentTypeListItem]
documentType :: Prelude.Maybe [DocumentTypeListItem],
    -- | Page-level errors that the system detected while processing the input
    -- document. The field is empty if the system encountered no errors.
    ClassifyDocumentResponse -> Maybe [ErrorsListItem]
errors :: Prelude.Maybe [ErrorsListItem],
    -- | The labels used the document being analyzed. These are used for
    -- multi-label trained models. Individual labels represent different
    -- categories that are related in some manner and are not mutually
    -- exclusive. For example, a movie can be just an action movie, or it can
    -- be an action movie, a science fiction movie, and a comedy, all at the
    -- same time.
    ClassifyDocumentResponse -> Maybe [DocumentLabel]
labels :: Prelude.Maybe [DocumentLabel],
    -- | The response's http status code.
    ClassifyDocumentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ClassifyDocumentResponse -> ClassifyDocumentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassifyDocumentResponse -> ClassifyDocumentResponse -> Bool
$c/= :: ClassifyDocumentResponse -> ClassifyDocumentResponse -> Bool
== :: ClassifyDocumentResponse -> ClassifyDocumentResponse -> Bool
$c== :: ClassifyDocumentResponse -> ClassifyDocumentResponse -> Bool
Prelude.Eq, Int -> ClassifyDocumentResponse -> ShowS
[ClassifyDocumentResponse] -> ShowS
ClassifyDocumentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClassifyDocumentResponse] -> ShowS
$cshowList :: [ClassifyDocumentResponse] -> ShowS
show :: ClassifyDocumentResponse -> String
$cshow :: ClassifyDocumentResponse -> String
showsPrec :: Int -> ClassifyDocumentResponse -> ShowS
$cshowsPrec :: Int -> ClassifyDocumentResponse -> ShowS
Prelude.Show, forall x.
Rep ClassifyDocumentResponse x -> ClassifyDocumentResponse
forall x.
ClassifyDocumentResponse -> Rep ClassifyDocumentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ClassifyDocumentResponse x -> ClassifyDocumentResponse
$cfrom :: forall x.
ClassifyDocumentResponse -> Rep ClassifyDocumentResponse x
Prelude.Generic)

-- |
-- Create a value of 'ClassifyDocumentResponse' 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:
--
-- 'classes', 'classifyDocumentResponse_classes' - The classes used by the document being analyzed. These are used for
-- multi-class trained models. Individual classes are mutually exclusive
-- and each document is expected to have only a single class assigned to
-- it. For example, an animal can be a dog or a cat, but not both at the
-- same time.
--
-- 'documentMetadata', 'classifyDocumentResponse_documentMetadata' - Extraction information about the document. This field is present in the
-- response only if your request includes the @Byte@ parameter.
--
-- 'documentType', 'classifyDocumentResponse_documentType' - The document type for each page in the input document. This field is
-- present in the response only if your request includes the @Byte@
-- parameter.
--
-- 'errors', 'classifyDocumentResponse_errors' - Page-level errors that the system detected while processing the input
-- document. The field is empty if the system encountered no errors.
--
-- 'labels', 'classifyDocumentResponse_labels' - The labels used the document being analyzed. These are used for
-- multi-label trained models. Individual labels represent different
-- categories that are related in some manner and are not mutually
-- exclusive. For example, a movie can be just an action movie, or it can
-- be an action movie, a science fiction movie, and a comedy, all at the
-- same time.
--
-- 'httpStatus', 'classifyDocumentResponse_httpStatus' - The response's http status code.
newClassifyDocumentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ClassifyDocumentResponse
newClassifyDocumentResponse :: Int -> ClassifyDocumentResponse
newClassifyDocumentResponse Int
pHttpStatus_ =
  ClassifyDocumentResponse'
    { $sel:classes:ClassifyDocumentResponse' :: Maybe [DocumentClass]
classes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:documentMetadata:ClassifyDocumentResponse' :: Maybe DocumentMetadata
documentMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:documentType:ClassifyDocumentResponse' :: Maybe [DocumentTypeListItem]
documentType = forall a. Maybe a
Prelude.Nothing,
      $sel:errors:ClassifyDocumentResponse' :: Maybe [ErrorsListItem]
errors = forall a. Maybe a
Prelude.Nothing,
      $sel:labels:ClassifyDocumentResponse' :: Maybe [DocumentLabel]
labels = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ClassifyDocumentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The classes used by the document being analyzed. These are used for
-- multi-class trained models. Individual classes are mutually exclusive
-- and each document is expected to have only a single class assigned to
-- it. For example, an animal can be a dog or a cat, but not both at the
-- same time.
classifyDocumentResponse_classes :: Lens.Lens' ClassifyDocumentResponse (Prelude.Maybe [DocumentClass])
classifyDocumentResponse_classes :: Lens' ClassifyDocumentResponse (Maybe [DocumentClass])
classifyDocumentResponse_classes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClassifyDocumentResponse' {Maybe [DocumentClass]
classes :: Maybe [DocumentClass]
$sel:classes:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Maybe [DocumentClass]
classes} -> Maybe [DocumentClass]
classes) (\s :: ClassifyDocumentResponse
s@ClassifyDocumentResponse' {} Maybe [DocumentClass]
a -> ClassifyDocumentResponse
s {$sel:classes:ClassifyDocumentResponse' :: Maybe [DocumentClass]
classes = Maybe [DocumentClass]
a} :: ClassifyDocumentResponse) 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

-- | Extraction information about the document. This field is present in the
-- response only if your request includes the @Byte@ parameter.
classifyDocumentResponse_documentMetadata :: Lens.Lens' ClassifyDocumentResponse (Prelude.Maybe DocumentMetadata)
classifyDocumentResponse_documentMetadata :: Lens' ClassifyDocumentResponse (Maybe DocumentMetadata)
classifyDocumentResponse_documentMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClassifyDocumentResponse' {Maybe DocumentMetadata
documentMetadata :: Maybe DocumentMetadata
$sel:documentMetadata:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Maybe DocumentMetadata
documentMetadata} -> Maybe DocumentMetadata
documentMetadata) (\s :: ClassifyDocumentResponse
s@ClassifyDocumentResponse' {} Maybe DocumentMetadata
a -> ClassifyDocumentResponse
s {$sel:documentMetadata:ClassifyDocumentResponse' :: Maybe DocumentMetadata
documentMetadata = Maybe DocumentMetadata
a} :: ClassifyDocumentResponse)

-- | The document type for each page in the input document. This field is
-- present in the response only if your request includes the @Byte@
-- parameter.
classifyDocumentResponse_documentType :: Lens.Lens' ClassifyDocumentResponse (Prelude.Maybe [DocumentTypeListItem])
classifyDocumentResponse_documentType :: Lens' ClassifyDocumentResponse (Maybe [DocumentTypeListItem])
classifyDocumentResponse_documentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClassifyDocumentResponse' {Maybe [DocumentTypeListItem]
documentType :: Maybe [DocumentTypeListItem]
$sel:documentType:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Maybe [DocumentTypeListItem]
documentType} -> Maybe [DocumentTypeListItem]
documentType) (\s :: ClassifyDocumentResponse
s@ClassifyDocumentResponse' {} Maybe [DocumentTypeListItem]
a -> ClassifyDocumentResponse
s {$sel:documentType:ClassifyDocumentResponse' :: Maybe [DocumentTypeListItem]
documentType = Maybe [DocumentTypeListItem]
a} :: ClassifyDocumentResponse) 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.
classifyDocumentResponse_errors :: Lens.Lens' ClassifyDocumentResponse (Prelude.Maybe [ErrorsListItem])
classifyDocumentResponse_errors :: Lens' ClassifyDocumentResponse (Maybe [ErrorsListItem])
classifyDocumentResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClassifyDocumentResponse' {Maybe [ErrorsListItem]
errors :: Maybe [ErrorsListItem]
$sel:errors:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Maybe [ErrorsListItem]
errors} -> Maybe [ErrorsListItem]
errors) (\s :: ClassifyDocumentResponse
s@ClassifyDocumentResponse' {} Maybe [ErrorsListItem]
a -> ClassifyDocumentResponse
s {$sel:errors:ClassifyDocumentResponse' :: Maybe [ErrorsListItem]
errors = Maybe [ErrorsListItem]
a} :: ClassifyDocumentResponse) 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 labels used the document being analyzed. These are used for
-- multi-label trained models. Individual labels represent different
-- categories that are related in some manner and are not mutually
-- exclusive. For example, a movie can be just an action movie, or it can
-- be an action movie, a science fiction movie, and a comedy, all at the
-- same time.
classifyDocumentResponse_labels :: Lens.Lens' ClassifyDocumentResponse (Prelude.Maybe [DocumentLabel])
classifyDocumentResponse_labels :: Lens' ClassifyDocumentResponse (Maybe [DocumentLabel])
classifyDocumentResponse_labels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClassifyDocumentResponse' {Maybe [DocumentLabel]
labels :: Maybe [DocumentLabel]
$sel:labels:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Maybe [DocumentLabel]
labels} -> Maybe [DocumentLabel]
labels) (\s :: ClassifyDocumentResponse
s@ClassifyDocumentResponse' {} Maybe [DocumentLabel]
a -> ClassifyDocumentResponse
s {$sel:labels:ClassifyDocumentResponse' :: Maybe [DocumentLabel]
labels = Maybe [DocumentLabel]
a} :: ClassifyDocumentResponse) 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.
classifyDocumentResponse_httpStatus :: Lens.Lens' ClassifyDocumentResponse Prelude.Int
classifyDocumentResponse_httpStatus :: Lens' ClassifyDocumentResponse Int
classifyDocumentResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClassifyDocumentResponse' {Int
httpStatus :: Int
$sel:httpStatus:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ClassifyDocumentResponse
s@ClassifyDocumentResponse' {} Int
a -> ClassifyDocumentResponse
s {$sel:httpStatus:ClassifyDocumentResponse' :: Int
httpStatus = Int
a} :: ClassifyDocumentResponse)

instance Prelude.NFData ClassifyDocumentResponse where
  rnf :: ClassifyDocumentResponse -> ()
rnf ClassifyDocumentResponse' {Int
Maybe [DocumentClass]
Maybe [DocumentLabel]
Maybe [DocumentTypeListItem]
Maybe [ErrorsListItem]
Maybe DocumentMetadata
httpStatus :: Int
labels :: Maybe [DocumentLabel]
errors :: Maybe [ErrorsListItem]
documentType :: Maybe [DocumentTypeListItem]
documentMetadata :: Maybe DocumentMetadata
classes :: Maybe [DocumentClass]
$sel:httpStatus:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Int
$sel:labels:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Maybe [DocumentLabel]
$sel:errors:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Maybe [ErrorsListItem]
$sel:documentType:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Maybe [DocumentTypeListItem]
$sel:documentMetadata:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Maybe DocumentMetadata
$sel:classes:ClassifyDocumentResponse' :: ClassifyDocumentResponse -> Maybe [DocumentClass]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DocumentClass]
classes
      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 [ErrorsListItem]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DocumentLabel]
labels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus