Adding error feedbacks when adding a payment

12 files changed, 162 insertions, 45 deletions

diff --git a/src/client/Model/View/Payment/Add.elm b/src/client/Model/View/Payment/Add.elm
new file mode 100644
index 0000000..ff64388
--- /dev/null
+++ b/src/client/Model/View/Payment/Add.elm
@@ -0,0 +1,36 @@
+module Model.View.Payment.Add
+  ( AddPayment
+  , initAddPayment
+  , validateName
+  , validateCost
+  ) where
+
+import Result as Result exposing (Result(..))
+
+import Utils.Validation exposing (..)
+
+type alias AddPayment =
+  { name : String
+  , nameError : Maybe String
+  , cost : String
+  , costError : Maybe String
+  }
+
+initAddPayment : AddPayment
+initAddPayment =
+  { name = ""
+  , nameError = Nothing
+  , cost = ""
+  , costError = Nothing
+  }
+
+validateName : String -> Result String String
+validateName name =
+  name
+    |> validateNonEmpty "The name is required."
+
+validateCost : String -> Result String Int
+validateCost cost =
+  cost
+    |> validateNonEmpty "The cost is required."
+    |> flip Result.andThen (validateNumber "The cost must be a number.")
diff --git a/src/client/Model/View/PaymentView.elm b/src/client/Model/View/PaymentView.elm
index 8de005d..07bd2ec 100644
--- a/src/client/Model/View/PaymentView.elm
+++ b/src/client/Model/View/PaymentView.elm
@@ -4,18 +4,17 @@ module Model.View.PaymentView
   ) where
 
 import Model.Payment exposing (Payments)
+import Model.View.Payment.Add exposing (..)
 
 type alias PaymentView =
   { userName : String
-  , name : String
-  , cost : String
+  , add : AddPayment
   , payments : Payments
   }
 
 initPaymentView : String -> Payments -> PaymentView
 initPaymentView userName payments =
   { userName = userName
-  , name = ""
-  , cost = ""
+  , add = initAddPayment
   , payments = payments
   }
diff --git a/src/client/Native/Reads.js b/src/client/Native/Reads.js
index 52590f9..5785aed 100644
--- a/src/client/Native/Reads.js
+++ b/src/client/Native/Reads.js
@@ -7,18 +7,13 @@ Elm.Native.Reads.make = function(localRuntime) {
     return localRuntime.Native.Reads.values;
   }
 
-  var Result = Elm.Result.make(localRuntime);
-
-  function div(a, b)
-  {
-    return (a/b)|0;
-  }
+  var Maybe = Elm.Maybe.make(localRuntime);
 
   function readInt(str) {
     var number = Number(str);
-    return isNaN(number)
-             ? Result.Err("unable to parse '" + str + "' as a number")
-             : Result.Ok(number);
+    return isNaN(number) || str === ''
+             ? Maybe.Nothing
+             : Maybe.Just(number);
   }
 
   return localRuntime.Native.Reads.values = {
diff --git a/src/client/Reads.elm b/src/client/Reads.elm
index 7bc1bbc..f855802 100644
--- a/src/client/Reads.elm
+++ b/src/client/Reads.elm
@@ -6,5 +6,5 @@ module Reads
 import Native.Reads
 import Result exposing (Result)
 
-readInt : String -> Result String Int
+readInt : String -> Maybe Int
 readInt = Native.Reads.readInt
diff --git a/src/client/Update/Payment.elm b/src/client/Update/Payment.elm
index 136f0f9..2d558fd 100644
--- a/src/client/Update/Payment.elm
+++ b/src/client/Update/Payment.elm
@@ -6,22 +6,22 @@ module Update.Payment
 import Date
 
 import Model exposing (Model)
-import Model.View.PaymentView exposing (..)
 import Model.Payment exposing (..)
+import Model.View.PaymentView exposing (..)
+import Model.View.Payment.Add exposing (..)
+
+import Update.Payment.Add exposing (..)
 
 type PaymentAction =
-  UpdateName String
-  | UpdateCost String
+  UpdateAdd AddPaymentAction
   | UpdatePayments Payments
   | AddPayment String Int
 
 updatePayment : Model -> PaymentAction -> PaymentView -> PaymentView
 updatePayment model action paymentView =
   case action of
-    UpdateName name ->
-      { paymentView | name <- name }
-    UpdateCost cost ->
-      { paymentView | cost <- cost }
+    UpdateAdd addPaymentAction ->
+      { paymentView | add <- updateAddPayment addPaymentAction paymentView.add }
     UpdatePayments payments ->
       { paymentView | payments <- payments }
     AddPayment name cost ->
@@ -33,6 +33,5 @@ updatePayment model action paymentView =
             }
       in  { paymentView
           | payments <- payment :: paymentView.payments
-          , name <- ""
-          , cost <- ""
+          , add <- initAddPayment
           }
diff --git a/src/client/Update/Payment/Add.elm b/src/client/Update/Payment/Add.elm
new file mode 100644
index 0000000..3ccce73
--- /dev/null
+++ b/src/client/Update/Payment/Add.elm
@@ -0,0 +1,24 @@
+module Update.Payment.Add
+  ( AddPaymentAction(..)
+  , updateAddPayment
+  ) where
+
+import Model.View.Payment.Add exposing (AddPayment)
+
+type AddPaymentAction =
+  UpdateName String
+  | UpdateCost String
+  | AddError (Maybe String) (Maybe String)
+
+updateAddPayment : AddPaymentAction -> AddPayment -> AddPayment
+updateAddPayment action addPayment =
+  case action of
+    UpdateName name ->
+      { addPayment | name <- name }
+    UpdateCost cost ->
+      { addPayment | cost <- cost }
+    AddError nameError costError ->
+      { addPayment
+      | nameError <- nameError
+      , costError <- costError
+      }
diff --git a/src/client/Utils/Either.elm b/src/client/Utils/Either.elm
new file mode 100644
index 0000000..10c40e3
--- /dev/null
+++ b/src/client/Utils/Either.elm
@@ -0,0 +1,9 @@
+module Utils.Either
+  ( toMaybeError
+  ) where
+
+toMaybeError : Result a b -> Maybe a
+toMaybeError result =
+  case result of
+    Ok _ -> Nothing
+    Err x -> Just x
diff --git a/src/client/Utils/Maybe.elm b/src/client/Utils/Maybe.elm
new file mode 100644
index 0000000..507d9a4
--- /dev/null
+++ b/src/client/Utils/Maybe.elm
@@ -0,0 +1,9 @@
+module Utils.Maybe
+  ( isJust
+  ) where
+
+isJust : Maybe a -> Bool
+isJust maybe =
+  case maybe of
+    Just _ -> True
+    Nothing -> False
diff --git a/src/client/Utils/Validation.elm b/src/client/Utils/Validation.elm
new file mode 100644
index 0000000..0c1773e
--- /dev/null
+++ b/src/client/Utils/Validation.elm
@@ -0,0 +1,21 @@
+module Utils.Validation
+  ( validateNonEmpty
+  , validateNumber
+  ) where
+
+import String
+import Reads exposing (readInt)
+
+validateNonEmpty : String -> String -> Result String String
+validateNonEmpty message str =
+  if String.isEmpty str
+   then Err message
+   else Ok str
+
+validateNumber : String -> String -> Result String Int
+validateNumber message str =
+  case readInt str of
+    Just number ->
+      Ok number
+    Nothing ->
+      Err message
diff --git a/src/client/View/Payments.elm b/src/client/View/Payments.elm
index dfc0905..7f0c66b 100644
--- a/src/client/View/Payments.elm
+++ b/src/client/View/Payments.elm
@@ -15,6 +15,6 @@ renderPayments : PaymentView -> Html
 renderPayments paymentView =
   div
     [ class "payments" ]
-    [ addPayment paymentView.name paymentView.cost
+    [ addPayment paymentView.add
     , paymentsTable paymentView.payments
     ]
diff --git a/src/client/View/Payments/Add.elm b/src/client/View/Payments/Add.elm
index 9d246ef..d11f208 100644
--- a/src/client/View/Payments/Add.elm
+++ b/src/client/View/Payments/Add.elm
@@ -12,17 +12,24 @@ import ServerCommunication as SC exposing (serverCommunications)
 
 import Update exposing (..)
 import Update.Payment exposing (..)
+import Update.Payment.Add exposing (..)
+
+import Model.View.Payment.Add exposing (..)
 
 import View.Events exposing (onSubmitPrevDefault)
 
-addPayment : String -> String -> Html
-addPayment name cost =
+import Utils.Maybe exposing (isJust)
+import Utils.Either exposing (toMaybeError)
+
+addPayment : AddPayment -> Html
+addPayment addPayment =
   H.form
     [ class "add"
-    , onSubmitPrevDefault serverCommunications.address
-        <| case readInt cost of
-             Ok number -> SC.AddPayment name number
-             Err _ -> SC.NoCommunication
+    , case (validateName addPayment.name, validateCost addPayment.cost) of
+        (Ok name, Ok cost) ->
+          onSubmitPrevDefault serverCommunications.address (SC.AddPayment name cost)
+        (resName, resCost) ->
+          onSubmitPrevDefault actions.address (UpdatePayment <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost))
     ]
     [ div
         [ class "name" ]
@@ -31,10 +38,16 @@ addPayment name cost =
             [ text "Name" ]
         , input
             [ id "nameInput"
-            , value name
-            , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateName)
+            , class (if isJust addPayment.nameError then "error" else "")
+            , value addPayment.name
+            , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateAdd << UpdateName)
             ]
             []
+        , case addPayment.nameError of
+            Just error ->
+              div [ class "errorMessage" ] [ text error ]
+            Nothing ->
+              text ""
         ]
     , div
         [ class "cost" ]
@@ -43,10 +56,16 @@ addPayment name cost =
             [ text "Cost" ]
         , input
             [ id "costInput"
-            , value cost
-            , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateCost)
+            , class (if isJust addPayment.costError then "error" else "")
+            , value addPayment.cost
+            , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateAdd << UpdateCost)
             ]
             []
+        , case addPayment.costError of
+            Just error ->
+              div [ class "errorMessage" ] [ text error ]
+            Nothing ->
+              text ""
         , button
             [ type' "submit" ]
             [ text "Add" ]
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 50cdbc4..ebe7ad7 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -7,6 +7,8 @@ module Design.Global
 import qualified Prelude
 import Prelude
 
+import Data.Monoid ((<>))
+
 import Clay
 
 import Data.Text.Lazy (Text)
@@ -51,30 +53,27 @@ global = do
   ".payments" ? do
     form # ".add" ? do
       let inputHeight = 40
-      width (pct 90)
+      width (pct 60)
       marginLeft auto
       marginRight auto
       marginBottom (px 45)
       clearFix
 
-      ".name" ? do
+      ".name" <> ".cost" ? do
+        position relative
         width (pct 50)
-        float floatLeft
         label ? do
           width (pct 25)
           paddingRight (pct 5)
-        input ? do
-          defaultInput inputHeight
-          width (pct 70)
+        input ? defaultInput inputHeight
+
+      ".name" ? do
+        float floatLeft
+        input ? width (pct 70)
 
       ".cost" ? do
-        width (pct 50)
         float floatRight
-        label ? do
-          width (pct 25)
-          paddingRight (pct 5)
         input ? do
-          defaultInput inputHeight
           width (pct 45)
           marginRight (pct 5)
         button ? do
@@ -82,6 +81,13 @@ global = do
           width (pct 20)
           height (px inputHeight)
 
+      input # ".error" ? borderColor C.red
+      ".errorMessage" ? do
+        position absolute
+        color C.red
+        top (px (inputHeight + 10))
+        left (px 0)
+
     table ? do
       width (pct 100)
       textAlign (alignSide (sideCenter))