Elm Form Builder for Hearken

Api.Error.elm

-- support stuff for remote stuff
type alias ErrorMessages =
    Dict.Dict String (List String)


type alias ApiError =
    { message : String
    , errors : ErrorMessages
    , explanation : Maybe String
    }


fieldHasError : String -> Maybe ApiError -> Bool
fieldHasError fieldName =
    Maybe.mapDefault False (.errors >> Dict.member fieldName)


errorMessages : String -> Maybe ApiError -> Maybe (List String)
errorMessages fieldName apiError =
    Maybe.map (.errors >> Dict.get fieldName) apiError
        |> Maybe.join


emptyErrors : ErrorMessages
emptyErrors =
    Dict.empty


errorDecoder : Decoder ApiError
errorDecoder =
    DecodePipeline.decode ApiError
        |> DecodePipeline.required "error" Json.Decode.string
        |> DecodePipeline.optional "errors" (Json.Decode.dict (Json.Decode.list Json.Decode.string)) Dict.empty
        |> DecodePipeline.custom (Json.Decode.maybe ("explanation" := Json.Decode.string))


httpErrorAsApiError : Error ApiError -> ApiError
httpErrorAsApiError httpError =
    case httpError of
        UnexpectedPayload str ->
            { message = "Unexpected Response from Server", errors = emptyErrors, explanation = Nothing }

        NetworkError ->
            { message = "A Network Error Occurred", errors = emptyErrors, explanation = Nothing }

        Timeout ->
            { message = "A Network Timeout Occurred", errors = emptyErrors, explanation = Nothing }

        BadResponse response ->
            response.data

Helpers.Form.elm

module Helpers.Forms exposing (..)

import Api
import Helpers exposing (classes)
import JsInterop
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (on, onInput)
import Markdown exposing (toHtml)
import Maybe.Extra as Maybe
import String
import Json.Decode as Decode exposing (at, string)
import Json.Encode as Encode


type WysiwygEditorStyle
    = RichEditor
    | PlainEditor


type alias WysiwygInputFieldData msg =
    { label : String
    , name : String
    , wide : Bool
    , id : String
    , classes : List String
    , value : String
    , innerHtmlMapper : String -> msg
    , editorStyle : WysiwygEditorStyle
    }


type alias TextInputFieldData msg =
    { label : String
    , name : String
    , wide : Bool
    , id : String
    , classes : List String
    , value : String
    , valueMapper : String -> msg
    }


type InputFieldDefinition msg
    = TextInputField (TextInputFieldData msg)
    | WysiwygInputField (WysiwygInputFieldData msg)


buildForm : Maybe Api.ApiError -> List (InputFieldDefinition msg) -> Html msg
buildForm error fieldDefs =
    let
        inputFieldBuilder error fieldDef =
            case fieldDef of
                TextInputField fieldData ->
                    textInputField error fieldData

                WysiwygInputField fieldData ->
                    wysiwygInputField error fieldData
    in
        div [ class "form-group" ] <|
            [ generalError error ]
                ++ (List.map (inputFieldBuilder error) fieldDefs)


textInputField : Maybe Api.ApiError -> TextInputFieldData msg -> Html msg
textInputField error fieldDef =
    div
        [ classList [ ( "form-item", True ), ( "has-error", Api.fieldHasError fieldDef.name error ) ] ]
        [ div [ classes ("form-label" :: fieldDef.classes) ] [ text fieldDef.label ]
        , input
            [ type' "text"
            , placeholder fieldDef.label
            , class "form-input"
            , value fieldDef.value
            , onInput fieldDef.valueMapper
            ]
            []
        , specificError fieldDef.name fieldDef.label error
        ]


wysiwygInputField : Maybe Api.ApiError -> WysiwygInputFieldData msg -> Html msg
wysiwygInputField error fieldDef =
    let
        editorStyleClass =
            case fieldDef.editorStyle of
                RichEditor ->
                    JsInterop.richWysiwygEditorClass

                PlainEditor ->
                    JsInterop.plainWysiwygEditorClass

        valueView =
            case fieldDef.editorStyle of
                RichEditor ->
                    Markdown.toHtml [] fieldDef.value

                PlainEditor ->
                    text fieldDef.value
    in
        div [ classList [ ( "form-item", True ), ( "wide", fieldDef.wide ), ( "has-error", Api.fieldHasError fieldDef.name error ) ] ]
            [ div [ class "form-label" ]
                [ h4 []
                    [ label []
                        [ text fieldDef.label ]
                    ]
                ]
            , div [ class "form-input" ]
                [ div
                    [ id fieldDef.id
                    , classes <| editorStyleClass :: fieldDef.classes
                    , on "input" <| at [ "target", "innerHTML" ] <| Decode.map fieldDef.innerHtmlMapper string
                    ]
                    [ valueView ]
                ]
            , specificError fieldDef.name fieldDef.label error
            ]


specificError : String -> String -> Maybe Api.ApiError -> Html msg
specificError fieldName fieldLabel apiError =
    case Api.errorMessages fieldName apiError of
        Nothing ->
            text ""

        Just messages ->
            div [] <|
                List.map
                    (\message ->
                        div [ class "error-message" ]
                            [ text (String.join " " [ fieldLabel, message ]) ]
                    )
                    messages


generalError : Maybe Api.ApiError -> Html msg
generalError apiError =
    Maybe.mapDefault (text "")
        (\error ->
            div [ class "error-message general" ]
                [ text error.message
                ]
        )
        apiError