{-# 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.Attribute
-- 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.Attribute where

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

-- | An extracted segment of the text that is an attribute of an entity, or
-- otherwise related to an entity, such as the dosage of a medication
-- taken. It contains information about the attribute such as id, begin and
-- end offset within the input text, and the segment of the input text.
--
-- /See:/ 'newAttribute' smart constructor.
data Attribute = Attribute'
  { -- | The 0-based character offset in the input text that shows where the
    -- attribute begins. The offset returns the UTF-8 code point in the string.
    Attribute -> Maybe Int
beginOffset :: Prelude.Maybe Prelude.Int,
    -- | The category of attribute.
    Attribute -> Maybe EntityType
category :: Prelude.Maybe EntityType,
    -- | The 0-based character offset in the input text that shows where the
    -- attribute ends. The offset returns the UTF-8 code point in the string.
    Attribute -> Maybe Int
endOffset :: Prelude.Maybe Prelude.Int,
    -- | The numeric identifier for this attribute. This is a monotonically
    -- increasing id unique within this response rather than a global unique
    -- identifier.
    Attribute -> Maybe Int
id :: Prelude.Maybe Prelude.Int,
    -- | The level of confidence that Comprehend Medical; has that this attribute
    -- is correctly related to this entity.
    Attribute -> Maybe Double
relationshipScore :: Prelude.Maybe Prelude.Double,
    -- | The type of relationship between the entity and attribute. Type for the
    -- relationship is @OVERLAP@, indicating that the entity occurred at the
    -- same time as the @Date_Expression@.
    Attribute -> Maybe RelationshipType
relationshipType :: Prelude.Maybe RelationshipType,
    -- | The level of confidence that Comprehend Medical; has that the segment of
    -- text is correctly recognized as an attribute.
    Attribute -> Maybe Double
score :: Prelude.Maybe Prelude.Double,
    -- | The segment of input text extracted as this attribute.
    Attribute -> Maybe Text
text :: Prelude.Maybe Prelude.Text,
    -- | Contextual information for this attribute.
    Attribute -> Maybe [Trait]
traits :: Prelude.Maybe [Trait],
    -- | The type of attribute.
    Attribute -> Maybe EntitySubType
type' :: Prelude.Maybe EntitySubType
  }
  deriving (Attribute -> Attribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Prelude.Eq, ReadPrec [Attribute]
ReadPrec Attribute
Int -> ReadS Attribute
ReadS [Attribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Attribute]
$creadListPrec :: ReadPrec [Attribute]
readPrec :: ReadPrec Attribute
$creadPrec :: ReadPrec Attribute
readList :: ReadS [Attribute]
$creadList :: ReadS [Attribute]
readsPrec :: Int -> ReadS Attribute
$creadsPrec :: Int -> ReadS Attribute
Prelude.Read, Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Prelude.Show, forall x. Rep Attribute x -> Attribute
forall x. Attribute -> Rep Attribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attribute x -> Attribute
$cfrom :: forall x. Attribute -> Rep Attribute x
Prelude.Generic)

-- |
-- Create a value of 'Attribute' 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:
--
-- 'beginOffset', 'attribute_beginOffset' - The 0-based character offset in the input text that shows where the
-- attribute begins. The offset returns the UTF-8 code point in the string.
--
-- 'category', 'attribute_category' - The category of attribute.
--
-- 'endOffset', 'attribute_endOffset' - The 0-based character offset in the input text that shows where the
-- attribute ends. The offset returns the UTF-8 code point in the string.
--
-- 'id', 'attribute_id' - The numeric identifier for this attribute. This is a monotonically
-- increasing id unique within this response rather than a global unique
-- identifier.
--
-- 'relationshipScore', 'attribute_relationshipScore' - The level of confidence that Comprehend Medical; has that this attribute
-- is correctly related to this entity.
--
-- 'relationshipType', 'attribute_relationshipType' - The type of relationship between the entity and attribute. Type for the
-- relationship is @OVERLAP@, indicating that the entity occurred at the
-- same time as the @Date_Expression@.
--
-- 'score', 'attribute_score' - The level of confidence that Comprehend Medical; has that the segment of
-- text is correctly recognized as an attribute.
--
-- 'text', 'attribute_text' - The segment of input text extracted as this attribute.
--
-- 'traits', 'attribute_traits' - Contextual information for this attribute.
--
-- 'type'', 'attribute_type' - The type of attribute.
newAttribute ::
  Attribute
newAttribute :: Attribute
newAttribute =
  Attribute'
    { $sel:beginOffset:Attribute' :: Maybe Int
beginOffset = forall a. Maybe a
Prelude.Nothing,
      $sel:category:Attribute' :: Maybe EntityType
category = forall a. Maybe a
Prelude.Nothing,
      $sel:endOffset:Attribute' :: Maybe Int
endOffset = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Attribute' :: Maybe Int
id = forall a. Maybe a
Prelude.Nothing,
      $sel:relationshipScore:Attribute' :: Maybe Double
relationshipScore = forall a. Maybe a
Prelude.Nothing,
      $sel:relationshipType:Attribute' :: Maybe RelationshipType
relationshipType = forall a. Maybe a
Prelude.Nothing,
      $sel:score:Attribute' :: Maybe Double
score = forall a. Maybe a
Prelude.Nothing,
      $sel:text:Attribute' :: Maybe Text
text = forall a. Maybe a
Prelude.Nothing,
      $sel:traits:Attribute' :: Maybe [Trait]
traits = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Attribute' :: Maybe EntitySubType
type' = forall a. Maybe a
Prelude.Nothing
    }

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

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

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

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

-- | The level of confidence that Comprehend Medical; has that this attribute
-- is correctly related to this entity.
attribute_relationshipScore :: Lens.Lens' Attribute (Prelude.Maybe Prelude.Double)
attribute_relationshipScore :: Lens' Attribute (Maybe Double)
attribute_relationshipScore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Attribute' {Maybe Double
relationshipScore :: Maybe Double
$sel:relationshipScore:Attribute' :: Attribute -> Maybe Double
relationshipScore} -> Maybe Double
relationshipScore) (\s :: Attribute
s@Attribute' {} Maybe Double
a -> Attribute
s {$sel:relationshipScore:Attribute' :: Maybe Double
relationshipScore = Maybe Double
a} :: Attribute)

-- | The type of relationship between the entity and attribute. Type for the
-- relationship is @OVERLAP@, indicating that the entity occurred at the
-- same time as the @Date_Expression@.
attribute_relationshipType :: Lens.Lens' Attribute (Prelude.Maybe RelationshipType)
attribute_relationshipType :: Lens' Attribute (Maybe RelationshipType)
attribute_relationshipType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Attribute' {Maybe RelationshipType
relationshipType :: Maybe RelationshipType
$sel:relationshipType:Attribute' :: Attribute -> Maybe RelationshipType
relationshipType} -> Maybe RelationshipType
relationshipType) (\s :: Attribute
s@Attribute' {} Maybe RelationshipType
a -> Attribute
s {$sel:relationshipType:Attribute' :: Maybe RelationshipType
relationshipType = Maybe RelationshipType
a} :: Attribute)

-- | The level of confidence that Comprehend Medical; has that the segment of
-- text is correctly recognized as an attribute.
attribute_score :: Lens.Lens' Attribute (Prelude.Maybe Prelude.Double)
attribute_score :: Lens' Attribute (Maybe Double)
attribute_score = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Attribute' {Maybe Double
score :: Maybe Double
$sel:score:Attribute' :: Attribute -> Maybe Double
score} -> Maybe Double
score) (\s :: Attribute
s@Attribute' {} Maybe Double
a -> Attribute
s {$sel:score:Attribute' :: Maybe Double
score = Maybe Double
a} :: Attribute)

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

-- | Contextual information for this attribute.
attribute_traits :: Lens.Lens' Attribute (Prelude.Maybe [Trait])
attribute_traits :: Lens' Attribute (Maybe [Trait])
attribute_traits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Attribute' {Maybe [Trait]
traits :: Maybe [Trait]
$sel:traits:Attribute' :: Attribute -> Maybe [Trait]
traits} -> Maybe [Trait]
traits) (\s :: Attribute
s@Attribute' {} Maybe [Trait]
a -> Attribute
s {$sel:traits:Attribute' :: Maybe [Trait]
traits = Maybe [Trait]
a} :: Attribute) 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 type of attribute.
attribute_type :: Lens.Lens' Attribute (Prelude.Maybe EntitySubType)
attribute_type :: Lens' Attribute (Maybe EntitySubType)
attribute_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Attribute' {Maybe EntitySubType
type' :: Maybe EntitySubType
$sel:type':Attribute' :: Attribute -> Maybe EntitySubType
type'} -> Maybe EntitySubType
type') (\s :: Attribute
s@Attribute' {} Maybe EntitySubType
a -> Attribute
s {$sel:type':Attribute' :: Maybe EntitySubType
type' = Maybe EntitySubType
a} :: Attribute)

instance Data.FromJSON Attribute where
  parseJSON :: Value -> Parser Attribute
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Attribute"
      ( \Object
x ->
          Maybe Int
-> Maybe EntityType
-> Maybe Int
-> Maybe Int
-> Maybe Double
-> Maybe RelationshipType
-> Maybe Double
-> Maybe Text
-> Maybe [Trait]
-> Maybe EntitySubType
-> Attribute
Attribute'
            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
"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
"RelationshipScore")
            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
"RelationshipType")
            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 Attribute where
  hashWithSalt :: Int -> Attribute -> Int
hashWithSalt Int
_salt Attribute' {Maybe Double
Maybe Int
Maybe [Trait]
Maybe Text
Maybe EntitySubType
Maybe EntityType
Maybe RelationshipType
type' :: Maybe EntitySubType
traits :: Maybe [Trait]
text :: Maybe Text
score :: Maybe Double
relationshipType :: Maybe RelationshipType
relationshipScore :: Maybe Double
id :: Maybe Int
endOffset :: Maybe Int
category :: Maybe EntityType
beginOffset :: Maybe Int
$sel:type':Attribute' :: Attribute -> Maybe EntitySubType
$sel:traits:Attribute' :: Attribute -> Maybe [Trait]
$sel:text:Attribute' :: Attribute -> Maybe Text
$sel:score:Attribute' :: Attribute -> Maybe Double
$sel:relationshipType:Attribute' :: Attribute -> Maybe RelationshipType
$sel:relationshipScore:Attribute' :: Attribute -> Maybe Double
$sel:id:Attribute' :: Attribute -> Maybe Int
$sel:endOffset:Attribute' :: Attribute -> Maybe Int
$sel:category:Attribute' :: Attribute -> Maybe EntityType
$sel:beginOffset:Attribute' :: Attribute -> Maybe Int
..} =
    Int
_salt
      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
relationshipScore
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RelationshipType
relationshipType
      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 Attribute where
  rnf :: Attribute -> ()
rnf Attribute' {Maybe Double
Maybe Int
Maybe [Trait]
Maybe Text
Maybe EntitySubType
Maybe EntityType
Maybe RelationshipType
type' :: Maybe EntitySubType
traits :: Maybe [Trait]
text :: Maybe Text
score :: Maybe Double
relationshipType :: Maybe RelationshipType
relationshipScore :: Maybe Double
id :: Maybe Int
endOffset :: Maybe Int
category :: Maybe EntityType
beginOffset :: Maybe Int
$sel:type':Attribute' :: Attribute -> Maybe EntitySubType
$sel:traits:Attribute' :: Attribute -> Maybe [Trait]
$sel:text:Attribute' :: Attribute -> Maybe Text
$sel:score:Attribute' :: Attribute -> Maybe Double
$sel:relationshipType:Attribute' :: Attribute -> Maybe RelationshipType
$sel:relationshipScore:Attribute' :: Attribute -> Maybe Double
$sel:id:Attribute' :: Attribute -> Maybe Int
$sel:endOffset:Attribute' :: Attribute -> Maybe Int
$sel:category:Attribute' :: Attribute -> Maybe EntityType
$sel:beginOffset:Attribute' :: Attribute -> Maybe Int
..} =
    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
relationshipScore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RelationshipType
relationshipType
      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'