Skip to content

Instantly share code, notes, and snippets.

@TheSeamau5
Last active October 30, 2020 16:54
Embed
What would you like to do?
Simple multi-page form
import Html exposing (Html, Attribute)
import Html.Attributes
import Html.Events
import Signal exposing (Address)
import List
import String
import StartApp
------------------
--- HELPER CODE --
------------------
-- This is just an infix operator to make CSS look nice
infixl 2 =>
(=>) = (,)
-- Function to update the nth value of a list
updateNth : Int -> (a -> a) -> List a -> List a
updateNth n update list =
List.indexedMap (\index a -> if index == n then update a else a) list
-- Event listener that sends the text inside an input to a given address
-- The constuctor is there in order to be able to send something more than just a string to an address
onInput : Address a -> (String -> a) -> Attribute
onInput address constructor =
Html.Events.on "input" Html.Events.targetValue (constructor >> Signal.message address)
-- Selection List --
-- A selection list is a non-empty list that is aware
-- of the current value selected
type alias SelectionList a =
{ previous : List a
, current : a
, next : List a
}
-- Constructor for a selection list
newSelectionList : a -> List a -> SelectionList a
newSelectionList current next =
{ previous = []
, current = current
, next = next
}
-- Go to the next value in the selection list
forward : SelectionList a -> SelectionList a
forward list =
case list.next of
[] -> list
x :: xs ->
{ previous = list.current :: list.previous
, current = x
, next = xs
}
-- Go to the previous value in the selection list
back : SelectionList a -> SelectionList a
back list =
case list.previous of
[] -> list
x :: xs ->
{ previous = xs
, current = x
, next = list.current :: list.next
}
-- Update current value in selection list
updateCurrent : (a -> a) -> SelectionList a -> SelectionList a
updateCurrent update list =
{ list | current <- update list.current }
-------------------
-------------------
---------------------------------------------------------------------------------------
------------------------------- ACTUAL CODE STARTS HERE -------------------------------
---------------------------------------------------------------------------------------
-----------------------
--- FIELD COMPONENT ---
-----------------------
-- The state of a field
type alias Field =
{ label : String
, value : String
, isRequired : Bool
}
-- Test if a field is considered completed
-- In this case we consider a field complete if it is non-empty
fieldIsCompleted : Field -> Bool
fieldIsCompleted field =
if field.isRequired
then
String.length field.value > 0
else
True
-- Constructor for an optional field
optionalField : String -> Field
optionalField label =
{ label = label
, value = ""
, isRequired = False
}
-- Constructor for a required field
requiredField : String -> Field
requiredField label =
{ label = label
, value = ""
, isRequired = True
}
labelColor : Field -> String
labelColor field =
if not field.isRequired
then "black"
else
if fieldIsCompleted field
then
"green"
else
"red"
-- The actions that can update a field
type FieldAction
= SetValue String
-- The update function for fields
updateField : FieldAction -> Field -> Field
updateField action field =
case action of
SetValue value ->
{ field | value <- value }
-- The view function for fields
viewField : Address FieldAction -> Field -> Html
viewField address field =
let
-- Your CSS here
containerStyle =
[]
labelStyle =
[ "color" => labelColor field ]
in
Html.div
[ Html.Attributes.style containerStyle ]
[ Html.span
[ Html.Attributes.style labelStyle ]
[ Html.text field.label ]
, Html.input
[ onInput address SetValue
, Html.Attributes.value field.value
]
[]
]
----------------------
--- PAGE COMPONENT ---
----------------------
-- The state of a form page
type alias Page =
{ fields : List Field }
-- Test if a page is considered completed
-- by testing if all the fields are considered completed
pageIsCompleted : Page -> Bool
pageIsCompleted page =
List.all fieldIsCompleted page.fields
-- The actions that can update a page
-- A page just dispatches the actions of the individual fields
type PageAction
= FieldSubAction Int FieldAction
-- The update function for pages
updatePage : PageAction -> Page -> Page
updatePage action page =
case action of
FieldSubAction n fieldAction ->
{ page | fields <- updateNth n (updateField fieldAction) page.fields }
-- The view function for pages
viewPage : Address PageAction -> Page -> Html
viewPage address page =
let
-- Your CSS here
containerStyle =
[]
viewN index field =
let
fieldAddress =
Signal.forwardTo address (FieldSubAction index)
in
viewField fieldAddress field
in
Html.div
[]
( List.indexedMap viewN page.fields )
----------------------
--- FORM COMPONENT ---
----------------------
-- The state of the form
type alias Form =
{ pages : SelectionList Page }
-- The actions that can update a form
type FormAction
= NextPage
| PreviousPage
| PageSubAction PageAction
-- The update function for forms
updateForm : FormAction -> Form -> Form
updateForm action form =
case action of
NextPage ->
if pageIsCompleted form.pages.current
then
{ form | pages <- forward form.pages }
else
form
PreviousPage ->
{ form | pages <- back form.pages }
PageSubAction pageAction ->
{ form | pages <- updateCurrent (updatePage pageAction) form.pages }
-- The view function for forms
viewForm : Address FormAction -> Form -> Html
viewForm address form =
let
-- Your CSS here
containerStyle =
[]
pageAddress =
Signal.forwardTo address PageSubAction
in
Html.div
[]
[ viewPage pageAddress form.pages.current
, Html.div
[]
[ Html.button
[ Html.Events.onClick address PreviousPage ]
[ Html.text "Previous" ]
, Html.button
[ Html.Events.onClick address NextPage ]
[ Html.text "Next" ]
]
]
-----------------
--- MAIN AREA ---
-----------------
page0 : Page
page0 =
{ fields =
[ requiredField "First Name"
, requiredField "Last Name"
, optionalField "Age"
]
}
page1 : Page
page1 =
{ fields =
[ optionalField "Favorite Pokemon"
, optionalField "Favorite Superhero"
]
}
page2 : Page
page2 =
{ fields =
[ requiredField "A required Field"
, requiredField "Another requiredField"
]
}
initial : Form
initial =
{ pages = newSelectionList page0 [ page1 , page2 ] }
main =
StartApp.start
{ model = initial
, update = updateForm
, view = viewForm
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment