{-# 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.Output
-- 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.Output 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.AudioDescription
import Amazonka.MediaConvert.Types.CaptionDescription
import Amazonka.MediaConvert.Types.ContainerSettings
import Amazonka.MediaConvert.Types.OutputSettings
import Amazonka.MediaConvert.Types.VideoDescription
import qualified Amazonka.Prelude as Prelude

-- | Each output in your job is a collection of settings that describes how
-- you want MediaConvert to encode a single output file or stream. For more
-- information, see
-- https:\/\/docs.aws.amazon.com\/mediaconvert\/latest\/ug\/create-outputs.html.
--
-- /See:/ 'newOutput' smart constructor.
data Output = Output'
  { -- | (AudioDescriptions) contains groups of audio encoding settings organized
    -- by audio codec. Include one instance of (AudioDescriptions) per output.
    -- (AudioDescriptions) can contain multiple groups of encoding settings.
    Output -> Maybe [AudioDescription]
audioDescriptions :: Prelude.Maybe [AudioDescription],
    -- | (CaptionDescriptions) contains groups of captions settings. For each
    -- output that has captions, include one instance of (CaptionDescriptions).
    -- (CaptionDescriptions) can contain multiple groups of captions settings.
    Output -> Maybe [CaptionDescription]
captionDescriptions :: Prelude.Maybe [CaptionDescription],
    -- | Container specific settings.
    Output -> Maybe ContainerSettings
containerSettings :: Prelude.Maybe ContainerSettings,
    -- | Use Extension (Extension) to specify the file extension for outputs in
    -- File output groups. If you do not specify a value, the service will use
    -- default extensions by container type as follows * MPEG-2 transport
    -- stream, m2ts * Quicktime, mov * MXF container, mxf * MPEG-4 container,
    -- mp4 * WebM container, webm * No Container, the service will use codec
    -- extensions (e.g. AAC, H265, H265, AC3)
    Output -> Maybe Text
extension :: Prelude.Maybe Prelude.Text,
    -- | Use Name modifier (NameModifier) to have the service add a string to the
    -- end of each output filename. You specify the base filename as part of
    -- your destination URI. When you create multiple outputs in the same
    -- output group, Name modifier (NameModifier) is required. Name modifier
    -- also accepts format identifiers. For DASH ISO outputs, if you use the
    -- format identifiers $Number$ or $Time$ in one output, you must use them
    -- in the same way in all outputs of the output group.
    Output -> Maybe Text
nameModifier :: Prelude.Maybe Prelude.Text,
    -- | Specific settings for this type of output.
    Output -> Maybe OutputSettings
outputSettings :: Prelude.Maybe OutputSettings,
    -- | Use Preset (Preset) to specify a preset for your transcoding settings.
    -- Provide the system or custom preset name. You can specify either Preset
    -- (Preset) or Container settings (ContainerSettings), but not both.
    Output -> Maybe Text
preset :: Prelude.Maybe Prelude.Text,
    -- | VideoDescription contains a group of video encoding settings. The
    -- specific video settings depend on the video codec that you choose for
    -- the property codec. Include one instance of VideoDescription per output.
    Output -> Maybe VideoDescription
videoDescription :: Prelude.Maybe VideoDescription
  }
  deriving (Output -> Output -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Output -> Output -> Bool
$c/= :: Output -> Output -> Bool
== :: Output -> Output -> Bool
$c== :: Output -> Output -> Bool
Prelude.Eq, ReadPrec [Output]
ReadPrec Output
Int -> ReadS Output
ReadS [Output]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Output]
$creadListPrec :: ReadPrec [Output]
readPrec :: ReadPrec Output
$creadPrec :: ReadPrec Output
readList :: ReadS [Output]
$creadList :: ReadS [Output]
readsPrec :: Int -> ReadS Output
$creadsPrec :: Int -> ReadS Output
Prelude.Read, Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output] -> ShowS
$cshowList :: [Output] -> ShowS
show :: Output -> String
$cshow :: Output -> String
showsPrec :: Int -> Output -> ShowS
$cshowsPrec :: Int -> Output -> ShowS
Prelude.Show, forall x. Rep Output x -> Output
forall x. Output -> Rep Output x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Output x -> Output
$cfrom :: forall x. Output -> Rep Output x
Prelude.Generic)

-- |
-- Create a value of 'Output' 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:
--
-- 'audioDescriptions', 'output_audioDescriptions' - (AudioDescriptions) contains groups of audio encoding settings organized
-- by audio codec. Include one instance of (AudioDescriptions) per output.
-- (AudioDescriptions) can contain multiple groups of encoding settings.
--
-- 'captionDescriptions', 'output_captionDescriptions' - (CaptionDescriptions) contains groups of captions settings. For each
-- output that has captions, include one instance of (CaptionDescriptions).
-- (CaptionDescriptions) can contain multiple groups of captions settings.
--
-- 'containerSettings', 'output_containerSettings' - Container specific settings.
--
-- 'extension', 'output_extension' - Use Extension (Extension) to specify the file extension for outputs in
-- File output groups. If you do not specify a value, the service will use
-- default extensions by container type as follows * MPEG-2 transport
-- stream, m2ts * Quicktime, mov * MXF container, mxf * MPEG-4 container,
-- mp4 * WebM container, webm * No Container, the service will use codec
-- extensions (e.g. AAC, H265, H265, AC3)
--
-- 'nameModifier', 'output_nameModifier' - Use Name modifier (NameModifier) to have the service add a string to the
-- end of each output filename. You specify the base filename as part of
-- your destination URI. When you create multiple outputs in the same
-- output group, Name modifier (NameModifier) is required. Name modifier
-- also accepts format identifiers. For DASH ISO outputs, if you use the
-- format identifiers $Number$ or $Time$ in one output, you must use them
-- in the same way in all outputs of the output group.
--
-- 'outputSettings', 'output_outputSettings' - Specific settings for this type of output.
--
-- 'preset', 'output_preset' - Use Preset (Preset) to specify a preset for your transcoding settings.
-- Provide the system or custom preset name. You can specify either Preset
-- (Preset) or Container settings (ContainerSettings), but not both.
--
-- 'videoDescription', 'output_videoDescription' - VideoDescription contains a group of video encoding settings. The
-- specific video settings depend on the video codec that you choose for
-- the property codec. Include one instance of VideoDescription per output.
newOutput ::
  Output
newOutput :: Output
newOutput =
  Output'
    { $sel:audioDescriptions:Output' :: Maybe [AudioDescription]
audioDescriptions = forall a. Maybe a
Prelude.Nothing,
      $sel:captionDescriptions:Output' :: Maybe [CaptionDescription]
captionDescriptions = forall a. Maybe a
Prelude.Nothing,
      $sel:containerSettings:Output' :: Maybe ContainerSettings
containerSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:extension:Output' :: Maybe Text
extension = forall a. Maybe a
Prelude.Nothing,
      $sel:nameModifier:Output' :: Maybe Text
nameModifier = forall a. Maybe a
Prelude.Nothing,
      $sel:outputSettings:Output' :: Maybe OutputSettings
outputSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:preset:Output' :: Maybe Text
preset = forall a. Maybe a
Prelude.Nothing,
      $sel:videoDescription:Output' :: Maybe VideoDescription
videoDescription = forall a. Maybe a
Prelude.Nothing
    }

-- | (AudioDescriptions) contains groups of audio encoding settings organized
-- by audio codec. Include one instance of (AudioDescriptions) per output.
-- (AudioDescriptions) can contain multiple groups of encoding settings.
output_audioDescriptions :: Lens.Lens' Output (Prelude.Maybe [AudioDescription])
output_audioDescriptions :: Lens' Output (Maybe [AudioDescription])
output_audioDescriptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe [AudioDescription]
audioDescriptions :: Maybe [AudioDescription]
$sel:audioDescriptions:Output' :: Output -> Maybe [AudioDescription]
audioDescriptions} -> Maybe [AudioDescription]
audioDescriptions) (\s :: Output
s@Output' {} Maybe [AudioDescription]
a -> Output
s {$sel:audioDescriptions:Output' :: Maybe [AudioDescription]
audioDescriptions = Maybe [AudioDescription]
a} :: Output) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | (CaptionDescriptions) contains groups of captions settings. For each
-- output that has captions, include one instance of (CaptionDescriptions).
-- (CaptionDescriptions) can contain multiple groups of captions settings.
output_captionDescriptions :: Lens.Lens' Output (Prelude.Maybe [CaptionDescription])
output_captionDescriptions :: Lens' Output (Maybe [CaptionDescription])
output_captionDescriptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe [CaptionDescription]
captionDescriptions :: Maybe [CaptionDescription]
$sel:captionDescriptions:Output' :: Output -> Maybe [CaptionDescription]
captionDescriptions} -> Maybe [CaptionDescription]
captionDescriptions) (\s :: Output
s@Output' {} Maybe [CaptionDescription]
a -> Output
s {$sel:captionDescriptions:Output' :: Maybe [CaptionDescription]
captionDescriptions = Maybe [CaptionDescription]
a} :: Output) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Container specific settings.
output_containerSettings :: Lens.Lens' Output (Prelude.Maybe ContainerSettings)
output_containerSettings :: Lens' Output (Maybe ContainerSettings)
output_containerSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe ContainerSettings
containerSettings :: Maybe ContainerSettings
$sel:containerSettings:Output' :: Output -> Maybe ContainerSettings
containerSettings} -> Maybe ContainerSettings
containerSettings) (\s :: Output
s@Output' {} Maybe ContainerSettings
a -> Output
s {$sel:containerSettings:Output' :: Maybe ContainerSettings
containerSettings = Maybe ContainerSettings
a} :: Output)

-- | Use Extension (Extension) to specify the file extension for outputs in
-- File output groups. If you do not specify a value, the service will use
-- default extensions by container type as follows * MPEG-2 transport
-- stream, m2ts * Quicktime, mov * MXF container, mxf * MPEG-4 container,
-- mp4 * WebM container, webm * No Container, the service will use codec
-- extensions (e.g. AAC, H265, H265, AC3)
output_extension :: Lens.Lens' Output (Prelude.Maybe Prelude.Text)
output_extension :: Lens' Output (Maybe Text)
output_extension = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe Text
extension :: Maybe Text
$sel:extension:Output' :: Output -> Maybe Text
extension} -> Maybe Text
extension) (\s :: Output
s@Output' {} Maybe Text
a -> Output
s {$sel:extension:Output' :: Maybe Text
extension = Maybe Text
a} :: Output)

-- | Use Name modifier (NameModifier) to have the service add a string to the
-- end of each output filename. You specify the base filename as part of
-- your destination URI. When you create multiple outputs in the same
-- output group, Name modifier (NameModifier) is required. Name modifier
-- also accepts format identifiers. For DASH ISO outputs, if you use the
-- format identifiers $Number$ or $Time$ in one output, you must use them
-- in the same way in all outputs of the output group.
output_nameModifier :: Lens.Lens' Output (Prelude.Maybe Prelude.Text)
output_nameModifier :: Lens' Output (Maybe Text)
output_nameModifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe Text
nameModifier :: Maybe Text
$sel:nameModifier:Output' :: Output -> Maybe Text
nameModifier} -> Maybe Text
nameModifier) (\s :: Output
s@Output' {} Maybe Text
a -> Output
s {$sel:nameModifier:Output' :: Maybe Text
nameModifier = Maybe Text
a} :: Output)

-- | Specific settings for this type of output.
output_outputSettings :: Lens.Lens' Output (Prelude.Maybe OutputSettings)
output_outputSettings :: Lens' Output (Maybe OutputSettings)
output_outputSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe OutputSettings
outputSettings :: Maybe OutputSettings
$sel:outputSettings:Output' :: Output -> Maybe OutputSettings
outputSettings} -> Maybe OutputSettings
outputSettings) (\s :: Output
s@Output' {} Maybe OutputSettings
a -> Output
s {$sel:outputSettings:Output' :: Maybe OutputSettings
outputSettings = Maybe OutputSettings
a} :: Output)

-- | Use Preset (Preset) to specify a preset for your transcoding settings.
-- Provide the system or custom preset name. You can specify either Preset
-- (Preset) or Container settings (ContainerSettings), but not both.
output_preset :: Lens.Lens' Output (Prelude.Maybe Prelude.Text)
output_preset :: Lens' Output (Maybe Text)
output_preset = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe Text
preset :: Maybe Text
$sel:preset:Output' :: Output -> Maybe Text
preset} -> Maybe Text
preset) (\s :: Output
s@Output' {} Maybe Text
a -> Output
s {$sel:preset:Output' :: Maybe Text
preset = Maybe Text
a} :: Output)

-- | VideoDescription contains a group of video encoding settings. The
-- specific video settings depend on the video codec that you choose for
-- the property codec. Include one instance of VideoDescription per output.
output_videoDescription :: Lens.Lens' Output (Prelude.Maybe VideoDescription)
output_videoDescription :: Lens' Output (Maybe VideoDescription)
output_videoDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Output' {Maybe VideoDescription
videoDescription :: Maybe VideoDescription
$sel:videoDescription:Output' :: Output -> Maybe VideoDescription
videoDescription} -> Maybe VideoDescription
videoDescription) (\s :: Output
s@Output' {} Maybe VideoDescription
a -> Output
s {$sel:videoDescription:Output' :: Maybe VideoDescription
videoDescription = Maybe VideoDescription
a} :: Output)

instance Data.FromJSON Output where
  parseJSON :: Value -> Parser Output
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Output"
      ( \Object
x ->
          Maybe [AudioDescription]
-> Maybe [CaptionDescription]
-> Maybe ContainerSettings
-> Maybe Text
-> Maybe Text
-> Maybe OutputSettings
-> Maybe Text
-> Maybe VideoDescription
-> Output
Output'
            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
"audioDescriptions"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"captionDescriptions"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"containerSettings")
            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
"extension")
            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
"nameModifier")
            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
"outputSettings")
            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
"preset")
            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
"videoDescription")
      )

instance Prelude.Hashable Output where
  hashWithSalt :: Int -> Output -> Int
hashWithSalt Int
_salt Output' {Maybe [AudioDescription]
Maybe [CaptionDescription]
Maybe Text
Maybe OutputSettings
Maybe ContainerSettings
Maybe VideoDescription
videoDescription :: Maybe VideoDescription
preset :: Maybe Text
outputSettings :: Maybe OutputSettings
nameModifier :: Maybe Text
extension :: Maybe Text
containerSettings :: Maybe ContainerSettings
captionDescriptions :: Maybe [CaptionDescription]
audioDescriptions :: Maybe [AudioDescription]
$sel:videoDescription:Output' :: Output -> Maybe VideoDescription
$sel:preset:Output' :: Output -> Maybe Text
$sel:outputSettings:Output' :: Output -> Maybe OutputSettings
$sel:nameModifier:Output' :: Output -> Maybe Text
$sel:extension:Output' :: Output -> Maybe Text
$sel:containerSettings:Output' :: Output -> Maybe ContainerSettings
$sel:captionDescriptions:Output' :: Output -> Maybe [CaptionDescription]
$sel:audioDescriptions:Output' :: Output -> Maybe [AudioDescription]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AudioDescription]
audioDescriptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CaptionDescription]
captionDescriptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContainerSettings
containerSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
extension
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nameModifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputSettings
outputSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preset
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VideoDescription
videoDescription

instance Prelude.NFData Output where
  rnf :: Output -> ()
rnf Output' {Maybe [AudioDescription]
Maybe [CaptionDescription]
Maybe Text
Maybe OutputSettings
Maybe ContainerSettings
Maybe VideoDescription
videoDescription :: Maybe VideoDescription
preset :: Maybe Text
outputSettings :: Maybe OutputSettings
nameModifier :: Maybe Text
extension :: Maybe Text
containerSettings :: Maybe ContainerSettings
captionDescriptions :: Maybe [CaptionDescription]
audioDescriptions :: Maybe [AudioDescription]
$sel:videoDescription:Output' :: Output -> Maybe VideoDescription
$sel:preset:Output' :: Output -> Maybe Text
$sel:outputSettings:Output' :: Output -> Maybe OutputSettings
$sel:nameModifier:Output' :: Output -> Maybe Text
$sel:extension:Output' :: Output -> Maybe Text
$sel:containerSettings:Output' :: Output -> Maybe ContainerSettings
$sel:captionDescriptions:Output' :: Output -> Maybe [CaptionDescription]
$sel:audioDescriptions:Output' :: Output -> Maybe [AudioDescription]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AudioDescription]
audioDescriptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CaptionDescription]
captionDescriptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ContainerSettings
containerSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
extension
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nameModifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputSettings
outputSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preset
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VideoDescription
videoDescription

instance Data.ToJSON Output where
  toJSON :: Output -> Value
toJSON Output' {Maybe [AudioDescription]
Maybe [CaptionDescription]
Maybe Text
Maybe OutputSettings
Maybe ContainerSettings
Maybe VideoDescription
videoDescription :: Maybe VideoDescription
preset :: Maybe Text
outputSettings :: Maybe OutputSettings
nameModifier :: Maybe Text
extension :: Maybe Text
containerSettings :: Maybe ContainerSettings
captionDescriptions :: Maybe [CaptionDescription]
audioDescriptions :: Maybe [AudioDescription]
$sel:videoDescription:Output' :: Output -> Maybe VideoDescription
$sel:preset:Output' :: Output -> Maybe Text
$sel:outputSettings:Output' :: Output -> Maybe OutputSettings
$sel:nameModifier:Output' :: Output -> Maybe Text
$sel:extension:Output' :: Output -> Maybe Text
$sel:containerSettings:Output' :: Output -> Maybe ContainerSettings
$sel:captionDescriptions:Output' :: Output -> Maybe [CaptionDescription]
$sel:audioDescriptions:Output' :: Output -> Maybe [AudioDescription]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"audioDescriptions" 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 [AudioDescription]
audioDescriptions,
            (Key
"captionDescriptions" 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 [CaptionDescription]
captionDescriptions,
            (Key
"containerSettings" 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 ContainerSettings
containerSettings,
            (Key
"extension" 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 Text
extension,
            (Key
"nameModifier" 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 Text
nameModifier,
            (Key
"outputSettings" 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 OutputSettings
outputSettings,
            (Key
"preset" 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 Text
preset,
            (Key
"videoDescription" 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 VideoDescription
videoDescription
          ]
      )