{-# 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.ComprehendMedical.Types.Entity
-- 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.ComprehendMedical.Types.Entity where

import Amazonka.ComprehendMedical.Types.Attribute
import Amazonka.ComprehendMedical.Types.EntitySubType
import Amazonka.ComprehendMedical.Types.EntityType
import Amazonka.ComprehendMedical.Types.Trait
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

-- | Provides information about an extracted medical entity.
--
-- /See:/ 'newEntity' smart constructor.
data Entity = Entity'
  { -- | The extracted attributes that relate to this entity.
    Entity -> Maybe [Attribute]
attributes :: Prelude.Maybe [Attribute],
    -- | The 0-based character offset in the input text that shows where the
    -- entity begins. The offset returns the UTF-8 code point in the string.
    Entity -> Maybe Int
beginOffset :: Prelude.Maybe Prelude.Int,
    -- | The category of the entity.
    Entity -> Maybe EntityType
category :: Prelude.Maybe EntityType,
    -- | The 0-based character offset in the input text that shows where the
    -- entity ends. The offset returns the UTF-8 code point in the string.
    Entity -> Maybe Int
endOffset :: Prelude.Maybe Prelude.Int,
    -- | The numeric identifier for the entity. This is a monotonically
    -- increasing id unique within this response rather than a global unique
    -- identifier.
    Entity -> Maybe Int
id :: Prelude.Maybe Prelude.Int,
    -- | The level of confidence that Comprehend Medical; has in the accuracy of
    -- the detection.
    Entity -> Maybe Double
score :: Prelude.Maybe Prelude.Double,
    -- | The segment of input text extracted as this entity.
    Entity -> Maybe Text
text :: Prelude.Maybe Prelude.Text,
    -- | Contextual information for the entity.
    Entity -> Maybe [Trait]
traits :: Prelude.Maybe [Trait],
    -- | Describes the specific type of entity with category of entities.
    Entity -> Maybe EntitySubType
type' :: Prelude.Maybe EntitySubType
  }
  deriving (Entity -> Entity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c== :: Entity -> Entity -> Bool
Prelude.Eq, ReadPrec [Entity]
ReadPrec Entity
Int -> ReadS Entity
ReadS [Entity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Entity]
$creadListPrec :: ReadPrec [Entity]
readPrec :: ReadPrec Entity
$creadPrec :: ReadPrec Entity
readList :: ReadS [Entity]
$creadList :: ReadS [Entity]
readsPrec :: Int -> ReadS Entity
$creadsPrec :: Int -> ReadS Entity
Prelude.Read, Int -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entity] -> ShowS
$cshowList :: [Entity] -> ShowS
show :: Entity -> String
$cshow :: Entity -> String
showsPrec :: Int -> Entity -> ShowS
$cshowsPrec :: Int -> Entity -> ShowS
Prelude.Show, forall x. Rep Entity x -> Entity
forall x. Entity -> Rep Entity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Entity x -> Entity
$cfrom :: forall x. Entity -> Rep Entity x
Prelude.Generic)

-- |
-- Create a value of 'Entity' 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:
--
-- 'attributes', 'entity_attributes' - The extracted attributes that relate to this entity.
--
-- 'beginOffset', 'entity_beginOffset' - The 0-based character offset in the input text that shows where the
-- entity begins. The offset returns the UTF-8 code point in the string.
--
-- 'category', 'entity_category' - The category of the entity.
--
-- 'endOffset', 'entity_endOffset' - The 0-based character offset in the input text that shows where the
-- entity ends. The offset returns the UTF-8 code point in the string.
--
-- 'id', 'entity_id' - The numeric identifier for the entity. This is a monotonically
-- increasing id unique within this response rather than a global unique
-- identifier.
--
-- 'score', 'entity_score' - The level of confidence that Comprehend Medical; has in the accuracy of
-- the detection.
--
-- 'text', 'entity_text' - The segment of input text extracted as this entity.
--
-- 'traits', 'entity_traits' - Contextual information for the entity.
--
-- 'type'', 'entity_type' - Describes the specific type of entity with category of entities.
newEntity ::
  Entity
newEntity :: Entity
newEntity =
  Entity'
    { $sel:attributes:Entity' :: Maybe [Attribute]
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:beginOffset:Entity' :: Maybe Int
beginOffset = forall a. Maybe a
Prelude.Nothing,
      $sel:category:Entity' :: Maybe EntityType
category = forall a. Maybe a
Prelude.Nothing,
      $sel:endOffset:Entity' :: Maybe Int
endOffset = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Entity' :: Maybe Int
id = forall a. Maybe a
Prelude.Nothing,
      $sel:score:Entity' :: Maybe Double
score = forall a. Maybe a
Prelude.Nothing,
      $sel:text:Entity' :: Maybe Text
text = forall a. Maybe a
Prelude.Nothing,
      $sel:traits:Entity' :: Maybe [Trait]
traits = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Entity' :: Maybe EntitySubType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | The extracted attributes that relate to this entity.
entity_attributes :: Lens.Lens' Entity (Prelude.Maybe [Attribute])
entity_attributes :: Lens' Entity (Maybe [Attribute])
entity_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Entity' {Maybe [Attribute]
attributes :: Maybe [Attribute]
$sel:attributes:Entity' :: Entity -> Maybe [Attribute]
attributes} -> Maybe [Attribute]
attributes) (\s :: Entity
s@Entity' {} Maybe [Attribute]
a -> Entity
s {$sel:attributes:Entity' :: Maybe [Attribute]
attributes = Maybe [Attribute]
a} :: Entity) 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 0-based character offset in the input text that shows where the
-- entity begins. The offset returns the UTF-8 code point in the string.
entity_beginOffset :: Lens.Lens' Entity (Prelude.Maybe Prelude.Int)
entity_beginOffset :: Lens' Entity (Maybe Int)
entity_beginOffset = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Entity' {Maybe Int
beginOffset :: Maybe Int
$sel:beginOffset:Entity' :: Entity -> Maybe Int
beginOffset} -> Maybe Int
beginOffset) (\s :: Entity
s@Entity' {} Maybe Int
a -> Entity
s {$sel:beginOffset:Entity' :: Maybe Int
beginOffset = Maybe Int
a} :: Entity)

-- | The category of the entity.
entity_category :: Lens.Lens' Entity (Prelude.Maybe EntityType)
entity_category :: Lens' Entity (Maybe EntityType)
entity_category = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Entity' {Maybe EntityType
category :: Maybe EntityType
$sel:category:Entity' :: Entity -> Maybe EntityType
category} -> Maybe EntityType
category) (\s :: Entity
s@Entity' {} Maybe EntityType
a -> Entity
s {$sel:category:Entity' :: Maybe EntityType
category = Maybe EntityType
a} :: Entity)

-- | The 0-based character offset in the input text that shows where the
-- entity ends. The offset returns the UTF-8 code point in the string.
entity_endOffset :: Lens.Lens' Entity (Prelude.Maybe Prelude.Int)
entity_endOffset :: Lens' Entity (Maybe Int)
entity_endOffset = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Entity' {Maybe Int
endOffset :: Maybe Int
$sel:endOffset:Entity' :: Entity -> Maybe Int
endOffset} -> Maybe Int
endOffset) (\s :: Entity
s@Entity' {} Maybe Int
a -> Entity
s {$sel:endOffset:Entity' :: Maybe Int
endOffset = Maybe Int
a} :: Entity)

-- | The numeric identifier for the entity. This is a monotonically
-- increasing id unique within this response rather than a global unique
-- identifier.
entity_id :: Lens.Lens' Entity (Prelude.Maybe Prelude.Int)
entity_id :: Lens' Entity (Maybe Int)
entity_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Entity' {Maybe Int
id :: Maybe Int
$sel:id:Entity' :: Entity -> Maybe Int
id} -> Maybe Int
id) (\s :: Entity
s@Entity' {} Maybe Int
a -> Entity
s {$sel:id:Entity' :: Maybe Int
id = Maybe Int
a} :: Entity)

-- | The level of confidence that Comprehend Medical; has in the accuracy of
-- the detection.
entity_score :: Lens.Lens' Entity (Prelude.Maybe Prelude.Double)
entity_score :: Lens' Entity (Maybe Double)
entity_score = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Entity' {Maybe Double
score :: Maybe Double
$sel:score:Entity' :: Entity -> Maybe Double
score} -> Maybe Double
score) (\s :: Entity
s@Entity' {} Maybe Double
a -> Entity
s {$sel:score:Entity' :: Maybe Double
score = Maybe Double
a} :: Entity)

-- | The segment of input text extracted as this entity.
entity_text :: Lens.Lens' Entity (Prelude.Maybe Prelude.Text)
entity_text :: Lens' Entity (Maybe Text)
entity_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Entity' {Maybe Text
text :: Maybe Text
$sel:text:Entity' :: Entity -> Maybe Text
text} -> Maybe Text
text) (\s :: Entity
s@Entity' {} Maybe Text
a -> Entity
s {$sel:text:Entity' :: Maybe Text
text = Maybe Text
a} :: Entity)

-- | Contextual information for the entity.
entity_traits :: Lens.Lens' Entity (Prelude.Maybe [Trait])
entity_traits :: Lens' Entity (Maybe [Trait])
entity_traits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Entity' {Maybe [Trait]
traits :: Maybe [Trait]
$sel:traits:Entity' :: Entity -> Maybe [Trait]
traits} -> Maybe [Trait]
traits) (\s :: Entity
s@Entity' {} Maybe [Trait]
a -> Entity
s {$sel:traits:Entity' :: Maybe [Trait]
traits = Maybe [Trait]
a} :: Entity) 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

-- | Describes the specific type of entity with category of entities.
entity_type :: Lens.Lens' Entity (Prelude.Maybe EntitySubType)
entity_type :: Lens' Entity (Maybe EntitySubType)
entity_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Entity' {Maybe EntitySubType
type' :: Maybe EntitySubType
$sel:type':Entity' :: Entity -> Maybe EntitySubType
type'} -> Maybe EntitySubType
type') (\s :: Entity
s@Entity' {} Maybe EntitySubType
a -> Entity
s {$sel:type':Entity' :: Maybe EntitySubType
type' = Maybe EntitySubType
a} :: Entity)

instance Data.FromJSON Entity where
  parseJSON :: Value -> Parser Entity
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Entity"
      ( \Object
x ->
          Maybe [Attribute]
-> Maybe Int
-> Maybe EntityType
-> Maybe Int
-> Maybe Int
-> Maybe Double
-> Maybe Text
-> Maybe [Trait]
-> Maybe EntitySubType
-> Entity
Entity'
            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
"Attributes" 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
"BeginOffset")
            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
"Category")
            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
"EndOffset")
            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
"Score")
            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")
            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
"Traits" 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
"Type")
      )

instance Prelude.Hashable Entity where
  hashWithSalt :: Int -> Entity -> Int
hashWithSalt Int
_salt Entity' {Maybe Double
Maybe Int
Maybe [Trait]
Maybe [Attribute]
Maybe Text
Maybe EntitySubType
Maybe EntityType
type' :: Maybe EntitySubType
traits :: Maybe [Trait]
text :: Maybe Text
score :: Maybe Double
id :: Maybe Int
endOffset :: Maybe Int
category :: Maybe EntityType
beginOffset :: Maybe Int
attributes :: Maybe [Attribute]
$sel:type':Entity' :: Entity -> Maybe EntitySubType
$sel:traits:Entity' :: Entity -> Maybe [Trait]
$sel:text:Entity' :: Entity -> Maybe Text
$sel:score:Entity' :: Entity -> Maybe Double
$sel:id:Entity' :: Entity -> Maybe Int
$sel:endOffset:Entity' :: Entity -> Maybe Int
$sel:category:Entity' :: Entity -> Maybe EntityType
$sel:beginOffset:Entity' :: Entity -> Maybe Int
$sel:attributes:Entity' :: Entity -> Maybe [Attribute]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Attribute]
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
beginOffset
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EntityType
category
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
endOffset
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
score
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
text
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Trait]
traits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EntitySubType
type'

instance Prelude.NFData Entity where
  rnf :: Entity -> ()
rnf Entity' {Maybe Double
Maybe Int
Maybe [Trait]
Maybe [Attribute]
Maybe Text
Maybe EntitySubType
Maybe EntityType
type' :: Maybe EntitySubType
traits :: Maybe [Trait]
text :: Maybe Text
score :: Maybe Double
id :: Maybe Int
endOffset :: Maybe Int
category :: Maybe EntityType
beginOffset :: Maybe Int
attributes :: Maybe [Attribute]
$sel:type':Entity' :: Entity -> Maybe EntitySubType
$sel:traits:Entity' :: Entity -> Maybe [Trait]
$sel:text:Entity' :: Entity -> Maybe Text
$sel:score:Entity' :: Entity -> Maybe Double
$sel:id:Entity' :: Entity -> Maybe Int
$sel:endOffset:Entity' :: Entity -> Maybe Int
$sel:category:Entity' :: Entity -> Maybe EntityType
$sel:beginOffset:Entity' :: Entity -> Maybe Int
$sel:attributes:Entity' :: Entity -> Maybe [Attribute]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Attribute]
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
beginOffset
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EntityType
category
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
endOffset
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
score
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
text
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Trait]
traits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EntitySubType
type'