Validation with Result Monad

validation.elm

import Result exposing (..)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)


main =
    Html.beginnerProgram
        { model = model
        , view = view
        , update = update
        }


type alias Model =
    { name : String
    , password : String
    , passwordAgain : String
    }


model : Model
model =
    Model "" "" ""


type Msg
    = Name String
    | Password String
    | PasswordAgain String


update : Msg -> Model -> Model
update msg model =
    case msg of
        Name name ->
            { model | name = name }

        Password password ->
            { model | password = password }

        PasswordAgain password ->
            { model | passwordAgain = password }


view : Model -> Html Msg
view model =
    div []
        [ input [ type_ "text", placeholder "Name", onInput Name ] []
        , input [ type_ "password", placeholder "Password", onInput Password ] []
        , input [ type_ "password", placeholder "Re-enter Password", onInput PasswordAgain ] []
        , viewValidation model
        ]


type alias ValidationResult =
    Result String Model


validateNameLength : Model -> ValidationResult
validateNameLength model =
    let
        nameLength =
            String.length model.name
    in
        if nameLength == 0 then
            Err "Name is too short"
        else if nameLength > 10 then
            Err "Name is too long"
        else
            Ok model


validatePasswordPresence : Model -> ValidationResult
validatePasswordPresence model =
    if String.isEmpty model.password then
        Err "Password is required"
    else
        Ok model


validatePasswordAgain : Model -> ValidationResult
validatePasswordAgain model =
    if model.password /= model.passwordAgain then
        Err "Passwords must be the same"
    else
        Ok model


validateModel : Model -> ValidationResult
validateModel model =
    Ok model
        |> andThen validateNameLength
        |> andThen validatePasswordPresence
        |> andThen validatePasswordAgain


viewValidation : Model -> Html msg
viewValidation model =
    let
        result =
            validateModel model

        ( message, color ) =
            case result of
                Err message ->
                    ( message, "red" )

                Ok model ->
                    ( "OK", "green" )
    in
        div [ style [ ( "color", color ) ] ]
            [ text message ]