From 23d12d785b92648251fe420a30b10bdb48e498b3 Mon Sep 17 00:00:00 2001 From: Alexander Simmerl Date: Mon, 16 Jan 2017 15:39:43 +0100 Subject: [PATCH] Rework form handling --- cmd/console/Action.elm | 7 ++- cmd/console/App/Model.elm | 16 ++++- cmd/console/App/View.elm | 6 +- cmd/console/Formo.elm | 110 +++++++++++++++++++++++++++++++++ cmd/console/Model.elm | 9 +-- cmd/console/Update.elm | 24 ++++--- cmd/console/View.elm | 101 ++++++++++++++++++------------ cmd/console/elm-package.json | 1 - cmd/console/styles/console.css | 12 ++++ 9 files changed, 225 insertions(+), 61 deletions(-) create mode 100644 cmd/console/Formo.elm diff --git a/cmd/console/Action.elm b/cmd/console/Action.elm index a17b179..529e16d 100644 --- a/cmd/console/Action.elm +++ b/cmd/console/Action.elm @@ -8,8 +8,10 @@ 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 @@ -17,5 +19,4 @@ type Msg | Navigate Route | NewApp (WebData App) | SelectApp String - | SubmitAppForm | Tick Time diff --git a/cmd/console/App/Model.elm b/cmd/console/App/Model.elm index 8955548..4642795 100644 --- a/cmd/console/App/Model.elm +++ b/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", [] ) + ] diff --git a/cmd/console/App/View.elm b/cmd/console/App/View.elm index 59bf1f0..d4f4ccb 100644 --- a/cmd/console/App/View.elm +++ b/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) diff --git a/cmd/console/Formo.elm b/cmd/console/Formo.elm new file mode 100644 index 0000000..88e4974 --- /dev/null +++ b/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 } diff --git a/cmd/console/Model.elm b/cmd/console/Model.elm index 4a43801..bbdc895 100644 --- a/cmd/console/Model.elm +++ b/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 diff --git a/cmd/console/Update.elm b/cmd/console/Update.elm index 61d4f3d..59828e1 100644 --- a/cmd/console/Update.elm +++ b/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 = diff --git a/cmd/console/View.elm b/cmd/console/View.elm index fcfe03d..0e58138 100644 --- a/cmd/console/View.elm +++ b/cmd/console/View.elm @@ -1,9 +1,10 @@ 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) @@ -11,6 +12,7 @@ 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 diff --git a/cmd/console/elm-package.json b/cmd/console/elm-package.json index 186884a..5d9cefd 100644 --- a/cmd/console/elm-package.json +++ b/cmd/console/elm-package.json @@ -8,7 +8,6 @@ ], "exposed-modules": [], "dependencies": { - "billperegoy/elm-form-validations": "1.0.2 <= v < 2.0.0", "elm-lang/animation-frame": "1.0.1 <= v < 2.0.0", "elm-lang/core": "5.0.0 <= v < 6.0.0", "elm-lang/html": "2.0.0 <= v < 3.0.0", diff --git a/cmd/console/styles/console.css b/cmd/console/styles/console.css index 0227e85..519434c 100644 --- a/cmd/console/styles/console.css +++ b/cmd/console/styles/console.css @@ -42,6 +42,7 @@ div.container { div.debug { border: 0.1rem dashed #c5c5c5; color: #797B74; + font-family: monospace; font-size: 1.6rem; padding: 1.5rem; text-align: center; @@ -63,6 +64,17 @@ footer { margin-top: 10rem; } +form { + display: flex; +} + +form div.form-group { + display: flex; + flex-direction: column; + margin-right: 2rem; + width: 45rem; +} + h1 { font-size: 5.6rem; font-weight: 700;