{-# 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.AmplifyUiBuilder.Types.CreateFormData
-- 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.AmplifyUiBuilder.Types.CreateFormData where

import Amazonka.AmplifyUiBuilder.Types.FieldConfig
import Amazonka.AmplifyUiBuilder.Types.FormActionType
import Amazonka.AmplifyUiBuilder.Types.FormCTA
import Amazonka.AmplifyUiBuilder.Types.FormDataTypeConfig
import Amazonka.AmplifyUiBuilder.Types.FormStyle
import Amazonka.AmplifyUiBuilder.Types.SectionalElement
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

-- | Represents all of the information that is required to create a form.
--
-- /See:/ 'newCreateFormData' smart constructor.
data CreateFormData = CreateFormData'
  { -- | The @FormCTA@ object that stores the call to action configuration for
    -- the form.
    CreateFormData -> Maybe FormCTA
cta :: Prelude.Maybe FormCTA,
    -- | One or more key-value pairs to use when tagging the form data.
    CreateFormData -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The type of data source to use to create the form.
    CreateFormData -> FormDataTypeConfig
dataType :: FormDataTypeConfig,
    -- | The configuration information for the form\'s fields.
    CreateFormData -> HashMap Text FieldConfig
fields :: Prelude.HashMap Prelude.Text FieldConfig,
    -- | Specifies whether to perform a create or update action on the form.
    CreateFormData -> FormActionType
formActionType :: FormActionType,
    -- | The name of the form.
    CreateFormData -> Text
name :: Prelude.Text,
    -- | The schema version of the form.
    CreateFormData -> Text
schemaVersion :: Prelude.Text,
    -- | The configuration information for the visual helper elements for the
    -- form. These elements are not associated with any data.
    CreateFormData -> HashMap Text SectionalElement
sectionalElements :: Prelude.HashMap Prelude.Text SectionalElement,
    -- | The configuration for the form\'s style.
    CreateFormData -> FormStyle
style :: FormStyle
  }
  deriving (CreateFormData -> CreateFormData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFormData -> CreateFormData -> Bool
$c/= :: CreateFormData -> CreateFormData -> Bool
== :: CreateFormData -> CreateFormData -> Bool
$c== :: CreateFormData -> CreateFormData -> Bool
Prelude.Eq, ReadPrec [CreateFormData]
ReadPrec CreateFormData
Int -> ReadS CreateFormData
ReadS [CreateFormData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFormData]
$creadListPrec :: ReadPrec [CreateFormData]
readPrec :: ReadPrec CreateFormData
$creadPrec :: ReadPrec CreateFormData
readList :: ReadS [CreateFormData]
$creadList :: ReadS [CreateFormData]
readsPrec :: Int -> ReadS CreateFormData
$creadsPrec :: Int -> ReadS CreateFormData
Prelude.Read, Int -> CreateFormData -> ShowS
[CreateFormData] -> ShowS
CreateFormData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFormData] -> ShowS
$cshowList :: [CreateFormData] -> ShowS
show :: CreateFormData -> String
$cshow :: CreateFormData -> String
showsPrec :: Int -> CreateFormData -> ShowS
$cshowsPrec :: Int -> CreateFormData -> ShowS
Prelude.Show, forall x. Rep CreateFormData x -> CreateFormData
forall x. CreateFormData -> Rep CreateFormData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFormData x -> CreateFormData
$cfrom :: forall x. CreateFormData -> Rep CreateFormData x
Prelude.Generic)

-- |
-- Create a value of 'CreateFormData' 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:
--
-- 'cta', 'createFormData_cta' - The @FormCTA@ object that stores the call to action configuration for
-- the form.
--
-- 'tags', 'createFormData_tags' - One or more key-value pairs to use when tagging the form data.
--
-- 'dataType', 'createFormData_dataType' - The type of data source to use to create the form.
--
-- 'fields', 'createFormData_fields' - The configuration information for the form\'s fields.
--
-- 'formActionType', 'createFormData_formActionType' - Specifies whether to perform a create or update action on the form.
--
-- 'name', 'createFormData_name' - The name of the form.
--
-- 'schemaVersion', 'createFormData_schemaVersion' - The schema version of the form.
--
-- 'sectionalElements', 'createFormData_sectionalElements' - The configuration information for the visual helper elements for the
-- form. These elements are not associated with any data.
--
-- 'style', 'createFormData_style' - The configuration for the form\'s style.
newCreateFormData ::
  -- | 'dataType'
  FormDataTypeConfig ->
  -- | 'formActionType'
  FormActionType ->
  -- | 'name'
  Prelude.Text ->
  -- | 'schemaVersion'
  Prelude.Text ->
  -- | 'style'
  FormStyle ->
  CreateFormData
newCreateFormData :: FormDataTypeConfig
-> FormActionType -> Text -> Text -> FormStyle -> CreateFormData
newCreateFormData
  FormDataTypeConfig
pDataType_
  FormActionType
pFormActionType_
  Text
pName_
  Text
pSchemaVersion_
  FormStyle
pStyle_ =
    CreateFormData'
      { $sel:cta:CreateFormData' :: Maybe FormCTA
cta = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateFormData' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:dataType:CreateFormData' :: FormDataTypeConfig
dataType = FormDataTypeConfig
pDataType_,
        $sel:fields:CreateFormData' :: HashMap Text FieldConfig
fields = forall a. Monoid a => a
Prelude.mempty,
        $sel:formActionType:CreateFormData' :: FormActionType
formActionType = FormActionType
pFormActionType_,
        $sel:name:CreateFormData' :: Text
name = Text
pName_,
        $sel:schemaVersion:CreateFormData' :: Text
schemaVersion = Text
pSchemaVersion_,
        $sel:sectionalElements:CreateFormData' :: HashMap Text SectionalElement
sectionalElements = forall a. Monoid a => a
Prelude.mempty,
        $sel:style:CreateFormData' :: FormStyle
style = FormStyle
pStyle_
      }

-- | The @FormCTA@ object that stores the call to action configuration for
-- the form.
createFormData_cta :: Lens.Lens' CreateFormData (Prelude.Maybe FormCTA)
createFormData_cta :: Lens' CreateFormData (Maybe FormCTA)
createFormData_cta = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFormData' {Maybe FormCTA
cta :: Maybe FormCTA
$sel:cta:CreateFormData' :: CreateFormData -> Maybe FormCTA
cta} -> Maybe FormCTA
cta) (\s :: CreateFormData
s@CreateFormData' {} Maybe FormCTA
a -> CreateFormData
s {$sel:cta:CreateFormData' :: Maybe FormCTA
cta = Maybe FormCTA
a} :: CreateFormData)

-- | One or more key-value pairs to use when tagging the form data.
createFormData_tags :: Lens.Lens' CreateFormData (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createFormData_tags :: Lens' CreateFormData (Maybe (HashMap Text Text))
createFormData_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFormData' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateFormData' :: CreateFormData -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateFormData
s@CreateFormData' {} Maybe (HashMap Text Text)
a -> CreateFormData
s {$sel:tags:CreateFormData' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateFormData) 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 type of data source to use to create the form.
createFormData_dataType :: Lens.Lens' CreateFormData FormDataTypeConfig
createFormData_dataType :: Lens' CreateFormData FormDataTypeConfig
createFormData_dataType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFormData' {FormDataTypeConfig
dataType :: FormDataTypeConfig
$sel:dataType:CreateFormData' :: CreateFormData -> FormDataTypeConfig
dataType} -> FormDataTypeConfig
dataType) (\s :: CreateFormData
s@CreateFormData' {} FormDataTypeConfig
a -> CreateFormData
s {$sel:dataType:CreateFormData' :: FormDataTypeConfig
dataType = FormDataTypeConfig
a} :: CreateFormData)

-- | The configuration information for the form\'s fields.
createFormData_fields :: Lens.Lens' CreateFormData (Prelude.HashMap Prelude.Text FieldConfig)
createFormData_fields :: Lens' CreateFormData (HashMap Text FieldConfig)
createFormData_fields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFormData' {HashMap Text FieldConfig
fields :: HashMap Text FieldConfig
$sel:fields:CreateFormData' :: CreateFormData -> HashMap Text FieldConfig
fields} -> HashMap Text FieldConfig
fields) (\s :: CreateFormData
s@CreateFormData' {} HashMap Text FieldConfig
a -> CreateFormData
s {$sel:fields:CreateFormData' :: HashMap Text FieldConfig
fields = HashMap Text FieldConfig
a} :: CreateFormData) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specifies whether to perform a create or update action on the form.
createFormData_formActionType :: Lens.Lens' CreateFormData FormActionType
createFormData_formActionType :: Lens' CreateFormData FormActionType
createFormData_formActionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFormData' {FormActionType
formActionType :: FormActionType
$sel:formActionType:CreateFormData' :: CreateFormData -> FormActionType
formActionType} -> FormActionType
formActionType) (\s :: CreateFormData
s@CreateFormData' {} FormActionType
a -> CreateFormData
s {$sel:formActionType:CreateFormData' :: FormActionType
formActionType = FormActionType
a} :: CreateFormData)

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

-- | The schema version of the form.
createFormData_schemaVersion :: Lens.Lens' CreateFormData Prelude.Text
createFormData_schemaVersion :: Lens' CreateFormData Text
createFormData_schemaVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFormData' {Text
schemaVersion :: Text
$sel:schemaVersion:CreateFormData' :: CreateFormData -> Text
schemaVersion} -> Text
schemaVersion) (\s :: CreateFormData
s@CreateFormData' {} Text
a -> CreateFormData
s {$sel:schemaVersion:CreateFormData' :: Text
schemaVersion = Text
a} :: CreateFormData)

-- | The configuration information for the visual helper elements for the
-- form. These elements are not associated with any data.
createFormData_sectionalElements :: Lens.Lens' CreateFormData (Prelude.HashMap Prelude.Text SectionalElement)
createFormData_sectionalElements :: Lens' CreateFormData (HashMap Text SectionalElement)
createFormData_sectionalElements = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFormData' {HashMap Text SectionalElement
sectionalElements :: HashMap Text SectionalElement
$sel:sectionalElements:CreateFormData' :: CreateFormData -> HashMap Text SectionalElement
sectionalElements} -> HashMap Text SectionalElement
sectionalElements) (\s :: CreateFormData
s@CreateFormData' {} HashMap Text SectionalElement
a -> CreateFormData
s {$sel:sectionalElements:CreateFormData' :: HashMap Text SectionalElement
sectionalElements = HashMap Text SectionalElement
a} :: CreateFormData) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The configuration for the form\'s style.
createFormData_style :: Lens.Lens' CreateFormData FormStyle
createFormData_style :: Lens' CreateFormData FormStyle
createFormData_style = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFormData' {FormStyle
style :: FormStyle
$sel:style:CreateFormData' :: CreateFormData -> FormStyle
style} -> FormStyle
style) (\s :: CreateFormData
s@CreateFormData' {} FormStyle
a -> CreateFormData
s {$sel:style:CreateFormData' :: FormStyle
style = FormStyle
a} :: CreateFormData)

instance Prelude.Hashable CreateFormData where
  hashWithSalt :: Int -> CreateFormData -> Int
hashWithSalt Int
_salt CreateFormData' {Maybe (HashMap Text Text)
Maybe FormCTA
Text
HashMap Text SectionalElement
HashMap Text FieldConfig
FormActionType
FormDataTypeConfig
FormStyle
style :: FormStyle
sectionalElements :: HashMap Text SectionalElement
schemaVersion :: Text
name :: Text
formActionType :: FormActionType
fields :: HashMap Text FieldConfig
dataType :: FormDataTypeConfig
tags :: Maybe (HashMap Text Text)
cta :: Maybe FormCTA
$sel:style:CreateFormData' :: CreateFormData -> FormStyle
$sel:sectionalElements:CreateFormData' :: CreateFormData -> HashMap Text SectionalElement
$sel:schemaVersion:CreateFormData' :: CreateFormData -> Text
$sel:name:CreateFormData' :: CreateFormData -> Text
$sel:formActionType:CreateFormData' :: CreateFormData -> FormActionType
$sel:fields:CreateFormData' :: CreateFormData -> HashMap Text FieldConfig
$sel:dataType:CreateFormData' :: CreateFormData -> FormDataTypeConfig
$sel:tags:CreateFormData' :: CreateFormData -> Maybe (HashMap Text Text)
$sel:cta:CreateFormData' :: CreateFormData -> Maybe FormCTA
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FormCTA
cta
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FormDataTypeConfig
dataType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text FieldConfig
fields
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FormActionType
formActionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schemaVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text SectionalElement
sectionalElements
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FormStyle
style

instance Prelude.NFData CreateFormData where
  rnf :: CreateFormData -> ()
rnf CreateFormData' {Maybe (HashMap Text Text)
Maybe FormCTA
Text
HashMap Text SectionalElement
HashMap Text FieldConfig
FormActionType
FormDataTypeConfig
FormStyle
style :: FormStyle
sectionalElements :: HashMap Text SectionalElement
schemaVersion :: Text
name :: Text
formActionType :: FormActionType
fields :: HashMap Text FieldConfig
dataType :: FormDataTypeConfig
tags :: Maybe (HashMap Text Text)
cta :: Maybe FormCTA
$sel:style:CreateFormData' :: CreateFormData -> FormStyle
$sel:sectionalElements:CreateFormData' :: CreateFormData -> HashMap Text SectionalElement
$sel:schemaVersion:CreateFormData' :: CreateFormData -> Text
$sel:name:CreateFormData' :: CreateFormData -> Text
$sel:formActionType:CreateFormData' :: CreateFormData -> FormActionType
$sel:fields:CreateFormData' :: CreateFormData -> HashMap Text FieldConfig
$sel:dataType:CreateFormData' :: CreateFormData -> FormDataTypeConfig
$sel:tags:CreateFormData' :: CreateFormData -> Maybe (HashMap Text Text)
$sel:cta:CreateFormData' :: CreateFormData -> Maybe FormCTA
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FormCTA
cta
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FormDataTypeConfig
dataType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text FieldConfig
fields
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FormActionType
formActionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
schemaVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text SectionalElement
sectionalElements
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FormStyle
style

instance Data.ToJSON CreateFormData where
  toJSON :: CreateFormData -> Value
toJSON CreateFormData' {Maybe (HashMap Text Text)
Maybe FormCTA
Text
HashMap Text SectionalElement
HashMap Text FieldConfig
FormActionType
FormDataTypeConfig
FormStyle
style :: FormStyle
sectionalElements :: HashMap Text SectionalElement
schemaVersion :: Text
name :: Text
formActionType :: FormActionType
fields :: HashMap Text FieldConfig
dataType :: FormDataTypeConfig
tags :: Maybe (HashMap Text Text)
cta :: Maybe FormCTA
$sel:style:CreateFormData' :: CreateFormData -> FormStyle
$sel:sectionalElements:CreateFormData' :: CreateFormData -> HashMap Text SectionalElement
$sel:schemaVersion:CreateFormData' :: CreateFormData -> Text
$sel:name:CreateFormData' :: CreateFormData -> Text
$sel:formActionType:CreateFormData' :: CreateFormData -> FormActionType
$sel:fields:CreateFormData' :: CreateFormData -> HashMap Text FieldConfig
$sel:dataType:CreateFormData' :: CreateFormData -> FormDataTypeConfig
$sel:tags:CreateFormData' :: CreateFormData -> Maybe (HashMap Text Text)
$sel:cta:CreateFormData' :: CreateFormData -> Maybe FormCTA
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cta" 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 FormCTA
cta,
            (Key
"tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"dataType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FormDataTypeConfig
dataType),
            forall a. a -> Maybe a
Prelude.Just (Key
"fields" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text FieldConfig
fields),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"formActionType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FormActionType
formActionType),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"schemaVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
schemaVersion),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"sectionalElements" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text SectionalElement
sectionalElements),
            forall a. a -> Maybe a
Prelude.Just (Key
"style" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FormStyle
style)
          ]
      )