{-# 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.SageMaker.Types.Channel
-- 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.SageMaker.Types.Channel where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.SageMaker.Types.CompressionType
import Amazonka.SageMaker.Types.DataSource
import Amazonka.SageMaker.Types.RecordWrapper
import Amazonka.SageMaker.Types.ShuffleConfig
import Amazonka.SageMaker.Types.TrainingInputMode

-- | A channel is a named input source that training algorithms can consume.
--
-- /See:/ 'newChannel' smart constructor.
data Channel = Channel'
  { -- | If training data is compressed, the compression type. The default value
    -- is @None@. @CompressionType@ is used only in Pipe input mode. In File
    -- mode, leave this field unset or set it to None.
    Channel -> Maybe CompressionType
compressionType :: Prelude.Maybe CompressionType,
    -- | The MIME type of the data.
    Channel -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | (Optional) The input mode to use for the data channel in a training job.
    -- If you don\'t set a value for @InputMode@, SageMaker uses the value set
    -- for @TrainingInputMode@. Use this parameter to override the
    -- @TrainingInputMode@ setting in a AlgorithmSpecification request when you
    -- have a channel that needs a different input mode from the training
    -- job\'s general setting. To download the data from Amazon Simple Storage
    -- Service (Amazon S3) to the provisioned ML storage volume, and mount the
    -- directory to a Docker volume, use @File@ input mode. To stream data
    -- directly from Amazon S3 to the container, choose @Pipe@ input mode.
    --
    -- To use a model for incremental training, choose @File@ input model.
    Channel -> Maybe TrainingInputMode
inputMode :: Prelude.Maybe TrainingInputMode,
    -- | Specify RecordIO as the value when input data is in raw format but the
    -- training algorithm requires the RecordIO format. In this case, SageMaker
    -- wraps each individual S3 object in a RecordIO record. If the input data
    -- is already in RecordIO format, you don\'t need to set this attribute.
    -- For more information, see
    -- <https://mxnet.apache.org/api/architecture/note_data_loading#data-format Create a Dataset Using RecordIO>.
    --
    -- In File mode, leave this field unset or set it to None.
    Channel -> Maybe RecordWrapper
recordWrapperType :: Prelude.Maybe RecordWrapper,
    -- | A configuration for a shuffle option for input data in a channel. If you
    -- use @S3Prefix@ for @S3DataType@, this shuffles the results of the S3 key
    -- prefix matches. If you use @ManifestFile@, the order of the S3 object
    -- references in the @ManifestFile@ is shuffled. If you use
    -- @AugmentedManifestFile@, the order of the JSON lines in the
    -- @AugmentedManifestFile@ is shuffled. The shuffling order is determined
    -- using the @Seed@ value.
    --
    -- For Pipe input mode, shuffling is done at the start of every epoch. With
    -- large datasets this ensures that the order of the training data is
    -- different for each epoch, it helps reduce bias and possible overfitting.
    -- In a multi-node training job when ShuffleConfig is combined with
    -- @S3DataDistributionType@ of @ShardedByS3Key@, the data is shuffled
    -- across nodes so that the content sent to a particular node on the first
    -- epoch might be sent to a different node on the second epoch.
    Channel -> Maybe ShuffleConfig
shuffleConfig :: Prelude.Maybe ShuffleConfig,
    -- | The name of the channel.
    Channel -> Text
channelName :: Prelude.Text,
    -- | The location of the channel data.
    Channel -> DataSource
dataSource :: DataSource
  }
  deriving (Channel -> Channel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Channel -> Channel -> Bool
$c/= :: Channel -> Channel -> Bool
== :: Channel -> Channel -> Bool
$c== :: Channel -> Channel -> Bool
Prelude.Eq, ReadPrec [Channel]
ReadPrec Channel
Int -> ReadS Channel
ReadS [Channel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Channel]
$creadListPrec :: ReadPrec [Channel]
readPrec :: ReadPrec Channel
$creadPrec :: ReadPrec Channel
readList :: ReadS [Channel]
$creadList :: ReadS [Channel]
readsPrec :: Int -> ReadS Channel
$creadsPrec :: Int -> ReadS Channel
Prelude.Read, Int -> Channel -> ShowS
[Channel] -> ShowS
Channel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Channel] -> ShowS
$cshowList :: [Channel] -> ShowS
show :: Channel -> String
$cshow :: Channel -> String
showsPrec :: Int -> Channel -> ShowS
$cshowsPrec :: Int -> Channel -> ShowS
Prelude.Show, forall x. Rep Channel x -> Channel
forall x. Channel -> Rep Channel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Channel x -> Channel
$cfrom :: forall x. Channel -> Rep Channel x
Prelude.Generic)

-- |
-- Create a value of 'Channel' 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:
--
-- 'compressionType', 'channel_compressionType' - If training data is compressed, the compression type. The default value
-- is @None@. @CompressionType@ is used only in Pipe input mode. In File
-- mode, leave this field unset or set it to None.
--
-- 'contentType', 'channel_contentType' - The MIME type of the data.
--
-- 'inputMode', 'channel_inputMode' - (Optional) The input mode to use for the data channel in a training job.
-- If you don\'t set a value for @InputMode@, SageMaker uses the value set
-- for @TrainingInputMode@. Use this parameter to override the
-- @TrainingInputMode@ setting in a AlgorithmSpecification request when you
-- have a channel that needs a different input mode from the training
-- job\'s general setting. To download the data from Amazon Simple Storage
-- Service (Amazon S3) to the provisioned ML storage volume, and mount the
-- directory to a Docker volume, use @File@ input mode. To stream data
-- directly from Amazon S3 to the container, choose @Pipe@ input mode.
--
-- To use a model for incremental training, choose @File@ input model.
--
-- 'recordWrapperType', 'channel_recordWrapperType' - Specify RecordIO as the value when input data is in raw format but the
-- training algorithm requires the RecordIO format. In this case, SageMaker
-- wraps each individual S3 object in a RecordIO record. If the input data
-- is already in RecordIO format, you don\'t need to set this attribute.
-- For more information, see
-- <https://mxnet.apache.org/api/architecture/note_data_loading#data-format Create a Dataset Using RecordIO>.
--
-- In File mode, leave this field unset or set it to None.
--
-- 'shuffleConfig', 'channel_shuffleConfig' - A configuration for a shuffle option for input data in a channel. If you
-- use @S3Prefix@ for @S3DataType@, this shuffles the results of the S3 key
-- prefix matches. If you use @ManifestFile@, the order of the S3 object
-- references in the @ManifestFile@ is shuffled. If you use
-- @AugmentedManifestFile@, the order of the JSON lines in the
-- @AugmentedManifestFile@ is shuffled. The shuffling order is determined
-- using the @Seed@ value.
--
-- For Pipe input mode, shuffling is done at the start of every epoch. With
-- large datasets this ensures that the order of the training data is
-- different for each epoch, it helps reduce bias and possible overfitting.
-- In a multi-node training job when ShuffleConfig is combined with
-- @S3DataDistributionType@ of @ShardedByS3Key@, the data is shuffled
-- across nodes so that the content sent to a particular node on the first
-- epoch might be sent to a different node on the second epoch.
--
-- 'channelName', 'channel_channelName' - The name of the channel.
--
-- 'dataSource', 'channel_dataSource' - The location of the channel data.
newChannel ::
  -- | 'channelName'
  Prelude.Text ->
  -- | 'dataSource'
  DataSource ->
  Channel
newChannel :: Text -> DataSource -> Channel
newChannel Text
pChannelName_ DataSource
pDataSource_ =
  Channel'
    { $sel:compressionType:Channel' :: Maybe CompressionType
compressionType = forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:Channel' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:inputMode:Channel' :: Maybe TrainingInputMode
inputMode = forall a. Maybe a
Prelude.Nothing,
      $sel:recordWrapperType:Channel' :: Maybe RecordWrapper
recordWrapperType = forall a. Maybe a
Prelude.Nothing,
      $sel:shuffleConfig:Channel' :: Maybe ShuffleConfig
shuffleConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:channelName:Channel' :: Text
channelName = Text
pChannelName_,
      $sel:dataSource:Channel' :: DataSource
dataSource = DataSource
pDataSource_
    }

-- | If training data is compressed, the compression type. The default value
-- is @None@. @CompressionType@ is used only in Pipe input mode. In File
-- mode, leave this field unset or set it to None.
channel_compressionType :: Lens.Lens' Channel (Prelude.Maybe CompressionType)
channel_compressionType :: Lens' Channel (Maybe CompressionType)
channel_compressionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe CompressionType
compressionType :: Maybe CompressionType
$sel:compressionType:Channel' :: Channel -> Maybe CompressionType
compressionType} -> Maybe CompressionType
compressionType) (\s :: Channel
s@Channel' {} Maybe CompressionType
a -> Channel
s {$sel:compressionType:Channel' :: Maybe CompressionType
compressionType = Maybe CompressionType
a} :: Channel)

-- | The MIME type of the data.
channel_contentType :: Lens.Lens' Channel (Prelude.Maybe Prelude.Text)
channel_contentType :: Lens' Channel (Maybe Text)
channel_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe Text
contentType :: Maybe Text
$sel:contentType:Channel' :: Channel -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: Channel
s@Channel' {} Maybe Text
a -> Channel
s {$sel:contentType:Channel' :: Maybe Text
contentType = Maybe Text
a} :: Channel)

-- | (Optional) The input mode to use for the data channel in a training job.
-- If you don\'t set a value for @InputMode@, SageMaker uses the value set
-- for @TrainingInputMode@. Use this parameter to override the
-- @TrainingInputMode@ setting in a AlgorithmSpecification request when you
-- have a channel that needs a different input mode from the training
-- job\'s general setting. To download the data from Amazon Simple Storage
-- Service (Amazon S3) to the provisioned ML storage volume, and mount the
-- directory to a Docker volume, use @File@ input mode. To stream data
-- directly from Amazon S3 to the container, choose @Pipe@ input mode.
--
-- To use a model for incremental training, choose @File@ input model.
channel_inputMode :: Lens.Lens' Channel (Prelude.Maybe TrainingInputMode)
channel_inputMode :: Lens' Channel (Maybe TrainingInputMode)
channel_inputMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe TrainingInputMode
inputMode :: Maybe TrainingInputMode
$sel:inputMode:Channel' :: Channel -> Maybe TrainingInputMode
inputMode} -> Maybe TrainingInputMode
inputMode) (\s :: Channel
s@Channel' {} Maybe TrainingInputMode
a -> Channel
s {$sel:inputMode:Channel' :: Maybe TrainingInputMode
inputMode = Maybe TrainingInputMode
a} :: Channel)

-- | Specify RecordIO as the value when input data is in raw format but the
-- training algorithm requires the RecordIO format. In this case, SageMaker
-- wraps each individual S3 object in a RecordIO record. If the input data
-- is already in RecordIO format, you don\'t need to set this attribute.
-- For more information, see
-- <https://mxnet.apache.org/api/architecture/note_data_loading#data-format Create a Dataset Using RecordIO>.
--
-- In File mode, leave this field unset or set it to None.
channel_recordWrapperType :: Lens.Lens' Channel (Prelude.Maybe RecordWrapper)
channel_recordWrapperType :: Lens' Channel (Maybe RecordWrapper)
channel_recordWrapperType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe RecordWrapper
recordWrapperType :: Maybe RecordWrapper
$sel:recordWrapperType:Channel' :: Channel -> Maybe RecordWrapper
recordWrapperType} -> Maybe RecordWrapper
recordWrapperType) (\s :: Channel
s@Channel' {} Maybe RecordWrapper
a -> Channel
s {$sel:recordWrapperType:Channel' :: Maybe RecordWrapper
recordWrapperType = Maybe RecordWrapper
a} :: Channel)

-- | A configuration for a shuffle option for input data in a channel. If you
-- use @S3Prefix@ for @S3DataType@, this shuffles the results of the S3 key
-- prefix matches. If you use @ManifestFile@, the order of the S3 object
-- references in the @ManifestFile@ is shuffled. If you use
-- @AugmentedManifestFile@, the order of the JSON lines in the
-- @AugmentedManifestFile@ is shuffled. The shuffling order is determined
-- using the @Seed@ value.
--
-- For Pipe input mode, shuffling is done at the start of every epoch. With
-- large datasets this ensures that the order of the training data is
-- different for each epoch, it helps reduce bias and possible overfitting.
-- In a multi-node training job when ShuffleConfig is combined with
-- @S3DataDistributionType@ of @ShardedByS3Key@, the data is shuffled
-- across nodes so that the content sent to a particular node on the first
-- epoch might be sent to a different node on the second epoch.
channel_shuffleConfig :: Lens.Lens' Channel (Prelude.Maybe ShuffleConfig)
channel_shuffleConfig :: Lens' Channel (Maybe ShuffleConfig)
channel_shuffleConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe ShuffleConfig
shuffleConfig :: Maybe ShuffleConfig
$sel:shuffleConfig:Channel' :: Channel -> Maybe ShuffleConfig
shuffleConfig} -> Maybe ShuffleConfig
shuffleConfig) (\s :: Channel
s@Channel' {} Maybe ShuffleConfig
a -> Channel
s {$sel:shuffleConfig:Channel' :: Maybe ShuffleConfig
shuffleConfig = Maybe ShuffleConfig
a} :: Channel)

-- | The name of the channel.
channel_channelName :: Lens.Lens' Channel Prelude.Text
channel_channelName :: Lens' Channel Text
channel_channelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Text
channelName :: Text
$sel:channelName:Channel' :: Channel -> Text
channelName} -> Text
channelName) (\s :: Channel
s@Channel' {} Text
a -> Channel
s {$sel:channelName:Channel' :: Text
channelName = Text
a} :: Channel)

-- | The location of the channel data.
channel_dataSource :: Lens.Lens' Channel DataSource
channel_dataSource :: Lens' Channel DataSource
channel_dataSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {DataSource
dataSource :: DataSource
$sel:dataSource:Channel' :: Channel -> DataSource
dataSource} -> DataSource
dataSource) (\s :: Channel
s@Channel' {} DataSource
a -> Channel
s {$sel:dataSource:Channel' :: DataSource
dataSource = DataSource
a} :: Channel)

instance Data.FromJSON Channel where
  parseJSON :: Value -> Parser Channel
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Channel"
      ( \Object
x ->
          Maybe CompressionType
-> Maybe Text
-> Maybe TrainingInputMode
-> Maybe RecordWrapper
-> Maybe ShuffleConfig
-> Text
-> DataSource
-> Channel
Channel'
            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
"CompressionType")
            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
"ContentType")
            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
"InputMode")
            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
"RecordWrapperType")
            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
"ShuffleConfig")
            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
"ChannelName")
            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
"DataSource")
      )

instance Prelude.Hashable Channel where
  hashWithSalt :: Int -> Channel -> Int
hashWithSalt Int
_salt Channel' {Maybe Text
Maybe CompressionType
Maybe RecordWrapper
Maybe ShuffleConfig
Maybe TrainingInputMode
Text
DataSource
dataSource :: DataSource
channelName :: Text
shuffleConfig :: Maybe ShuffleConfig
recordWrapperType :: Maybe RecordWrapper
inputMode :: Maybe TrainingInputMode
contentType :: Maybe Text
compressionType :: Maybe CompressionType
$sel:dataSource:Channel' :: Channel -> DataSource
$sel:channelName:Channel' :: Channel -> Text
$sel:shuffleConfig:Channel' :: Channel -> Maybe ShuffleConfig
$sel:recordWrapperType:Channel' :: Channel -> Maybe RecordWrapper
$sel:inputMode:Channel' :: Channel -> Maybe TrainingInputMode
$sel:contentType:Channel' :: Channel -> Maybe Text
$sel:compressionType:Channel' :: Channel -> Maybe CompressionType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CompressionType
compressionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
contentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TrainingInputMode
inputMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RecordWrapper
recordWrapperType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ShuffleConfig
shuffleConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DataSource
dataSource

instance Prelude.NFData Channel where
  rnf :: Channel -> ()
rnf Channel' {Maybe Text
Maybe CompressionType
Maybe RecordWrapper
Maybe ShuffleConfig
Maybe TrainingInputMode
Text
DataSource
dataSource :: DataSource
channelName :: Text
shuffleConfig :: Maybe ShuffleConfig
recordWrapperType :: Maybe RecordWrapper
inputMode :: Maybe TrainingInputMode
contentType :: Maybe Text
compressionType :: Maybe CompressionType
$sel:dataSource:Channel' :: Channel -> DataSource
$sel:channelName:Channel' :: Channel -> Text
$sel:shuffleConfig:Channel' :: Channel -> Maybe ShuffleConfig
$sel:recordWrapperType:Channel' :: Channel -> Maybe RecordWrapper
$sel:inputMode:Channel' :: Channel -> Maybe TrainingInputMode
$sel:contentType:Channel' :: Channel -> Maybe Text
$sel:compressionType:Channel' :: Channel -> Maybe CompressionType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CompressionType
compressionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TrainingInputMode
inputMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RecordWrapper
recordWrapperType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ShuffleConfig
shuffleConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
channelName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DataSource
dataSource

instance Data.ToJSON Channel where
  toJSON :: Channel -> Value
toJSON Channel' {Maybe Text
Maybe CompressionType
Maybe RecordWrapper
Maybe ShuffleConfig
Maybe TrainingInputMode
Text
DataSource
dataSource :: DataSource
channelName :: Text
shuffleConfig :: Maybe ShuffleConfig
recordWrapperType :: Maybe RecordWrapper
inputMode :: Maybe TrainingInputMode
contentType :: Maybe Text
compressionType :: Maybe CompressionType
$sel:dataSource:Channel' :: Channel -> DataSource
$sel:channelName:Channel' :: Channel -> Text
$sel:shuffleConfig:Channel' :: Channel -> Maybe ShuffleConfig
$sel:recordWrapperType:Channel' :: Channel -> Maybe RecordWrapper
$sel:inputMode:Channel' :: Channel -> Maybe TrainingInputMode
$sel:contentType:Channel' :: Channel -> Maybe Text
$sel:compressionType:Channel' :: Channel -> Maybe CompressionType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CompressionType" 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 CompressionType
compressionType,
            (Key
"ContentType" 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
contentType,
            (Key
"InputMode" 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 TrainingInputMode
inputMode,
            (Key
"RecordWrapperType" 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 RecordWrapper
recordWrapperType,
            (Key
"ShuffleConfig" 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 ShuffleConfig
shuffleConfig,
            forall a. a -> Maybe a
Prelude.Just (Key
"ChannelName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
channelName),
            forall a. a -> Maybe a
Prelude.Just (Key
"DataSource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DataSource
dataSource)
          ]
      )