Rework form handling

cmd/console/Action.elm

@@ -8,14 +8,15 @@ import App.Model exposing (App)
 import Route exposing (Route)
 
 type Msg
-    = AppDescription String
-    | AppName String
+    = AppFormBlur String
+    | AppFormFocus String
+    | AppFormSubmit
+    | AppFormUpdate String String
     | FetchApp (WebData App)
     | FetchApps (WebData (List App))
     | ListApps
     | LocationChange Location
     | Navigate Route
     | NewApp (WebData App)
     | SelectApp String
-    | SubmitAppForm
     | Tick Time

cmd/console/App/Model.elm

@@ -1,9 +1,11 @@
-module App.Model exposing (App, decode, decodeList, encode)
+module App.Model exposing (App, decode, decodeList, encode, initAppForm)
 
 import Http
 import Json.Decode as Decode
 import Json.Encode as Encode
 
+import Formo exposing (Form, initForm)
+
 -- MODEL
 
 
@@ -17,6 +19,8 @@ type alias App =
     }
 
 
+-- DECODERS
+
 decode : Decode.Decoder App
 decode =
     Decode.map6 App
@@ -41,3 +45,13 @@ encode name description =
         ]
         |> Http.jsonBody
 
+
+-- FORM
+
+
+initAppForm : Form
+initAppForm =
+    initForm
+        [ ( "description", [] )
+        , ( "name", [] )
+        ]

cmd/console/App/View.elm

@@ -1,8 +1,8 @@
 module App.View exposing (viewAppItem, viewAppsContext, viewAppsTable)
 
-import Html exposing (Html, a, h2, nav, section, span, table, tbody, td, th, thead, tr, text)
-import Html.Attributes exposing (class, id, title)
-import Html.Events exposing (onClick)
+import Html exposing (Html, a, div, h2, input, nav, section, small, span, table, tbody, td, th, thead, tr, text)
+import Html.Attributes exposing (class, id, placeholder, title, type_, value)
+import Html.Events exposing (onClick, onInput)
 import RemoteData exposing (RemoteData(Success), WebData)
 
 import App.Model exposing (App)

cmd/console/Formo.elm

@@ -0,0 +1,110 @@
+module Formo exposing (..)
+
+import Dict exposing (Dict)
+
+
+-- MODEL
+
+
+type alias Element =
+    { errors : List ValidationError
+    , focused : Bool
+    , validators : List ElementValidator
+    , value : String
+    }
+
+
+type alias Elements =
+    Dict String Element
+
+
+type alias ElementValidator =
+    String -> ValidationError
+
+
+type alias Form =
+    { elements : Elements
+    }
+
+
+type alias ValidationError =
+    Maybe String
+
+
+initForm : List ( String, List ElementValidator ) -> Form
+initForm fields =
+    let
+        elements =
+            List.foldl
+                (\e -> Dict.insert (Tuple.first e) (initElement e))
+                Dict.empty
+                fields
+    in
+        Form elements
+
+
+initElement : ( String, List ElementValidator ) -> Element
+initElement ( _, validators ) =
+    Element [] False validators ""
+
+
+blurElement : Form -> String -> Form
+blurElement form name =
+    case Dict.get name form.elements of
+        Nothing ->
+            form
+
+        Just element ->
+            let
+                elements =
+                    Dict.insert
+                        name
+                        { element | focused = False }
+                        form.elements
+            in
+                { form | elements = elements }
+
+elementError : Form -> String -> String
+elementError form name =
+    ""
+
+elementValue : Form -> String -> String
+elementValue form name =
+    case Dict.get name form.elements of
+        Nothing ->
+            ""
+
+        Just element ->
+            element.value
+
+focusElement : Form -> String -> Form
+focusElement form name =
+    case Dict.get name form.elements of
+        Nothing ->
+            form
+
+        Just element ->
+            let
+                elements =
+                    Dict.insert
+                        name
+                        { element | focused = True }
+                        form.elements
+            in
+                { form | elements = elements }
+
+updateElementValue : Form -> String -> String -> Form
+updateElementValue form name value =
+    case Dict.get name form.elements of
+        Nothing ->
+            form
+
+        Just element ->
+            let
+                elements =
+                    Dict.insert
+                        name
+                        { element | value = value }
+                        form.elements
+            in
+                { form | elements = elements }

cmd/console/Model.elm

@@ -6,7 +6,8 @@ import Time exposing (Time)
 
 import Action exposing (..)
 import App.Api exposing (getApp, getApps)
-import App.Model exposing (App)
+import App.Model exposing (App, initAppForm)
+import Formo exposing (Form)
 import Route exposing (Route, parse)
 
 type alias Flags =
@@ -16,8 +17,8 @@ type alias Flags =
 type alias Model =
     { app : WebData App
     , apps : WebData (List App)
-    , appDescription : String
-    , appName : String
+    , appForm : Form
+    , focus : String
     , newApp : WebData App
     , route : Maybe Route
     , startTime : Time
@@ -44,4 +45,4 @@ init { zone } location =
 
 initModel : String -> Maybe Route -> WebData App -> WebData (List App) -> Model
 initModel zone route app apps =
-    Model app apps "" "" NotAsked route 0 0 zone
+    Model app apps initAppForm "" NotAsked route 0 0 zone

cmd/console/Update.elm

@@ -1,19 +1,28 @@
 module Update exposing (update)
-import Model exposing (Flags, Model, init)
+
 import RemoteData exposing (RemoteData(Loading, NotAsked), WebData)
 
 import Action exposing (Msg(..))
+import Formo exposing (blurElement, elementValue, focusElement, updateElementValue)
+import Model exposing (Flags, Model, init)
 import App.Api exposing (createApp)
+import App.Model exposing (initAppForm)
 import Route
 
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
-        AppDescription description ->
-            ( { model | appDescription = description }, Cmd.none )
+        AppFormBlur field ->
+            ( { model | appForm = blurElement model.appForm field }, Cmd.none )
 
-        AppName name ->
-            ( { model | appName = name }, Cmd.none )
+        AppFormFocus field ->
+            ( { model | appForm = focusElement model.appForm field }, Cmd.none )
+
+        AppFormSubmit ->
+            ( { model | newApp = Loading }, Cmd.map NewApp (createApp (elementValue model.appForm "name") (elementValue model.appForm "description") ) )
+
+        AppFormUpdate field value ->
+            ( { model | appForm = updateElementValue model.appForm field value }, Cmd.none )
 
         FetchApp response ->
             ( { model | app = response }, Cmd.none )
@@ -31,14 +40,11 @@ update msg model =
             ( model, Cmd.map LocationChange (Route.navigate route) )
 
         NewApp response ->
-            ( { model | apps = (appendWebData model.apps response), newApp = NotAsked }, Cmd.none )
+            ( { model | appForm = initAppForm, apps = (appendWebData model.apps response), newApp = NotAsked }, Cmd.none )
 
         SelectApp id ->
             ( model, Cmd.map LocationChange (Route.navigate (Route.App id)) )
 
-        SubmitAppForm ->
-            ( { model | newApp = Loading }, Cmd.map NewApp (createApp model.appName model.appDescription) )
-
         Tick time ->
             let
                 startTime =

cmd/console/View.elm

@@ -1,16 +1,18 @@
 module View exposing (view)
 
+import Char
 import Color exposing (rgb)
 import Html exposing (..)
 import Html.Attributes exposing (class, href, id, placeholder, title, type_, value)
-import Html.Events exposing (onClick, onInput, onSubmit)
+import Html.Events exposing (onClick, onFocus, onInput, onSubmit)
 import RemoteData exposing (RemoteData(Failure, Loading, NotAsked, Success), WebData)
 import Time exposing (Time)
 
 import Action exposing (..)
 import App.Model exposing (App)
 import App.View exposing (viewAppItem, viewAppsContext, viewAppsTable)
 import Container
+import Formo exposing (Form, elementError, elementValue)
 import Loader
 import Model exposing (Model)
 import Route
@@ -63,7 +65,7 @@ pageApp {app, startTime, time} =
             ]
 
 pageApps : Model -> Html Msg
-pageApps {app, apps, appDescription, appName, newApp, startTime, time} =
+pageApps {app, apps, appForm, newApp, startTime, time} =
     let
         viewItem =
             (\app -> viewAppItem (SelectApp app.id) app)
@@ -85,11 +87,11 @@ pageApps {app, apps, appDescription, appName, newApp, startTime, time} =
                 Success apps ->
                     if List.length apps == 0 then
                         [ h3 [] [ text "Looks like you haven't created an App yet." ]
-                        , viewAppForm newApp appName appDescription startTime time
+                        , formApp newApp appForm startTime time
                         ]
                     else
                         [ viewAppsTable viewItem apps
-                        , viewAppForm newApp appName appDescription startTime time
+                        , formApp newApp appForm startTime time
                         ]
     in
         div []
@@ -122,42 +124,6 @@ pageNotFound =
         [ h3 [] [ text "Looks like we couldn't find the page you were looking for." ]
         ]
 
-viewAppForm : WebData App -> String -> String -> Time -> Time -> Html Msg
-viewAppForm new name description startTime time =
-    let
-        createForm =
-            form [ onSubmit SubmitAppForm ]
-                [ input
-                    [ onInput AppName
-                    , placeholder "Name"
-                    , type_ "text"
-                    , value name
-                    ]
-                    []
-                , input
-                    [ class "description"
-                    , onInput AppDescription
-                    , placeholder "Description"
-                    , type_ "text"
-                    , value description
-                    ]
-                    []
-                , button [ type_ "submit" ] [ text "Create" ]
-                ]
-    in
-        case new of
-            NotAsked ->
-                createForm
-
-            Loading ->
-                Loader.view 48 (rgb 63 91 96) (Loader.nextStep startTime time)
-
-            Failure err ->
-                text ("Failed: " ++ toString err)
-
-            Success _ ->
-                createForm
-
 viewDebug : Model -> Html Msg
 viewDebug model =
     div [ class "debug" ]
@@ -183,3 +149,58 @@ viewFooter model =
     Container.view (footer [])
         [ viewDebug model
         ]
+
+
+-- FORM
+
+
+formApp : WebData App -> Form -> Time -> Time -> Html Msg
+formApp new appForm startTime time =
+    let
+        createForm =
+            form [ onSubmit AppFormSubmit ]
+                [ formElementText (AppFormFocus "name") (AppFormUpdate "name") appForm "name"
+                , formElementText (AppFormFocus "description") (AppFormUpdate "description") appForm "description"
+                , button [ type_ "submit" ] [ text "Create" ]
+                ]
+    in
+        case new of
+            NotAsked ->
+                createForm
+
+            Loading ->
+                Loader.view 48 (rgb 63 91 96) (Loader.nextStep startTime time)
+
+            Failure err ->
+                text ("Failed: " ++ toString err)
+
+            Success _ ->
+                createForm
+
+formElementText : Msg -> (String -> Msg) -> Form -> String -> Html Msg
+formElementText focusMsg inputMsg form field =
+    div [ class "form-group" ]
+        [ input
+            [ class field
+            , onFocus focusMsg
+            , onInput inputMsg
+            , placeholder (capitalise field)
+            , type_ "text"
+            , value (elementValue form field)
+            ]
+            []
+        , span []
+            [ text (elementError form field) ]
+        ]
+
+
+-- HELPER
+
+capitalise : String -> String
+capitalise s =
+    case String.uncons s of
+        Nothing ->
+            ""
+
+        Just (head, tail) ->
+            String.cons (Char.toUpper head) tail