{-# 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.FaceDetail
-- 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.FaceDetail 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.AgeRange
import Amazonka.Rekognition.Types.Beard
import Amazonka.Rekognition.Types.BoundingBox
import Amazonka.Rekognition.Types.Emotion
import Amazonka.Rekognition.Types.EyeOpen
import Amazonka.Rekognition.Types.Eyeglasses
import Amazonka.Rekognition.Types.Gender
import Amazonka.Rekognition.Types.ImageQuality
import Amazonka.Rekognition.Types.Landmark
import Amazonka.Rekognition.Types.MouthOpen
import Amazonka.Rekognition.Types.Mustache
import Amazonka.Rekognition.Types.Pose
import Amazonka.Rekognition.Types.Smile
import Amazonka.Rekognition.Types.Sunglasses

-- | Structure containing attributes of the face that the algorithm detected.
--
-- A @FaceDetail@ object contains either the default facial attributes or
-- all facial attributes. The default attributes are @BoundingBox@,
-- @Confidence@, @Landmarks@, @Pose@, and @Quality@.
--
-- GetFaceDetection is the only Amazon Rekognition Video stored video
-- operation that can return a @FaceDetail@ object with all attributes. To
-- specify which attributes to return, use the @FaceAttributes@ input
-- parameter for StartFaceDetection. The following Amazon Rekognition Video
-- operations return only the default attributes. The corresponding Start
-- operations don\'t have a @FaceAttributes@ input parameter:
--
-- -   GetCelebrityRecognition
--
-- -   GetPersonTracking
--
-- -   GetFaceSearch
--
-- The Amazon Rekognition Image DetectFaces and IndexFaces operations can
-- return all facial attributes. To specify which attributes to return, use
-- the @Attributes@ input parameter for @DetectFaces@. For @IndexFaces@,
-- use the @DetectAttributes@ input parameter.
--
-- /See:/ 'newFaceDetail' smart constructor.
data FaceDetail = FaceDetail'
  { -- | The estimated age range, in years, for the face. Low represents the
    -- lowest estimated age and High represents the highest estimated age.
    FaceDetail -> Maybe AgeRange
ageRange :: Prelude.Maybe AgeRange,
    -- | Indicates whether or not the face has a beard, and the confidence level
    -- in the determination.
    FaceDetail -> Maybe Beard
beard :: Prelude.Maybe Beard,
    -- | Bounding box of the face. Default attribute.
    FaceDetail -> Maybe BoundingBox
boundingBox :: Prelude.Maybe BoundingBox,
    -- | Confidence level that the bounding box contains a face (and not a
    -- different object such as a tree). Default attribute.
    FaceDetail -> Maybe Double
confidence :: Prelude.Maybe Prelude.Double,
    -- | The emotions that appear to be expressed on the face, and the confidence
    -- level in the determination. The API is only making a determination of
    -- the physical appearance of a person\'s face. It is not a determination
    -- of the person’s internal emotional state and should not be used in such
    -- a way. For example, a person pretending to have a sad face might not be
    -- sad emotionally.
    FaceDetail -> Maybe [Emotion]
emotions :: Prelude.Maybe [Emotion],
    -- | Indicates whether or not the face is wearing eye glasses, and the
    -- confidence level in the determination.
    FaceDetail -> Maybe Eyeglasses
eyeglasses :: Prelude.Maybe Eyeglasses,
    -- | Indicates whether or not the eyes on the face are open, and the
    -- confidence level in the determination.
    FaceDetail -> Maybe EyeOpen
eyesOpen :: Prelude.Maybe EyeOpen,
    -- | The predicted gender of a detected face.
    FaceDetail -> Maybe Gender
gender :: Prelude.Maybe Gender,
    -- | Indicates the location of landmarks on the face. Default attribute.
    FaceDetail -> Maybe [Landmark]
landmarks :: Prelude.Maybe [Landmark],
    -- | Indicates whether or not the mouth on the face is open, and the
    -- confidence level in the determination.
    FaceDetail -> Maybe MouthOpen
mouthOpen :: Prelude.Maybe MouthOpen,
    -- | Indicates whether or not the face has a mustache, and the confidence
    -- level in the determination.
    FaceDetail -> Maybe Mustache
mustache :: Prelude.Maybe Mustache,
    -- | Indicates the pose of the face as determined by its pitch, roll, and
    -- yaw. Default attribute.
    FaceDetail -> Maybe Pose
pose :: Prelude.Maybe Pose,
    -- | Identifies image brightness and sharpness. Default attribute.
    FaceDetail -> Maybe ImageQuality
quality :: Prelude.Maybe ImageQuality,
    -- | Indicates whether or not the face is smiling, and the confidence level
    -- in the determination.
    FaceDetail -> Maybe Smile
smile :: Prelude.Maybe Smile,
    -- | Indicates whether or not the face is wearing sunglasses, and the
    -- confidence level in the determination.
    FaceDetail -> Maybe Sunglasses
sunglasses :: Prelude.Maybe Sunglasses
  }
  deriving (FaceDetail -> FaceDetail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FaceDetail -> FaceDetail -> Bool
$c/= :: FaceDetail -> FaceDetail -> Bool
== :: FaceDetail -> FaceDetail -> Bool
$c== :: FaceDetail -> FaceDetail -> Bool
Prelude.Eq, ReadPrec [FaceDetail]
ReadPrec FaceDetail
Int -> ReadS FaceDetail
ReadS [FaceDetail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FaceDetail]
$creadListPrec :: ReadPrec [FaceDetail]
readPrec :: ReadPrec FaceDetail
$creadPrec :: ReadPrec FaceDetail
readList :: ReadS [FaceDetail]
$creadList :: ReadS [FaceDetail]
readsPrec :: Int -> ReadS FaceDetail
$creadsPrec :: Int -> ReadS FaceDetail
Prelude.Read, Int -> FaceDetail -> ShowS
[FaceDetail] -> ShowS
FaceDetail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FaceDetail] -> ShowS
$cshowList :: [FaceDetail] -> ShowS
show :: FaceDetail -> String
$cshow :: FaceDetail -> String
showsPrec :: Int -> FaceDetail -> ShowS
$cshowsPrec :: Int -> FaceDetail -> ShowS
Prelude.Show, forall x. Rep FaceDetail x -> FaceDetail
forall x. FaceDetail -> Rep FaceDetail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FaceDetail x -> FaceDetail
$cfrom :: forall x. FaceDetail -> Rep FaceDetail x
Prelude.Generic)

-- |
-- Create a value of 'FaceDetail' 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:
--
-- 'ageRange', 'faceDetail_ageRange' - The estimated age range, in years, for the face. Low represents the
-- lowest estimated age and High represents the highest estimated age.
--
-- 'beard', 'faceDetail_beard' - Indicates whether or not the face has a beard, and the confidence level
-- in the determination.
--
-- 'boundingBox', 'faceDetail_boundingBox' - Bounding box of the face. Default attribute.
--
-- 'confidence', 'faceDetail_confidence' - Confidence level that the bounding box contains a face (and not a
-- different object such as a tree). Default attribute.
--
-- 'emotions', 'faceDetail_emotions' - The emotions that appear to be expressed on the face, and the confidence
-- level in the determination. The API is only making a determination of
-- the physical appearance of a person\'s face. It is not a determination
-- of the person’s internal emotional state and should not be used in such
-- a way. For example, a person pretending to have a sad face might not be
-- sad emotionally.
--
-- 'eyeglasses', 'faceDetail_eyeglasses' - Indicates whether or not the face is wearing eye glasses, and the
-- confidence level in the determination.
--
-- 'eyesOpen', 'faceDetail_eyesOpen' - Indicates whether or not the eyes on the face are open, and the
-- confidence level in the determination.
--
-- 'gender', 'faceDetail_gender' - The predicted gender of a detected face.
--
-- 'landmarks', 'faceDetail_landmarks' - Indicates the location of landmarks on the face. Default attribute.
--
-- 'mouthOpen', 'faceDetail_mouthOpen' - Indicates whether or not the mouth on the face is open, and the
-- confidence level in the determination.
--
-- 'mustache', 'faceDetail_mustache' - Indicates whether or not the face has a mustache, and the confidence
-- level in the determination.
--
-- 'pose', 'faceDetail_pose' - Indicates the pose of the face as determined by its pitch, roll, and
-- yaw. Default attribute.
--
-- 'quality', 'faceDetail_quality' - Identifies image brightness and sharpness. Default attribute.
--
-- 'smile', 'faceDetail_smile' - Indicates whether or not the face is smiling, and the confidence level
-- in the determination.
--
-- 'sunglasses', 'faceDetail_sunglasses' - Indicates whether or not the face is wearing sunglasses, and the
-- confidence level in the determination.
newFaceDetail ::
  FaceDetail
newFaceDetail :: FaceDetail
newFaceDetail =
  FaceDetail'
    { $sel:ageRange:FaceDetail' :: Maybe AgeRange
ageRange = forall a. Maybe a
Prelude.Nothing,
      $sel:beard:FaceDetail' :: Maybe Beard
beard = forall a. Maybe a
Prelude.Nothing,
      $sel:boundingBox:FaceDetail' :: Maybe BoundingBox
boundingBox = forall a. Maybe a
Prelude.Nothing,
      $sel:confidence:FaceDetail' :: Maybe Double
confidence = forall a. Maybe a
Prelude.Nothing,
      $sel:emotions:FaceDetail' :: Maybe [Emotion]
emotions = forall a. Maybe a
Prelude.Nothing,
      $sel:eyeglasses:FaceDetail' :: Maybe Eyeglasses
eyeglasses = forall a. Maybe a
Prelude.Nothing,
      $sel:eyesOpen:FaceDetail' :: Maybe EyeOpen
eyesOpen = forall a. Maybe a
Prelude.Nothing,
      $sel:gender:FaceDetail' :: Maybe Gender
gender = forall a. Maybe a
Prelude.Nothing,
      $sel:landmarks:FaceDetail' :: Maybe [Landmark]
landmarks = forall a. Maybe a
Prelude.Nothing,
      $sel:mouthOpen:FaceDetail' :: Maybe MouthOpen
mouthOpen = forall a. Maybe a
Prelude.Nothing,
      $sel:mustache:FaceDetail' :: Maybe Mustache
mustache = forall a. Maybe a
Prelude.Nothing,
      $sel:pose:FaceDetail' :: Maybe Pose
pose = forall a. Maybe a
Prelude.Nothing,
      $sel:quality:FaceDetail' :: Maybe ImageQuality
quality = forall a. Maybe a
Prelude.Nothing,
      $sel:smile:FaceDetail' :: Maybe Smile
smile = forall a. Maybe a
Prelude.Nothing,
      $sel:sunglasses:FaceDetail' :: Maybe Sunglasses
sunglasses = forall a. Maybe a
Prelude.Nothing
    }

-- | The estimated age range, in years, for the face. Low represents the
-- lowest estimated age and High represents the highest estimated age.
faceDetail_ageRange :: Lens.Lens' FaceDetail (Prelude.Maybe AgeRange)
faceDetail_ageRange :: Lens' FaceDetail (Maybe AgeRange)
faceDetail_ageRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FaceDetail' {Maybe AgeRange
ageRange :: Maybe AgeRange
$sel:ageRange:FaceDetail' :: FaceDetail -> Maybe AgeRange
ageRange} -> Maybe AgeRange
ageRange) (\s :: FaceDetail
s@FaceDetail' {} Maybe AgeRange
a -> FaceDetail
s {$sel:ageRange:FaceDetail' :: Maybe AgeRange
ageRange = Maybe AgeRange
a} :: FaceDetail)

-- | Indicates whether or not the face has a beard, and the confidence level
-- in the determination.
faceDetail_beard :: Lens.Lens' FaceDetail (Prelude.Maybe Beard)
faceDetail_beard :: Lens' FaceDetail (Maybe Beard)
faceDetail_beard = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FaceDetail' {Maybe Beard
beard :: Maybe Beard
$sel:beard:FaceDetail' :: FaceDetail -> Maybe Beard
beard} -> Maybe Beard
beard) (\s :: FaceDetail
s@FaceDetail' {} Maybe Beard
a -> FaceDetail
s {$sel:beard:FaceDetail' :: Maybe Beard
beard = Maybe Beard
a} :: FaceDetail)

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

-- | Confidence level that the bounding box contains a face (and not a
-- different object such as a tree). Default attribute.
faceDetail_confidence :: Lens.Lens' FaceDetail (Prelude.Maybe Prelude.Double)
faceDetail_confidence :: Lens' FaceDetail (Maybe Double)
faceDetail_confidence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FaceDetail' {Maybe Double
confidence :: Maybe Double
$sel:confidence:FaceDetail' :: FaceDetail -> Maybe Double
confidence} -> Maybe Double
confidence) (\s :: FaceDetail
s@FaceDetail' {} Maybe Double
a -> FaceDetail
s {$sel:confidence:FaceDetail' :: Maybe Double
confidence = Maybe Double
a} :: FaceDetail)

-- | The emotions that appear to be expressed on the face, and the confidence
-- level in the determination. The API is only making a determination of
-- the physical appearance of a person\'s face. It is not a determination
-- of the person’s internal emotional state and should not be used in such
-- a way. For example, a person pretending to have a sad face might not be
-- sad emotionally.
faceDetail_emotions :: Lens.Lens' FaceDetail (Prelude.Maybe [Emotion])
faceDetail_emotions :: Lens' FaceDetail (Maybe [Emotion])
faceDetail_emotions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FaceDetail' {Maybe [Emotion]
emotions :: Maybe [Emotion]
$sel:emotions:FaceDetail' :: FaceDetail -> Maybe [Emotion]
emotions} -> Maybe [Emotion]
emotions) (\s :: FaceDetail
s@FaceDetail' {} Maybe [Emotion]
a -> FaceDetail
s {$sel:emotions:FaceDetail' :: Maybe [Emotion]
emotions = Maybe [Emotion]
a} :: FaceDetail) 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 whether or not the face is wearing eye glasses, and the
-- confidence level in the determination.
faceDetail_eyeglasses :: Lens.Lens' FaceDetail (Prelude.Maybe Eyeglasses)
faceDetail_eyeglasses :: Lens' FaceDetail (Maybe Eyeglasses)
faceDetail_eyeglasses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FaceDetail' {Maybe Eyeglasses
eyeglasses :: Maybe Eyeglasses
$sel:eyeglasses:FaceDetail' :: FaceDetail -> Maybe Eyeglasses
eyeglasses} -> Maybe Eyeglasses
eyeglasses) (\s :: FaceDetail
s@FaceDetail' {} Maybe Eyeglasses
a -> FaceDetail
s {$sel:eyeglasses:FaceDetail' :: Maybe Eyeglasses
eyeglasses = Maybe Eyeglasses
a} :: FaceDetail)

-- | Indicates whether or not the eyes on the face are open, and the
-- confidence level in the determination.
faceDetail_eyesOpen :: Lens.Lens' FaceDetail (Prelude.Maybe EyeOpen)
faceDetail_eyesOpen :: Lens' FaceDetail (Maybe EyeOpen)
faceDetail_eyesOpen = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FaceDetail' {Maybe EyeOpen
eyesOpen :: Maybe EyeOpen
$sel:eyesOpen:FaceDetail' :: FaceDetail -> Maybe EyeOpen
eyesOpen} -> Maybe EyeOpen
eyesOpen) (\s :: FaceDetail
s@FaceDetail' {} Maybe EyeOpen
a -> FaceDetail
s {$sel:eyesOpen:FaceDetail' :: Maybe EyeOpen
eyesOpen = Maybe EyeOpen
a} :: FaceDetail)

-- | The predicted gender of a detected face.
faceDetail_gender :: Lens.Lens' FaceDetail (Prelude.Maybe Gender)
faceDetail_gender :: Lens' FaceDetail (Maybe Gender)
faceDetail_gender = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FaceDetail' {Maybe Gender
gender :: Maybe Gender
$sel:gender:FaceDetail' :: FaceDetail -> Maybe Gender
gender} -> Maybe Gender
gender) (\s :: FaceDetail
s@FaceDetail' {} Maybe Gender
a -> FaceDetail
s {$sel:gender:FaceDetail' :: Maybe Gender
gender = Maybe Gender
a} :: FaceDetail)

-- | Indicates the location of landmarks on the face. Default attribute.
faceDetail_landmarks :: Lens.Lens' FaceDetail (Prelude.Maybe [Landmark])
faceDetail_landmarks :: Lens' FaceDetail (Maybe [Landmark])
faceDetail_landmarks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FaceDetail' {Maybe [Landmark]
landmarks :: Maybe [Landmark]
$sel:landmarks:FaceDetail' :: FaceDetail -> Maybe [Landmark]
landmarks} -> Maybe [Landmark]
landmarks) (\s :: FaceDetail
s@FaceDetail' {} Maybe [Landmark]
a -> FaceDetail
s {$sel:landmarks:FaceDetail' :: Maybe [Landmark]
landmarks = Maybe [Landmark]
a} :: FaceDetail) 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 whether or not the mouth on the face is open, and the
-- confidence level in the determination.
faceDetail_mouthOpen :: Lens.Lens' FaceDetail (Prelude.Maybe MouthOpen)
faceDetail_mouthOpen :: Lens' FaceDetail (Maybe MouthOpen)
faceDetail_mouthOpen = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FaceDetail' {Maybe MouthOpen
mouthOpen :: Maybe MouthOpen
$sel:mouthOpen:FaceDetail' :: FaceDetail -> Maybe MouthOpen
mouthOpen} -> Maybe MouthOpen
mouthOpen) (\s :: FaceDetail
s@FaceDetail' {} Maybe MouthOpen
a -> FaceDetail
s {$sel:mouthOpen:FaceDetail' :: Maybe MouthOpen
mouthOpen = Maybe MouthOpen
a} :: FaceDetail)

-- | Indicates whether or not the face has a mustache, and the confidence
-- level in the determination.
faceDetail_mustache :: Lens.Lens' FaceDetail (Prelude.Maybe Mustache)
faceDetail_mustache :: Lens' FaceDetail (Maybe Mustache)
faceDetail_mustache = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FaceDetail' {Maybe Mustache
mustache :: Maybe Mustache
$sel:mustache:FaceDetail' :: FaceDetail -> Maybe Mustache
mustache} -> Maybe Mustache
mustache) (\s :: FaceDetail
s@FaceDetail' {} Maybe Mustache
a -> FaceDetail
s {$sel:mustache:FaceDetail' :: Maybe Mustache
mustache = Maybe Mustache
a} :: FaceDetail)

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

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

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

-- | Indicates whether or not the face is wearing sunglasses, and the
-- confidence level in the determination.
faceDetail_sunglasses :: Lens.Lens' FaceDetail (Prelude.Maybe Sunglasses)
faceDetail_sunglasses :: Lens' FaceDetail (Maybe Sunglasses)
faceDetail_sunglasses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FaceDetail' {Maybe Sunglasses
sunglasses :: Maybe Sunglasses
$sel:sunglasses:FaceDetail' :: FaceDetail -> Maybe Sunglasses
sunglasses} -> Maybe Sunglasses
sunglasses) (\s :: FaceDetail
s@FaceDetail' {} Maybe Sunglasses
a -> FaceDetail
s {$sel:sunglasses:FaceDetail' :: Maybe Sunglasses
sunglasses = Maybe Sunglasses
a} :: FaceDetail)

instance Data.FromJSON FaceDetail where
  parseJSON :: Value -> Parser FaceDetail
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"FaceDetail"
      ( \Object
x ->
          Maybe AgeRange
-> Maybe Beard
-> Maybe BoundingBox
-> Maybe Double
-> Maybe [Emotion]
-> Maybe Eyeglasses
-> Maybe EyeOpen
-> Maybe Gender
-> Maybe [Landmark]
-> Maybe MouthOpen
-> Maybe Mustache
-> Maybe Pose
-> Maybe ImageQuality
-> Maybe Smile
-> Maybe Sunglasses
-> FaceDetail
FaceDetail'
            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
"AgeRange")
            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
"Beard")
            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
"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
"Eyeglasses")
            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
"EyesOpen")
            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
"Gender")
            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
"MouthOpen")
            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
"Mustache")
            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")
            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
"Sunglasses")
      )

instance Prelude.Hashable FaceDetail where
  hashWithSalt :: Int -> FaceDetail -> Int
hashWithSalt Int
_salt FaceDetail' {Maybe Double
Maybe [Emotion]
Maybe [Landmark]
Maybe AgeRange
Maybe Beard
Maybe BoundingBox
Maybe EyeOpen
Maybe Eyeglasses
Maybe Gender
Maybe ImageQuality
Maybe MouthOpen
Maybe Mustache
Maybe Pose
Maybe Smile
Maybe Sunglasses
sunglasses :: Maybe Sunglasses
smile :: Maybe Smile
quality :: Maybe ImageQuality
pose :: Maybe Pose
mustache :: Maybe Mustache
mouthOpen :: Maybe MouthOpen
landmarks :: Maybe [Landmark]
gender :: Maybe Gender
eyesOpen :: Maybe EyeOpen
eyeglasses :: Maybe Eyeglasses
emotions :: Maybe [Emotion]
confidence :: Maybe Double
boundingBox :: Maybe BoundingBox
beard :: Maybe Beard
ageRange :: Maybe AgeRange
$sel:sunglasses:FaceDetail' :: FaceDetail -> Maybe Sunglasses
$sel:smile:FaceDetail' :: FaceDetail -> Maybe Smile
$sel:quality:FaceDetail' :: FaceDetail -> Maybe ImageQuality
$sel:pose:FaceDetail' :: FaceDetail -> Maybe Pose
$sel:mustache:FaceDetail' :: FaceDetail -> Maybe Mustache
$sel:mouthOpen:FaceDetail' :: FaceDetail -> Maybe MouthOpen
$sel:landmarks:FaceDetail' :: FaceDetail -> Maybe [Landmark]
$sel:gender:FaceDetail' :: FaceDetail -> Maybe Gender
$sel:eyesOpen:FaceDetail' :: FaceDetail -> Maybe EyeOpen
$sel:eyeglasses:FaceDetail' :: FaceDetail -> Maybe Eyeglasses
$sel:emotions:FaceDetail' :: FaceDetail -> Maybe [Emotion]
$sel:confidence:FaceDetail' :: FaceDetail -> Maybe Double
$sel:boundingBox:FaceDetail' :: FaceDetail -> Maybe BoundingBox
$sel:beard:FaceDetail' :: FaceDetail -> Maybe Beard
$sel:ageRange:FaceDetail' :: FaceDetail -> Maybe AgeRange
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AgeRange
ageRange
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Beard
beard
      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 Eyeglasses
eyeglasses
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EyeOpen
eyesOpen
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Gender
gender
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Landmark]
landmarks
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MouthOpen
mouthOpen
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mustache
mustache
      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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Sunglasses
sunglasses

instance Prelude.NFData FaceDetail where
  rnf :: FaceDetail -> ()
rnf FaceDetail' {Maybe Double
Maybe [Emotion]
Maybe [Landmark]
Maybe AgeRange
Maybe Beard
Maybe BoundingBox
Maybe EyeOpen
Maybe Eyeglasses
Maybe Gender
Maybe ImageQuality
Maybe MouthOpen
Maybe Mustache
Maybe Pose
Maybe Smile
Maybe Sunglasses
sunglasses :: Maybe Sunglasses
smile :: Maybe Smile
quality :: Maybe ImageQuality
pose :: Maybe Pose
mustache :: Maybe Mustache
mouthOpen :: Maybe MouthOpen
landmarks :: Maybe [Landmark]
gender :: Maybe Gender
eyesOpen :: Maybe EyeOpen
eyeglasses :: Maybe Eyeglasses
emotions :: Maybe [Emotion]
confidence :: Maybe Double
boundingBox :: Maybe BoundingBox
beard :: Maybe Beard
ageRange :: Maybe AgeRange
$sel:sunglasses:FaceDetail' :: FaceDetail -> Maybe Sunglasses
$sel:smile:FaceDetail' :: FaceDetail -> Maybe Smile
$sel:quality:FaceDetail' :: FaceDetail -> Maybe ImageQuality
$sel:pose:FaceDetail' :: FaceDetail -> Maybe Pose
$sel:mustache:FaceDetail' :: FaceDetail -> Maybe Mustache
$sel:mouthOpen:FaceDetail' :: FaceDetail -> Maybe MouthOpen
$sel:landmarks:FaceDetail' :: FaceDetail -> Maybe [Landmark]
$sel:gender:FaceDetail' :: FaceDetail -> Maybe Gender
$sel:eyesOpen:FaceDetail' :: FaceDetail -> Maybe EyeOpen
$sel:eyeglasses:FaceDetail' :: FaceDetail -> Maybe Eyeglasses
$sel:emotions:FaceDetail' :: FaceDetail -> Maybe [Emotion]
$sel:confidence:FaceDetail' :: FaceDetail -> Maybe Double
$sel:boundingBox:FaceDetail' :: FaceDetail -> Maybe BoundingBox
$sel:beard:FaceDetail' :: FaceDetail -> Maybe Beard
$sel:ageRange:FaceDetail' :: FaceDetail -> Maybe AgeRange
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AgeRange
ageRange
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Beard
beard
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Eyeglasses
eyeglasses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EyeOpen
eyesOpen
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Gender
gender
      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 MouthOpen
mouthOpen
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mustache
mustache
      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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Sunglasses
sunglasses