{-# 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.DvbSdtSettings
-- 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.DvbSdtSettings 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.DvbSdtOutputSdt
import qualified Amazonka.Prelude as Prelude

-- | DVB Service Description Table (SDT)
--
-- /See:/ 'newDvbSdtSettings' smart constructor.
data DvbSdtSettings = DvbSdtSettings'
  { -- | Selects method of inserting SDT information into output stream. The
    -- sdtFollow setting copies SDT information from input stream to output
    -- stream. The sdtFollowIfPresent setting copies SDT information from input
    -- stream to output stream if SDT information is present in the input,
    -- otherwise it will fall back on the user-defined values. The sdtManual
    -- setting means user will enter the SDT information. The sdtNone setting
    -- means output stream will not contain SDT information.
    DvbSdtSettings -> Maybe DvbSdtOutputSdt
outputSdt :: Prelude.Maybe DvbSdtOutputSdt,
    -- | The number of milliseconds between instances of this table in the output
    -- transport stream.
    DvbSdtSettings -> Maybe Natural
repInterval :: Prelude.Maybe Prelude.Natural,
    -- | The service name placed in the serviceDescriptor in the Service
    -- Description Table. Maximum length is 256 characters.
    DvbSdtSettings -> Maybe Text
serviceName :: Prelude.Maybe Prelude.Text,
    -- | The service provider name placed in the serviceDescriptor in the Service
    -- Description Table. Maximum length is 256 characters.
    DvbSdtSettings -> Maybe Text
serviceProviderName :: Prelude.Maybe Prelude.Text
  }
  deriving (DvbSdtSettings -> DvbSdtSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DvbSdtSettings -> DvbSdtSettings -> Bool
$c/= :: DvbSdtSettings -> DvbSdtSettings -> Bool
== :: DvbSdtSettings -> DvbSdtSettings -> Bool
$c== :: DvbSdtSettings -> DvbSdtSettings -> Bool
Prelude.Eq, ReadPrec [DvbSdtSettings]
ReadPrec DvbSdtSettings
Int -> ReadS DvbSdtSettings
ReadS [DvbSdtSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DvbSdtSettings]
$creadListPrec :: ReadPrec [DvbSdtSettings]
readPrec :: ReadPrec DvbSdtSettings
$creadPrec :: ReadPrec DvbSdtSettings
readList :: ReadS [DvbSdtSettings]
$creadList :: ReadS [DvbSdtSettings]
readsPrec :: Int -> ReadS DvbSdtSettings
$creadsPrec :: Int -> ReadS DvbSdtSettings
Prelude.Read, Int -> DvbSdtSettings -> ShowS
[DvbSdtSettings] -> ShowS
DvbSdtSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DvbSdtSettings] -> ShowS
$cshowList :: [DvbSdtSettings] -> ShowS
show :: DvbSdtSettings -> String
$cshow :: DvbSdtSettings -> String
showsPrec :: Int -> DvbSdtSettings -> ShowS
$cshowsPrec :: Int -> DvbSdtSettings -> ShowS
Prelude.Show, forall x. Rep DvbSdtSettings x -> DvbSdtSettings
forall x. DvbSdtSettings -> Rep DvbSdtSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DvbSdtSettings x -> DvbSdtSettings
$cfrom :: forall x. DvbSdtSettings -> Rep DvbSdtSettings x
Prelude.Generic)

-- |
-- Create a value of 'DvbSdtSettings' 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:
--
-- 'outputSdt', 'dvbSdtSettings_outputSdt' - Selects method of inserting SDT information into output stream. The
-- sdtFollow setting copies SDT information from input stream to output
-- stream. The sdtFollowIfPresent setting copies SDT information from input
-- stream to output stream if SDT information is present in the input,
-- otherwise it will fall back on the user-defined values. The sdtManual
-- setting means user will enter the SDT information. The sdtNone setting
-- means output stream will not contain SDT information.
--
-- 'repInterval', 'dvbSdtSettings_repInterval' - The number of milliseconds between instances of this table in the output
-- transport stream.
--
-- 'serviceName', 'dvbSdtSettings_serviceName' - The service name placed in the serviceDescriptor in the Service
-- Description Table. Maximum length is 256 characters.
--
-- 'serviceProviderName', 'dvbSdtSettings_serviceProviderName' - The service provider name placed in the serviceDescriptor in the Service
-- Description Table. Maximum length is 256 characters.
newDvbSdtSettings ::
  DvbSdtSettings
newDvbSdtSettings :: DvbSdtSettings
newDvbSdtSettings =
  DvbSdtSettings'
    { $sel:outputSdt:DvbSdtSettings' :: Maybe DvbSdtOutputSdt
outputSdt = forall a. Maybe a
Prelude.Nothing,
      $sel:repInterval:DvbSdtSettings' :: Maybe Natural
repInterval = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceName:DvbSdtSettings' :: Maybe Text
serviceName = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceProviderName:DvbSdtSettings' :: Maybe Text
serviceProviderName = forall a. Maybe a
Prelude.Nothing
    }

-- | Selects method of inserting SDT information into output stream. The
-- sdtFollow setting copies SDT information from input stream to output
-- stream. The sdtFollowIfPresent setting copies SDT information from input
-- stream to output stream if SDT information is present in the input,
-- otherwise it will fall back on the user-defined values. The sdtManual
-- setting means user will enter the SDT information. The sdtNone setting
-- means output stream will not contain SDT information.
dvbSdtSettings_outputSdt :: Lens.Lens' DvbSdtSettings (Prelude.Maybe DvbSdtOutputSdt)
dvbSdtSettings_outputSdt :: Lens' DvbSdtSettings (Maybe DvbSdtOutputSdt)
dvbSdtSettings_outputSdt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DvbSdtSettings' {Maybe DvbSdtOutputSdt
outputSdt :: Maybe DvbSdtOutputSdt
$sel:outputSdt:DvbSdtSettings' :: DvbSdtSettings -> Maybe DvbSdtOutputSdt
outputSdt} -> Maybe DvbSdtOutputSdt
outputSdt) (\s :: DvbSdtSettings
s@DvbSdtSettings' {} Maybe DvbSdtOutputSdt
a -> DvbSdtSettings
s {$sel:outputSdt:DvbSdtSettings' :: Maybe DvbSdtOutputSdt
outputSdt = Maybe DvbSdtOutputSdt
a} :: DvbSdtSettings)

-- | The number of milliseconds between instances of this table in the output
-- transport stream.
dvbSdtSettings_repInterval :: Lens.Lens' DvbSdtSettings (Prelude.Maybe Prelude.Natural)
dvbSdtSettings_repInterval :: Lens' DvbSdtSettings (Maybe Natural)
dvbSdtSettings_repInterval = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DvbSdtSettings' {Maybe Natural
repInterval :: Maybe Natural
$sel:repInterval:DvbSdtSettings' :: DvbSdtSettings -> Maybe Natural
repInterval} -> Maybe Natural
repInterval) (\s :: DvbSdtSettings
s@DvbSdtSettings' {} Maybe Natural
a -> DvbSdtSettings
s {$sel:repInterval:DvbSdtSettings' :: Maybe Natural
repInterval = Maybe Natural
a} :: DvbSdtSettings)

-- | The service name placed in the serviceDescriptor in the Service
-- Description Table. Maximum length is 256 characters.
dvbSdtSettings_serviceName :: Lens.Lens' DvbSdtSettings (Prelude.Maybe Prelude.Text)
dvbSdtSettings_serviceName :: Lens' DvbSdtSettings (Maybe Text)
dvbSdtSettings_serviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DvbSdtSettings' {Maybe Text
serviceName :: Maybe Text
$sel:serviceName:DvbSdtSettings' :: DvbSdtSettings -> Maybe Text
serviceName} -> Maybe Text
serviceName) (\s :: DvbSdtSettings
s@DvbSdtSettings' {} Maybe Text
a -> DvbSdtSettings
s {$sel:serviceName:DvbSdtSettings' :: Maybe Text
serviceName = Maybe Text
a} :: DvbSdtSettings)

-- | The service provider name placed in the serviceDescriptor in the Service
-- Description Table. Maximum length is 256 characters.
dvbSdtSettings_serviceProviderName :: Lens.Lens' DvbSdtSettings (Prelude.Maybe Prelude.Text)
dvbSdtSettings_serviceProviderName :: Lens' DvbSdtSettings (Maybe Text)
dvbSdtSettings_serviceProviderName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DvbSdtSettings' {Maybe Text
serviceProviderName :: Maybe Text
$sel:serviceProviderName:DvbSdtSettings' :: DvbSdtSettings -> Maybe Text
serviceProviderName} -> Maybe Text
serviceProviderName) (\s :: DvbSdtSettings
s@DvbSdtSettings' {} Maybe Text
a -> DvbSdtSettings
s {$sel:serviceProviderName:DvbSdtSettings' :: Maybe Text
serviceProviderName = Maybe Text
a} :: DvbSdtSettings)

instance Data.FromJSON DvbSdtSettings where
  parseJSON :: Value -> Parser DvbSdtSettings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"DvbSdtSettings"
      ( \Object
x ->
          Maybe DvbSdtOutputSdt
-> Maybe Natural -> Maybe Text -> Maybe Text -> DvbSdtSettings
DvbSdtSettings'
            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
"outputSdt")
            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
"repInterval")
            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
"serviceName")
            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
"serviceProviderName")
      )

instance Prelude.Hashable DvbSdtSettings where
  hashWithSalt :: Int -> DvbSdtSettings -> Int
hashWithSalt Int
_salt DvbSdtSettings' {Maybe Natural
Maybe Text
Maybe DvbSdtOutputSdt
serviceProviderName :: Maybe Text
serviceName :: Maybe Text
repInterval :: Maybe Natural
outputSdt :: Maybe DvbSdtOutputSdt
$sel:serviceProviderName:DvbSdtSettings' :: DvbSdtSettings -> Maybe Text
$sel:serviceName:DvbSdtSettings' :: DvbSdtSettings -> Maybe Text
$sel:repInterval:DvbSdtSettings' :: DvbSdtSettings -> Maybe Natural
$sel:outputSdt:DvbSdtSettings' :: DvbSdtSettings -> Maybe DvbSdtOutputSdt
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DvbSdtOutputSdt
outputSdt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
repInterval
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceProviderName

instance Prelude.NFData DvbSdtSettings where
  rnf :: DvbSdtSettings -> ()
rnf DvbSdtSettings' {Maybe Natural
Maybe Text
Maybe DvbSdtOutputSdt
serviceProviderName :: Maybe Text
serviceName :: Maybe Text
repInterval :: Maybe Natural
outputSdt :: Maybe DvbSdtOutputSdt
$sel:serviceProviderName:DvbSdtSettings' :: DvbSdtSettings -> Maybe Text
$sel:serviceName:DvbSdtSettings' :: DvbSdtSettings -> Maybe Text
$sel:repInterval:DvbSdtSettings' :: DvbSdtSettings -> Maybe Natural
$sel:outputSdt:DvbSdtSettings' :: DvbSdtSettings -> Maybe DvbSdtOutputSdt
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DvbSdtOutputSdt
outputSdt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
repInterval
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceProviderName

instance Data.ToJSON DvbSdtSettings where
  toJSON :: DvbSdtSettings -> Value
toJSON DvbSdtSettings' {Maybe Natural
Maybe Text
Maybe DvbSdtOutputSdt
serviceProviderName :: Maybe Text
serviceName :: Maybe Text
repInterval :: Maybe Natural
outputSdt :: Maybe DvbSdtOutputSdt
$sel:serviceProviderName:DvbSdtSettings' :: DvbSdtSettings -> Maybe Text
$sel:serviceName:DvbSdtSettings' :: DvbSdtSettings -> Maybe Text
$sel:repInterval:DvbSdtSettings' :: DvbSdtSettings -> Maybe Natural
$sel:outputSdt:DvbSdtSettings' :: DvbSdtSettings -> Maybe DvbSdtOutputSdt
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"outputSdt" 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 DvbSdtOutputSdt
outputSdt,
            (Key
"repInterval" 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
repInterval,
            (Key
"serviceName" 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
serviceName,
            (Key
"serviceProviderName" 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
serviceProviderName
          ]
      )