{-# 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.RobOMaker.Types.RobotApplicationConfig
-- 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.RobOMaker.Types.RobotApplicationConfig 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.RobOMaker.Types.LaunchConfig
import Amazonka.RobOMaker.Types.Tool
import Amazonka.RobOMaker.Types.UploadConfiguration

-- | Application configuration information for a robot.
--
-- /See:/ 'newRobotApplicationConfig' smart constructor.
data RobotApplicationConfig = RobotApplicationConfig'
  { -- | The version of the robot application.
    RobotApplicationConfig -> Maybe Text
applicationVersion :: Prelude.Maybe Prelude.Text,
    -- | Information about tools configured for the robot application.
    RobotApplicationConfig -> Maybe [Tool]
tools :: Prelude.Maybe [Tool],
    -- | The upload configurations for the robot application.
    RobotApplicationConfig -> Maybe [UploadConfiguration]
uploadConfigurations :: Prelude.Maybe [UploadConfiguration],
    -- | A Boolean indicating whether to use default robot application tools. The
    -- default tools are rviz, rqt, terminal and rosbag record. The default is
    -- @False@.
    --
    -- This API is no longer supported and will throw an error if used.
    RobotApplicationConfig -> Maybe Bool
useDefaultTools :: Prelude.Maybe Prelude.Bool,
    -- | A Boolean indicating whether to use default upload configurations. By
    -- default, @.ros@ and @.gazebo@ files are uploaded when the application
    -- terminates and all ROS topics will be recorded.
    --
    -- If you set this value, you must specify an @outputLocation@.
    --
    -- This API is no longer supported and will throw an error if used.
    RobotApplicationConfig -> Maybe Bool
useDefaultUploadConfigurations :: Prelude.Maybe Prelude.Bool,
    -- | The application information for the robot application.
    RobotApplicationConfig -> Text
application :: Prelude.Text,
    -- | The launch configuration for the robot application.
    RobotApplicationConfig -> LaunchConfig
launchConfig :: LaunchConfig
  }
  deriving (RobotApplicationConfig -> RobotApplicationConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RobotApplicationConfig -> RobotApplicationConfig -> Bool
$c/= :: RobotApplicationConfig -> RobotApplicationConfig -> Bool
== :: RobotApplicationConfig -> RobotApplicationConfig -> Bool
$c== :: RobotApplicationConfig -> RobotApplicationConfig -> Bool
Prelude.Eq, ReadPrec [RobotApplicationConfig]
ReadPrec RobotApplicationConfig
Int -> ReadS RobotApplicationConfig
ReadS [RobotApplicationConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RobotApplicationConfig]
$creadListPrec :: ReadPrec [RobotApplicationConfig]
readPrec :: ReadPrec RobotApplicationConfig
$creadPrec :: ReadPrec RobotApplicationConfig
readList :: ReadS [RobotApplicationConfig]
$creadList :: ReadS [RobotApplicationConfig]
readsPrec :: Int -> ReadS RobotApplicationConfig
$creadsPrec :: Int -> ReadS RobotApplicationConfig
Prelude.Read, Int -> RobotApplicationConfig -> ShowS
[RobotApplicationConfig] -> ShowS
RobotApplicationConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RobotApplicationConfig] -> ShowS
$cshowList :: [RobotApplicationConfig] -> ShowS
show :: RobotApplicationConfig -> String
$cshow :: RobotApplicationConfig -> String
showsPrec :: Int -> RobotApplicationConfig -> ShowS
$cshowsPrec :: Int -> RobotApplicationConfig -> ShowS
Prelude.Show, forall x. Rep RobotApplicationConfig x -> RobotApplicationConfig
forall x. RobotApplicationConfig -> Rep RobotApplicationConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RobotApplicationConfig x -> RobotApplicationConfig
$cfrom :: forall x. RobotApplicationConfig -> Rep RobotApplicationConfig x
Prelude.Generic)

-- |
-- Create a value of 'RobotApplicationConfig' 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:
--
-- 'applicationVersion', 'robotApplicationConfig_applicationVersion' - The version of the robot application.
--
-- 'tools', 'robotApplicationConfig_tools' - Information about tools configured for the robot application.
--
-- 'uploadConfigurations', 'robotApplicationConfig_uploadConfigurations' - The upload configurations for the robot application.
--
-- 'useDefaultTools', 'robotApplicationConfig_useDefaultTools' - A Boolean indicating whether to use default robot application tools. The
-- default tools are rviz, rqt, terminal and rosbag record. The default is
-- @False@.
--
-- This API is no longer supported and will throw an error if used.
--
-- 'useDefaultUploadConfigurations', 'robotApplicationConfig_useDefaultUploadConfigurations' - A Boolean indicating whether to use default upload configurations. By
-- default, @.ros@ and @.gazebo@ files are uploaded when the application
-- terminates and all ROS topics will be recorded.
--
-- If you set this value, you must specify an @outputLocation@.
--
-- This API is no longer supported and will throw an error if used.
--
-- 'application', 'robotApplicationConfig_application' - The application information for the robot application.
--
-- 'launchConfig', 'robotApplicationConfig_launchConfig' - The launch configuration for the robot application.
newRobotApplicationConfig ::
  -- | 'application'
  Prelude.Text ->
  -- | 'launchConfig'
  LaunchConfig ->
  RobotApplicationConfig
newRobotApplicationConfig :: Text -> LaunchConfig -> RobotApplicationConfig
newRobotApplicationConfig
  Text
pApplication_
  LaunchConfig
pLaunchConfig_ =
    RobotApplicationConfig'
      { $sel:applicationVersion:RobotApplicationConfig' :: Maybe Text
applicationVersion =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tools:RobotApplicationConfig' :: Maybe [Tool]
tools = forall a. Maybe a
Prelude.Nothing,
        $sel:uploadConfigurations:RobotApplicationConfig' :: Maybe [UploadConfiguration]
uploadConfigurations = forall a. Maybe a
Prelude.Nothing,
        $sel:useDefaultTools:RobotApplicationConfig' :: Maybe Bool
useDefaultTools = forall a. Maybe a
Prelude.Nothing,
        $sel:useDefaultUploadConfigurations:RobotApplicationConfig' :: Maybe Bool
useDefaultUploadConfigurations = forall a. Maybe a
Prelude.Nothing,
        $sel:application:RobotApplicationConfig' :: Text
application = Text
pApplication_,
        $sel:launchConfig:RobotApplicationConfig' :: LaunchConfig
launchConfig = LaunchConfig
pLaunchConfig_
      }

-- | The version of the robot application.
robotApplicationConfig_applicationVersion :: Lens.Lens' RobotApplicationConfig (Prelude.Maybe Prelude.Text)
robotApplicationConfig_applicationVersion :: Lens' RobotApplicationConfig (Maybe Text)
robotApplicationConfig_applicationVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RobotApplicationConfig' {Maybe Text
applicationVersion :: Maybe Text
$sel:applicationVersion:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Text
applicationVersion} -> Maybe Text
applicationVersion) (\s :: RobotApplicationConfig
s@RobotApplicationConfig' {} Maybe Text
a -> RobotApplicationConfig
s {$sel:applicationVersion:RobotApplicationConfig' :: Maybe Text
applicationVersion = Maybe Text
a} :: RobotApplicationConfig)

-- | Information about tools configured for the robot application.
robotApplicationConfig_tools :: Lens.Lens' RobotApplicationConfig (Prelude.Maybe [Tool])
robotApplicationConfig_tools :: Lens' RobotApplicationConfig (Maybe [Tool])
robotApplicationConfig_tools = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RobotApplicationConfig' {Maybe [Tool]
tools :: Maybe [Tool]
$sel:tools:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe [Tool]
tools} -> Maybe [Tool]
tools) (\s :: RobotApplicationConfig
s@RobotApplicationConfig' {} Maybe [Tool]
a -> RobotApplicationConfig
s {$sel:tools:RobotApplicationConfig' :: Maybe [Tool]
tools = Maybe [Tool]
a} :: RobotApplicationConfig) 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

-- | The upload configurations for the robot application.
robotApplicationConfig_uploadConfigurations :: Lens.Lens' RobotApplicationConfig (Prelude.Maybe [UploadConfiguration])
robotApplicationConfig_uploadConfigurations :: Lens' RobotApplicationConfig (Maybe [UploadConfiguration])
robotApplicationConfig_uploadConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RobotApplicationConfig' {Maybe [UploadConfiguration]
uploadConfigurations :: Maybe [UploadConfiguration]
$sel:uploadConfigurations:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe [UploadConfiguration]
uploadConfigurations} -> Maybe [UploadConfiguration]
uploadConfigurations) (\s :: RobotApplicationConfig
s@RobotApplicationConfig' {} Maybe [UploadConfiguration]
a -> RobotApplicationConfig
s {$sel:uploadConfigurations:RobotApplicationConfig' :: Maybe [UploadConfiguration]
uploadConfigurations = Maybe [UploadConfiguration]
a} :: RobotApplicationConfig) 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

-- | A Boolean indicating whether to use default robot application tools. The
-- default tools are rviz, rqt, terminal and rosbag record. The default is
-- @False@.
--
-- This API is no longer supported and will throw an error if used.
robotApplicationConfig_useDefaultTools :: Lens.Lens' RobotApplicationConfig (Prelude.Maybe Prelude.Bool)
robotApplicationConfig_useDefaultTools :: Lens' RobotApplicationConfig (Maybe Bool)
robotApplicationConfig_useDefaultTools = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RobotApplicationConfig' {Maybe Bool
useDefaultTools :: Maybe Bool
$sel:useDefaultTools:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Bool
useDefaultTools} -> Maybe Bool
useDefaultTools) (\s :: RobotApplicationConfig
s@RobotApplicationConfig' {} Maybe Bool
a -> RobotApplicationConfig
s {$sel:useDefaultTools:RobotApplicationConfig' :: Maybe Bool
useDefaultTools = Maybe Bool
a} :: RobotApplicationConfig)

-- | A Boolean indicating whether to use default upload configurations. By
-- default, @.ros@ and @.gazebo@ files are uploaded when the application
-- terminates and all ROS topics will be recorded.
--
-- If you set this value, you must specify an @outputLocation@.
--
-- This API is no longer supported and will throw an error if used.
robotApplicationConfig_useDefaultUploadConfigurations :: Lens.Lens' RobotApplicationConfig (Prelude.Maybe Prelude.Bool)
robotApplicationConfig_useDefaultUploadConfigurations :: Lens' RobotApplicationConfig (Maybe Bool)
robotApplicationConfig_useDefaultUploadConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RobotApplicationConfig' {Maybe Bool
useDefaultUploadConfigurations :: Maybe Bool
$sel:useDefaultUploadConfigurations:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Bool
useDefaultUploadConfigurations} -> Maybe Bool
useDefaultUploadConfigurations) (\s :: RobotApplicationConfig
s@RobotApplicationConfig' {} Maybe Bool
a -> RobotApplicationConfig
s {$sel:useDefaultUploadConfigurations:RobotApplicationConfig' :: Maybe Bool
useDefaultUploadConfigurations = Maybe Bool
a} :: RobotApplicationConfig)

-- | The application information for the robot application.
robotApplicationConfig_application :: Lens.Lens' RobotApplicationConfig Prelude.Text
robotApplicationConfig_application :: Lens' RobotApplicationConfig Text
robotApplicationConfig_application = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RobotApplicationConfig' {Text
application :: Text
$sel:application:RobotApplicationConfig' :: RobotApplicationConfig -> Text
application} -> Text
application) (\s :: RobotApplicationConfig
s@RobotApplicationConfig' {} Text
a -> RobotApplicationConfig
s {$sel:application:RobotApplicationConfig' :: Text
application = Text
a} :: RobotApplicationConfig)

-- | The launch configuration for the robot application.
robotApplicationConfig_launchConfig :: Lens.Lens' RobotApplicationConfig LaunchConfig
robotApplicationConfig_launchConfig :: Lens' RobotApplicationConfig LaunchConfig
robotApplicationConfig_launchConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RobotApplicationConfig' {LaunchConfig
launchConfig :: LaunchConfig
$sel:launchConfig:RobotApplicationConfig' :: RobotApplicationConfig -> LaunchConfig
launchConfig} -> LaunchConfig
launchConfig) (\s :: RobotApplicationConfig
s@RobotApplicationConfig' {} LaunchConfig
a -> RobotApplicationConfig
s {$sel:launchConfig:RobotApplicationConfig' :: LaunchConfig
launchConfig = LaunchConfig
a} :: RobotApplicationConfig)

instance Data.FromJSON RobotApplicationConfig where
  parseJSON :: Value -> Parser RobotApplicationConfig
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"RobotApplicationConfig"
      ( \Object
x ->
          Maybe Text
-> Maybe [Tool]
-> Maybe [UploadConfiguration]
-> Maybe Bool
-> Maybe Bool
-> Text
-> LaunchConfig
-> RobotApplicationConfig
RobotApplicationConfig'
            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
"applicationVersion")
            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
"tools" 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
"uploadConfigurations"
                            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
"useDefaultTools")
            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
"useDefaultUploadConfigurations")
            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
"application")
            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
"launchConfig")
      )

instance Prelude.Hashable RobotApplicationConfig where
  hashWithSalt :: Int -> RobotApplicationConfig -> Int
hashWithSalt Int
_salt RobotApplicationConfig' {Maybe Bool
Maybe [Tool]
Maybe [UploadConfiguration]
Maybe Text
Text
LaunchConfig
launchConfig :: LaunchConfig
application :: Text
useDefaultUploadConfigurations :: Maybe Bool
useDefaultTools :: Maybe Bool
uploadConfigurations :: Maybe [UploadConfiguration]
tools :: Maybe [Tool]
applicationVersion :: Maybe Text
$sel:launchConfig:RobotApplicationConfig' :: RobotApplicationConfig -> LaunchConfig
$sel:application:RobotApplicationConfig' :: RobotApplicationConfig -> Text
$sel:useDefaultUploadConfigurations:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Bool
$sel:useDefaultTools:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Bool
$sel:uploadConfigurations:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe [UploadConfiguration]
$sel:tools:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe [Tool]
$sel:applicationVersion:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
applicationVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tool]
tools
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [UploadConfiguration]
uploadConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
useDefaultTools
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
useDefaultUploadConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
application
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LaunchConfig
launchConfig

instance Prelude.NFData RobotApplicationConfig where
  rnf :: RobotApplicationConfig -> ()
rnf RobotApplicationConfig' {Maybe Bool
Maybe [Tool]
Maybe [UploadConfiguration]
Maybe Text
Text
LaunchConfig
launchConfig :: LaunchConfig
application :: Text
useDefaultUploadConfigurations :: Maybe Bool
useDefaultTools :: Maybe Bool
uploadConfigurations :: Maybe [UploadConfiguration]
tools :: Maybe [Tool]
applicationVersion :: Maybe Text
$sel:launchConfig:RobotApplicationConfig' :: RobotApplicationConfig -> LaunchConfig
$sel:application:RobotApplicationConfig' :: RobotApplicationConfig -> Text
$sel:useDefaultUploadConfigurations:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Bool
$sel:useDefaultTools:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Bool
$sel:uploadConfigurations:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe [UploadConfiguration]
$sel:tools:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe [Tool]
$sel:applicationVersion:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tool]
tools
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UploadConfiguration]
uploadConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
useDefaultTools
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
useDefaultUploadConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
application
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LaunchConfig
launchConfig

instance Data.ToJSON RobotApplicationConfig where
  toJSON :: RobotApplicationConfig -> Value
toJSON RobotApplicationConfig' {Maybe Bool
Maybe [Tool]
Maybe [UploadConfiguration]
Maybe Text
Text
LaunchConfig
launchConfig :: LaunchConfig
application :: Text
useDefaultUploadConfigurations :: Maybe Bool
useDefaultTools :: Maybe Bool
uploadConfigurations :: Maybe [UploadConfiguration]
tools :: Maybe [Tool]
applicationVersion :: Maybe Text
$sel:launchConfig:RobotApplicationConfig' :: RobotApplicationConfig -> LaunchConfig
$sel:application:RobotApplicationConfig' :: RobotApplicationConfig -> Text
$sel:useDefaultUploadConfigurations:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Bool
$sel:useDefaultTools:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Bool
$sel:uploadConfigurations:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe [UploadConfiguration]
$sel:tools:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe [Tool]
$sel:applicationVersion:RobotApplicationConfig' :: RobotApplicationConfig -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"applicationVersion" 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
applicationVersion,
            (Key
"tools" 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 [Tool]
tools,
            (Key
"uploadConfigurations" 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 [UploadConfiguration]
uploadConfigurations,
            (Key
"useDefaultTools" 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 Bool
useDefaultTools,
            (Key
"useDefaultUploadConfigurations" 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 Bool
useDefaultUploadConfigurations,
            forall a. a -> Maybe a
Prelude.Just (Key
"application" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
application),
            forall a. a -> Maybe a
Prelude.Just (Key
"launchConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LaunchConfig
launchConfig)
          ]
      )