Form Validation

Main.elm

module App exposing (..)

import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Validate exposing (..)


-- FIELD


type alias Field e a =
    { value : a
    , errors : List e
    , touched : Bool
    }


initField : a -> Field e a
initField x =
    { value = x
    , errors = []
    , touched = False
    }



-- MODEL


type alias Model =
    { firstName : Field String String
    , lastName : Field String String
    , age : Field String String
    , agree : Field String Bool
    , submissionTried : Bool
    , user : Maybe User
    }


init : ( Model, Cmd Msg )
init =
    ( { firstName = initField ""
      , lastName = initField ""
      , age = initField ""
      , agree = initField False
      , submissionTried = False
      , user = Nothing
      }
    , Cmd.none
    )


type alias User =
    { firstName : String
    , lastName : String
    , age : Int
    }


toUser : Model -> User
toUser { firstName, lastName, age } =
    { firstName = firstName.value
    , lastName = lastName.value
    , age = String.toInt age.value |> Result.withDefault 0
    }


fromUser : User -> Model
fromUser user =
    { firstName = initField user.firstName
    , lastName = initField user.lastName
    , age = initField <| toString user.age
    , agree = initField False
    , submissionTried = False
    , user = Nothing
    }



-- UPDATE


type Msg
    = NoOp
    | UpdateFirstName (FieldMsg String)
    | UpdateLastName (FieldMsg String)
    | UpdateAge (FieldMsg String)
    | UpdateAgree (FieldMsg Bool)
    | Submit


type FieldMsg a
    = Change a
    | Blur


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        NoOp ->
            ( model, Cmd.none )

        UpdateFirstName fieldMsg ->
            ( validateModel { model | firstName = updateField fieldMsg model.firstName }
            , Cmd.none
            )

        UpdateLastName fieldMsg ->
            ( validateModel { model | lastName = updateField fieldMsg model.lastName }
            , Cmd.none
            )

        UpdateAge fieldMsg ->
            ( validateModel { model | age = updateField fieldMsg model.age }
            , Cmd.none
            )

        UpdateAgree fieldMsg ->
            ( validateModel { model | agree = updateField fieldMsg model.agree }
            , Cmd.none
            )

        Submit ->
            let
                validated =
                    validateModel model
            in
                case collectErrors validated of
                    [] ->
                        ( { model | user = Just <| toUser model }
                        , Cmd.none
                        )

                    errors ->
                        ( { validated | submissionTried = True }
                        , Cmd.none
                        )


updateField : FieldMsg a -> Field e a -> Field e a
updateField msg field =
    case msg of
        Change value ->
            { field | value = value }

        Blur ->
            { field | touched = True }


validateModel : Model -> Model
validateModel model =
    { model
        | firstName = validateField model.firstName [ ifBlank "What is your first name?" ]
        , lastName = validateField model.lastName [ ifBlank "What is your last name?" ]
        , age = validateField model.age [ ifBlank "How old are you?", ifNotInt "Please input a number." ]
        , agree = validateField model.agree [ ifInvalid not "Do you agree with our terms and conditions?" ]
    }


validateField : Field e a -> List (Validator e a) -> Field e a
validateField field validators =
    { field | errors = field.value |> Validate.all validators }


collectErrors : Model -> List String
collectErrors { firstName, lastName, age, agree } =
    List.concat
        [ firstName.errors
        , lastName.errors
        , age.errors
        , agree.errors
        ]



-- VIEW


wrapField : String -> Bool -> List String -> Html msg -> Html msg
wrapField labelText showErrors errors control =
    let
        errorsView =
            if showErrors then
                div [ class "help is-danger" ]
                    (List.map text errors |> List.intersperse (br [] []))
            else
                text ""
    in
        div [ class "field" ]
            [ label
                [ class "label" ]
                [ text labelText ]
            , div
                [ class "control" ]
                [ control
                , errorsView
                ]
            ]


shouldShowErrors : Bool -> Field e a -> Bool
shouldShowErrors submitted field =
    (submitted || field.touched) && not (List.isEmpty field.errors)


stringField : String -> String -> (FieldMsg String -> msg) -> Bool -> Field String String -> Html msg
stringField inputType label msg submitted field =
    let
        showErrors =
            shouldShowErrors submitted field
    in
        wrapField label showErrors field.errors <|
            input
                [ classList
                    [ ( "input", True )
                    , ( "is-danger", showErrors )
                    ]
                , type_ inputType
                , value field.value
                , onInput (Change >> msg)
                , onBlur (msg Blur)
                ]
                []


checkboxField : String -> String -> (FieldMsg Bool -> msg) -> Bool -> Field String Bool -> Html msg
checkboxField labelText inputText msg submitted field =
    let
        showErrors =
            shouldShowErrors submitted field
    in
        wrapField labelText showErrors field.errors <|
            label
                [ class "checkbox" ]
                [ input
                    [ type_ "checkbox"
                    , onCheck (Change >> msg)
                    , onBlur (msg Blur)
                    ]
                    []
                , text <| " " ++ inputText
                ]


view : Model -> Html Msg
view model =
    div
        [ class "container" ]
        [ div
            [ class "section" ]
            [ Html.form
                [ onSubmit Submit ]
                [ stringField "text" "First Name" UpdateFirstName model.submissionTried model.firstName
                , stringField "text" "Last Name" UpdateLastName model.submissionTried model.lastName
                , stringField "number" "Age" UpdateAge model.submissionTried model.age
                , checkboxField "Terms and Conditions" "I agree to terms and conditions" UpdateAgree model.submissionTried model.agree
                , input
                    [ type_ "submit"
                    , value "Submit"
                    ]
                    []
                ]
            ]
        , div
            [ class "section" ]
            [ p []
                [ case model.user of
                    Nothing ->
                        text "Editing..."

                    Just user ->
                        text <| "Submitted: " ++ user.firstName ++ " " ++ user.lastName ++ ", " ++ toString user.age ++ "years old"
                ]
            ]
        ]



---- PROGRAM ----


main : Program Never Model Msg
main =
    Html.program
        { view = view
        , init = init
        , update = update
        , subscriptions = \_ -> Sub.none
        }