{-# 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.SegmentDetection
-- 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.SegmentDetection 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.SegmentType
import Amazonka.Rekognition.Types.ShotSegment
import Amazonka.Rekognition.Types.TechnicalCueSegment

-- | A technical cue or shot detection segment detected in a video. An array
-- of @SegmentDetection@ objects containing all segments detected in a
-- stored video is returned by GetSegmentDetection.
--
-- /See:/ 'newSegmentDetection' smart constructor.
data SegmentDetection = SegmentDetection'
  { -- | The duration of a video segment, expressed in frames.
    SegmentDetection -> Maybe Natural
durationFrames :: Prelude.Maybe Prelude.Natural,
    -- | The duration of the detected segment in milliseconds.
    SegmentDetection -> Maybe Natural
durationMillis :: Prelude.Maybe Prelude.Natural,
    -- | The duration of the timecode for the detected segment in SMPTE format.
    SegmentDetection -> Maybe Text
durationSMPTE :: Prelude.Maybe Prelude.Text,
    -- | The frame number at the end of a video segment, using a frame index that
    -- starts with 0.
    SegmentDetection -> Maybe Natural
endFrameNumber :: Prelude.Maybe Prelude.Natural,
    -- | The frame-accurate SMPTE timecode, from the start of a video, for the
    -- end of a detected segment. @EndTimecode@ is in /HH:MM:SS:fr/ format (and
    -- /;fr/ for drop frame-rates).
    SegmentDetection -> Maybe Text
endTimecodeSMPTE :: Prelude.Maybe Prelude.Text,
    -- | The end time of the detected segment, in milliseconds, from the start of
    -- the video. This value is rounded down.
    SegmentDetection -> Maybe Integer
endTimestampMillis :: Prelude.Maybe Prelude.Integer,
    -- | If the segment is a shot detection, contains information about the shot
    -- detection.
    SegmentDetection -> Maybe ShotSegment
shotSegment :: Prelude.Maybe ShotSegment,
    -- | The frame number of the start of a video segment, using a frame index
    -- that starts with 0.
    SegmentDetection -> Maybe Natural
startFrameNumber :: Prelude.Maybe Prelude.Natural,
    -- | The frame-accurate SMPTE timecode, from the start of a video, for the
    -- start of a detected segment. @StartTimecode@ is in /HH:MM:SS:fr/ format
    -- (and /;fr/ for drop frame-rates).
    SegmentDetection -> Maybe Text
startTimecodeSMPTE :: Prelude.Maybe Prelude.Text,
    -- | The start time of the detected segment in milliseconds from the start of
    -- the video. This value is rounded down. For example, if the actual
    -- timestamp is 100.6667 milliseconds, Amazon Rekognition Video returns a
    -- value of 100 millis.
    SegmentDetection -> Maybe Integer
startTimestampMillis :: Prelude.Maybe Prelude.Integer,
    -- | If the segment is a technical cue, contains information about the
    -- technical cue.
    SegmentDetection -> Maybe TechnicalCueSegment
technicalCueSegment :: Prelude.Maybe TechnicalCueSegment,
    -- | The type of the segment. Valid values are @TECHNICAL_CUE@ and @SHOT@.
    SegmentDetection -> Maybe SegmentType
type' :: Prelude.Maybe SegmentType
  }
  deriving (SegmentDetection -> SegmentDetection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegmentDetection -> SegmentDetection -> Bool
$c/= :: SegmentDetection -> SegmentDetection -> Bool
== :: SegmentDetection -> SegmentDetection -> Bool
$c== :: SegmentDetection -> SegmentDetection -> Bool
Prelude.Eq, ReadPrec [SegmentDetection]
ReadPrec SegmentDetection
Int -> ReadS SegmentDetection
ReadS [SegmentDetection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SegmentDetection]
$creadListPrec :: ReadPrec [SegmentDetection]
readPrec :: ReadPrec SegmentDetection
$creadPrec :: ReadPrec SegmentDetection
readList :: ReadS [SegmentDetection]
$creadList :: ReadS [SegmentDetection]
readsPrec :: Int -> ReadS SegmentDetection
$creadsPrec :: Int -> ReadS SegmentDetection
Prelude.Read, Int -> SegmentDetection -> ShowS
[SegmentDetection] -> ShowS
SegmentDetection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SegmentDetection] -> ShowS
$cshowList :: [SegmentDetection] -> ShowS
show :: SegmentDetection -> String
$cshow :: SegmentDetection -> String
showsPrec :: Int -> SegmentDetection -> ShowS
$cshowsPrec :: Int -> SegmentDetection -> ShowS
Prelude.Show, forall x. Rep SegmentDetection x -> SegmentDetection
forall x. SegmentDetection -> Rep SegmentDetection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SegmentDetection x -> SegmentDetection
$cfrom :: forall x. SegmentDetection -> Rep SegmentDetection x
Prelude.Generic)

-- |
-- Create a value of 'SegmentDetection' 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:
--
-- 'durationFrames', 'segmentDetection_durationFrames' - The duration of a video segment, expressed in frames.
--
-- 'durationMillis', 'segmentDetection_durationMillis' - The duration of the detected segment in milliseconds.
--
-- 'durationSMPTE', 'segmentDetection_durationSMPTE' - The duration of the timecode for the detected segment in SMPTE format.
--
-- 'endFrameNumber', 'segmentDetection_endFrameNumber' - The frame number at the end of a video segment, using a frame index that
-- starts with 0.
--
-- 'endTimecodeSMPTE', 'segmentDetection_endTimecodeSMPTE' - The frame-accurate SMPTE timecode, from the start of a video, for the
-- end of a detected segment. @EndTimecode@ is in /HH:MM:SS:fr/ format (and
-- /;fr/ for drop frame-rates).
--
-- 'endTimestampMillis', 'segmentDetection_endTimestampMillis' - The end time of the detected segment, in milliseconds, from the start of
-- the video. This value is rounded down.
--
-- 'shotSegment', 'segmentDetection_shotSegment' - If the segment is a shot detection, contains information about the shot
-- detection.
--
-- 'startFrameNumber', 'segmentDetection_startFrameNumber' - The frame number of the start of a video segment, using a frame index
-- that starts with 0.
--
-- 'startTimecodeSMPTE', 'segmentDetection_startTimecodeSMPTE' - The frame-accurate SMPTE timecode, from the start of a video, for the
-- start of a detected segment. @StartTimecode@ is in /HH:MM:SS:fr/ format
-- (and /;fr/ for drop frame-rates).
--
-- 'startTimestampMillis', 'segmentDetection_startTimestampMillis' - The start time of the detected segment in milliseconds from the start of
-- the video. This value is rounded down. For example, if the actual
-- timestamp is 100.6667 milliseconds, Amazon Rekognition Video returns a
-- value of 100 millis.
--
-- 'technicalCueSegment', 'segmentDetection_technicalCueSegment' - If the segment is a technical cue, contains information about the
-- technical cue.
--
-- 'type'', 'segmentDetection_type' - The type of the segment. Valid values are @TECHNICAL_CUE@ and @SHOT@.
newSegmentDetection ::
  SegmentDetection
newSegmentDetection :: SegmentDetection
newSegmentDetection =
  SegmentDetection'
    { $sel:durationFrames:SegmentDetection' :: Maybe Natural
durationFrames = forall a. Maybe a
Prelude.Nothing,
      $sel:durationMillis:SegmentDetection' :: Maybe Natural
durationMillis = forall a. Maybe a
Prelude.Nothing,
      $sel:durationSMPTE:SegmentDetection' :: Maybe Text
durationSMPTE = forall a. Maybe a
Prelude.Nothing,
      $sel:endFrameNumber:SegmentDetection' :: Maybe Natural
endFrameNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:endTimecodeSMPTE:SegmentDetection' :: Maybe Text
endTimecodeSMPTE = forall a. Maybe a
Prelude.Nothing,
      $sel:endTimestampMillis:SegmentDetection' :: Maybe Integer
endTimestampMillis = forall a. Maybe a
Prelude.Nothing,
      $sel:shotSegment:SegmentDetection' :: Maybe ShotSegment
shotSegment = forall a. Maybe a
Prelude.Nothing,
      $sel:startFrameNumber:SegmentDetection' :: Maybe Natural
startFrameNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:startTimecodeSMPTE:SegmentDetection' :: Maybe Text
startTimecodeSMPTE = forall a. Maybe a
Prelude.Nothing,
      $sel:startTimestampMillis:SegmentDetection' :: Maybe Integer
startTimestampMillis = forall a. Maybe a
Prelude.Nothing,
      $sel:technicalCueSegment:SegmentDetection' :: Maybe TechnicalCueSegment
technicalCueSegment = forall a. Maybe a
Prelude.Nothing,
      $sel:type':SegmentDetection' :: Maybe SegmentType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | The duration of a video segment, expressed in frames.
segmentDetection_durationFrames :: Lens.Lens' SegmentDetection (Prelude.Maybe Prelude.Natural)
segmentDetection_durationFrames :: Lens' SegmentDetection (Maybe Natural)
segmentDetection_durationFrames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe Natural
durationFrames :: Maybe Natural
$sel:durationFrames:SegmentDetection' :: SegmentDetection -> Maybe Natural
durationFrames} -> Maybe Natural
durationFrames) (\s :: SegmentDetection
s@SegmentDetection' {} Maybe Natural
a -> SegmentDetection
s {$sel:durationFrames:SegmentDetection' :: Maybe Natural
durationFrames = Maybe Natural
a} :: SegmentDetection)

-- | The duration of the detected segment in milliseconds.
segmentDetection_durationMillis :: Lens.Lens' SegmentDetection (Prelude.Maybe Prelude.Natural)
segmentDetection_durationMillis :: Lens' SegmentDetection (Maybe Natural)
segmentDetection_durationMillis = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe Natural
durationMillis :: Maybe Natural
$sel:durationMillis:SegmentDetection' :: SegmentDetection -> Maybe Natural
durationMillis} -> Maybe Natural
durationMillis) (\s :: SegmentDetection
s@SegmentDetection' {} Maybe Natural
a -> SegmentDetection
s {$sel:durationMillis:SegmentDetection' :: Maybe Natural
durationMillis = Maybe Natural
a} :: SegmentDetection)

-- | The duration of the timecode for the detected segment in SMPTE format.
segmentDetection_durationSMPTE :: Lens.Lens' SegmentDetection (Prelude.Maybe Prelude.Text)
segmentDetection_durationSMPTE :: Lens' SegmentDetection (Maybe Text)
segmentDetection_durationSMPTE = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe Text
durationSMPTE :: Maybe Text
$sel:durationSMPTE:SegmentDetection' :: SegmentDetection -> Maybe Text
durationSMPTE} -> Maybe Text
durationSMPTE) (\s :: SegmentDetection
s@SegmentDetection' {} Maybe Text
a -> SegmentDetection
s {$sel:durationSMPTE:SegmentDetection' :: Maybe Text
durationSMPTE = Maybe Text
a} :: SegmentDetection)

-- | The frame number at the end of a video segment, using a frame index that
-- starts with 0.
segmentDetection_endFrameNumber :: Lens.Lens' SegmentDetection (Prelude.Maybe Prelude.Natural)
segmentDetection_endFrameNumber :: Lens' SegmentDetection (Maybe Natural)
segmentDetection_endFrameNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe Natural
endFrameNumber :: Maybe Natural
$sel:endFrameNumber:SegmentDetection' :: SegmentDetection -> Maybe Natural
endFrameNumber} -> Maybe Natural
endFrameNumber) (\s :: SegmentDetection
s@SegmentDetection' {} Maybe Natural
a -> SegmentDetection
s {$sel:endFrameNumber:SegmentDetection' :: Maybe Natural
endFrameNumber = Maybe Natural
a} :: SegmentDetection)

-- | The frame-accurate SMPTE timecode, from the start of a video, for the
-- end of a detected segment. @EndTimecode@ is in /HH:MM:SS:fr/ format (and
-- /;fr/ for drop frame-rates).
segmentDetection_endTimecodeSMPTE :: Lens.Lens' SegmentDetection (Prelude.Maybe Prelude.Text)
segmentDetection_endTimecodeSMPTE :: Lens' SegmentDetection (Maybe Text)
segmentDetection_endTimecodeSMPTE = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe Text
endTimecodeSMPTE :: Maybe Text
$sel:endTimecodeSMPTE:SegmentDetection' :: SegmentDetection -> Maybe Text
endTimecodeSMPTE} -> Maybe Text
endTimecodeSMPTE) (\s :: SegmentDetection
s@SegmentDetection' {} Maybe Text
a -> SegmentDetection
s {$sel:endTimecodeSMPTE:SegmentDetection' :: Maybe Text
endTimecodeSMPTE = Maybe Text
a} :: SegmentDetection)

-- | The end time of the detected segment, in milliseconds, from the start of
-- the video. This value is rounded down.
segmentDetection_endTimestampMillis :: Lens.Lens' SegmentDetection (Prelude.Maybe Prelude.Integer)
segmentDetection_endTimestampMillis :: Lens' SegmentDetection (Maybe Integer)
segmentDetection_endTimestampMillis = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe Integer
endTimestampMillis :: Maybe Integer
$sel:endTimestampMillis:SegmentDetection' :: SegmentDetection -> Maybe Integer
endTimestampMillis} -> Maybe Integer
endTimestampMillis) (\s :: SegmentDetection
s@SegmentDetection' {} Maybe Integer
a -> SegmentDetection
s {$sel:endTimestampMillis:SegmentDetection' :: Maybe Integer
endTimestampMillis = Maybe Integer
a} :: SegmentDetection)

-- | If the segment is a shot detection, contains information about the shot
-- detection.
segmentDetection_shotSegment :: Lens.Lens' SegmentDetection (Prelude.Maybe ShotSegment)
segmentDetection_shotSegment :: Lens' SegmentDetection (Maybe ShotSegment)
segmentDetection_shotSegment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe ShotSegment
shotSegment :: Maybe ShotSegment
$sel:shotSegment:SegmentDetection' :: SegmentDetection -> Maybe ShotSegment
shotSegment} -> Maybe ShotSegment
shotSegment) (\s :: SegmentDetection
s@SegmentDetection' {} Maybe ShotSegment
a -> SegmentDetection
s {$sel:shotSegment:SegmentDetection' :: Maybe ShotSegment
shotSegment = Maybe ShotSegment
a} :: SegmentDetection)

-- | The frame number of the start of a video segment, using a frame index
-- that starts with 0.
segmentDetection_startFrameNumber :: Lens.Lens' SegmentDetection (Prelude.Maybe Prelude.Natural)
segmentDetection_startFrameNumber :: Lens' SegmentDetection (Maybe Natural)
segmentDetection_startFrameNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe Natural
startFrameNumber :: Maybe Natural
$sel:startFrameNumber:SegmentDetection' :: SegmentDetection -> Maybe Natural
startFrameNumber} -> Maybe Natural
startFrameNumber) (\s :: SegmentDetection
s@SegmentDetection' {} Maybe Natural
a -> SegmentDetection
s {$sel:startFrameNumber:SegmentDetection' :: Maybe Natural
startFrameNumber = Maybe Natural
a} :: SegmentDetection)

-- | The frame-accurate SMPTE timecode, from the start of a video, for the
-- start of a detected segment. @StartTimecode@ is in /HH:MM:SS:fr/ format
-- (and /;fr/ for drop frame-rates).
segmentDetection_startTimecodeSMPTE :: Lens.Lens' SegmentDetection (Prelude.Maybe Prelude.Text)
segmentDetection_startTimecodeSMPTE :: Lens' SegmentDetection (Maybe Text)
segmentDetection_startTimecodeSMPTE = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe Text
startTimecodeSMPTE :: Maybe Text
$sel:startTimecodeSMPTE:SegmentDetection' :: SegmentDetection -> Maybe Text
startTimecodeSMPTE} -> Maybe Text
startTimecodeSMPTE) (\s :: SegmentDetection
s@SegmentDetection' {} Maybe Text
a -> SegmentDetection
s {$sel:startTimecodeSMPTE:SegmentDetection' :: Maybe Text
startTimecodeSMPTE = Maybe Text
a} :: SegmentDetection)

-- | The start time of the detected segment in milliseconds from the start of
-- the video. This value is rounded down. For example, if the actual
-- timestamp is 100.6667 milliseconds, Amazon Rekognition Video returns a
-- value of 100 millis.
segmentDetection_startTimestampMillis :: Lens.Lens' SegmentDetection (Prelude.Maybe Prelude.Integer)
segmentDetection_startTimestampMillis :: Lens' SegmentDetection (Maybe Integer)
segmentDetection_startTimestampMillis = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe Integer
startTimestampMillis :: Maybe Integer
$sel:startTimestampMillis:SegmentDetection' :: SegmentDetection -> Maybe Integer
startTimestampMillis} -> Maybe Integer
startTimestampMillis) (\s :: SegmentDetection
s@SegmentDetection' {} Maybe Integer
a -> SegmentDetection
s {$sel:startTimestampMillis:SegmentDetection' :: Maybe Integer
startTimestampMillis = Maybe Integer
a} :: SegmentDetection)

-- | If the segment is a technical cue, contains information about the
-- technical cue.
segmentDetection_technicalCueSegment :: Lens.Lens' SegmentDetection (Prelude.Maybe TechnicalCueSegment)
segmentDetection_technicalCueSegment :: Lens' SegmentDetection (Maybe TechnicalCueSegment)
segmentDetection_technicalCueSegment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe TechnicalCueSegment
technicalCueSegment :: Maybe TechnicalCueSegment
$sel:technicalCueSegment:SegmentDetection' :: SegmentDetection -> Maybe TechnicalCueSegment
technicalCueSegment} -> Maybe TechnicalCueSegment
technicalCueSegment) (\s :: SegmentDetection
s@SegmentDetection' {} Maybe TechnicalCueSegment
a -> SegmentDetection
s {$sel:technicalCueSegment:SegmentDetection' :: Maybe TechnicalCueSegment
technicalCueSegment = Maybe TechnicalCueSegment
a} :: SegmentDetection)

-- | The type of the segment. Valid values are @TECHNICAL_CUE@ and @SHOT@.
segmentDetection_type :: Lens.Lens' SegmentDetection (Prelude.Maybe SegmentType)
segmentDetection_type :: Lens' SegmentDetection (Maybe SegmentType)
segmentDetection_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SegmentDetection' {Maybe SegmentType
type' :: Maybe SegmentType
$sel:type':SegmentDetection' :: SegmentDetection -> Maybe SegmentType
type'} -> Maybe SegmentType
type') (\s :: SegmentDetection
s@SegmentDetection' {} Maybe SegmentType
a -> SegmentDetection
s {$sel:type':SegmentDetection' :: Maybe SegmentType
type' = Maybe SegmentType
a} :: SegmentDetection)

instance Data.FromJSON SegmentDetection where
  parseJSON :: Value -> Parser SegmentDetection
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SegmentDetection"
      ( \Object
x ->
          Maybe Natural
-> Maybe Natural
-> Maybe Text
-> Maybe Natural
-> Maybe Text
-> Maybe Integer
-> Maybe ShotSegment
-> Maybe Natural
-> Maybe Text
-> Maybe Integer
-> Maybe TechnicalCueSegment
-> Maybe SegmentType
-> SegmentDetection
SegmentDetection'
            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
"DurationFrames")
            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
"DurationMillis")
            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
"DurationSMPTE")
            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
"EndFrameNumber")
            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
"EndTimecodeSMPTE")
            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
"EndTimestampMillis")
            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
"ShotSegment")
            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
"StartFrameNumber")
            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
"StartTimecodeSMPTE")
            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
"StartTimestampMillis")
            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
"TechnicalCueSegment")
            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 SegmentDetection where
  hashWithSalt :: Int -> SegmentDetection -> Int
hashWithSalt Int
_salt SegmentDetection' {Maybe Integer
Maybe Natural
Maybe Text
Maybe SegmentType
Maybe ShotSegment
Maybe TechnicalCueSegment
type' :: Maybe SegmentType
technicalCueSegment :: Maybe TechnicalCueSegment
startTimestampMillis :: Maybe Integer
startTimecodeSMPTE :: Maybe Text
startFrameNumber :: Maybe Natural
shotSegment :: Maybe ShotSegment
endTimestampMillis :: Maybe Integer
endTimecodeSMPTE :: Maybe Text
endFrameNumber :: Maybe Natural
durationSMPTE :: Maybe Text
durationMillis :: Maybe Natural
durationFrames :: Maybe Natural
$sel:type':SegmentDetection' :: SegmentDetection -> Maybe SegmentType
$sel:technicalCueSegment:SegmentDetection' :: SegmentDetection -> Maybe TechnicalCueSegment
$sel:startTimestampMillis:SegmentDetection' :: SegmentDetection -> Maybe Integer
$sel:startTimecodeSMPTE:SegmentDetection' :: SegmentDetection -> Maybe Text
$sel:startFrameNumber:SegmentDetection' :: SegmentDetection -> Maybe Natural
$sel:shotSegment:SegmentDetection' :: SegmentDetection -> Maybe ShotSegment
$sel:endTimestampMillis:SegmentDetection' :: SegmentDetection -> Maybe Integer
$sel:endTimecodeSMPTE:SegmentDetection' :: SegmentDetection -> Maybe Text
$sel:endFrameNumber:SegmentDetection' :: SegmentDetection -> Maybe Natural
$sel:durationSMPTE:SegmentDetection' :: SegmentDetection -> Maybe Text
$sel:durationMillis:SegmentDetection' :: SegmentDetection -> Maybe Natural
$sel:durationFrames:SegmentDetection' :: SegmentDetection -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
durationFrames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
durationMillis
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
durationSMPTE
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
endFrameNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
endTimecodeSMPTE
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
endTimestampMillis
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ShotSegment
shotSegment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
startFrameNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
startTimecodeSMPTE
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
startTimestampMillis
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TechnicalCueSegment
technicalCueSegment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SegmentType
type'

instance Prelude.NFData SegmentDetection where
  rnf :: SegmentDetection -> ()
rnf SegmentDetection' {Maybe Integer
Maybe Natural
Maybe Text
Maybe SegmentType
Maybe ShotSegment
Maybe TechnicalCueSegment
type' :: Maybe SegmentType
technicalCueSegment :: Maybe TechnicalCueSegment
startTimestampMillis :: Maybe Integer
startTimecodeSMPTE :: Maybe Text
startFrameNumber :: Maybe Natural
shotSegment :: Maybe ShotSegment
endTimestampMillis :: Maybe Integer
endTimecodeSMPTE :: Maybe Text
endFrameNumber :: Maybe Natural
durationSMPTE :: Maybe Text
durationMillis :: Maybe Natural
durationFrames :: Maybe Natural
$sel:type':SegmentDetection' :: SegmentDetection -> Maybe SegmentType
$sel:technicalCueSegment:SegmentDetection' :: SegmentDetection -> Maybe TechnicalCueSegment
$sel:startTimestampMillis:SegmentDetection' :: SegmentDetection -> Maybe Integer
$sel:startTimecodeSMPTE:SegmentDetection' :: SegmentDetection -> Maybe Text
$sel:startFrameNumber:SegmentDetection' :: SegmentDetection -> Maybe Natural
$sel:shotSegment:SegmentDetection' :: SegmentDetection -> Maybe ShotSegment
$sel:endTimestampMillis:SegmentDetection' :: SegmentDetection -> Maybe Integer
$sel:endTimecodeSMPTE:SegmentDetection' :: SegmentDetection -> Maybe Text
$sel:endFrameNumber:SegmentDetection' :: SegmentDetection -> Maybe Natural
$sel:durationSMPTE:SegmentDetection' :: SegmentDetection -> Maybe Text
$sel:durationMillis:SegmentDetection' :: SegmentDetection -> Maybe Natural
$sel:durationFrames:SegmentDetection' :: SegmentDetection -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
durationFrames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
durationMillis
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
durationSMPTE
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
endFrameNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endTimecodeSMPTE
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
endTimestampMillis
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ShotSegment
shotSegment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
startFrameNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
startTimecodeSMPTE
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
startTimestampMillis
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TechnicalCueSegment
technicalCueSegment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SegmentType
type'