{-# 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.MediaConnect.Types.Fmtp
-- 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.MediaConnect.Types.Fmtp where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaConnect.Types.Colorimetry
import Amazonka.MediaConnect.Types.Range
import Amazonka.MediaConnect.Types.ScanMode
import Amazonka.MediaConnect.Types.Tcs
import qualified Amazonka.Prelude as Prelude

-- | FMTP
--
-- /See:/ 'newFmtp' smart constructor.
data Fmtp = Fmtp'
  { -- | The format of the audio channel.
    Fmtp -> Maybe Text
channelOrder :: Prelude.Maybe Prelude.Text,
    -- | The format that is used for the representation of color.
    Fmtp -> Maybe Colorimetry
colorimetry :: Prelude.Maybe Colorimetry,
    -- | The frame rate for the video stream, in frames\/second. For example:
    -- 60000\/1001. If you specify a whole number, MediaConnect uses a ratio of
    -- N\/1. For example, if you specify 60, MediaConnect uses 60\/1 as the
    -- exactFramerate.
    Fmtp -> Maybe Text
exactFramerate :: Prelude.Maybe Prelude.Text,
    -- | The pixel aspect ratio (PAR) of the video.
    Fmtp -> Maybe Text
par :: Prelude.Maybe Prelude.Text,
    -- | The encoding range of the video.
    Fmtp -> Maybe Range
range :: Prelude.Maybe Range,
    -- | The type of compression that was used to smooth the video’s appearance
    Fmtp -> Maybe ScanMode
scanMode :: Prelude.Maybe ScanMode,
    -- | The transfer characteristic system (TCS) that is used in the video.
    Fmtp -> Maybe Tcs
tcs :: Prelude.Maybe Tcs
  }
  deriving (Fmtp -> Fmtp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fmtp -> Fmtp -> Bool
$c/= :: Fmtp -> Fmtp -> Bool
== :: Fmtp -> Fmtp -> Bool
$c== :: Fmtp -> Fmtp -> Bool
Prelude.Eq, ReadPrec [Fmtp]
ReadPrec Fmtp
Int -> ReadS Fmtp
ReadS [Fmtp]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Fmtp]
$creadListPrec :: ReadPrec [Fmtp]
readPrec :: ReadPrec Fmtp
$creadPrec :: ReadPrec Fmtp
readList :: ReadS [Fmtp]
$creadList :: ReadS [Fmtp]
readsPrec :: Int -> ReadS Fmtp
$creadsPrec :: Int -> ReadS Fmtp
Prelude.Read, Int -> Fmtp -> ShowS
[Fmtp] -> ShowS
Fmtp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fmtp] -> ShowS
$cshowList :: [Fmtp] -> ShowS
show :: Fmtp -> String
$cshow :: Fmtp -> String
showsPrec :: Int -> Fmtp -> ShowS
$cshowsPrec :: Int -> Fmtp -> ShowS
Prelude.Show, forall x. Rep Fmtp x -> Fmtp
forall x. Fmtp -> Rep Fmtp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fmtp x -> Fmtp
$cfrom :: forall x. Fmtp -> Rep Fmtp x
Prelude.Generic)

-- |
-- Create a value of 'Fmtp' 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:
--
-- 'channelOrder', 'fmtp_channelOrder' - The format of the audio channel.
--
-- 'colorimetry', 'fmtp_colorimetry' - The format that is used for the representation of color.
--
-- 'exactFramerate', 'fmtp_exactFramerate' - The frame rate for the video stream, in frames\/second. For example:
-- 60000\/1001. If you specify a whole number, MediaConnect uses a ratio of
-- N\/1. For example, if you specify 60, MediaConnect uses 60\/1 as the
-- exactFramerate.
--
-- 'par', 'fmtp_par' - The pixel aspect ratio (PAR) of the video.
--
-- 'range', 'fmtp_range' - The encoding range of the video.
--
-- 'scanMode', 'fmtp_scanMode' - The type of compression that was used to smooth the video’s appearance
--
-- 'tcs', 'fmtp_tcs' - The transfer characteristic system (TCS) that is used in the video.
newFmtp ::
  Fmtp
newFmtp :: Fmtp
newFmtp =
  Fmtp'
    { $sel:channelOrder:Fmtp' :: Maybe Text
channelOrder = forall a. Maybe a
Prelude.Nothing,
      $sel:colorimetry:Fmtp' :: Maybe Colorimetry
colorimetry = forall a. Maybe a
Prelude.Nothing,
      $sel:exactFramerate:Fmtp' :: Maybe Text
exactFramerate = forall a. Maybe a
Prelude.Nothing,
      $sel:par:Fmtp' :: Maybe Text
par = forall a. Maybe a
Prelude.Nothing,
      $sel:range:Fmtp' :: Maybe Range
range = forall a. Maybe a
Prelude.Nothing,
      $sel:scanMode:Fmtp' :: Maybe ScanMode
scanMode = forall a. Maybe a
Prelude.Nothing,
      $sel:tcs:Fmtp' :: Maybe Tcs
tcs = forall a. Maybe a
Prelude.Nothing
    }

-- | The format of the audio channel.
fmtp_channelOrder :: Lens.Lens' Fmtp (Prelude.Maybe Prelude.Text)
fmtp_channelOrder :: Lens' Fmtp (Maybe Text)
fmtp_channelOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Fmtp' {Maybe Text
channelOrder :: Maybe Text
$sel:channelOrder:Fmtp' :: Fmtp -> Maybe Text
channelOrder} -> Maybe Text
channelOrder) (\s :: Fmtp
s@Fmtp' {} Maybe Text
a -> Fmtp
s {$sel:channelOrder:Fmtp' :: Maybe Text
channelOrder = Maybe Text
a} :: Fmtp)

-- | The format that is used for the representation of color.
fmtp_colorimetry :: Lens.Lens' Fmtp (Prelude.Maybe Colorimetry)
fmtp_colorimetry :: Lens' Fmtp (Maybe Colorimetry)
fmtp_colorimetry = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Fmtp' {Maybe Colorimetry
colorimetry :: Maybe Colorimetry
$sel:colorimetry:Fmtp' :: Fmtp -> Maybe Colorimetry
colorimetry} -> Maybe Colorimetry
colorimetry) (\s :: Fmtp
s@Fmtp' {} Maybe Colorimetry
a -> Fmtp
s {$sel:colorimetry:Fmtp' :: Maybe Colorimetry
colorimetry = Maybe Colorimetry
a} :: Fmtp)

-- | The frame rate for the video stream, in frames\/second. For example:
-- 60000\/1001. If you specify a whole number, MediaConnect uses a ratio of
-- N\/1. For example, if you specify 60, MediaConnect uses 60\/1 as the
-- exactFramerate.
fmtp_exactFramerate :: Lens.Lens' Fmtp (Prelude.Maybe Prelude.Text)
fmtp_exactFramerate :: Lens' Fmtp (Maybe Text)
fmtp_exactFramerate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Fmtp' {Maybe Text
exactFramerate :: Maybe Text
$sel:exactFramerate:Fmtp' :: Fmtp -> Maybe Text
exactFramerate} -> Maybe Text
exactFramerate) (\s :: Fmtp
s@Fmtp' {} Maybe Text
a -> Fmtp
s {$sel:exactFramerate:Fmtp' :: Maybe Text
exactFramerate = Maybe Text
a} :: Fmtp)

-- | The pixel aspect ratio (PAR) of the video.
fmtp_par :: Lens.Lens' Fmtp (Prelude.Maybe Prelude.Text)
fmtp_par :: Lens' Fmtp (Maybe Text)
fmtp_par = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Fmtp' {Maybe Text
par :: Maybe Text
$sel:par:Fmtp' :: Fmtp -> Maybe Text
par} -> Maybe Text
par) (\s :: Fmtp
s@Fmtp' {} Maybe Text
a -> Fmtp
s {$sel:par:Fmtp' :: Maybe Text
par = Maybe Text
a} :: Fmtp)

-- | The encoding range of the video.
fmtp_range :: Lens.Lens' Fmtp (Prelude.Maybe Range)
fmtp_range :: Lens' Fmtp (Maybe Range)
fmtp_range = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Fmtp' {Maybe Range
range :: Maybe Range
$sel:range:Fmtp' :: Fmtp -> Maybe Range
range} -> Maybe Range
range) (\s :: Fmtp
s@Fmtp' {} Maybe Range
a -> Fmtp
s {$sel:range:Fmtp' :: Maybe Range
range = Maybe Range
a} :: Fmtp)

-- | The type of compression that was used to smooth the video’s appearance
fmtp_scanMode :: Lens.Lens' Fmtp (Prelude.Maybe ScanMode)
fmtp_scanMode :: Lens' Fmtp (Maybe ScanMode)
fmtp_scanMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Fmtp' {Maybe ScanMode
scanMode :: Maybe ScanMode
$sel:scanMode:Fmtp' :: Fmtp -> Maybe ScanMode
scanMode} -> Maybe ScanMode
scanMode) (\s :: Fmtp
s@Fmtp' {} Maybe ScanMode
a -> Fmtp
s {$sel:scanMode:Fmtp' :: Maybe ScanMode
scanMode = Maybe ScanMode
a} :: Fmtp)

-- | The transfer characteristic system (TCS) that is used in the video.
fmtp_tcs :: Lens.Lens' Fmtp (Prelude.Maybe Tcs)
fmtp_tcs :: Lens' Fmtp (Maybe Tcs)
fmtp_tcs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Fmtp' {Maybe Tcs
tcs :: Maybe Tcs
$sel:tcs:Fmtp' :: Fmtp -> Maybe Tcs
tcs} -> Maybe Tcs
tcs) (\s :: Fmtp
s@Fmtp' {} Maybe Tcs
a -> Fmtp
s {$sel:tcs:Fmtp' :: Maybe Tcs
tcs = Maybe Tcs
a} :: Fmtp)

instance Data.FromJSON Fmtp where
  parseJSON :: Value -> Parser Fmtp
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Fmtp"
      ( \Object
x ->
          Maybe Text
-> Maybe Colorimetry
-> Maybe Text
-> Maybe Text
-> Maybe Range
-> Maybe ScanMode
-> Maybe Tcs
-> Fmtp
Fmtp'
            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
"channelOrder")
            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
"colorimetry")
            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
"exactFramerate")
            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
"par")
            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
"range")
            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
"scanMode")
            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
"tcs")
      )

instance Prelude.Hashable Fmtp where
  hashWithSalt :: Int -> Fmtp -> Int
hashWithSalt Int
_salt Fmtp' {Maybe Text
Maybe Colorimetry
Maybe Range
Maybe ScanMode
Maybe Tcs
tcs :: Maybe Tcs
scanMode :: Maybe ScanMode
range :: Maybe Range
par :: Maybe Text
exactFramerate :: Maybe Text
colorimetry :: Maybe Colorimetry
channelOrder :: Maybe Text
$sel:tcs:Fmtp' :: Fmtp -> Maybe Tcs
$sel:scanMode:Fmtp' :: Fmtp -> Maybe ScanMode
$sel:range:Fmtp' :: Fmtp -> Maybe Range
$sel:par:Fmtp' :: Fmtp -> Maybe Text
$sel:exactFramerate:Fmtp' :: Fmtp -> Maybe Text
$sel:colorimetry:Fmtp' :: Fmtp -> Maybe Colorimetry
$sel:channelOrder:Fmtp' :: Fmtp -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
channelOrder
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Colorimetry
colorimetry
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
exactFramerate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
par
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Range
range
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ScanMode
scanMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Tcs
tcs

instance Prelude.NFData Fmtp where
  rnf :: Fmtp -> ()
rnf Fmtp' {Maybe Text
Maybe Colorimetry
Maybe Range
Maybe ScanMode
Maybe Tcs
tcs :: Maybe Tcs
scanMode :: Maybe ScanMode
range :: Maybe Range
par :: Maybe Text
exactFramerate :: Maybe Text
colorimetry :: Maybe Colorimetry
channelOrder :: Maybe Text
$sel:tcs:Fmtp' :: Fmtp -> Maybe Tcs
$sel:scanMode:Fmtp' :: Fmtp -> Maybe ScanMode
$sel:range:Fmtp' :: Fmtp -> Maybe Range
$sel:par:Fmtp' :: Fmtp -> Maybe Text
$sel:exactFramerate:Fmtp' :: Fmtp -> Maybe Text
$sel:colorimetry:Fmtp' :: Fmtp -> Maybe Colorimetry
$sel:channelOrder:Fmtp' :: Fmtp -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
channelOrder
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Colorimetry
colorimetry
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
exactFramerate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
par
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Range
range
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ScanMode
scanMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Tcs
tcs