{-# 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.MediaLive.Types.Mpeg2Settings
-- 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.MediaLive.Types.Mpeg2Settings where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaLive.Types.AfdSignaling
import Amazonka.MediaLive.Types.FixedAfd
import Amazonka.MediaLive.Types.Mpeg2AdaptiveQuantization
import Amazonka.MediaLive.Types.Mpeg2ColorMetadata
import Amazonka.MediaLive.Types.Mpeg2ColorSpace
import Amazonka.MediaLive.Types.Mpeg2DisplayRatio
import Amazonka.MediaLive.Types.Mpeg2FilterSettings
import Amazonka.MediaLive.Types.Mpeg2GopSizeUnits
import Amazonka.MediaLive.Types.Mpeg2ScanType
import Amazonka.MediaLive.Types.Mpeg2SubGopLength
import Amazonka.MediaLive.Types.Mpeg2TimecodeInsertionBehavior
import Amazonka.MediaLive.Types.TimecodeBurninSettings
import qualified Amazonka.Prelude as Prelude

-- | Mpeg2 Settings
--
-- /See:/ 'newMpeg2Settings' smart constructor.
data Mpeg2Settings = Mpeg2Settings'
  { -- | Choose Off to disable adaptive quantization. Or choose another value to
    -- enable the quantizer and set its strength. The strengths are: Auto, Off,
    -- Low, Medium, High. When you enable this field, MediaLive allows
    -- intra-frame quantizers to vary, which might improve visual quality.
    Mpeg2Settings -> Maybe Mpeg2AdaptiveQuantization
adaptiveQuantization :: Prelude.Maybe Mpeg2AdaptiveQuantization,
    -- | Indicates the AFD values that MediaLive will write into the video
    -- encode. If you do not know what AFD signaling is, or if your downstream
    -- system has not given you guidance, choose AUTO. AUTO: MediaLive will try
    -- to preserve the input AFD value (in cases where multiple AFD values are
    -- valid). FIXED: MediaLive will use the value you specify in fixedAFD.
    Mpeg2Settings -> Maybe AfdSignaling
afdSignaling :: Prelude.Maybe AfdSignaling,
    -- | Specifies whether to include the color space metadata. The metadata
    -- describes the color space that applies to the video (the colorSpace
    -- field). We recommend that you insert the metadata.
    Mpeg2Settings -> Maybe Mpeg2ColorMetadata
colorMetadata :: Prelude.Maybe Mpeg2ColorMetadata,
    -- | Choose the type of color space conversion to apply to the output. For
    -- detailed information on setting up both the input and the output to
    -- obtain the desired color space in the output, see the section on
    -- \\\"MediaLive Features - Video - color space\\\" in the MediaLive User
    -- Guide. PASSTHROUGH: Keep the color space of the input content - do not
    -- convert it. AUTO:Convert all content that is SD to rec 601, and convert
    -- all content that is HD to rec 709.
    Mpeg2Settings -> Maybe Mpeg2ColorSpace
colorSpace :: Prelude.Maybe Mpeg2ColorSpace,
    -- | Sets the pixel aspect ratio for the encode.
    Mpeg2Settings -> Maybe Mpeg2DisplayRatio
displayAspectRatio :: Prelude.Maybe Mpeg2DisplayRatio,
    -- | Optionally specify a noise reduction filter, which can improve quality
    -- of compressed content. If you do not choose a filter, no filter will be
    -- applied. TEMPORAL: This filter is useful for both source content that is
    -- noisy (when it has excessive digital artifacts) and source content that
    -- is clean. When the content is noisy, the filter cleans up the source
    -- content before the encoding phase, with these two effects: First, it
    -- improves the output video quality because the content has been cleaned
    -- up. Secondly, it decreases the bandwidth because MediaLive does not
    -- waste bits on encoding noise. When the content is reasonably clean, the
    -- filter tends to decrease the bitrate.
    Mpeg2Settings -> Maybe Mpeg2FilterSettings
filterSettings :: Prelude.Maybe Mpeg2FilterSettings,
    -- | Complete this field only when afdSignaling is set to FIXED. Enter the
    -- AFD value (4 bits) to write on all frames of the video encode.
    Mpeg2Settings -> Maybe FixedAfd
fixedAfd :: Prelude.Maybe FixedAfd,
    -- | MPEG2: default is open GOP.
    Mpeg2Settings -> Maybe Natural
gopClosedCadence :: Prelude.Maybe Prelude.Natural,
    -- | Relates to the GOP structure. The number of B-frames between reference
    -- frames. If you do not know what a B-frame is, use the default.
    Mpeg2Settings -> Maybe Natural
gopNumBFrames :: Prelude.Maybe Prelude.Natural,
    -- | Relates to the GOP structure. The GOP size (keyframe interval) in the
    -- units specified in gopSizeUnits. If you do not know what GOP is, use the
    -- default. If gopSizeUnits is frames, then the gopSize must be an integer
    -- and must be greater than or equal to 1. If gopSizeUnits is seconds, the
    -- gopSize must be greater than 0, but does not need to be an integer.
    Mpeg2Settings -> Maybe Double
gopSize :: Prelude.Maybe Prelude.Double,
    -- | Relates to the GOP structure. Specifies whether the gopSize is specified
    -- in frames or seconds. If you do not plan to change the default gopSize,
    -- leave the default. If you specify SECONDS, MediaLive will internally
    -- convert the gop size to a frame count.
    Mpeg2Settings -> Maybe Mpeg2GopSizeUnits
gopSizeUnits :: Prelude.Maybe Mpeg2GopSizeUnits,
    -- | Set the scan type of the output to PROGRESSIVE or INTERLACED (top field
    -- first).
    Mpeg2Settings -> Maybe Mpeg2ScanType
scanType :: Prelude.Maybe Mpeg2ScanType,
    -- | Relates to the GOP structure. If you do not know what GOP is, use the
    -- default. FIXED: Set the number of B-frames in each sub-GOP to the value
    -- in gopNumBFrames. DYNAMIC: Let MediaLive optimize the number of B-frames
    -- in each sub-GOP, to improve visual quality.
    Mpeg2Settings -> Maybe Mpeg2SubGopLength
subgopLength :: Prelude.Maybe Mpeg2SubGopLength,
    -- | Timecode burn-in settings
    Mpeg2Settings -> Maybe TimecodeBurninSettings
timecodeBurninSettings :: Prelude.Maybe TimecodeBurninSettings,
    -- | Determines how MediaLive inserts timecodes in the output video. For
    -- detailed information about setting up the input and the output for a
    -- timecode, see the section on \\\"MediaLive Features - Timecode
    -- configuration\\\" in the MediaLive User Guide. DISABLED: do not include
    -- timecodes. GOP_TIMECODE: Include timecode metadata in the GOP header.
    Mpeg2Settings -> Maybe Mpeg2TimecodeInsertionBehavior
timecodeInsertion :: Prelude.Maybe Mpeg2TimecodeInsertionBehavior,
    -- | The framerate numerator. For example, 24000. The framerate is the
    -- numerator divided by the denominator. For example, 24000 \/ 1001 =
    -- 23.976 FPS.
    Mpeg2Settings -> Natural
framerateNumerator :: Prelude.Natural,
    -- | description\": \"The framerate denominator. For example, 1001. The
    -- framerate is the numerator divided by the denominator. For example,
    -- 24000 \/ 1001 = 23.976 FPS.
    Mpeg2Settings -> Natural
framerateDenominator :: Prelude.Natural
  }
  deriving (Mpeg2Settings -> Mpeg2Settings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mpeg2Settings -> Mpeg2Settings -> Bool
$c/= :: Mpeg2Settings -> Mpeg2Settings -> Bool
== :: Mpeg2Settings -> Mpeg2Settings -> Bool
$c== :: Mpeg2Settings -> Mpeg2Settings -> Bool
Prelude.Eq, ReadPrec [Mpeg2Settings]
ReadPrec Mpeg2Settings
Int -> ReadS Mpeg2Settings
ReadS [Mpeg2Settings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mpeg2Settings]
$creadListPrec :: ReadPrec [Mpeg2Settings]
readPrec :: ReadPrec Mpeg2Settings
$creadPrec :: ReadPrec Mpeg2Settings
readList :: ReadS [Mpeg2Settings]
$creadList :: ReadS [Mpeg2Settings]
readsPrec :: Int -> ReadS Mpeg2Settings
$creadsPrec :: Int -> ReadS Mpeg2Settings
Prelude.Read, Int -> Mpeg2Settings -> ShowS
[Mpeg2Settings] -> ShowS
Mpeg2Settings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mpeg2Settings] -> ShowS
$cshowList :: [Mpeg2Settings] -> ShowS
show :: Mpeg2Settings -> String
$cshow :: Mpeg2Settings -> String
showsPrec :: Int -> Mpeg2Settings -> ShowS
$cshowsPrec :: Int -> Mpeg2Settings -> ShowS
Prelude.Show, forall x. Rep Mpeg2Settings x -> Mpeg2Settings
forall x. Mpeg2Settings -> Rep Mpeg2Settings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mpeg2Settings x -> Mpeg2Settings
$cfrom :: forall x. Mpeg2Settings -> Rep Mpeg2Settings x
Prelude.Generic)

-- |
-- Create a value of 'Mpeg2Settings' 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:
--
-- 'adaptiveQuantization', 'mpeg2Settings_adaptiveQuantization' - Choose Off to disable adaptive quantization. Or choose another value to
-- enable the quantizer and set its strength. The strengths are: Auto, Off,
-- Low, Medium, High. When you enable this field, MediaLive allows
-- intra-frame quantizers to vary, which might improve visual quality.
--
-- 'afdSignaling', 'mpeg2Settings_afdSignaling' - Indicates the AFD values that MediaLive will write into the video
-- encode. If you do not know what AFD signaling is, or if your downstream
-- system has not given you guidance, choose AUTO. AUTO: MediaLive will try
-- to preserve the input AFD value (in cases where multiple AFD values are
-- valid). FIXED: MediaLive will use the value you specify in fixedAFD.
--
-- 'colorMetadata', 'mpeg2Settings_colorMetadata' - Specifies whether to include the color space metadata. The metadata
-- describes the color space that applies to the video (the colorSpace
-- field). We recommend that you insert the metadata.
--
-- 'colorSpace', 'mpeg2Settings_colorSpace' - Choose the type of color space conversion to apply to the output. For
-- detailed information on setting up both the input and the output to
-- obtain the desired color space in the output, see the section on
-- \\\"MediaLive Features - Video - color space\\\" in the MediaLive User
-- Guide. PASSTHROUGH: Keep the color space of the input content - do not
-- convert it. AUTO:Convert all content that is SD to rec 601, and convert
-- all content that is HD to rec 709.
--
-- 'displayAspectRatio', 'mpeg2Settings_displayAspectRatio' - Sets the pixel aspect ratio for the encode.
--
-- 'filterSettings', 'mpeg2Settings_filterSettings' - Optionally specify a noise reduction filter, which can improve quality
-- of compressed content. If you do not choose a filter, no filter will be
-- applied. TEMPORAL: This filter is useful for both source content that is
-- noisy (when it has excessive digital artifacts) and source content that
-- is clean. When the content is noisy, the filter cleans up the source
-- content before the encoding phase, with these two effects: First, it
-- improves the output video quality because the content has been cleaned
-- up. Secondly, it decreases the bandwidth because MediaLive does not
-- waste bits on encoding noise. When the content is reasonably clean, the
-- filter tends to decrease the bitrate.
--
-- 'fixedAfd', 'mpeg2Settings_fixedAfd' - Complete this field only when afdSignaling is set to FIXED. Enter the
-- AFD value (4 bits) to write on all frames of the video encode.
--
-- 'gopClosedCadence', 'mpeg2Settings_gopClosedCadence' - MPEG2: default is open GOP.
--
-- 'gopNumBFrames', 'mpeg2Settings_gopNumBFrames' - Relates to the GOP structure. The number of B-frames between reference
-- frames. If you do not know what a B-frame is, use the default.
--
-- 'gopSize', 'mpeg2Settings_gopSize' - Relates to the GOP structure. The GOP size (keyframe interval) in the
-- units specified in gopSizeUnits. If you do not know what GOP is, use the
-- default. If gopSizeUnits is frames, then the gopSize must be an integer
-- and must be greater than or equal to 1. If gopSizeUnits is seconds, the
-- gopSize must be greater than 0, but does not need to be an integer.
--
-- 'gopSizeUnits', 'mpeg2Settings_gopSizeUnits' - Relates to the GOP structure. Specifies whether the gopSize is specified
-- in frames or seconds. If you do not plan to change the default gopSize,
-- leave the default. If you specify SECONDS, MediaLive will internally
-- convert the gop size to a frame count.
--
-- 'scanType', 'mpeg2Settings_scanType' - Set the scan type of the output to PROGRESSIVE or INTERLACED (top field
-- first).
--
-- 'subgopLength', 'mpeg2Settings_subgopLength' - Relates to the GOP structure. If you do not know what GOP is, use the
-- default. FIXED: Set the number of B-frames in each sub-GOP to the value
-- in gopNumBFrames. DYNAMIC: Let MediaLive optimize the number of B-frames
-- in each sub-GOP, to improve visual quality.
--
-- 'timecodeBurninSettings', 'mpeg2Settings_timecodeBurninSettings' - Timecode burn-in settings
--
-- 'timecodeInsertion', 'mpeg2Settings_timecodeInsertion' - Determines how MediaLive inserts timecodes in the output video. For
-- detailed information about setting up the input and the output for a
-- timecode, see the section on \\\"MediaLive Features - Timecode
-- configuration\\\" in the MediaLive User Guide. DISABLED: do not include
-- timecodes. GOP_TIMECODE: Include timecode metadata in the GOP header.
--
-- 'framerateNumerator', 'mpeg2Settings_framerateNumerator' - The framerate numerator. For example, 24000. The framerate is the
-- numerator divided by the denominator. For example, 24000 \/ 1001 =
-- 23.976 FPS.
--
-- 'framerateDenominator', 'mpeg2Settings_framerateDenominator' - description\": \"The framerate denominator. For example, 1001. The
-- framerate is the numerator divided by the denominator. For example,
-- 24000 \/ 1001 = 23.976 FPS.
newMpeg2Settings ::
  -- | 'framerateNumerator'
  Prelude.Natural ->
  -- | 'framerateDenominator'
  Prelude.Natural ->
  Mpeg2Settings
newMpeg2Settings :: Natural -> Natural -> Mpeg2Settings
newMpeg2Settings
  Natural
pFramerateNumerator_
  Natural
pFramerateDenominator_ =
    Mpeg2Settings'
      { $sel:adaptiveQuantization:Mpeg2Settings' :: Maybe Mpeg2AdaptiveQuantization
adaptiveQuantization =
          forall a. Maybe a
Prelude.Nothing,
        $sel:afdSignaling:Mpeg2Settings' :: Maybe AfdSignaling
afdSignaling = forall a. Maybe a
Prelude.Nothing,
        $sel:colorMetadata:Mpeg2Settings' :: Maybe Mpeg2ColorMetadata
colorMetadata = forall a. Maybe a
Prelude.Nothing,
        $sel:colorSpace:Mpeg2Settings' :: Maybe Mpeg2ColorSpace
colorSpace = forall a. Maybe a
Prelude.Nothing,
        $sel:displayAspectRatio:Mpeg2Settings' :: Maybe Mpeg2DisplayRatio
displayAspectRatio = forall a. Maybe a
Prelude.Nothing,
        $sel:filterSettings:Mpeg2Settings' :: Maybe Mpeg2FilterSettings
filterSettings = forall a. Maybe a
Prelude.Nothing,
        $sel:fixedAfd:Mpeg2Settings' :: Maybe FixedAfd
fixedAfd = forall a. Maybe a
Prelude.Nothing,
        $sel:gopClosedCadence:Mpeg2Settings' :: Maybe Natural
gopClosedCadence = forall a. Maybe a
Prelude.Nothing,
        $sel:gopNumBFrames:Mpeg2Settings' :: Maybe Natural
gopNumBFrames = forall a. Maybe a
Prelude.Nothing,
        $sel:gopSize:Mpeg2Settings' :: Maybe Double
gopSize = forall a. Maybe a
Prelude.Nothing,
        $sel:gopSizeUnits:Mpeg2Settings' :: Maybe Mpeg2GopSizeUnits
gopSizeUnits = forall a. Maybe a
Prelude.Nothing,
        $sel:scanType:Mpeg2Settings' :: Maybe Mpeg2ScanType
scanType = forall a. Maybe a
Prelude.Nothing,
        $sel:subgopLength:Mpeg2Settings' :: Maybe Mpeg2SubGopLength
subgopLength = forall a. Maybe a
Prelude.Nothing,
        $sel:timecodeBurninSettings:Mpeg2Settings' :: Maybe TimecodeBurninSettings
timecodeBurninSettings = forall a. Maybe a
Prelude.Nothing,
        $sel:timecodeInsertion:Mpeg2Settings' :: Maybe Mpeg2TimecodeInsertionBehavior
timecodeInsertion = forall a. Maybe a
Prelude.Nothing,
        $sel:framerateNumerator:Mpeg2Settings' :: Natural
framerateNumerator = Natural
pFramerateNumerator_,
        $sel:framerateDenominator:Mpeg2Settings' :: Natural
framerateDenominator = Natural
pFramerateDenominator_
      }

-- | Choose Off to disable adaptive quantization. Or choose another value to
-- enable the quantizer and set its strength. The strengths are: Auto, Off,
-- Low, Medium, High. When you enable this field, MediaLive allows
-- intra-frame quantizers to vary, which might improve visual quality.
mpeg2Settings_adaptiveQuantization :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Mpeg2AdaptiveQuantization)
mpeg2Settings_adaptiveQuantization :: Lens' Mpeg2Settings (Maybe Mpeg2AdaptiveQuantization)
mpeg2Settings_adaptiveQuantization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Mpeg2AdaptiveQuantization
adaptiveQuantization :: Maybe Mpeg2AdaptiveQuantization
$sel:adaptiveQuantization:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2AdaptiveQuantization
adaptiveQuantization} -> Maybe Mpeg2AdaptiveQuantization
adaptiveQuantization) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Mpeg2AdaptiveQuantization
a -> Mpeg2Settings
s {$sel:adaptiveQuantization:Mpeg2Settings' :: Maybe Mpeg2AdaptiveQuantization
adaptiveQuantization = Maybe Mpeg2AdaptiveQuantization
a} :: Mpeg2Settings)

-- | Indicates the AFD values that MediaLive will write into the video
-- encode. If you do not know what AFD signaling is, or if your downstream
-- system has not given you guidance, choose AUTO. AUTO: MediaLive will try
-- to preserve the input AFD value (in cases where multiple AFD values are
-- valid). FIXED: MediaLive will use the value you specify in fixedAFD.
mpeg2Settings_afdSignaling :: Lens.Lens' Mpeg2Settings (Prelude.Maybe AfdSignaling)
mpeg2Settings_afdSignaling :: Lens' Mpeg2Settings (Maybe AfdSignaling)
mpeg2Settings_afdSignaling = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe AfdSignaling
afdSignaling :: Maybe AfdSignaling
$sel:afdSignaling:Mpeg2Settings' :: Mpeg2Settings -> Maybe AfdSignaling
afdSignaling} -> Maybe AfdSignaling
afdSignaling) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe AfdSignaling
a -> Mpeg2Settings
s {$sel:afdSignaling:Mpeg2Settings' :: Maybe AfdSignaling
afdSignaling = Maybe AfdSignaling
a} :: Mpeg2Settings)

-- | Specifies whether to include the color space metadata. The metadata
-- describes the color space that applies to the video (the colorSpace
-- field). We recommend that you insert the metadata.
mpeg2Settings_colorMetadata :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Mpeg2ColorMetadata)
mpeg2Settings_colorMetadata :: Lens' Mpeg2Settings (Maybe Mpeg2ColorMetadata)
mpeg2Settings_colorMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Mpeg2ColorMetadata
colorMetadata :: Maybe Mpeg2ColorMetadata
$sel:colorMetadata:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ColorMetadata
colorMetadata} -> Maybe Mpeg2ColorMetadata
colorMetadata) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Mpeg2ColorMetadata
a -> Mpeg2Settings
s {$sel:colorMetadata:Mpeg2Settings' :: Maybe Mpeg2ColorMetadata
colorMetadata = Maybe Mpeg2ColorMetadata
a} :: Mpeg2Settings)

-- | Choose the type of color space conversion to apply to the output. For
-- detailed information on setting up both the input and the output to
-- obtain the desired color space in the output, see the section on
-- \\\"MediaLive Features - Video - color space\\\" in the MediaLive User
-- Guide. PASSTHROUGH: Keep the color space of the input content - do not
-- convert it. AUTO:Convert all content that is SD to rec 601, and convert
-- all content that is HD to rec 709.
mpeg2Settings_colorSpace :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Mpeg2ColorSpace)
mpeg2Settings_colorSpace :: Lens' Mpeg2Settings (Maybe Mpeg2ColorSpace)
mpeg2Settings_colorSpace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Mpeg2ColorSpace
colorSpace :: Maybe Mpeg2ColorSpace
$sel:colorSpace:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ColorSpace
colorSpace} -> Maybe Mpeg2ColorSpace
colorSpace) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Mpeg2ColorSpace
a -> Mpeg2Settings
s {$sel:colorSpace:Mpeg2Settings' :: Maybe Mpeg2ColorSpace
colorSpace = Maybe Mpeg2ColorSpace
a} :: Mpeg2Settings)

-- | Sets the pixel aspect ratio for the encode.
mpeg2Settings_displayAspectRatio :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Mpeg2DisplayRatio)
mpeg2Settings_displayAspectRatio :: Lens' Mpeg2Settings (Maybe Mpeg2DisplayRatio)
mpeg2Settings_displayAspectRatio = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Mpeg2DisplayRatio
displayAspectRatio :: Maybe Mpeg2DisplayRatio
$sel:displayAspectRatio:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2DisplayRatio
displayAspectRatio} -> Maybe Mpeg2DisplayRatio
displayAspectRatio) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Mpeg2DisplayRatio
a -> Mpeg2Settings
s {$sel:displayAspectRatio:Mpeg2Settings' :: Maybe Mpeg2DisplayRatio
displayAspectRatio = Maybe Mpeg2DisplayRatio
a} :: Mpeg2Settings)

-- | Optionally specify a noise reduction filter, which can improve quality
-- of compressed content. If you do not choose a filter, no filter will be
-- applied. TEMPORAL: This filter is useful for both source content that is
-- noisy (when it has excessive digital artifacts) and source content that
-- is clean. When the content is noisy, the filter cleans up the source
-- content before the encoding phase, with these two effects: First, it
-- improves the output video quality because the content has been cleaned
-- up. Secondly, it decreases the bandwidth because MediaLive does not
-- waste bits on encoding noise. When the content is reasonably clean, the
-- filter tends to decrease the bitrate.
mpeg2Settings_filterSettings :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Mpeg2FilterSettings)
mpeg2Settings_filterSettings :: Lens' Mpeg2Settings (Maybe Mpeg2FilterSettings)
mpeg2Settings_filterSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Mpeg2FilterSettings
filterSettings :: Maybe Mpeg2FilterSettings
$sel:filterSettings:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2FilterSettings
filterSettings} -> Maybe Mpeg2FilterSettings
filterSettings) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Mpeg2FilterSettings
a -> Mpeg2Settings
s {$sel:filterSettings:Mpeg2Settings' :: Maybe Mpeg2FilterSettings
filterSettings = Maybe Mpeg2FilterSettings
a} :: Mpeg2Settings)

-- | Complete this field only when afdSignaling is set to FIXED. Enter the
-- AFD value (4 bits) to write on all frames of the video encode.
mpeg2Settings_fixedAfd :: Lens.Lens' Mpeg2Settings (Prelude.Maybe FixedAfd)
mpeg2Settings_fixedAfd :: Lens' Mpeg2Settings (Maybe FixedAfd)
mpeg2Settings_fixedAfd = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe FixedAfd
fixedAfd :: Maybe FixedAfd
$sel:fixedAfd:Mpeg2Settings' :: Mpeg2Settings -> Maybe FixedAfd
fixedAfd} -> Maybe FixedAfd
fixedAfd) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe FixedAfd
a -> Mpeg2Settings
s {$sel:fixedAfd:Mpeg2Settings' :: Maybe FixedAfd
fixedAfd = Maybe FixedAfd
a} :: Mpeg2Settings)

-- | MPEG2: default is open GOP.
mpeg2Settings_gopClosedCadence :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Prelude.Natural)
mpeg2Settings_gopClosedCadence :: Lens' Mpeg2Settings (Maybe Natural)
mpeg2Settings_gopClosedCadence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Natural
gopClosedCadence :: Maybe Natural
$sel:gopClosedCadence:Mpeg2Settings' :: Mpeg2Settings -> Maybe Natural
gopClosedCadence} -> Maybe Natural
gopClosedCadence) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Natural
a -> Mpeg2Settings
s {$sel:gopClosedCadence:Mpeg2Settings' :: Maybe Natural
gopClosedCadence = Maybe Natural
a} :: Mpeg2Settings)

-- | Relates to the GOP structure. The number of B-frames between reference
-- frames. If you do not know what a B-frame is, use the default.
mpeg2Settings_gopNumBFrames :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Prelude.Natural)
mpeg2Settings_gopNumBFrames :: Lens' Mpeg2Settings (Maybe Natural)
mpeg2Settings_gopNumBFrames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Natural
gopNumBFrames :: Maybe Natural
$sel:gopNumBFrames:Mpeg2Settings' :: Mpeg2Settings -> Maybe Natural
gopNumBFrames} -> Maybe Natural
gopNumBFrames) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Natural
a -> Mpeg2Settings
s {$sel:gopNumBFrames:Mpeg2Settings' :: Maybe Natural
gopNumBFrames = Maybe Natural
a} :: Mpeg2Settings)

-- | Relates to the GOP structure. The GOP size (keyframe interval) in the
-- units specified in gopSizeUnits. If you do not know what GOP is, use the
-- default. If gopSizeUnits is frames, then the gopSize must be an integer
-- and must be greater than or equal to 1. If gopSizeUnits is seconds, the
-- gopSize must be greater than 0, but does not need to be an integer.
mpeg2Settings_gopSize :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Prelude.Double)
mpeg2Settings_gopSize :: Lens' Mpeg2Settings (Maybe Double)
mpeg2Settings_gopSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Double
gopSize :: Maybe Double
$sel:gopSize:Mpeg2Settings' :: Mpeg2Settings -> Maybe Double
gopSize} -> Maybe Double
gopSize) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Double
a -> Mpeg2Settings
s {$sel:gopSize:Mpeg2Settings' :: Maybe Double
gopSize = Maybe Double
a} :: Mpeg2Settings)

-- | Relates to the GOP structure. Specifies whether the gopSize is specified
-- in frames or seconds. If you do not plan to change the default gopSize,
-- leave the default. If you specify SECONDS, MediaLive will internally
-- convert the gop size to a frame count.
mpeg2Settings_gopSizeUnits :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Mpeg2GopSizeUnits)
mpeg2Settings_gopSizeUnits :: Lens' Mpeg2Settings (Maybe Mpeg2GopSizeUnits)
mpeg2Settings_gopSizeUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Mpeg2GopSizeUnits
gopSizeUnits :: Maybe Mpeg2GopSizeUnits
$sel:gopSizeUnits:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2GopSizeUnits
gopSizeUnits} -> Maybe Mpeg2GopSizeUnits
gopSizeUnits) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Mpeg2GopSizeUnits
a -> Mpeg2Settings
s {$sel:gopSizeUnits:Mpeg2Settings' :: Maybe Mpeg2GopSizeUnits
gopSizeUnits = Maybe Mpeg2GopSizeUnits
a} :: Mpeg2Settings)

-- | Set the scan type of the output to PROGRESSIVE or INTERLACED (top field
-- first).
mpeg2Settings_scanType :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Mpeg2ScanType)
mpeg2Settings_scanType :: Lens' Mpeg2Settings (Maybe Mpeg2ScanType)
mpeg2Settings_scanType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Mpeg2ScanType
scanType :: Maybe Mpeg2ScanType
$sel:scanType:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ScanType
scanType} -> Maybe Mpeg2ScanType
scanType) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Mpeg2ScanType
a -> Mpeg2Settings
s {$sel:scanType:Mpeg2Settings' :: Maybe Mpeg2ScanType
scanType = Maybe Mpeg2ScanType
a} :: Mpeg2Settings)

-- | Relates to the GOP structure. If you do not know what GOP is, use the
-- default. FIXED: Set the number of B-frames in each sub-GOP to the value
-- in gopNumBFrames. DYNAMIC: Let MediaLive optimize the number of B-frames
-- in each sub-GOP, to improve visual quality.
mpeg2Settings_subgopLength :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Mpeg2SubGopLength)
mpeg2Settings_subgopLength :: Lens' Mpeg2Settings (Maybe Mpeg2SubGopLength)
mpeg2Settings_subgopLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Mpeg2SubGopLength
subgopLength :: Maybe Mpeg2SubGopLength
$sel:subgopLength:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2SubGopLength
subgopLength} -> Maybe Mpeg2SubGopLength
subgopLength) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Mpeg2SubGopLength
a -> Mpeg2Settings
s {$sel:subgopLength:Mpeg2Settings' :: Maybe Mpeg2SubGopLength
subgopLength = Maybe Mpeg2SubGopLength
a} :: Mpeg2Settings)

-- | Timecode burn-in settings
mpeg2Settings_timecodeBurninSettings :: Lens.Lens' Mpeg2Settings (Prelude.Maybe TimecodeBurninSettings)
mpeg2Settings_timecodeBurninSettings :: Lens' Mpeg2Settings (Maybe TimecodeBurninSettings)
mpeg2Settings_timecodeBurninSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe TimecodeBurninSettings
timecodeBurninSettings :: Maybe TimecodeBurninSettings
$sel:timecodeBurninSettings:Mpeg2Settings' :: Mpeg2Settings -> Maybe TimecodeBurninSettings
timecodeBurninSettings} -> Maybe TimecodeBurninSettings
timecodeBurninSettings) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe TimecodeBurninSettings
a -> Mpeg2Settings
s {$sel:timecodeBurninSettings:Mpeg2Settings' :: Maybe TimecodeBurninSettings
timecodeBurninSettings = Maybe TimecodeBurninSettings
a} :: Mpeg2Settings)

-- | Determines how MediaLive inserts timecodes in the output video. For
-- detailed information about setting up the input and the output for a
-- timecode, see the section on \\\"MediaLive Features - Timecode
-- configuration\\\" in the MediaLive User Guide. DISABLED: do not include
-- timecodes. GOP_TIMECODE: Include timecode metadata in the GOP header.
mpeg2Settings_timecodeInsertion :: Lens.Lens' Mpeg2Settings (Prelude.Maybe Mpeg2TimecodeInsertionBehavior)
mpeg2Settings_timecodeInsertion :: Lens' Mpeg2Settings (Maybe Mpeg2TimecodeInsertionBehavior)
mpeg2Settings_timecodeInsertion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Maybe Mpeg2TimecodeInsertionBehavior
timecodeInsertion :: Maybe Mpeg2TimecodeInsertionBehavior
$sel:timecodeInsertion:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2TimecodeInsertionBehavior
timecodeInsertion} -> Maybe Mpeg2TimecodeInsertionBehavior
timecodeInsertion) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Maybe Mpeg2TimecodeInsertionBehavior
a -> Mpeg2Settings
s {$sel:timecodeInsertion:Mpeg2Settings' :: Maybe Mpeg2TimecodeInsertionBehavior
timecodeInsertion = Maybe Mpeg2TimecodeInsertionBehavior
a} :: Mpeg2Settings)

-- | The framerate numerator. For example, 24000. The framerate is the
-- numerator divided by the denominator. For example, 24000 \/ 1001 =
-- 23.976 FPS.
mpeg2Settings_framerateNumerator :: Lens.Lens' Mpeg2Settings Prelude.Natural
mpeg2Settings_framerateNumerator :: Lens' Mpeg2Settings Natural
mpeg2Settings_framerateNumerator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Natural
framerateNumerator :: Natural
$sel:framerateNumerator:Mpeg2Settings' :: Mpeg2Settings -> Natural
framerateNumerator} -> Natural
framerateNumerator) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Natural
a -> Mpeg2Settings
s {$sel:framerateNumerator:Mpeg2Settings' :: Natural
framerateNumerator = Natural
a} :: Mpeg2Settings)

-- | description\": \"The framerate denominator. For example, 1001. The
-- framerate is the numerator divided by the denominator. For example,
-- 24000 \/ 1001 = 23.976 FPS.
mpeg2Settings_framerateDenominator :: Lens.Lens' Mpeg2Settings Prelude.Natural
mpeg2Settings_framerateDenominator :: Lens' Mpeg2Settings Natural
mpeg2Settings_framerateDenominator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mpeg2Settings' {Natural
framerateDenominator :: Natural
$sel:framerateDenominator:Mpeg2Settings' :: Mpeg2Settings -> Natural
framerateDenominator} -> Natural
framerateDenominator) (\s :: Mpeg2Settings
s@Mpeg2Settings' {} Natural
a -> Mpeg2Settings
s {$sel:framerateDenominator:Mpeg2Settings' :: Natural
framerateDenominator = Natural
a} :: Mpeg2Settings)

instance Data.FromJSON Mpeg2Settings where
  parseJSON :: Value -> Parser Mpeg2Settings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Mpeg2Settings"
      ( \Object
x ->
          Maybe Mpeg2AdaptiveQuantization
-> Maybe AfdSignaling
-> Maybe Mpeg2ColorMetadata
-> Maybe Mpeg2ColorSpace
-> Maybe Mpeg2DisplayRatio
-> Maybe Mpeg2FilterSettings
-> Maybe FixedAfd
-> Maybe Natural
-> Maybe Natural
-> Maybe Double
-> Maybe Mpeg2GopSizeUnits
-> Maybe Mpeg2ScanType
-> Maybe Mpeg2SubGopLength
-> Maybe TimecodeBurninSettings
-> Maybe Mpeg2TimecodeInsertionBehavior
-> Natural
-> Natural
-> Mpeg2Settings
Mpeg2Settings'
            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
"adaptiveQuantization")
            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
"afdSignaling")
            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
"colorMetadata")
            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
"colorSpace")
            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
"displayAspectRatio")
            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
"filterSettings")
            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
"fixedAfd")
            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
"gopClosedCadence")
            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
"gopNumBFrames")
            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
"gopSize")
            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
"gopSizeUnits")
            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
"scanType")
            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
"subgopLength")
            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
"timecodeBurninSettings")
            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
"timecodeInsertion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"framerateNumerator")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"framerateDenominator")
      )

instance Prelude.Hashable Mpeg2Settings where
  hashWithSalt :: Int -> Mpeg2Settings -> Int
hashWithSalt Int
_salt Mpeg2Settings' {Natural
Maybe Double
Maybe Natural
Maybe AfdSignaling
Maybe FixedAfd
Maybe Mpeg2AdaptiveQuantization
Maybe Mpeg2ColorMetadata
Maybe Mpeg2ColorSpace
Maybe Mpeg2DisplayRatio
Maybe Mpeg2GopSizeUnits
Maybe Mpeg2ScanType
Maybe Mpeg2SubGopLength
Maybe Mpeg2TimecodeInsertionBehavior
Maybe Mpeg2FilterSettings
Maybe TimecodeBurninSettings
framerateDenominator :: Natural
framerateNumerator :: Natural
timecodeInsertion :: Maybe Mpeg2TimecodeInsertionBehavior
timecodeBurninSettings :: Maybe TimecodeBurninSettings
subgopLength :: Maybe Mpeg2SubGopLength
scanType :: Maybe Mpeg2ScanType
gopSizeUnits :: Maybe Mpeg2GopSizeUnits
gopSize :: Maybe Double
gopNumBFrames :: Maybe Natural
gopClosedCadence :: Maybe Natural
fixedAfd :: Maybe FixedAfd
filterSettings :: Maybe Mpeg2FilterSettings
displayAspectRatio :: Maybe Mpeg2DisplayRatio
colorSpace :: Maybe Mpeg2ColorSpace
colorMetadata :: Maybe Mpeg2ColorMetadata
afdSignaling :: Maybe AfdSignaling
adaptiveQuantization :: Maybe Mpeg2AdaptiveQuantization
$sel:framerateDenominator:Mpeg2Settings' :: Mpeg2Settings -> Natural
$sel:framerateNumerator:Mpeg2Settings' :: Mpeg2Settings -> Natural
$sel:timecodeInsertion:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2TimecodeInsertionBehavior
$sel:timecodeBurninSettings:Mpeg2Settings' :: Mpeg2Settings -> Maybe TimecodeBurninSettings
$sel:subgopLength:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2SubGopLength
$sel:scanType:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ScanType
$sel:gopSizeUnits:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2GopSizeUnits
$sel:gopSize:Mpeg2Settings' :: Mpeg2Settings -> Maybe Double
$sel:gopNumBFrames:Mpeg2Settings' :: Mpeg2Settings -> Maybe Natural
$sel:gopClosedCadence:Mpeg2Settings' :: Mpeg2Settings -> Maybe Natural
$sel:fixedAfd:Mpeg2Settings' :: Mpeg2Settings -> Maybe FixedAfd
$sel:filterSettings:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2FilterSettings
$sel:displayAspectRatio:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2DisplayRatio
$sel:colorSpace:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ColorSpace
$sel:colorMetadata:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ColorMetadata
$sel:afdSignaling:Mpeg2Settings' :: Mpeg2Settings -> Maybe AfdSignaling
$sel:adaptiveQuantization:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2AdaptiveQuantization
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mpeg2AdaptiveQuantization
adaptiveQuantization
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AfdSignaling
afdSignaling
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mpeg2ColorMetadata
colorMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mpeg2ColorSpace
colorSpace
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mpeg2DisplayRatio
displayAspectRatio
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mpeg2FilterSettings
filterSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FixedAfd
fixedAfd
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
gopClosedCadence
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
gopNumBFrames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
gopSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mpeg2GopSizeUnits
gopSizeUnits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mpeg2ScanType
scanType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mpeg2SubGopLength
subgopLength
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimecodeBurninSettings
timecodeBurninSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mpeg2TimecodeInsertionBehavior
timecodeInsertion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
framerateNumerator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
framerateDenominator

instance Prelude.NFData Mpeg2Settings where
  rnf :: Mpeg2Settings -> ()
rnf Mpeg2Settings' {Natural
Maybe Double
Maybe Natural
Maybe AfdSignaling
Maybe FixedAfd
Maybe Mpeg2AdaptiveQuantization
Maybe Mpeg2ColorMetadata
Maybe Mpeg2ColorSpace
Maybe Mpeg2DisplayRatio
Maybe Mpeg2GopSizeUnits
Maybe Mpeg2ScanType
Maybe Mpeg2SubGopLength
Maybe Mpeg2TimecodeInsertionBehavior
Maybe Mpeg2FilterSettings
Maybe TimecodeBurninSettings
framerateDenominator :: Natural
framerateNumerator :: Natural
timecodeInsertion :: Maybe Mpeg2TimecodeInsertionBehavior
timecodeBurninSettings :: Maybe TimecodeBurninSettings
subgopLength :: Maybe Mpeg2SubGopLength
scanType :: Maybe Mpeg2ScanType
gopSizeUnits :: Maybe Mpeg2GopSizeUnits
gopSize :: Maybe Double
gopNumBFrames :: Maybe Natural
gopClosedCadence :: Maybe Natural
fixedAfd :: Maybe FixedAfd
filterSettings :: Maybe Mpeg2FilterSettings
displayAspectRatio :: Maybe Mpeg2DisplayRatio
colorSpace :: Maybe Mpeg2ColorSpace
colorMetadata :: Maybe Mpeg2ColorMetadata
afdSignaling :: Maybe AfdSignaling
adaptiveQuantization :: Maybe Mpeg2AdaptiveQuantization
$sel:framerateDenominator:Mpeg2Settings' :: Mpeg2Settings -> Natural
$sel:framerateNumerator:Mpeg2Settings' :: Mpeg2Settings -> Natural
$sel:timecodeInsertion:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2TimecodeInsertionBehavior
$sel:timecodeBurninSettings:Mpeg2Settings' :: Mpeg2Settings -> Maybe TimecodeBurninSettings
$sel:subgopLength:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2SubGopLength
$sel:scanType:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ScanType
$sel:gopSizeUnits:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2GopSizeUnits
$sel:gopSize:Mpeg2Settings' :: Mpeg2Settings -> Maybe Double
$sel:gopNumBFrames:Mpeg2Settings' :: Mpeg2Settings -> Maybe Natural
$sel:gopClosedCadence:Mpeg2Settings' :: Mpeg2Settings -> Maybe Natural
$sel:fixedAfd:Mpeg2Settings' :: Mpeg2Settings -> Maybe FixedAfd
$sel:filterSettings:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2FilterSettings
$sel:displayAspectRatio:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2DisplayRatio
$sel:colorSpace:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ColorSpace
$sel:colorMetadata:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ColorMetadata
$sel:afdSignaling:Mpeg2Settings' :: Mpeg2Settings -> Maybe AfdSignaling
$sel:adaptiveQuantization:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2AdaptiveQuantization
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Mpeg2AdaptiveQuantization
adaptiveQuantization
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AfdSignaling
afdSignaling
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mpeg2ColorMetadata
colorMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mpeg2ColorSpace
colorSpace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mpeg2DisplayRatio
displayAspectRatio
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mpeg2FilterSettings
filterSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FixedAfd
fixedAfd
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
gopClosedCadence
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
gopNumBFrames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
gopSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mpeg2GopSizeUnits
gopSizeUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mpeg2ScanType
scanType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mpeg2SubGopLength
subgopLength
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TimecodeBurninSettings
timecodeBurninSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mpeg2TimecodeInsertionBehavior
timecodeInsertion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
framerateNumerator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
framerateDenominator

instance Data.ToJSON Mpeg2Settings where
  toJSON :: Mpeg2Settings -> Value
toJSON Mpeg2Settings' {Natural
Maybe Double
Maybe Natural
Maybe AfdSignaling
Maybe FixedAfd
Maybe Mpeg2AdaptiveQuantization
Maybe Mpeg2ColorMetadata
Maybe Mpeg2ColorSpace
Maybe Mpeg2DisplayRatio
Maybe Mpeg2GopSizeUnits
Maybe Mpeg2ScanType
Maybe Mpeg2SubGopLength
Maybe Mpeg2TimecodeInsertionBehavior
Maybe Mpeg2FilterSettings
Maybe TimecodeBurninSettings
framerateDenominator :: Natural
framerateNumerator :: Natural
timecodeInsertion :: Maybe Mpeg2TimecodeInsertionBehavior
timecodeBurninSettings :: Maybe TimecodeBurninSettings
subgopLength :: Maybe Mpeg2SubGopLength
scanType :: Maybe Mpeg2ScanType
gopSizeUnits :: Maybe Mpeg2GopSizeUnits
gopSize :: Maybe Double
gopNumBFrames :: Maybe Natural
gopClosedCadence :: Maybe Natural
fixedAfd :: Maybe FixedAfd
filterSettings :: Maybe Mpeg2FilterSettings
displayAspectRatio :: Maybe Mpeg2DisplayRatio
colorSpace :: Maybe Mpeg2ColorSpace
colorMetadata :: Maybe Mpeg2ColorMetadata
afdSignaling :: Maybe AfdSignaling
adaptiveQuantization :: Maybe Mpeg2AdaptiveQuantization
$sel:framerateDenominator:Mpeg2Settings' :: Mpeg2Settings -> Natural
$sel:framerateNumerator:Mpeg2Settings' :: Mpeg2Settings -> Natural
$sel:timecodeInsertion:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2TimecodeInsertionBehavior
$sel:timecodeBurninSettings:Mpeg2Settings' :: Mpeg2Settings -> Maybe TimecodeBurninSettings
$sel:subgopLength:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2SubGopLength
$sel:scanType:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ScanType
$sel:gopSizeUnits:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2GopSizeUnits
$sel:gopSize:Mpeg2Settings' :: Mpeg2Settings -> Maybe Double
$sel:gopNumBFrames:Mpeg2Settings' :: Mpeg2Settings -> Maybe Natural
$sel:gopClosedCadence:Mpeg2Settings' :: Mpeg2Settings -> Maybe Natural
$sel:fixedAfd:Mpeg2Settings' :: Mpeg2Settings -> Maybe FixedAfd
$sel:filterSettings:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2FilterSettings
$sel:displayAspectRatio:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2DisplayRatio
$sel:colorSpace:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ColorSpace
$sel:colorMetadata:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2ColorMetadata
$sel:afdSignaling:Mpeg2Settings' :: Mpeg2Settings -> Maybe AfdSignaling
$sel:adaptiveQuantization:Mpeg2Settings' :: Mpeg2Settings -> Maybe Mpeg2AdaptiveQuantization
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"adaptiveQuantization" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Mpeg2AdaptiveQuantization
adaptiveQuantization,
            (Key
"afdSignaling" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AfdSignaling
afdSignaling,
            (Key
"colorMetadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Mpeg2ColorMetadata
colorMetadata,
            (Key
"colorSpace" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Mpeg2ColorSpace
colorSpace,
            (Key
"displayAspectRatio" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Mpeg2DisplayRatio
displayAspectRatio,
            (Key
"filterSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Mpeg2FilterSettings
filterSettings,
            (Key
"fixedAfd" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe FixedAfd
fixedAfd,
            (Key
"gopClosedCadence" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
gopClosedCadence,
            (Key
"gopNumBFrames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
gopNumBFrames,
            (Key
"gopSize" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Double
gopSize,
            (Key
"gopSizeUnits" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Mpeg2GopSizeUnits
gopSizeUnits,
            (Key
"scanType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Mpeg2ScanType
scanType,
            (Key
"subgopLength" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Mpeg2SubGopLength
subgopLength,
            (Key
"timecodeBurninSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe TimecodeBurninSettings
timecodeBurninSettings,
            (Key
"timecodeInsertion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Mpeg2TimecodeInsertionBehavior
timecodeInsertion,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"framerateNumerator" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
framerateNumerator),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"framerateDenominator"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
framerateDenominator
              )
          ]
      )