{-# 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.MediaConvert.Types.CaptionSourceSettings
-- 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.MediaConvert.Types.CaptionSourceSettings where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaConvert.Types.AncillarySourceSettings
import Amazonka.MediaConvert.Types.CaptionSourceType
import Amazonka.MediaConvert.Types.DvbSubSourceSettings
import Amazonka.MediaConvert.Types.EmbeddedSourceSettings
import Amazonka.MediaConvert.Types.FileSourceSettings
import Amazonka.MediaConvert.Types.TeletextSourceSettings
import Amazonka.MediaConvert.Types.TrackSourceSettings
import Amazonka.MediaConvert.Types.WebvttHlsSourceSettings
import qualified Amazonka.Prelude as Prelude

-- | If your input captions are SCC, TTML, STL, SMI, SRT, or IMSC in an xml
-- file, specify the URI of the input captions source file. If your input
-- captions are IMSC in an IMF package, use TrackSourceSettings instead of
-- FileSoureSettings.
--
-- /See:/ 'newCaptionSourceSettings' smart constructor.
data CaptionSourceSettings = CaptionSourceSettings'
  { -- | Settings for ancillary captions source.
    CaptionSourceSettings -> Maybe AncillarySourceSettings
ancillarySourceSettings :: Prelude.Maybe AncillarySourceSettings,
    -- | DVB Sub Source Settings
    CaptionSourceSettings -> Maybe DvbSubSourceSettings
dvbSubSourceSettings :: Prelude.Maybe DvbSubSourceSettings,
    -- | Settings for embedded captions Source
    CaptionSourceSettings -> Maybe EmbeddedSourceSettings
embeddedSourceSettings :: Prelude.Maybe EmbeddedSourceSettings,
    -- | If your input captions are SCC, SMI, SRT, STL, TTML, WebVTT, or IMSC 1.1
    -- in an xml file, specify the URI of the input caption source file. If
    -- your caption source is IMSC in an IMF package, use TrackSourceSettings
    -- instead of FileSoureSettings.
    CaptionSourceSettings -> Maybe FileSourceSettings
fileSourceSettings :: Prelude.Maybe FileSourceSettings,
    -- | Use Source (SourceType) to identify the format of your input captions.
    -- The service cannot auto-detect caption format.
    CaptionSourceSettings -> Maybe CaptionSourceType
sourceType :: Prelude.Maybe CaptionSourceType,
    -- | Settings specific to Teletext caption sources, including Page number.
    CaptionSourceSettings -> Maybe TeletextSourceSettings
teletextSourceSettings :: Prelude.Maybe TeletextSourceSettings,
    -- | Settings specific to caption sources that are specified by track number.
    -- Currently, this is only IMSC captions in an IMF package. If your caption
    -- source is IMSC 1.1 in a separate xml file, use FileSourceSettings
    -- instead of TrackSourceSettings.
    CaptionSourceSettings -> Maybe TrackSourceSettings
trackSourceSettings :: Prelude.Maybe TrackSourceSettings,
    -- | Settings specific to WebVTT sources in HLS alternative rendition group.
    -- Specify the properties (renditionGroupId, renditionName or
    -- renditionLanguageCode) to identify the unique subtitle track among the
    -- alternative rendition groups present in the HLS manifest. If no unique
    -- track is found, or multiple tracks match the specified properties, the
    -- job fails. If there is only one subtitle track in the rendition group,
    -- the settings can be left empty and the default subtitle track will be
    -- chosen. If your caption source is a sidecar file, use FileSourceSettings
    -- instead of WebvttHlsSourceSettings.
    CaptionSourceSettings -> Maybe WebvttHlsSourceSettings
webvttHlsSourceSettings :: Prelude.Maybe WebvttHlsSourceSettings
  }
  deriving (CaptionSourceSettings -> CaptionSourceSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaptionSourceSettings -> CaptionSourceSettings -> Bool
$c/= :: CaptionSourceSettings -> CaptionSourceSettings -> Bool
== :: CaptionSourceSettings -> CaptionSourceSettings -> Bool
$c== :: CaptionSourceSettings -> CaptionSourceSettings -> Bool
Prelude.Eq, ReadPrec [CaptionSourceSettings]
ReadPrec CaptionSourceSettings
Int -> ReadS CaptionSourceSettings
ReadS [CaptionSourceSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CaptionSourceSettings]
$creadListPrec :: ReadPrec [CaptionSourceSettings]
readPrec :: ReadPrec CaptionSourceSettings
$creadPrec :: ReadPrec CaptionSourceSettings
readList :: ReadS [CaptionSourceSettings]
$creadList :: ReadS [CaptionSourceSettings]
readsPrec :: Int -> ReadS CaptionSourceSettings
$creadsPrec :: Int -> ReadS CaptionSourceSettings
Prelude.Read, Int -> CaptionSourceSettings -> ShowS
[CaptionSourceSettings] -> ShowS
CaptionSourceSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaptionSourceSettings] -> ShowS
$cshowList :: [CaptionSourceSettings] -> ShowS
show :: CaptionSourceSettings -> String
$cshow :: CaptionSourceSettings -> String
showsPrec :: Int -> CaptionSourceSettings -> ShowS
$cshowsPrec :: Int -> CaptionSourceSettings -> ShowS
Prelude.Show, forall x. Rep CaptionSourceSettings x -> CaptionSourceSettings
forall x. CaptionSourceSettings -> Rep CaptionSourceSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CaptionSourceSettings x -> CaptionSourceSettings
$cfrom :: forall x. CaptionSourceSettings -> Rep CaptionSourceSettings x
Prelude.Generic)

-- |
-- Create a value of 'CaptionSourceSettings' 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:
--
-- 'ancillarySourceSettings', 'captionSourceSettings_ancillarySourceSettings' - Settings for ancillary captions source.
--
-- 'dvbSubSourceSettings', 'captionSourceSettings_dvbSubSourceSettings' - DVB Sub Source Settings
--
-- 'embeddedSourceSettings', 'captionSourceSettings_embeddedSourceSettings' - Settings for embedded captions Source
--
-- 'fileSourceSettings', 'captionSourceSettings_fileSourceSettings' - If your input captions are SCC, SMI, SRT, STL, TTML, WebVTT, or IMSC 1.1
-- in an xml file, specify the URI of the input caption source file. If
-- your caption source is IMSC in an IMF package, use TrackSourceSettings
-- instead of FileSoureSettings.
--
-- 'sourceType', 'captionSourceSettings_sourceType' - Use Source (SourceType) to identify the format of your input captions.
-- The service cannot auto-detect caption format.
--
-- 'teletextSourceSettings', 'captionSourceSettings_teletextSourceSettings' - Settings specific to Teletext caption sources, including Page number.
--
-- 'trackSourceSettings', 'captionSourceSettings_trackSourceSettings' - Settings specific to caption sources that are specified by track number.
-- Currently, this is only IMSC captions in an IMF package. If your caption
-- source is IMSC 1.1 in a separate xml file, use FileSourceSettings
-- instead of TrackSourceSettings.
--
-- 'webvttHlsSourceSettings', 'captionSourceSettings_webvttHlsSourceSettings' - Settings specific to WebVTT sources in HLS alternative rendition group.
-- Specify the properties (renditionGroupId, renditionName or
-- renditionLanguageCode) to identify the unique subtitle track among the
-- alternative rendition groups present in the HLS manifest. If no unique
-- track is found, or multiple tracks match the specified properties, the
-- job fails. If there is only one subtitle track in the rendition group,
-- the settings can be left empty and the default subtitle track will be
-- chosen. If your caption source is a sidecar file, use FileSourceSettings
-- instead of WebvttHlsSourceSettings.
newCaptionSourceSettings ::
  CaptionSourceSettings
newCaptionSourceSettings :: CaptionSourceSettings
newCaptionSourceSettings =
  CaptionSourceSettings'
    { $sel:ancillarySourceSettings:CaptionSourceSettings' :: Maybe AncillarySourceSettings
ancillarySourceSettings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dvbSubSourceSettings:CaptionSourceSettings' :: Maybe DvbSubSourceSettings
dvbSubSourceSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:embeddedSourceSettings:CaptionSourceSettings' :: Maybe EmbeddedSourceSettings
embeddedSourceSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:fileSourceSettings:CaptionSourceSettings' :: Maybe FileSourceSettings
fileSourceSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceType:CaptionSourceSettings' :: Maybe CaptionSourceType
sourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:teletextSourceSettings:CaptionSourceSettings' :: Maybe TeletextSourceSettings
teletextSourceSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:trackSourceSettings:CaptionSourceSettings' :: Maybe TrackSourceSettings
trackSourceSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:webvttHlsSourceSettings:CaptionSourceSettings' :: Maybe WebvttHlsSourceSettings
webvttHlsSourceSettings = forall a. Maybe a
Prelude.Nothing
    }

-- | Settings for ancillary captions source.
captionSourceSettings_ancillarySourceSettings :: Lens.Lens' CaptionSourceSettings (Prelude.Maybe AncillarySourceSettings)
captionSourceSettings_ancillarySourceSettings :: Lens' CaptionSourceSettings (Maybe AncillarySourceSettings)
captionSourceSettings_ancillarySourceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CaptionSourceSettings' {Maybe AncillarySourceSettings
ancillarySourceSettings :: Maybe AncillarySourceSettings
$sel:ancillarySourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe AncillarySourceSettings
ancillarySourceSettings} -> Maybe AncillarySourceSettings
ancillarySourceSettings) (\s :: CaptionSourceSettings
s@CaptionSourceSettings' {} Maybe AncillarySourceSettings
a -> CaptionSourceSettings
s {$sel:ancillarySourceSettings:CaptionSourceSettings' :: Maybe AncillarySourceSettings
ancillarySourceSettings = Maybe AncillarySourceSettings
a} :: CaptionSourceSettings)

-- | DVB Sub Source Settings
captionSourceSettings_dvbSubSourceSettings :: Lens.Lens' CaptionSourceSettings (Prelude.Maybe DvbSubSourceSettings)
captionSourceSettings_dvbSubSourceSettings :: Lens' CaptionSourceSettings (Maybe DvbSubSourceSettings)
captionSourceSettings_dvbSubSourceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CaptionSourceSettings' {Maybe DvbSubSourceSettings
dvbSubSourceSettings :: Maybe DvbSubSourceSettings
$sel:dvbSubSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe DvbSubSourceSettings
dvbSubSourceSettings} -> Maybe DvbSubSourceSettings
dvbSubSourceSettings) (\s :: CaptionSourceSettings
s@CaptionSourceSettings' {} Maybe DvbSubSourceSettings
a -> CaptionSourceSettings
s {$sel:dvbSubSourceSettings:CaptionSourceSettings' :: Maybe DvbSubSourceSettings
dvbSubSourceSettings = Maybe DvbSubSourceSettings
a} :: CaptionSourceSettings)

-- | Settings for embedded captions Source
captionSourceSettings_embeddedSourceSettings :: Lens.Lens' CaptionSourceSettings (Prelude.Maybe EmbeddedSourceSettings)
captionSourceSettings_embeddedSourceSettings :: Lens' CaptionSourceSettings (Maybe EmbeddedSourceSettings)
captionSourceSettings_embeddedSourceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CaptionSourceSettings' {Maybe EmbeddedSourceSettings
embeddedSourceSettings :: Maybe EmbeddedSourceSettings
$sel:embeddedSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe EmbeddedSourceSettings
embeddedSourceSettings} -> Maybe EmbeddedSourceSettings
embeddedSourceSettings) (\s :: CaptionSourceSettings
s@CaptionSourceSettings' {} Maybe EmbeddedSourceSettings
a -> CaptionSourceSettings
s {$sel:embeddedSourceSettings:CaptionSourceSettings' :: Maybe EmbeddedSourceSettings
embeddedSourceSettings = Maybe EmbeddedSourceSettings
a} :: CaptionSourceSettings)

-- | If your input captions are SCC, SMI, SRT, STL, TTML, WebVTT, or IMSC 1.1
-- in an xml file, specify the URI of the input caption source file. If
-- your caption source is IMSC in an IMF package, use TrackSourceSettings
-- instead of FileSoureSettings.
captionSourceSettings_fileSourceSettings :: Lens.Lens' CaptionSourceSettings (Prelude.Maybe FileSourceSettings)
captionSourceSettings_fileSourceSettings :: Lens' CaptionSourceSettings (Maybe FileSourceSettings)
captionSourceSettings_fileSourceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CaptionSourceSettings' {Maybe FileSourceSettings
fileSourceSettings :: Maybe FileSourceSettings
$sel:fileSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe FileSourceSettings
fileSourceSettings} -> Maybe FileSourceSettings
fileSourceSettings) (\s :: CaptionSourceSettings
s@CaptionSourceSettings' {} Maybe FileSourceSettings
a -> CaptionSourceSettings
s {$sel:fileSourceSettings:CaptionSourceSettings' :: Maybe FileSourceSettings
fileSourceSettings = Maybe FileSourceSettings
a} :: CaptionSourceSettings)

-- | Use Source (SourceType) to identify the format of your input captions.
-- The service cannot auto-detect caption format.
captionSourceSettings_sourceType :: Lens.Lens' CaptionSourceSettings (Prelude.Maybe CaptionSourceType)
captionSourceSettings_sourceType :: Lens' CaptionSourceSettings (Maybe CaptionSourceType)
captionSourceSettings_sourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CaptionSourceSettings' {Maybe CaptionSourceType
sourceType :: Maybe CaptionSourceType
$sel:sourceType:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe CaptionSourceType
sourceType} -> Maybe CaptionSourceType
sourceType) (\s :: CaptionSourceSettings
s@CaptionSourceSettings' {} Maybe CaptionSourceType
a -> CaptionSourceSettings
s {$sel:sourceType:CaptionSourceSettings' :: Maybe CaptionSourceType
sourceType = Maybe CaptionSourceType
a} :: CaptionSourceSettings)

-- | Settings specific to Teletext caption sources, including Page number.
captionSourceSettings_teletextSourceSettings :: Lens.Lens' CaptionSourceSettings (Prelude.Maybe TeletextSourceSettings)
captionSourceSettings_teletextSourceSettings :: Lens' CaptionSourceSettings (Maybe TeletextSourceSettings)
captionSourceSettings_teletextSourceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CaptionSourceSettings' {Maybe TeletextSourceSettings
teletextSourceSettings :: Maybe TeletextSourceSettings
$sel:teletextSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe TeletextSourceSettings
teletextSourceSettings} -> Maybe TeletextSourceSettings
teletextSourceSettings) (\s :: CaptionSourceSettings
s@CaptionSourceSettings' {} Maybe TeletextSourceSettings
a -> CaptionSourceSettings
s {$sel:teletextSourceSettings:CaptionSourceSettings' :: Maybe TeletextSourceSettings
teletextSourceSettings = Maybe TeletextSourceSettings
a} :: CaptionSourceSettings)

-- | Settings specific to caption sources that are specified by track number.
-- Currently, this is only IMSC captions in an IMF package. If your caption
-- source is IMSC 1.1 in a separate xml file, use FileSourceSettings
-- instead of TrackSourceSettings.
captionSourceSettings_trackSourceSettings :: Lens.Lens' CaptionSourceSettings (Prelude.Maybe TrackSourceSettings)
captionSourceSettings_trackSourceSettings :: Lens' CaptionSourceSettings (Maybe TrackSourceSettings)
captionSourceSettings_trackSourceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CaptionSourceSettings' {Maybe TrackSourceSettings
trackSourceSettings :: Maybe TrackSourceSettings
$sel:trackSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe TrackSourceSettings
trackSourceSettings} -> Maybe TrackSourceSettings
trackSourceSettings) (\s :: CaptionSourceSettings
s@CaptionSourceSettings' {} Maybe TrackSourceSettings
a -> CaptionSourceSettings
s {$sel:trackSourceSettings:CaptionSourceSettings' :: Maybe TrackSourceSettings
trackSourceSettings = Maybe TrackSourceSettings
a} :: CaptionSourceSettings)

-- | Settings specific to WebVTT sources in HLS alternative rendition group.
-- Specify the properties (renditionGroupId, renditionName or
-- renditionLanguageCode) to identify the unique subtitle track among the
-- alternative rendition groups present in the HLS manifest. If no unique
-- track is found, or multiple tracks match the specified properties, the
-- job fails. If there is only one subtitle track in the rendition group,
-- the settings can be left empty and the default subtitle track will be
-- chosen. If your caption source is a sidecar file, use FileSourceSettings
-- instead of WebvttHlsSourceSettings.
captionSourceSettings_webvttHlsSourceSettings :: Lens.Lens' CaptionSourceSettings (Prelude.Maybe WebvttHlsSourceSettings)
captionSourceSettings_webvttHlsSourceSettings :: Lens' CaptionSourceSettings (Maybe WebvttHlsSourceSettings)
captionSourceSettings_webvttHlsSourceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CaptionSourceSettings' {Maybe WebvttHlsSourceSettings
webvttHlsSourceSettings :: Maybe WebvttHlsSourceSettings
$sel:webvttHlsSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe WebvttHlsSourceSettings
webvttHlsSourceSettings} -> Maybe WebvttHlsSourceSettings
webvttHlsSourceSettings) (\s :: CaptionSourceSettings
s@CaptionSourceSettings' {} Maybe WebvttHlsSourceSettings
a -> CaptionSourceSettings
s {$sel:webvttHlsSourceSettings:CaptionSourceSettings' :: Maybe WebvttHlsSourceSettings
webvttHlsSourceSettings = Maybe WebvttHlsSourceSettings
a} :: CaptionSourceSettings)

instance Data.FromJSON CaptionSourceSettings where
  parseJSON :: Value -> Parser CaptionSourceSettings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"CaptionSourceSettings"
      ( \Object
x ->
          Maybe AncillarySourceSettings
-> Maybe DvbSubSourceSettings
-> Maybe EmbeddedSourceSettings
-> Maybe FileSourceSettings
-> Maybe CaptionSourceType
-> Maybe TeletextSourceSettings
-> Maybe TrackSourceSettings
-> Maybe WebvttHlsSourceSettings
-> CaptionSourceSettings
CaptionSourceSettings'
            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
"ancillarySourceSettings")
            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
"dvbSubSourceSettings")
            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
"embeddedSourceSettings")
            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
"fileSourceSettings")
            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
"sourceType")
            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
"teletextSourceSettings")
            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
"trackSourceSettings")
            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
"webvttHlsSourceSettings")
      )

instance Prelude.Hashable CaptionSourceSettings where
  hashWithSalt :: Int -> CaptionSourceSettings -> Int
hashWithSalt Int
_salt CaptionSourceSettings' {Maybe AncillarySourceSettings
Maybe CaptionSourceType
Maybe DvbSubSourceSettings
Maybe EmbeddedSourceSettings
Maybe FileSourceSettings
Maybe TeletextSourceSettings
Maybe TrackSourceSettings
Maybe WebvttHlsSourceSettings
webvttHlsSourceSettings :: Maybe WebvttHlsSourceSettings
trackSourceSettings :: Maybe TrackSourceSettings
teletextSourceSettings :: Maybe TeletextSourceSettings
sourceType :: Maybe CaptionSourceType
fileSourceSettings :: Maybe FileSourceSettings
embeddedSourceSettings :: Maybe EmbeddedSourceSettings
dvbSubSourceSettings :: Maybe DvbSubSourceSettings
ancillarySourceSettings :: Maybe AncillarySourceSettings
$sel:webvttHlsSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe WebvttHlsSourceSettings
$sel:trackSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe TrackSourceSettings
$sel:teletextSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe TeletextSourceSettings
$sel:sourceType:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe CaptionSourceType
$sel:fileSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe FileSourceSettings
$sel:embeddedSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe EmbeddedSourceSettings
$sel:dvbSubSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe DvbSubSourceSettings
$sel:ancillarySourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe AncillarySourceSettings
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AncillarySourceSettings
ancillarySourceSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DvbSubSourceSettings
dvbSubSourceSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EmbeddedSourceSettings
embeddedSourceSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FileSourceSettings
fileSourceSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CaptionSourceType
sourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TeletextSourceSettings
teletextSourceSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TrackSourceSettings
trackSourceSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WebvttHlsSourceSettings
webvttHlsSourceSettings

instance Prelude.NFData CaptionSourceSettings where
  rnf :: CaptionSourceSettings -> ()
rnf CaptionSourceSettings' {Maybe AncillarySourceSettings
Maybe CaptionSourceType
Maybe DvbSubSourceSettings
Maybe EmbeddedSourceSettings
Maybe FileSourceSettings
Maybe TeletextSourceSettings
Maybe TrackSourceSettings
Maybe WebvttHlsSourceSettings
webvttHlsSourceSettings :: Maybe WebvttHlsSourceSettings
trackSourceSettings :: Maybe TrackSourceSettings
teletextSourceSettings :: Maybe TeletextSourceSettings
sourceType :: Maybe CaptionSourceType
fileSourceSettings :: Maybe FileSourceSettings
embeddedSourceSettings :: Maybe EmbeddedSourceSettings
dvbSubSourceSettings :: Maybe DvbSubSourceSettings
ancillarySourceSettings :: Maybe AncillarySourceSettings
$sel:webvttHlsSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe WebvttHlsSourceSettings
$sel:trackSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe TrackSourceSettings
$sel:teletextSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe TeletextSourceSettings
$sel:sourceType:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe CaptionSourceType
$sel:fileSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe FileSourceSettings
$sel:embeddedSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe EmbeddedSourceSettings
$sel:dvbSubSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe DvbSubSourceSettings
$sel:ancillarySourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe AncillarySourceSettings
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AncillarySourceSettings
ancillarySourceSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DvbSubSourceSettings
dvbSubSourceSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EmbeddedSourceSettings
embeddedSourceSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FileSourceSettings
fileSourceSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CaptionSourceType
sourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TeletextSourceSettings
teletextSourceSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TrackSourceSettings
trackSourceSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WebvttHlsSourceSettings
webvttHlsSourceSettings

instance Data.ToJSON CaptionSourceSettings where
  toJSON :: CaptionSourceSettings -> Value
toJSON CaptionSourceSettings' {Maybe AncillarySourceSettings
Maybe CaptionSourceType
Maybe DvbSubSourceSettings
Maybe EmbeddedSourceSettings
Maybe FileSourceSettings
Maybe TeletextSourceSettings
Maybe TrackSourceSettings
Maybe WebvttHlsSourceSettings
webvttHlsSourceSettings :: Maybe WebvttHlsSourceSettings
trackSourceSettings :: Maybe TrackSourceSettings
teletextSourceSettings :: Maybe TeletextSourceSettings
sourceType :: Maybe CaptionSourceType
fileSourceSettings :: Maybe FileSourceSettings
embeddedSourceSettings :: Maybe EmbeddedSourceSettings
dvbSubSourceSettings :: Maybe DvbSubSourceSettings
ancillarySourceSettings :: Maybe AncillarySourceSettings
$sel:webvttHlsSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe WebvttHlsSourceSettings
$sel:trackSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe TrackSourceSettings
$sel:teletextSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe TeletextSourceSettings
$sel:sourceType:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe CaptionSourceType
$sel:fileSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe FileSourceSettings
$sel:embeddedSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe EmbeddedSourceSettings
$sel:dvbSubSourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe DvbSubSourceSettings
$sel:ancillarySourceSettings:CaptionSourceSettings' :: CaptionSourceSettings -> Maybe AncillarySourceSettings
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ancillarySourceSettings" 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 AncillarySourceSettings
ancillarySourceSettings,
            (Key
"dvbSubSourceSettings" 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 DvbSubSourceSettings
dvbSubSourceSettings,
            (Key
"embeddedSourceSettings" 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 EmbeddedSourceSettings
embeddedSourceSettings,
            (Key
"fileSourceSettings" 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 FileSourceSettings
fileSourceSettings,
            (Key
"sourceType" 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 CaptionSourceType
sourceType,
            (Key
"teletextSourceSettings" 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 TeletextSourceSettings
teletextSourceSettings,
            (Key
"trackSourceSettings" 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 TrackSourceSettings
trackSourceSettings,
            (Key
"webvttHlsSourceSettings" 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 WebvttHlsSourceSettings
webvttHlsSourceSettings
          ]
      )