{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.Block
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Comprehend.Types.Block where

import Amazonka.Comprehend.Types.BlockType
import Amazonka.Comprehend.Types.Geometry
import Amazonka.Comprehend.Types.RelationshipsListItem
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

-- | Information about each word or line of text in the input document.
--
-- For additional information, see
-- <https://docs.aws.amazon.com/textract/latest/dg/API_Block.html Block> in
-- the Amazon Textract API reference.
--
-- /See:/ 'newBlock' smart constructor.
data Block = Block'
  { -- | The block represents a line of text or one word of text.
    --
    -- -   WORD - A word that\'s detected on a document page. A word is one or
    --     more ISO basic Latin script characters that aren\'t separated by
    --     spaces.
    --
    -- -   LINE - A string of tab-delimited, contiguous words that are detected
    --     on a document page
    Block -> Maybe BlockType
blockType :: Prelude.Maybe BlockType,
    -- | Co-ordinates of the rectangle or polygon that contains the text.
    Block -> Maybe Geometry
geometry :: Prelude.Maybe Geometry,
    -- | Unique identifier for the block.
    Block -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | Page number where the block appears.
    Block -> Maybe Int
page :: Prelude.Maybe Prelude.Int,
    -- | A list of child blocks of the current block. For example, a LINE object
    -- has child blocks for each WORD block that\'s part of the line of text.
    Block -> Maybe [RelationshipsListItem]
relationships :: Prelude.Maybe [RelationshipsListItem],
    -- | The word or line of text extracted from the block.
    Block -> Maybe Text
text :: Prelude.Maybe Prelude.Text
  }
  deriving (Block -> Block -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: Block -> Block -> Bool
Prelude.Eq, ReadPrec [Block]
ReadPrec Block
Int -> ReadS Block
ReadS [Block]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Block]
$creadListPrec :: ReadPrec [Block]
readPrec :: ReadPrec Block
$creadPrec :: ReadPrec Block
readList :: ReadS [Block]
$creadList :: ReadS [Block]
readsPrec :: Int -> ReadS Block
$creadsPrec :: Int -> ReadS Block
Prelude.Read, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Prelude.Show, forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Prelude.Generic)

-- |
-- Create a value of 'Block' 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:
--
-- 'blockType', 'block_blockType' - The block represents a line of text or one word of text.
--
-- -   WORD - A word that\'s detected on a document page. A word is one or
--     more ISO basic Latin script characters that aren\'t separated by
--     spaces.
--
-- -   LINE - A string of tab-delimited, contiguous words that are detected
--     on a document page
--
-- 'geometry', 'block_geometry' - Co-ordinates of the rectangle or polygon that contains the text.
--
-- 'id', 'block_id' - Unique identifier for the block.
--
-- 'page', 'block_page' - Page number where the block appears.
--
-- 'relationships', 'block_relationships' - A list of child blocks of the current block. For example, a LINE object
-- has child blocks for each WORD block that\'s part of the line of text.
--
-- 'text', 'block_text' - The word or line of text extracted from the block.
newBlock ::
  Block
newBlock :: Block
newBlock =
  Block'
    { $sel:blockType:Block' :: Maybe BlockType
blockType = forall a. Maybe a
Prelude.Nothing,
      $sel:geometry:Block' :: Maybe Geometry
geometry = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Block' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:page:Block' :: Maybe Int
page = forall a. Maybe a
Prelude.Nothing,
      $sel:relationships:Block' :: Maybe [RelationshipsListItem]
relationships = forall a. Maybe a
Prelude.Nothing,
      $sel:text:Block' :: Maybe Text
text = forall a. Maybe a
Prelude.Nothing
    }

-- | The block represents a line of text or one word of text.
--
-- -   WORD - A word that\'s detected on a document page. A word is one or
--     more ISO basic Latin script characters that aren\'t separated by
--     spaces.
--
-- -   LINE - A string of tab-delimited, contiguous words that are detected
--     on a document page
block_blockType :: Lens.Lens' Block (Prelude.Maybe BlockType)
block_blockType :: Lens' Block (Maybe BlockType)
block_blockType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Block' {Maybe BlockType
blockType :: Maybe BlockType
$sel:blockType:Block' :: Block -> Maybe BlockType
blockType} -> Maybe BlockType
blockType) (\s :: Block
s@Block' {} Maybe BlockType
a -> Block
s {$sel:blockType:Block' :: Maybe BlockType
blockType = Maybe BlockType
a} :: Block)

-- | Co-ordinates of the rectangle or polygon that contains the text.
block_geometry :: Lens.Lens' Block (Prelude.Maybe Geometry)
block_geometry :: Lens' Block (Maybe Geometry)
block_geometry = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Block' {Maybe Geometry
geometry :: Maybe Geometry
$sel:geometry:Block' :: Block -> Maybe Geometry
geometry} -> Maybe Geometry
geometry) (\s :: Block
s@Block' {} Maybe Geometry
a -> Block
s {$sel:geometry:Block' :: Maybe Geometry
geometry = Maybe Geometry
a} :: Block)

-- | Unique identifier for the block.
block_id :: Lens.Lens' Block (Prelude.Maybe Prelude.Text)
block_id :: Lens' Block (Maybe Text)
block_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Block' {Maybe Text
id :: Maybe Text
$sel:id:Block' :: Block -> Maybe Text
id} -> Maybe Text
id) (\s :: Block
s@Block' {} Maybe Text
a -> Block
s {$sel:id:Block' :: Maybe Text
id = Maybe Text
a} :: Block)

-- | Page number where the block appears.
block_page :: Lens.Lens' Block (Prelude.Maybe Prelude.Int)
block_page :: Lens' Block (Maybe Int)
block_page = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Block' {Maybe Int
page :: Maybe Int
$sel:page:Block' :: Block -> Maybe Int
page} -> Maybe Int
page) (\s :: Block
s@Block' {} Maybe Int
a -> Block
s {$sel:page:Block' :: Maybe Int
page = Maybe Int
a} :: Block)

-- | A list of child blocks of the current block. For example, a LINE object
-- has child blocks for each WORD block that\'s part of the line of text.
block_relationships :: Lens.Lens' Block (Prelude.Maybe [RelationshipsListItem])
block_relationships :: Lens' Block (Maybe [RelationshipsListItem])
block_relationships = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Block' {Maybe [RelationshipsListItem]
relationships :: Maybe [RelationshipsListItem]
$sel:relationships:Block' :: Block -> Maybe [RelationshipsListItem]
relationships} -> Maybe [RelationshipsListItem]
relationships) (\s :: Block
s@Block' {} Maybe [RelationshipsListItem]
a -> Block
s {$sel:relationships:Block' :: Maybe [RelationshipsListItem]
relationships = Maybe [RelationshipsListItem]
a} :: Block) 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 word or line of text extracted from the block.
block_text :: Lens.Lens' Block (Prelude.Maybe Prelude.Text)
block_text :: Lens' Block (Maybe Text)
block_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Block' {Maybe Text
text :: Maybe Text
$sel:text:Block' :: Block -> Maybe Text
text} -> Maybe Text
text) (\s :: Block
s@Block' {} Maybe Text
a -> Block
s {$sel:text:Block' :: Maybe Text
text = Maybe Text
a} :: Block)

instance Data.FromJSON Block where
  parseJSON :: Value -> Parser Block
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Block"
      ( \Object
x ->
          Maybe BlockType
-> Maybe Geometry
-> Maybe Text
-> Maybe Int
-> Maybe [RelationshipsListItem]
-> Maybe Text
-> Block
Block'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"BlockType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Geometry")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Page")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Relationships" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"Text")
      )

instance Prelude.Hashable Block where
  hashWithSalt :: Int -> Block -> Int
hashWithSalt Int
_salt Block' {Maybe Int
Maybe [RelationshipsListItem]
Maybe Text
Maybe BlockType
Maybe Geometry
text :: Maybe Text
relationships :: Maybe [RelationshipsListItem]
page :: Maybe Int
id :: Maybe Text
geometry :: Maybe Geometry
blockType :: Maybe BlockType
$sel:text:Block' :: Block -> Maybe Text
$sel:relationships:Block' :: Block -> Maybe [RelationshipsListItem]
$sel:page:Block' :: Block -> Maybe Int
$sel:id:Block' :: Block -> Maybe Text
$sel:geometry:Block' :: Block -> Maybe Geometry
$sel:blockType:Block' :: Block -> Maybe BlockType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BlockType
blockType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Geometry
geometry
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
page
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [RelationshipsListItem]
relationships
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
text

instance Prelude.NFData Block where
  rnf :: Block -> ()
rnf Block' {Maybe Int
Maybe [RelationshipsListItem]
Maybe Text
Maybe BlockType
Maybe Geometry
text :: Maybe Text
relationships :: Maybe [RelationshipsListItem]
page :: Maybe Int
id :: Maybe Text
geometry :: Maybe Geometry
blockType :: Maybe BlockType
$sel:text:Block' :: Block -> Maybe Text
$sel:relationships:Block' :: Block -> Maybe [RelationshipsListItem]
$sel:page:Block' :: Block -> Maybe Int
$sel:id:Block' :: Block -> Maybe Text
$sel:geometry:Block' :: Block -> Maybe Geometry
$sel:blockType:Block' :: Block -> Maybe BlockType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BlockType
blockType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Geometry
geometry
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
page
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RelationshipsListItem]
relationships
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
text