Simple multi-page form

multipageform.elm

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
    }