{-# 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.CelebrityDetail
-- 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.CelebrityDetail 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.FaceDetail
import Amazonka.Rekognition.Types.KnownGender

-- | Information about a recognized celebrity.
--
-- /See:/ 'newCelebrityDetail' smart constructor.
data CelebrityDetail = CelebrityDetail'
  { -- | Bounding box around the body of a celebrity.
    CelebrityDetail -> Maybe BoundingBox
boundingBox :: Prelude.Maybe BoundingBox,
    -- | The confidence, in percentage, that Amazon Rekognition has that the
    -- recognized face is the celebrity.
    CelebrityDetail -> Maybe Double
confidence :: Prelude.Maybe Prelude.Double,
    -- | Face details for the recognized celebrity.
    CelebrityDetail -> Maybe FaceDetail
face :: Prelude.Maybe FaceDetail,
    -- | The unique identifier for the celebrity.
    CelebrityDetail -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | Retrieves the known gender for the celebrity.
    CelebrityDetail -> Maybe KnownGender
knownGender :: Prelude.Maybe KnownGender,
    -- | The name of the celebrity.
    CelebrityDetail -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | An array of URLs pointing to additional celebrity information.
    CelebrityDetail -> Maybe [Text]
urls :: Prelude.Maybe [Prelude.Text]
  }
  deriving (CelebrityDetail -> CelebrityDetail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CelebrityDetail -> CelebrityDetail -> Bool
$c/= :: CelebrityDetail -> CelebrityDetail -> Bool
== :: CelebrityDetail -> CelebrityDetail -> Bool
$c== :: CelebrityDetail -> CelebrityDetail -> Bool
Prelude.Eq, ReadPrec [CelebrityDetail]
ReadPrec CelebrityDetail
Int -> ReadS CelebrityDetail
ReadS [CelebrityDetail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CelebrityDetail]
$creadListPrec :: ReadPrec [CelebrityDetail]
readPrec :: ReadPrec CelebrityDetail
$creadPrec :: ReadPrec CelebrityDetail
readList :: ReadS [CelebrityDetail]
$creadList :: ReadS [CelebrityDetail]
readsPrec :: Int -> ReadS CelebrityDetail
$creadsPrec :: Int -> ReadS CelebrityDetail
Prelude.Read, Int -> CelebrityDetail -> ShowS
[CelebrityDetail] -> ShowS
CelebrityDetail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CelebrityDetail] -> ShowS
$cshowList :: [CelebrityDetail] -> ShowS
show :: CelebrityDetail -> String
$cshow :: CelebrityDetail -> String
showsPrec :: Int -> CelebrityDetail -> ShowS
$cshowsPrec :: Int -> CelebrityDetail -> ShowS
Prelude.Show, forall x. Rep CelebrityDetail x -> CelebrityDetail
forall x. CelebrityDetail -> Rep CelebrityDetail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CelebrityDetail x -> CelebrityDetail
$cfrom :: forall x. CelebrityDetail -> Rep CelebrityDetail x
Prelude.Generic)

-- |
-- Create a value of 'CelebrityDetail' 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', 'celebrityDetail_boundingBox' - Bounding box around the body of a celebrity.
--
-- 'confidence', 'celebrityDetail_confidence' - The confidence, in percentage, that Amazon Rekognition has that the
-- recognized face is the celebrity.
--
-- 'face', 'celebrityDetail_face' - Face details for the recognized celebrity.
--
-- 'id', 'celebrityDetail_id' - The unique identifier for the celebrity.
--
-- 'knownGender', 'celebrityDetail_knownGender' - Retrieves the known gender for the celebrity.
--
-- 'name', 'celebrityDetail_name' - The name of the celebrity.
--
-- 'urls', 'celebrityDetail_urls' - An array of URLs pointing to additional celebrity information.
newCelebrityDetail ::
  CelebrityDetail
newCelebrityDetail :: CelebrityDetail
newCelebrityDetail =
  CelebrityDetail'
    { $sel:boundingBox:CelebrityDetail' :: Maybe BoundingBox
boundingBox = forall a. Maybe a
Prelude.Nothing,
      $sel:confidence:CelebrityDetail' :: Maybe Double
confidence = forall a. Maybe a
Prelude.Nothing,
      $sel:face:CelebrityDetail' :: Maybe FaceDetail
face = forall a. Maybe a
Prelude.Nothing,
      $sel:id:CelebrityDetail' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:knownGender:CelebrityDetail' :: Maybe KnownGender
knownGender = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CelebrityDetail' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:urls:CelebrityDetail' :: Maybe [Text]
urls = forall a. Maybe a
Prelude.Nothing
    }

-- | Bounding box around the body of a celebrity.
celebrityDetail_boundingBox :: Lens.Lens' CelebrityDetail (Prelude.Maybe BoundingBox)
celebrityDetail_boundingBox :: Lens' CelebrityDetail (Maybe BoundingBox)
celebrityDetail_boundingBox = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CelebrityDetail' {Maybe BoundingBox
boundingBox :: Maybe BoundingBox
$sel:boundingBox:CelebrityDetail' :: CelebrityDetail -> Maybe BoundingBox
boundingBox} -> Maybe BoundingBox
boundingBox) (\s :: CelebrityDetail
s@CelebrityDetail' {} Maybe BoundingBox
a -> CelebrityDetail
s {$sel:boundingBox:CelebrityDetail' :: Maybe BoundingBox
boundingBox = Maybe BoundingBox
a} :: CelebrityDetail)

-- | The confidence, in percentage, that Amazon Rekognition has that the
-- recognized face is the celebrity.
celebrityDetail_confidence :: Lens.Lens' CelebrityDetail (Prelude.Maybe Prelude.Double)
celebrityDetail_confidence :: Lens' CelebrityDetail (Maybe Double)
celebrityDetail_confidence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CelebrityDetail' {Maybe Double
confidence :: Maybe Double
$sel:confidence:CelebrityDetail' :: CelebrityDetail -> Maybe Double
confidence} -> Maybe Double
confidence) (\s :: CelebrityDetail
s@CelebrityDetail' {} Maybe Double
a -> CelebrityDetail
s {$sel:confidence:CelebrityDetail' :: Maybe Double
confidence = Maybe Double
a} :: CelebrityDetail)

-- | Face details for the recognized celebrity.
celebrityDetail_face :: Lens.Lens' CelebrityDetail (Prelude.Maybe FaceDetail)
celebrityDetail_face :: Lens' CelebrityDetail (Maybe FaceDetail)
celebrityDetail_face = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CelebrityDetail' {Maybe FaceDetail
face :: Maybe FaceDetail
$sel:face:CelebrityDetail' :: CelebrityDetail -> Maybe FaceDetail
face} -> Maybe FaceDetail
face) (\s :: CelebrityDetail
s@CelebrityDetail' {} Maybe FaceDetail
a -> CelebrityDetail
s {$sel:face:CelebrityDetail' :: Maybe FaceDetail
face = Maybe FaceDetail
a} :: CelebrityDetail)

-- | The unique identifier for the celebrity.
celebrityDetail_id :: Lens.Lens' CelebrityDetail (Prelude.Maybe Prelude.Text)
celebrityDetail_id :: Lens' CelebrityDetail (Maybe Text)
celebrityDetail_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CelebrityDetail' {Maybe Text
id :: Maybe Text
$sel:id:CelebrityDetail' :: CelebrityDetail -> Maybe Text
id} -> Maybe Text
id) (\s :: CelebrityDetail
s@CelebrityDetail' {} Maybe Text
a -> CelebrityDetail
s {$sel:id:CelebrityDetail' :: Maybe Text
id = Maybe Text
a} :: CelebrityDetail)

-- | Retrieves the known gender for the celebrity.
celebrityDetail_knownGender :: Lens.Lens' CelebrityDetail (Prelude.Maybe KnownGender)
celebrityDetail_knownGender :: Lens' CelebrityDetail (Maybe KnownGender)
celebrityDetail_knownGender = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CelebrityDetail' {Maybe KnownGender
knownGender :: Maybe KnownGender
$sel:knownGender:CelebrityDetail' :: CelebrityDetail -> Maybe KnownGender
knownGender} -> Maybe KnownGender
knownGender) (\s :: CelebrityDetail
s@CelebrityDetail' {} Maybe KnownGender
a -> CelebrityDetail
s {$sel:knownGender:CelebrityDetail' :: Maybe KnownGender
knownGender = Maybe KnownGender
a} :: CelebrityDetail)

-- | The name of the celebrity.
celebrityDetail_name :: Lens.Lens' CelebrityDetail (Prelude.Maybe Prelude.Text)
celebrityDetail_name :: Lens' CelebrityDetail (Maybe Text)
celebrityDetail_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CelebrityDetail' {Maybe Text
name :: Maybe Text
$sel:name:CelebrityDetail' :: CelebrityDetail -> Maybe Text
name} -> Maybe Text
name) (\s :: CelebrityDetail
s@CelebrityDetail' {} Maybe Text
a -> CelebrityDetail
s {$sel:name:CelebrityDetail' :: Maybe Text
name = Maybe Text
a} :: CelebrityDetail)

-- | An array of URLs pointing to additional celebrity information.
celebrityDetail_urls :: Lens.Lens' CelebrityDetail (Prelude.Maybe [Prelude.Text])
celebrityDetail_urls :: Lens' CelebrityDetail (Maybe [Text])
celebrityDetail_urls = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CelebrityDetail' {Maybe [Text]
urls :: Maybe [Text]
$sel:urls:CelebrityDetail' :: CelebrityDetail -> Maybe [Text]
urls} -> Maybe [Text]
urls) (\s :: CelebrityDetail
s@CelebrityDetail' {} Maybe [Text]
a -> CelebrityDetail
s {$sel:urls:CelebrityDetail' :: Maybe [Text]
urls = Maybe [Text]
a} :: CelebrityDetail) 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

instance Data.FromJSON CelebrityDetail where
  parseJSON :: Value -> Parser CelebrityDetail
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"CelebrityDetail"
      ( \Object
x ->
          Maybe BoundingBox
-> Maybe Double
-> Maybe FaceDetail
-> Maybe Text
-> Maybe KnownGender
-> Maybe Text
-> Maybe [Text]
-> CelebrityDetail
CelebrityDetail'
            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
"Face")
            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
"KnownGender")
            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
"Name")
            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
"Urls" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable CelebrityDetail where
  hashWithSalt :: Int -> CelebrityDetail -> Int
hashWithSalt Int
_salt CelebrityDetail' {Maybe Double
Maybe [Text]
Maybe Text
Maybe BoundingBox
Maybe KnownGender
Maybe FaceDetail
urls :: Maybe [Text]
name :: Maybe Text
knownGender :: Maybe KnownGender
id :: Maybe Text
face :: Maybe FaceDetail
confidence :: Maybe Double
boundingBox :: Maybe BoundingBox
$sel:urls:CelebrityDetail' :: CelebrityDetail -> Maybe [Text]
$sel:name:CelebrityDetail' :: CelebrityDetail -> Maybe Text
$sel:knownGender:CelebrityDetail' :: CelebrityDetail -> Maybe KnownGender
$sel:id:CelebrityDetail' :: CelebrityDetail -> Maybe Text
$sel:face:CelebrityDetail' :: CelebrityDetail -> Maybe FaceDetail
$sel:confidence:CelebrityDetail' :: CelebrityDetail -> Maybe Double
$sel:boundingBox:CelebrityDetail' :: CelebrityDetail -> 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 FaceDetail
face
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KnownGender
knownGender
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
urls

instance Prelude.NFData CelebrityDetail where
  rnf :: CelebrityDetail -> ()
rnf CelebrityDetail' {Maybe Double
Maybe [Text]
Maybe Text
Maybe BoundingBox
Maybe KnownGender
Maybe FaceDetail
urls :: Maybe [Text]
name :: Maybe Text
knownGender :: Maybe KnownGender
id :: Maybe Text
face :: Maybe FaceDetail
confidence :: Maybe Double
boundingBox :: Maybe BoundingBox
$sel:urls:CelebrityDetail' :: CelebrityDetail -> Maybe [Text]
$sel:name:CelebrityDetail' :: CelebrityDetail -> Maybe Text
$sel:knownGender:CelebrityDetail' :: CelebrityDetail -> Maybe KnownGender
$sel:id:CelebrityDetail' :: CelebrityDetail -> Maybe Text
$sel:face:CelebrityDetail' :: CelebrityDetail -> Maybe FaceDetail
$sel:confidence:CelebrityDetail' :: CelebrityDetail -> Maybe Double
$sel:boundingBox:CelebrityDetail' :: CelebrityDetail -> 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 FaceDetail
face
      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 KnownGender
knownGender
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
urls