Add prototype for form parser.

src/Pages/Form.elm

@@ -0,0 +1,135 @@
+module Pages.Form exposing (..)
+
+import Dict exposing (Dict)
+import Html exposing (Attribute)
+import Html.Attributes
+import Html.Events
+import Json.Decode as Decode exposing (Decoder)
+import Pages.Msg
+
+
+listeners : String -> List (Attribute (Pages.Msg.Msg userMsg))
+listeners formId =
+    [ Html.Events.on "focusin" (Decode.value |> Decode.map Pages.Msg.FormFieldEvent)
+    , Html.Events.on "focusout" (Decode.value |> Decode.map Pages.Msg.FormFieldEvent)
+    , Html.Events.on "input" (Decode.value |> Decode.map Pages.Msg.FormFieldEvent)
+    , Html.Attributes.id formId
+    ]
+
+
+type Event
+    = InputEvent String
+    | FocusEvent
+      --| ChangeEvent
+    | BlurEvent
+
+
+type alias FieldEvent =
+    { formId : String
+    , name : String
+    , event : Event
+    }
+
+
+fieldEventDecoder : Decoder FieldEvent
+fieldEventDecoder =
+    Decode.map3 FieldEvent
+        (Decode.at [ "currentTarget", "id" ] Decode.string)
+        (Decode.at [ "target", "name" ] Decode.string)
+        fieldDecoder
+
+
+fieldDecoder : Decoder Event
+fieldDecoder =
+    Decode.field "type" Decode.string
+        |> Decode.andThen
+            (\type_ ->
+                case type_ of
+                    "input" ->
+                        Decode.map InputEvent
+                            (Decode.at [ "target", "value" ] Decode.string)
+
+                    "focusin" ->
+                        FocusEvent
+                            |> Decode.succeed
+
+                    "focusout" ->
+                        BlurEvent
+                            |> Decode.succeed
+
+                    _ ->
+                        Decode.fail "Unexpected event.type"
+            )
+
+
+update : Decode.Value -> PageFormState -> PageFormState
+update eventObject pageFormState =
+    --if Dict.isEmpty pageFormState then
+    --    -- TODO get all initial field values
+    --    pageFormState
+    --
+    --else
+    case eventObject |> Decode.decodeValue fieldEventDecoder |> Debug.log "fieldEvent" of
+        Ok fieldEvent ->
+            pageFormState
+                |> Dict.update fieldEvent.formId
+                    (\previousValue_ ->
+                        let
+                            previousValue : FormState
+                            previousValue =
+                                previousValue_
+                                    |> Maybe.withDefault Dict.empty
+                        in
+                        previousValue
+                            |> updateForm fieldEvent
+                            |> Just
+                    )
+
+        Err _ ->
+            pageFormState
+
+
+updateForm : FieldEvent -> FormState -> FormState
+updateForm fieldEvent formState =
+    formState
+        |> Dict.update fieldEvent.name
+            (\previousValue_ ->
+                let
+                    previousValue : FieldState
+                    previousValue =
+                        previousValue_
+                            |> Maybe.withDefault { value = "", status = NotVisited }
+                in
+                (case fieldEvent.event of
+                    InputEvent newValue ->
+                        { previousValue | value = newValue |> Debug.log fieldEvent.name }
+
+                    FocusEvent ->
+                        previousValue
+
+                    BlurEvent ->
+                        previousValue
+                )
+                    |> Just
+            )
+
+
+type alias PageFormState =
+    Dict String FormState
+
+
+type alias FormState =
+    Dict String FieldState
+
+
+type alias FieldState =
+    { value : String
+    , status : FieldStatus
+    }
+
+
+type FieldStatus
+    = NotVisited
+    | Focused
+    | Changed
+    | Blurred

src/Pages/FormParser.elm

@@ -0,0 +1,69 @@
+module Pages.FormParser exposing (..)
+
+import Dict exposing (Dict)
+import Pages.Form as Form
+
+
+type
+    ParseResult error decoded
+    -- TODO parse into both errors AND a decoded value
+    = Success decoded
+    | DecodedWithErrors (Dict String (List error)) decoded
+    | DecodeFailure (Dict String (List error))
+
+
+type Parser error decoded
+    = Parser (Dict String (List error) -> Form.FormState -> ( Maybe decoded, Dict String (List error) ))
+
+
+required : String -> error -> Parser error String
+required name error =
+    (\errors form ->
+        case form |> Dict.get name |> Maybe.map .value of
+            Just "" ->
+                ( Just "", errors |> addError name error )
+
+            Just nonEmptyValue ->
+                ( Just nonEmptyValue, errors )
+
+            Nothing ->
+                ( Just "", errors |> addError name error )
+    )
+        |> Parser
+
+
+map2 : (value1 -> value2 -> combined) -> Parser error value1 -> Parser error value2 -> Parser error combined
+map2 combineFn (Parser parser1) (Parser parser2) =
+    (\errors form ->
+        let
+            ( combined1, allErrors1 ) =
+                parser1 errors form
+
+            ( combined2, allErrors2 ) =
+                parser2 errors form
+        in
+        ( Maybe.map2 combineFn combined1 combined2
+        , Dict.merge (\name errors1 dict -> ( name, errors1 ) :: dict)
+            (\name errors1 errors2 dict -> ( name, errors1 ++ errors2 ) :: dict)
+            (\name errors2 dict -> ( name, errors2 ) :: dict)
+            allErrors1
+            allErrors2
+            []
+            |> Dict.fromList
+        )
+    )
+        |> Parser
+
+
+run : Form.FormState -> Parser error decoded -> ( Maybe decoded, Dict String (List error) )
+run formState (Parser parser) =
+    parser Dict.empty formState
+
+
+addError : String -> error -> Dict String (List error) -> Dict String (List error)
+addError name error allErrors =
+    allErrors
+        |> Dict.update name
+            (\errors ->
+                Just (error :: (errors |> Maybe.withDefault []))
+            )

tests/FormParserTests.elm

@@ -0,0 +1,44 @@
+module FormParserTests exposing (all)
+
+import Dict exposing (Dict)
+import Expect
+import Pages.Form
+import Pages.FormParser as FormParser
+import Test exposing (Test, describe, test)
+
+
+formDecoder : FormParser.Parser String ( String, String )
+formDecoder =
+    FormParser.map2 Tuple.pair
+        (FormParser.required "first" "First is required")
+        (FormParser.required "last" "Last is required")
+
+
+all : Test
+all =
+    describe "Path"
+        [ test "join two segments" <|
+            \() ->
+                FormParser.run
+                    (Dict.fromList
+                        [ ( "first"
+                          , { value = ""
+                            , status = Pages.Form.NotVisited
+                            }
+                          )
+                        , ( "last"
+                          , { value = ""
+                            , status = Pages.Form.NotVisited
+                            }
+                          )
+                        ]
+                    )
+                    formDecoder
+                    |> Expect.equal
+                        ( Just ( "", "" )
+                        , Dict.fromList
+                            [ ( "first", [ "First is required" ] )
+                            , ( "last", [ "Last is required" ] )
+                            ]
+                        )
+        ]