{-# 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.Rekognition.Types.ComparedFace
-- 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.Rekognition.Types.ComparedFace where

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 Amazonka.Rekognition.Types.BoundingBox
import Amazonka.Rekognition.Types.Emotion
import Amazonka.Rekognition.Types.ImageQuality
import Amazonka.Rekognition.Types.Landmark
import Amazonka.Rekognition.Types.Pose
import Amazonka.Rekognition.Types.Smile

-- | Provides face metadata for target image faces that are analyzed by
-- @CompareFaces@ and @RecognizeCelebrities@.
--
-- /See:/ 'newComparedFace' smart constructor.
data ComparedFace = ComparedFace'
  { -- | Bounding box of the face.
    ComparedFace -> Maybe BoundingBox
boundingBox :: Prelude.Maybe BoundingBox,
    -- | Level of confidence that what the bounding box contains is a face.
    ComparedFace -> Maybe Double
confidence :: Prelude.Maybe Prelude.Double,
    -- | The emotions that appear to be expressed on the face, and the confidence
    -- level in the determination. Valid values include \"Happy\", \"Sad\",
    -- \"Angry\", \"Confused\", \"Disgusted\", \"Surprised\", \"Calm\",
    -- \"Unknown\", and \"Fear\".
    ComparedFace -> Maybe [Emotion]
emotions :: Prelude.Maybe [Emotion],
    -- | An array of facial landmarks.
    ComparedFace -> Maybe [Landmark]
landmarks :: Prelude.Maybe [Landmark],
    -- | Indicates the pose of the face as determined by its pitch, roll, and
    -- yaw.
    ComparedFace -> Maybe Pose
pose :: Prelude.Maybe Pose,
    -- | Identifies face image brightness and sharpness.
    ComparedFace -> Maybe ImageQuality
quality :: Prelude.Maybe ImageQuality,
    -- | Indicates whether or not the face is smiling, and the confidence level
    -- in the determination.
    ComparedFace -> Maybe Smile
smile :: Prelude.Maybe Smile
  }
  deriving (ComparedFace -> ComparedFace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComparedFace -> ComparedFace -> Bool
$c/= :: ComparedFace -> ComparedFace -> Bool
== :: ComparedFace -> ComparedFace -> Bool
$c== :: ComparedFace -> ComparedFace -> Bool
Prelude.Eq, ReadPrec [ComparedFace]
ReadPrec ComparedFace
Int -> ReadS ComparedFace
ReadS [ComparedFace]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComparedFace]
$creadListPrec :: ReadPrec [ComparedFace]
readPrec :: ReadPrec ComparedFace
$creadPrec :: ReadPrec ComparedFace
readList :: ReadS [ComparedFace]
$creadList :: ReadS [ComparedFace]
readsPrec :: Int -> ReadS ComparedFace
$creadsPrec :: Int -> ReadS ComparedFace
Prelude.Read, Int -> ComparedFace -> ShowS
[ComparedFace] -> ShowS
ComparedFace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComparedFace] -> ShowS
$cshowList :: [ComparedFace] -> ShowS
show :: ComparedFace -> String
$cshow :: ComparedFace -> String
showsPrec :: Int -> ComparedFace -> ShowS
$cshowsPrec :: Int -> ComparedFace -> ShowS
Prelude.Show, forall x. Rep ComparedFace x -> ComparedFace
forall x. ComparedFace -> Rep ComparedFace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComparedFace x -> ComparedFace
$cfrom :: forall x. ComparedFace -> Rep ComparedFace x
Prelude.Generic)

-- |
-- Create a value of 'ComparedFace' 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:
--
-- 'boundingBox', 'comparedFace_boundingBox' - Bounding box of the face.
--
-- 'confidence', 'comparedFace_confidence' - Level of confidence that what the bounding box contains is a face.
--
-- 'emotions', 'comparedFace_emotions' - The emotions that appear to be expressed on the face, and the confidence
-- level in the determination. Valid values include \"Happy\", \"Sad\",
-- \"Angry\", \"Confused\", \"Disgusted\", \"Surprised\", \"Calm\",
-- \"Unknown\", and \"Fear\".
--
-- 'landmarks', 'comparedFace_landmarks' - An array of facial landmarks.
--
-- 'pose', 'comparedFace_pose' - Indicates the pose of the face as determined by its pitch, roll, and
-- yaw.
--
-- 'quality', 'comparedFace_quality' - Identifies face image brightness and sharpness.
--
-- 'smile', 'comparedFace_smile' - Indicates whether or not the face is smiling, and the confidence level
-- in the determination.
newComparedFace ::
  ComparedFace
newComparedFace :: ComparedFace
newComparedFace =
  ComparedFace'
    { $sel:boundingBox:ComparedFace' :: Maybe BoundingBox
boundingBox = forall a. Maybe a
Prelude.Nothing,
      $sel:confidence:ComparedFace' :: Maybe Double
confidence = forall a. Maybe a
Prelude.Nothing,
      $sel:emotions:ComparedFace' :: Maybe [Emotion]
emotions = forall a. Maybe a
Prelude.Nothing,
      $sel:landmarks:ComparedFace' :: Maybe [Landmark]
landmarks = forall a. Maybe a
Prelude.Nothing,
      $sel:pose:ComparedFace' :: Maybe Pose
pose = forall a. Maybe a
Prelude.Nothing,
      $sel:quality:ComparedFace' :: Maybe ImageQuality
quality = forall a. Maybe a
Prelude.Nothing,
      $sel:smile:ComparedFace' :: Maybe Smile
smile = forall a. Maybe a
Prelude.Nothing
    }

-- | Bounding box of the face.
comparedFace_boundingBox :: Lens.Lens' ComparedFace (Prelude.Maybe BoundingBox)
comparedFace_boundingBox :: Lens' ComparedFace (Maybe BoundingBox)
comparedFace_boundingBox = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComparedFace' {Maybe BoundingBox
boundingBox :: Maybe BoundingBox
$sel:boundingBox:ComparedFace' :: ComparedFace -> Maybe BoundingBox
boundingBox} -> Maybe BoundingBox
boundingBox) (\s :: ComparedFace
s@ComparedFace' {} Maybe BoundingBox
a -> ComparedFace
s {$sel:boundingBox:ComparedFace' :: Maybe BoundingBox
boundingBox = Maybe BoundingBox
a} :: ComparedFace)

-- | Level of confidence that what the bounding box contains is a face.
comparedFace_confidence :: Lens.Lens' ComparedFace (Prelude.Maybe Prelude.Double)
comparedFace_confidence :: Lens' ComparedFace (Maybe Double)
comparedFace_confidence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComparedFace' {Maybe Double
confidence :: Maybe Double
$sel:confidence:ComparedFace' :: ComparedFace -> Maybe Double
confidence} -> Maybe Double
confidence) (\s :: ComparedFace
s@ComparedFace' {} Maybe Double
a -> ComparedFace
s {$sel:confidence:ComparedFace' :: Maybe Double
confidence = Maybe Double
a} :: ComparedFace)

-- | The emotions that appear to be expressed on the face, and the confidence
-- level in the determination. Valid values include \"Happy\", \"Sad\",
-- \"Angry\", \"Confused\", \"Disgusted\", \"Surprised\", \"Calm\",
-- \"Unknown\", and \"Fear\".
comparedFace_emotions :: Lens.Lens' ComparedFace (Prelude.Maybe [Emotion])
comparedFace_emotions :: Lens' ComparedFace (Maybe [Emotion])
comparedFace_emotions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComparedFace' {Maybe [Emotion]
emotions :: Maybe [Emotion]
$sel:emotions:ComparedFace' :: ComparedFace -> Maybe [Emotion]
emotions} -> Maybe [Emotion]
emotions) (\s :: ComparedFace
s@ComparedFace' {} Maybe [Emotion]
a -> ComparedFace
s {$sel:emotions:ComparedFace' :: Maybe [Emotion]
emotions = Maybe [Emotion]
a} :: ComparedFace) 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

-- | An array of facial landmarks.
comparedFace_landmarks :: Lens.Lens' ComparedFace (Prelude.Maybe [Landmark])
comparedFace_landmarks :: Lens' ComparedFace (Maybe [Landmark])
comparedFace_landmarks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComparedFace' {Maybe [Landmark]
landmarks :: Maybe [Landmark]
$sel:landmarks:ComparedFace' :: ComparedFace -> Maybe [Landmark]
landmarks} -> Maybe [Landmark]
landmarks) (\s :: ComparedFace
s@ComparedFace' {} Maybe [Landmark]
a -> ComparedFace
s {$sel:landmarks:ComparedFace' :: Maybe [Landmark]
landmarks = Maybe [Landmark]
a} :: ComparedFace) 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

-- | Indicates the pose of the face as determined by its pitch, roll, and
-- yaw.
comparedFace_pose :: Lens.Lens' ComparedFace (Prelude.Maybe Pose)
comparedFace_pose :: Lens' ComparedFace (Maybe Pose)
comparedFace_pose = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComparedFace' {Maybe Pose
pose :: Maybe Pose
$sel:pose:ComparedFace' :: ComparedFace -> Maybe Pose
pose} -> Maybe Pose
pose) (\s :: ComparedFace
s@ComparedFace' {} Maybe Pose
a -> ComparedFace
s {$sel:pose:ComparedFace' :: Maybe Pose
pose = Maybe Pose
a} :: ComparedFace)

-- | Identifies face image brightness and sharpness.
comparedFace_quality :: Lens.Lens' ComparedFace (Prelude.Maybe ImageQuality)
comparedFace_quality :: Lens' ComparedFace (Maybe ImageQuality)
comparedFace_quality = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComparedFace' {Maybe ImageQuality
quality :: Maybe ImageQuality
$sel:quality:ComparedFace' :: ComparedFace -> Maybe ImageQuality
quality} -> Maybe ImageQuality
quality) (\s :: ComparedFace
s@ComparedFace' {} Maybe ImageQuality
a -> ComparedFace
s {$sel:quality:ComparedFace' :: Maybe ImageQuality
quality = Maybe ImageQuality
a} :: ComparedFace)

-- | Indicates whether or not the face is smiling, and the confidence level
-- in the determination.
comparedFace_smile :: Lens.Lens' ComparedFace (Prelude.Maybe Smile)
comparedFace_smile :: Lens' ComparedFace (Maybe Smile)
comparedFace_smile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComparedFace' {Maybe Smile
smile :: Maybe Smile
$sel:smile:ComparedFace' :: ComparedFace -> Maybe Smile
smile} -> Maybe Smile
smile) (\s :: ComparedFace
s@ComparedFace' {} Maybe Smile
a -> ComparedFace
s {$sel:smile:ComparedFace' :: Maybe Smile
smile = Maybe Smile
a} :: ComparedFace)

instance Data.FromJSON ComparedFace where
  parseJSON :: Value -> Parser ComparedFace
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ComparedFace"
      ( \Object
x ->
          Maybe BoundingBox
-> Maybe Double
-> Maybe [Emotion]
-> Maybe [Landmark]
-> Maybe Pose
-> Maybe ImageQuality
-> Maybe Smile
-> ComparedFace
ComparedFace'
            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
"BoundingBox")
            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
"Confidence")
            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
"Emotions" 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
"Landmarks" 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
"Pose")
            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
"Quality")
            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
"Smile")
      )

instance Prelude.Hashable ComparedFace where
  hashWithSalt :: Int -> ComparedFace -> Int
hashWithSalt Int
_salt ComparedFace' {Maybe Double
Maybe [Emotion]
Maybe [Landmark]
Maybe BoundingBox
Maybe ImageQuality
Maybe Pose
Maybe Smile
smile :: Maybe Smile
quality :: Maybe ImageQuality
pose :: Maybe Pose
landmarks :: Maybe [Landmark]
emotions :: Maybe [Emotion]
confidence :: Maybe Double
boundingBox :: Maybe BoundingBox
$sel:smile:ComparedFace' :: ComparedFace -> Maybe Smile
$sel:quality:ComparedFace' :: ComparedFace -> Maybe ImageQuality
$sel:pose:ComparedFace' :: ComparedFace -> Maybe Pose
$sel:landmarks:ComparedFace' :: ComparedFace -> Maybe [Landmark]
$sel:emotions:ComparedFace' :: ComparedFace -> Maybe [Emotion]
$sel:confidence:ComparedFace' :: ComparedFace -> Maybe Double
$sel:boundingBox:ComparedFace' :: ComparedFace -> Maybe BoundingBox
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BoundingBox
boundingBox
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
confidence
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Emotion]
emotions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Landmark]
landmarks
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Pose
pose
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ImageQuality
quality
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Smile
smile

instance Prelude.NFData ComparedFace where
  rnf :: ComparedFace -> ()
rnf ComparedFace' {Maybe Double
Maybe [Emotion]
Maybe [Landmark]
Maybe BoundingBox
Maybe ImageQuality
Maybe Pose
Maybe Smile
smile :: Maybe Smile
quality :: Maybe ImageQuality
pose :: Maybe Pose
landmarks :: Maybe [Landmark]
emotions :: Maybe [Emotion]
confidence :: Maybe Double
boundingBox :: Maybe BoundingBox
$sel:smile:ComparedFace' :: ComparedFace -> Maybe Smile
$sel:quality:ComparedFace' :: ComparedFace -> Maybe ImageQuality
$sel:pose:ComparedFace' :: ComparedFace -> Maybe Pose
$sel:landmarks:ComparedFace' :: ComparedFace -> Maybe [Landmark]
$sel:emotions:ComparedFace' :: ComparedFace -> Maybe [Emotion]
$sel:confidence:ComparedFace' :: ComparedFace -> Maybe Double
$sel:boundingBox:ComparedFace' :: ComparedFace -> Maybe BoundingBox
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BoundingBox
boundingBox
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
confidence
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Emotion]
emotions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Landmark]
landmarks
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Pose
pose
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImageQuality
quality
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Smile
smile