Simple multi-page form

multipageform.elm

import Html exposing (Html, Attribute)
import Html
import Html.Attributes
import Html.Events exposing (..)
import List
import String
------------------
--- 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



-- 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 FieldMsg
  = SetValue String


-- The update function for fields
updateField : FieldMsg -> Field -> Field
updateField msg field =
  case msg of
    SetValue value ->
      { field | value = value }


-- The view function for fields
viewField : Field -> Html FieldMsg
viewField 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 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 PageMsg
  = FieldSubMsg Int FieldMsg


-- The update function for pages
updatePage : PageMsg -> Page -> Page
updatePage msg page =
  case msg of
    FieldSubMsg n fieldMsg ->
      { page | fields = updateNth n (updateField fieldMsg) page.fields }



-- The view function for pages
viewPage : Page -> Html PageMsg
viewPage page =
  let
      -- Your CSS here
      containerStyle =
          []


      viewN index field =
          Html.map (FieldSubMsg index) (viewField 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 FormMsg
  = NextPage
  | PreviousPage
  | PageSubMsg PageMsg



-- The update function for forms
updateForm : FormMsg -> 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 }

    PageSubMsg pageMsg ->
      { form | pages = updateCurrent (updatePage pageMsg) form.pages }


-- The view function for forms
viewForm : Form -> Html FormMsg
viewForm form =
  let
      -- Your CSS here
      containerStyle =
          []

  in
      Html.div
          []
          [ Html.map PageSubMsg (viewPage form.pages.current)
          , Html.div
                []
                [ Html.button
                      [ onClick PreviousPage ]
                      [ Html.text "Previous" ]
                , Html.button
                      [ onClick 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 =
  Html.beginnerProgram
    {
      model = initial,
      view = viewForm,
      update = updateForm
    }