From 4ce4de89a5400b0d8b9cddaa2922901a081fdaaa Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 23 Jun 2016 23:43:23 +0200
Subject: Use a dialog to add a payment

---
 src/client/elm/Dialog.elm                          |  30 ++--
 src/client/elm/LoggedIn/Home/AddPayment/Model.elm  |  29 ----
 src/client/elm/LoggedIn/Home/AddPayment/Msg.elm    |  14 --
 src/client/elm/LoggedIn/Home/AddPayment/Update.elm |  58 --------
 src/client/elm/LoggedIn/Home/AddPayment/View.elm   | 164 ++++++---------------
 src/client/elm/LoggedIn/Home/Model.elm             |  43 ++++--
 src/client/elm/LoggedIn/Home/Msg.elm               |   4 +-
 src/client/elm/LoggedIn/Home/Search/View.elm       |   8 +-
 src/client/elm/LoggedIn/Home/Update.elm            |  14 +-
 src/client/elm/LoggedIn/Home/View.elm              |   4 +-
 src/client/elm/LoggedIn/Income/View.elm            |   3 +-
 src/client/elm/LoggedIn/Msg.elm                    |   2 +-
 src/client/elm/LoggedIn/Update.elm                 |  56 +++----
 src/client/elm/Server.elm                          |   4 +-
 src/client/elm/Update.elm                          |   2 +-
 src/client/elm/View.elm                            |   3 +
 src/client/elm/View/Form.elm                       |  41 ++++--
 src/server/Design/Form.hs                          |  22 ++-
 src/server/Design/LoggedIn/Home/Search.hs          |  12 ++
 src/server/Design/LoggedIn/Home/Table.hs           |  36 ++---
 src/server/Model/Message/Key.hs                    |   7 +-
 src/server/Model/Message/Translations.hs           |  42 ++++--
 22 files changed, 258 insertions(+), 340 deletions(-)
 delete mode 100644 src/client/elm/LoggedIn/Home/AddPayment/Model.elm
 delete mode 100644 src/client/elm/LoggedIn/Home/AddPayment/Msg.elm
 delete mode 100644 src/client/elm/LoggedIn/Home/AddPayment/Update.elm

diff --git a/src/client/elm/Dialog.elm b/src/client/elm/Dialog.elm
index 0fb43db..4b5b4cd 100644
--- a/src/client/elm/Dialog.elm
+++ b/src/client/elm/Dialog.elm
@@ -8,7 +8,7 @@ module Dialog exposing
   )
 
 import Platform.Cmd exposing (Cmd)
-import Task
+import Task exposing (Task)
 
 import Html exposing (..)
 import Html.Attributes exposing (..)
@@ -25,7 +25,7 @@ type alias Config model msg =
   { title : String
   , body : model -> Html msg
   , confirm : String
-  , confirmMsg : msg
+  , confirmMsg : model -> Result msg msg
   , undo : String
   }
 
@@ -39,12 +39,12 @@ init mapMsg =
 
 type Msg model msg =
   NoOp
-  | ConfirmMsg msg
+  | ConfirmMsg (model -> Result msg msg)
   | Open (Config model msg)
   | Close
 
-update : Msg model msg -> Model model msg -> (Model model msg, Cmd msg)
-update msg model =
+update : Msg model msg -> model -> Model model msg -> (Model model msg, Cmd msg)
+update msg baseModel model =
   case msg of
     NoOp ->
       ( model
@@ -52,10 +52,15 @@ update msg model =
       )
 
     ConfirmMsg confirmMsg ->
-      ( { model | config = Nothing }
-      , Task.succeed msg
-          |> Task.perform (always confirmMsg) (always confirmMsg)
-      )
+      case confirmMsg baseModel of
+        Ok msg ->
+          ( { model | config = Nothing }
+          , Task.perform (always msg) (always msg) (Task.succeed NoOp)
+          )
+        Err msg ->
+          ( model
+          , Task.perform (always msg) (always msg) (Task.succeed NoOp)
+          )
 
     Open config ->
       ( { model | config = Just config }
@@ -90,7 +95,7 @@ curtain mapMsg isVisible =
   div
     [ class "curtain"
     , style
-        [ ("position", "absolute")
+        [ ("position", "fixed")
         , ("top", "0")
         , ("left", "0")
         , ("width", "100%")
@@ -109,11 +114,10 @@ dialog model mapMsg { title, body, confirm, confirmMsg, undo } =
   div
     [ class "content"
     , style
-        [ ("min-width", "300px")
-        , ("position", "absolute")
+        [ ("position", "fixed")
         , ("top", "25%")
         , ("left", "50%")
-        , ("transform", "translate(-50%, -50%)")
+        , ("transform", "translate(-50%, -25%)")
         , ("z-index", "1000")
         , ("background-color", "white")
         , ("padding", "20px")
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Model.elm b/src/client/elm/LoggedIn/Home/AddPayment/Model.elm
deleted file mode 100644
index b656077..0000000
--- a/src/client/elm/LoggedIn/Home/AddPayment/Model.elm
+++ /dev/null
@@ -1,29 +0,0 @@
-module LoggedIn.Home.AddPayment.Model exposing
-  ( Model
-  , init
-  )
-
-import Result as Result exposing (Result(..))
-import Json.Decode exposing ((:=))
-
-import Model.Translations exposing (..)
-import Model.Payment exposing (Frequency(..))
-
-type alias Model =
-  { name : String
-  , nameError : Maybe String
-  , cost : String
-  , costError : Maybe String
-  , frequency : Frequency
-  , waitingServer : Bool
-  }
-
-init : Frequency -> Model
-init frequency =
-  { name = ""
-  , nameError = Nothing
-  , cost = ""
-  , costError = Nothing
-  , frequency = frequency
-  , waitingServer = False
-  }
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Msg.elm b/src/client/elm/LoggedIn/Home/AddPayment/Msg.elm
deleted file mode 100644
index 53e6e26..0000000
--- a/src/client/elm/LoggedIn/Home/AddPayment/Msg.elm
+++ /dev/null
@@ -1,14 +0,0 @@
-module LoggedIn.Home.AddPayment.Msg exposing
-  ( Msg(..)
-  )
-
-import Model.Payment exposing (Frequency)
-
-type Msg =
-  NoOp
-  | Init Frequency
-  | UpdateName String
-  | UpdateCost String
-  | AddError (Maybe String) (Maybe String)
-  | ToggleFrequency
-  | WaitingServer
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Update.elm b/src/client/elm/LoggedIn/Home/AddPayment/Update.elm
deleted file mode 100644
index dc1ea57..0000000
--- a/src/client/elm/LoggedIn/Home/AddPayment/Update.elm
+++ /dev/null
@@ -1,58 +0,0 @@
-module LoggedIn.Home.AddPayment.Update exposing
-  ( update
-  , addPaymentError
-  )
-
-import Maybe
-import Json.Decode as Json exposing ((:=))
-
-import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
-import LoggedIn.Home.AddPayment.Model as AddPaymentModel
-
-import Model.Translations exposing (Translations, getMessage)
-import Model.Payment exposing (Frequency(..))
-
-update : AddPaymentMsg.Msg -> AddPaymentModel.Model -> AddPaymentModel.Model
-update msg addPayment =
-  case msg of
-
-    AddPaymentMsg.NoOp ->
-      addPayment
-
-    AddPaymentMsg.Init frequency ->
-      AddPaymentModel.init frequency
-
-    AddPaymentMsg.UpdateName name ->
-      { addPayment | name = name }
-
-    AddPaymentMsg.UpdateCost cost ->
-      { addPayment | cost = cost }
-
-    AddPaymentMsg.AddError nameError costError ->
-      { addPayment
-      | nameError = nameError
-      , costError = costError
-      , waitingServer = False
-      }
-
-    AddPaymentMsg.ToggleFrequency ->
-      { addPayment
-      | frequency = if addPayment.frequency == Punctual then Monthly else Punctual
-      }
-
-    AddPaymentMsg.WaitingServer ->
-      { addPayment | waitingServer = True }
-
-addPaymentError : Translations -> String -> Maybe AddPaymentMsg.Msg
-addPaymentError translations jsonErr =
-  let decoder =
-        Json.object2 (,)
-          (Json.maybe <| "name" := Json.string)
-          (Json.maybe <| "cost" := Json.string)
-  in  case Json.decodeString decoder jsonErr of
-        Err _ ->
-          Nothing
-        Ok (mbNameKey, mbCostKey) ->
-          Just <| AddPaymentMsg.AddError
-            (Maybe.map (flip getMessage translations) mbNameKey)
-            (Maybe.map (flip getMessage translations) mbCostKey)
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/View.elm b/src/client/elm/LoggedIn/Home/AddPayment/View.elm
index b13097b..5ccdb35 100644
--- a/src/client/elm/LoggedIn/Home/AddPayment/View.elm
+++ b/src/client/elm/LoggedIn/Home/AddPayment/View.elm
@@ -2,133 +2,67 @@ module LoggedIn.Home.AddPayment.View exposing
   ( view
   )
 
-import Result exposing (..)
-import Json.Decode as Json
-import Color
-
-import FontAwesome
-
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
+import Html.App as Html
+import Task
 
-import Msg exposing (Msg)
-
-import LoggedIn.Msg as LoggedInMsg
+import Form exposing (Form)
 
-import LoggedIn.Home.Msg as HomeMsg
-import LoggedIn.Home.Model as HomeModel
-
-import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
-import LoggedIn.Home.AddPayment.Model as AddPaymentModel
-
-import Model.Payment exposing (Frequency(..))
-import Model.Translations exposing (getMessage)
-import LoggedData exposing (LoggedData)
+import Dialog
 
+import View.Form as Form
 import View.Events exposing (onSubmitPrevDefault)
 
-import Utils.Maybe exposing (isJust)
-import Utils.Either exposing (toMaybeError)
+import Msg exposing (Msg)
+import LoggedIn.Msg as LoggedInMsg
+import LoggedIn.Home.Msg as HomeMsg
 
-view : LoggedData -> HomeModel.Model -> Html Msg
-view loggedData homeModel =
-  Html.form
-    [ let update =
-            if homeModel.add.waitingServer
-              then
-                Msg.NoOp
-              else
-                Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment homeModel.add.name homeModel.add.cost homeModel.add.frequency
-      in  onSubmitPrevDefault update
-    , class "addPayment"
-    ]
-    [ addPaymentName loggedData homeModel.add
-    , addPaymentCost loggedData homeModel.add
-    , paymentFrequency loggedData homeModel.add
-    , button
-        [ type' "submit"
-        , classList
-            [ ("add", True)
-            , ("waitingServer", homeModel.add.waitingServer)
-            ]
-        ]
-        [ text (getMessage "Add" loggedData.translations)
-        , if homeModel.add.waitingServer
-            then FontAwesome.spinner Color.white 20
-            else text ""
-        ]
-    ]
+import Model.Translations exposing (getMessage)
+import Model.Payment as Payment
+import Model.View exposing (View(LoggedInView))
 
-addPaymentName : LoggedData -> AddPaymentModel.Model -> Html Msg
-addPaymentName loggedData addPayment =
-  div
-    [ classList
-        [ ("name", True)
-        , ("error", isJust addPayment.nameError)
-        ]
-    ]
-    [ input
-        [ id "nameInput"
-        , value addPayment.name
-        , on "input" (targetValue |> (Json.map <| Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdateAdd << AddPaymentMsg.UpdateName))
-        , maxlength 20
-        ]
-        []
-    , label
-        [ for "nameInput" ]
-        [ FontAwesome.shopping_cart Color.white 20 ]
-    , case addPayment.nameError of
-        Just error ->
-          div [ class "errorMessage" ] [ text error ]
-        Nothing ->
-          text ""
-    ]
+import LoggedData exposing (LoggedData)
+import LoggedIn.Home.Model as HomeModel
 
-addPaymentCost : LoggedData -> AddPaymentModel.Model -> Html Msg
-addPaymentCost loggedData addPayment =
-  div
-    [ classList
-        [ ("cost", True)
-        , ("error", isJust addPayment.costError)
-        ]
-    ]
-    [ input
-        [ id "costInput"
-        , value addPayment.cost
-        , on "input" (targetValue |> (Json.map <| Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdateAdd << AddPaymentMsg.UpdateCost))
-        , maxlength 7
+view : LoggedData -> Html Msg
+view loggedData =
+  let dialogConfig =
+        { title = getMessage "AddPayment" loggedData.translations
+        , body = \view -> (
+            case view of
+              LoggedInView loggedIn -> addPaymentForm loggedData loggedIn.home
+              _ -> text ""
+        )
+        , confirm = getMessage "Confirm" loggedData.translations
+        , confirmMsg = \view -> (
+            case view of
+              LoggedInView loggedIn ->
+                case Form.getOutput loggedIn.home.addPayment of
+                  Just data ->
+                    Ok (Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment data.name data.cost data.frequency)
+                  Nothing ->
+                    Err (Msg.UpdateLoggedIn <| LoggedInMsg.HomeMsg <| HomeMsg.AddPaymentMsg <| Form.Submit)
+              _ ->
+                Err (Msg.UpdateLoggedIn LoggedInMsg.NoOp)
+          )
+        , undo = getMessage "Undo" loggedData.translations
+        }
+  in  button
+        [ class "addPayment"
+        , onClick (Msg.Dialog <| Dialog.Open dialogConfig)
         ]
-        []
-    , label
-        [ for "costInput" ]
-        [ text loggedData.conf.currency ]
-    , case addPayment.costError of
-        Just error ->
-          div [ class "errorMessage" ] [ text error ]
-        Nothing ->
-          text ""
-    ]
+        [ text (getMessage "AddPayment" loggedData.translations) ]
 
-paymentFrequency : LoggedData -> AddPaymentModel.Model -> Html Msg
-paymentFrequency loggedData addPayment =
-  button
-    [ type' "button"
-    , class "frequency"
-    , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdateAdd <| AddPaymentMsg.ToggleFrequency)
-    ]
-    [ div
-        [ classList
-            [ ("punctual", True)
-            , ("selected", addPayment.frequency == Punctual)
-            ]
+addPaymentForm : LoggedData -> HomeModel.Model -> Html Msg
+addPaymentForm loggedData { addPayment } =
+  let htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.AddPaymentMsg)
+  in  Html.form
+        [ class "addPayment"
+        , onSubmitPrevDefault Msg.NoOp
         ]
-        [ text (getMessage "Punctual" loggedData.translations) ]
-    , div
-        [ classList
-            [ ("monthly", True)
-            , ("selected", addPayment.frequency == Monthly)
-            ]
+        [ Form.textInput loggedData.translations addPayment htmlMap "name"
+        , Form.textInput loggedData.translations addPayment htmlMap "cost"
+        , Form.radioInputs loggedData.translations addPayment htmlMap "frequency" [ toString Payment.Punctual, toString Payment.Monthly ]
         ]
-        [ text (getMessage "Monthly" loggedData.translations) ]
-    ]
diff --git a/src/client/elm/LoggedIn/Home/Model.elm b/src/client/elm/LoggedIn/Home/Model.elm
index 6b29d8c..e802828 100644
--- a/src/client/elm/LoggedIn/Home/Model.elm
+++ b/src/client/elm/LoggedIn/Home/Model.elm
@@ -2,39 +2,64 @@ module LoggedIn.Home.Model exposing
   ( Model
   , Search
   , init
+  , addPaymentInitial
   )
 
 import Form exposing (Form)
 import Form.Validate as Validate exposing (Validation)
+import Form.Field as Field exposing (Field)
 
 import Model.User exposing (Users, UserId)
 import Model.Payment exposing (PaymentId, Payments, Frequency(..))
 import Model.Payer exposing (Payers)
 
-import LoggedIn.Home.AddPayment.Model as AddPaymentModel
-
 type alias Model =
-  { add : AddPaymentModel.Model
-  , paymentEdition : Maybe PaymentId
+  { paymentEdition : Maybe PaymentId
   , currentPage : Int
   , monthlyDetail : Bool
   , search : Form String Search
+  , addPayment : Form String AddPayment
   }
 
 type alias Search =
   { searchText : Maybe String
   }
 
+type alias AddPayment =
+  { name : String
+  , cost : Int
+  , frequency : Frequency
+  }
+
 init : Model
 init =
-  { add = AddPaymentModel.init Punctual
-  , paymentEdition = Nothing
+  { paymentEdition = Nothing
   , currentPage = 1
   , monthlyDetail = False
-  , search = Form.initial [] validate
+  , search = Form.initial [] searchValidation
+  , addPayment = Form.initial addPaymentInitial addPaymentValidation
   }
 
-validate : Validation String Search
-validate =
+searchValidation : Validation String Search
+searchValidation =
   Validate.form1 Search
     (Validate.get "searchText" (Validate.maybe Validate.string))
+
+addPaymentInitial : List (String, Field)
+addPaymentInitial = [ ("frequency", Field.Radio (toString Punctual)) ]
+
+addPaymentValidation : Validation String AddPayment
+addPaymentValidation =
+  Validate.form3 AddPayment
+    (Validate.get "name" (Validate.string `Validate.andThen` (Validate.nonEmpty)))
+    (Validate.get "cost" (Validate.int `Validate.andThen` (Validate.minInt 1)))
+    (Validate.get "frequency" validateFrequency)
+
+validateFrequency : Validation String Frequency
+validateFrequency =
+  Validate.customValidation Validate.string (\str ->
+    case str of
+      "Punctual" -> Ok Punctual
+      "Monthly" -> Ok Monthly
+      _ -> Err (Validate.customError "InvalidFrequency")
+  )
diff --git a/src/client/elm/LoggedIn/Home/Msg.elm b/src/client/elm/LoggedIn/Home/Msg.elm
index 17a88f8..bb6f77d 100644
--- a/src/client/elm/LoggedIn/Home/Msg.elm
+++ b/src/client/elm/LoggedIn/Home/Msg.elm
@@ -6,13 +6,11 @@ import Form exposing (Form)
 
 import Model.Payment exposing (PaymentId)
 
-import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
-
 type Msg =
   NoOp
-  | UpdateAdd AddPaymentMsg.Msg
   | ToggleEdit PaymentId
   | UpdatePage Int
   | ShowMonthlyDetail
   | ToggleMonthlyDetail
   | SearchMsg Form.Msg
+  | AddPaymentMsg Form.Msg
diff --git a/src/client/elm/LoggedIn/Home/Search/View.elm b/src/client/elm/LoggedIn/Home/Search/View.elm
index f06377d..99eec95 100644
--- a/src/client/elm/LoggedIn/Home/Search/View.elm
+++ b/src/client/elm/LoggedIn/Home/Search/View.elm
@@ -19,6 +19,9 @@ import LoggedIn.Home.Model as HomeModel
 import Model.Translations exposing (getParamMessage)
 import Model.Conf exposing (Conf)
 import Model.Payment exposing (Payments)
+import Model.Translations exposing (getMessage)
+
+import LoggedIn.Home.AddPayment.View as AddPayment
 
 import LoggedIn.View.Format as Format
 import View.Plural exposing (plural)
@@ -29,6 +32,7 @@ view loggedData { search } payments =
     [ class "search" ]
     [ searchForm loggedData search
     , paymentsStat loggedData payments
+    , AddPayment.view loggedData
     ]
 
 searchForm : LoggedData -> Form String HomeModel.Search -> Html Msg
@@ -40,7 +44,9 @@ paymentsStat : LoggedData -> Payments -> Html Msg
 paymentsStat loggedData payments =
   let count = plural loggedData.translations (List.length payments) "Payment" "Payments"
       sum = paymentsSum loggedData.conf payments
-  in  text <| getParamMessage [ count, sum ] "Worth" loggedData.translations
+  in  span
+        [ class "stat" ]
+        [ text <| getParamMessage [ count, sum ] "Worth" loggedData.translations ]
 
 paymentsSum : Conf -> Payments -> String
 paymentsSum conf payments =
diff --git a/src/client/elm/LoggedIn/Home/Update.elm b/src/client/elm/LoggedIn/Home/Update.elm
index af3504a..562cd20 100644
--- a/src/client/elm/LoggedIn/Home/Update.elm
+++ b/src/client/elm/LoggedIn/Home/Update.elm
@@ -9,19 +9,12 @@ import LoggedData exposing (LoggedData)
 import LoggedIn.Home.Msg as HomeMsg
 import LoggedIn.Home.Model as HomeModel
 
-import LoggedIn.Home.AddPayment.Update as AddPaymentUpdate
-
 update : LoggedData -> HomeMsg.Msg -> HomeModel.Model -> (HomeModel.Model, Cmd HomeMsg.Msg)
 update loggedData msg homeModel =
   case msg of
 
     HomeMsg.NoOp -> (homeModel, Cmd.none)
 
-    HomeMsg.UpdateAdd addPaymentMsg ->
-      ( { homeModel | add = AddPaymentUpdate.update addPaymentMsg homeModel.add }
-      , Cmd.none
-      )
-
     HomeMsg.ToggleEdit id ->
       ( { homeModel | paymentEdition = if homeModel.paymentEdition == Just id then Nothing else Just id }
       , Cmd.none
@@ -52,3 +45,10 @@ update loggedData msg homeModel =
         }
       , Cmd.none
       )
+
+    HomeMsg.AddPaymentMsg formMsg ->
+      ( { homeModel
+        | addPayment = Form.update formMsg homeModel.addPayment
+        }
+      , Cmd.none
+      )
diff --git a/src/client/elm/LoggedIn/Home/View.elm b/src/client/elm/LoggedIn/Home/View.elm
index 82ec8a3..8076673 100644
--- a/src/client/elm/LoggedIn/Home/View.elm
+++ b/src/client/elm/LoggedIn/Home/View.elm
@@ -16,7 +16,6 @@ import Model.Payment as Payment
 
 import LoggedIn.Home.Model as LoggedInModel
 import LoggedIn.Home.Search.View as SearchView
-import LoggedIn.Home.AddPayment.View as AddPaymentView
 import LoggedIn.Home.View.Monthly as MonthlyView
 
 import LoggedIn.Home.View.Table exposing (paymentsTable)
@@ -27,9 +26,8 @@ view loggedData loggedIn =
   let punctualPayments = Payment.sortedFiltredPunctual (Form.fieldAsText loggedIn.search "searchText") loggedData.payments
   in  div
         [ class "home" ]
-        [ AddPaymentView.view loggedData loggedIn
+        [ SearchView.view loggedData loggedIn punctualPayments
         , MonthlyView.view loggedData loggedIn
-        , SearchView.view loggedData loggedIn punctualPayments
         , paymentsTable loggedData loggedIn punctualPayments
         , paymentsPaging loggedIn punctualPayments
         ]
diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm
index 7970284..25cb5a6 100644
--- a/src/client/elm/LoggedIn/Income/View.elm
+++ b/src/client/elm/LoggedIn/Income/View.elm
@@ -6,6 +6,7 @@ import Dict
 import Date
 import Time exposing (Time)
 import Color
+import Task
 
 import FontAwesome
 
@@ -114,7 +115,7 @@ incomeView loggedData (incomeId, income) =
             { title = getMessage "ConfirmDelete" loggedData.translations
             , body = always <| text ""
             , confirm = getMessage "Confirm" loggedData.translations
-            , confirmMsg = Msg.UpdateLoggedIn <| LoggedInMsg.DeleteIncome incomeId
+            , confirmMsg = always <| Ok <| Msg.UpdateLoggedIn <| LoggedInMsg.DeleteIncome incomeId
             , undo = getMessage "Undo" loggedData.translations
             }
       in  button
diff --git a/src/client/elm/LoggedIn/Msg.elm b/src/client/elm/LoggedIn/Msg.elm
index 6f6dab0..c09655f 100644
--- a/src/client/elm/LoggedIn/Msg.elm
+++ b/src/client/elm/LoggedIn/Msg.elm
@@ -15,7 +15,7 @@ type Msg =
   | HomeMsg HomeMsg.Msg
   | IncomeMsg IncomeMsg.Msg
 
-  | AddPayment String String Frequency
+  | AddPayment String Int Frequency
   | ValidateAddPayment PaymentId String Int Frequency
 
   | DeletePayment PaymentId
diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm
index 7133786..4fddc2c 100644
--- a/src/client/elm/LoggedIn/Update.elm
+++ b/src/client/elm/LoggedIn/Update.elm
@@ -10,6 +10,8 @@ import Http exposing (Error(..))
 import Date exposing (Date)
 import Platform.Cmd exposing (Cmd)
 
+import Form
+
 import Model exposing (Model)
 import Model.Translations exposing (getMessage)
 import Model.Payment exposing (Payment, Frequency(..), deletePayment)
@@ -22,13 +24,11 @@ import LoggedIn.Model as LoggedInModel
 
 import LoggedIn.Home.Msg as HomeMsg
 import LoggedIn.Home.Update as HomeUpdate
+import LoggedIn.Home.Model as HomeModel
 
 import LoggedIn.Income.Msg as IncomeMsg
 import LoggedIn.Income.Update as IncomeUpdate
 
-import LoggedIn.Home.AddPayment.Msg as AddPaymentMsg
-import LoggedIn.Home.AddPayment.Update as AddPaymentUpdate
-
 import LoggedIn.Income.Model as IncomeModel
 
 import Utils.Tuple as Tuple
@@ -40,7 +40,9 @@ update model msg loggedIn =
   in  case msg of
 
         LoggedInMsg.NoOp ->
-          (loggedIn, Cmd.none)
+          ( loggedIn
+          , Cmd.none
+          )
 
         LoggedInMsg.HomeMsg homeMsg ->
           case HomeUpdate.update loggedData homeMsg loggedIn.home of
@@ -57,37 +59,27 @@ update model msg loggedIn =
               )
 
         LoggedInMsg.AddPayment name cost frequency ->
-          update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd <| AddPaymentMsg.WaitingServer) loggedIn
-            :> \loggedIn ->
-                 Server.addPayment name cost frequency
-                   |> Task.perform
-                        (\err ->
-                          case err of
-                            BadResponse 400 jsonErr ->
-                              case AddPaymentUpdate.addPaymentError model.translations jsonErr of
-                                Just addPaymentMsg -> (LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd addPaymentMsg)
-                                Nothing -> LoggedInMsg.NoOp
-                            _ ->
-                              LoggedInMsg.NoOp
-                        )
-                        (\paymentId ->
-                          case String.toInt cost of
-                            Err _ ->
-                              LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd (AddPaymentMsg.AddError Nothing (Just (getMessage "CostRequired" loggedData.translations)))
-                            Ok costNumber ->
-                              LoggedInMsg.ValidateAddPayment paymentId name costNumber frequency
-                        )
-                   |> \cmd -> (loggedIn, cmd)
+          Server.addPayment name cost frequency
+            |> Task.perform
+                 (\err ->
+                   case err of
+                     BadResponse 400 jsonErr ->
+                       LoggedInMsg.NoOp
+                     _ ->
+                       LoggedInMsg.NoOp
+                 )
+                 (\paymentId -> LoggedInMsg.ValidateAddPayment paymentId name cost frequency)
+            |> \cmd -> (loggedIn, cmd)
 
         LoggedInMsg.ValidateAddPayment paymentId name cost frequency ->
-          update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdateAdd <| AddPaymentMsg.Init frequency) loggedIn
+          update model (LoggedInMsg.HomeMsg <| HomeMsg.AddPaymentMsg (Form.Reset HomeModel.addPaymentInitial)) loggedIn
             :> (\loggedIn ->
-                 case frequency of
-                   Punctual ->
-                     update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdatePage 1) loggedIn
-                   Monthly ->
-                     update model (LoggedInMsg.HomeMsg <| HomeMsg.ShowMonthlyDetail) loggedIn
-               )
+                  case frequency of
+                    Punctual ->
+                      update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdatePage 1) loggedIn
+                    Monthly ->
+                      update model (LoggedInMsg.HomeMsg <| HomeMsg.ShowMonthlyDetail) loggedIn
+                )
             :> (\loggedIn ->
                  let newPayment = Payment paymentId (Date.fromTime model.currentTime) name cost loggedIn.me frequency
                  in  ( { loggedIn | payments = newPayment :: loggedIn.payments }
diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm
index dc47007..f3ed949 100644
--- a/src/client/elm/Server.elm
+++ b/src/client/elm/Server.elm
@@ -28,9 +28,9 @@ signIn email =
   post ("/signIn?email=" ++ email)
     |> Task.map (always ())
 
-addPayment : String -> String -> Frequency -> Task Http.Error PaymentId
+addPayment : String -> Int -> Frequency -> Task Http.Error PaymentId
 addPayment name cost frequency =
-  post ("/payment/add?name=" ++ name ++ "&cost=" ++ cost ++ "&frequency=" ++ (toString frequency))
+  post ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency))
     |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
 
 deletePayment : PaymentId -> Task Http.Error ()
diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm
index db8889f..d3e82de 100644
--- a/src/client/elm/Update.elm
+++ b/src/client/elm/Update.elm
@@ -68,7 +68,7 @@ update msg model =
       )
 
     Dialog dialogMsg ->
-      let (newDialog, command) = Dialog.update dialogMsg model.dialog
+      let (newDialog, command) = Dialog.update dialogMsg model.view model.dialog
       in  ( { model | dialog = newDialog }
           , command
           )
diff --git a/src/client/elm/View.elm b/src/client/elm/View.elm
index f4b0953..4e97472 100644
--- a/src/client/elm/View.elm
+++ b/src/client/elm/View.elm
@@ -4,6 +4,7 @@ module View exposing
 
 import Html exposing (..)
 import Html.App as Html
+import Html.Attributes exposing (..)
 
 import Model exposing (Model)
 import Msg exposing (Msg)
@@ -16,6 +17,8 @@ import View.Header exposing (renderHeader)
 import SignIn.View as SignInView
 import LoggedIn.View as LoggedInView
 
+import Utils.Maybe as Maybe
+
 view : Model -> Html Msg
 view model =
   div
diff --git a/src/client/elm/View/Form.elm b/src/client/elm/View/Form.elm
index a85ba8a..5471e7d 100644
--- a/src/client/elm/View/Form.elm
+++ b/src/client/elm/View/Form.elm
@@ -1,11 +1,12 @@
 module View.Form exposing
   ( textInput
+  , radioInputs
   )
 
 import Html exposing (..)
 import Html.Attributes exposing (..)
 
-import Form exposing (Form)
+import Form exposing (Form, FieldState)
 import Form.Input as Input
 import Form.Error as FormError exposing (Error(..))
 
@@ -40,29 +41,41 @@ textInput translations form htmlMap fieldName =
             Nothing -> text ""
         ]
 
-simpleTextInput : Translations -> Form String a -> (Html Form.Msg -> Html msg) -> String -> Html msg
-simpleTextInput translations form htmlMap fieldName =
-  let field = Form.getFieldAsString fieldName form
+radioInputs : Translations -> Form String a -> (Html Form.Msg -> Html msg) -> String -> List String -> Html msg
+radioInputs translations form htmlMap radioName fieldNames =
+  let field = Form.getFieldAsString radioName form
   in  div
         [ classList
-            [ ("textInput", True)
+            [ ("radioGroup", True)
             , ("error", isJust field.liveError)
             ]
         ]
-        [ htmlMap <|
-            Input.textInput
-              field
-              [ id fieldName
-              , classList [ ("filled", isJust field.value) ]
-              ]
-        , label
-            [ for fieldName ]
-            [ text (Translations.getMessage fieldName translations) ]
+        [ div
+            [ class "title" ]
+            [ text (Translations.getMessage radioName translations) ]
+        , div
+            [ class "radioElems" ]
+            (List.map (radioInput translations field htmlMap) fieldNames)
         , case field.liveError of
             Just error -> formError translations error
             Nothing -> text ""
         ]
 
+radioInput : Translations -> FieldState String String -> (Html Form.Msg -> Html msg) -> String -> Html msg
+radioInput translations field htmlMap fieldName =
+  label
+    [ for fieldName ]
+    [ htmlMap <|
+        Input.radioInput
+          field.path
+          field
+          [ id fieldName
+          , value fieldName
+          , checked (field.value == Just fieldName)
+          ]
+    , text (Translations.getMessage fieldName translations)
+    ]
+
 formError : Translations -> FormError.Error String -> Html msg
 formError translations error =
   let errorElement error params =
diff --git a/src/server/Design/Form.hs b/src/server/Design/Form.hs
index 2ad6a9c..4bd1ad6 100644
--- a/src/server/Design/Form.hs
+++ b/src/server/Design/Form.hs
@@ -19,7 +19,7 @@ design = do
 
   ".textInput" ? do
     position relative
-    marginBottom (em 1)
+    marginBottom (em 1.5)
     paddingTop (px inputTop)
     marginTop (px (-10))
 
@@ -57,3 +57,23 @@ design = do
         position absolute
         color Color.chestnutRose
         fontSize (pct 80)
+
+  ".radioGroup" ? do
+    position relative
+    marginBottom (em 2)
+
+    ".title" ? do
+      color Color.silver
+      marginBottom (em 0.8)
+
+    ".radioElems" ? do
+      display flex
+      "justify-content" -: "space-around"
+
+      label ? do
+        marginBottom (px 5)
+        display block
+        cursor pointer
+        input ? do
+          margin (px 0) (px 8) (px (-1)) (px 0)
+          cursor pointer
diff --git a/src/server/Design/LoggedIn/Home/Search.hs b/src/server/Design/LoggedIn/Home/Search.hs
index 1bc91ef..726b4cf 100644
--- a/src/server/Design/LoggedIn/Home/Search.hs
+++ b/src/server/Design/LoggedIn/Home/Search.hs
@@ -8,6 +8,10 @@ import Clay
 
 import Design.Constants
 
+import qualified Design.Helper as Helper
+import qualified Design.Color as Color
+import qualified Design.Constants as Constants
+
 design :: Css
 design = do
   marginBottom blockMarginBottom
@@ -17,3 +21,11 @@ design = do
   ".textInput" ? do
     display inlineBlock
     marginRight (px 30)
+    marginBottom (px 0)
+
+  ".stat" ? do
+    lineHeight (pct 100)
+
+  ".addPayment" ? do
+    Helper.defaultButton Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
+    float floatRight
diff --git a/src/server/Design/LoggedIn/Home/Table.hs b/src/server/Design/LoggedIn/Home/Table.hs
index b68f48f..538bc6d 100644
--- a/src/server/Design/LoggedIn/Home/Table.hs
+++ b/src/server/Design/LoggedIn/Home/Table.hs
@@ -33,32 +33,20 @@ design = do
   ".row" ? do
     fontSize (px 18)
     height (px rowHeightPx)
+    ".cell:first-child::before" ? do
+      display block
+      content (stringContent "")
+      position absolute
+      top (px 0)
+      left (px 0)
+      width (px 0)
+      height (px rowHeightPx)
+      backgroundColor Color.mossGreen
+      transition "width" (sec 0.3) ease (sec 0)
+      opacity (0.8)
 
     hover & do
-      let (borderW, triangleW, triangleH) = (4, 6, 8)
-      ".cell:first-child::before" ? do
-        display block
-        content (stringContent "")
-        position absolute
-        top (px 0)
-        left (px 0)
-
-        width (px borderW)
-        height (px rowHeightPx)
-        backgroundColor Color.mossGreen
-
-      ".cell:first-child::after" ? do
-        display block
-        content (stringContent "")
-        position absolute
-        top (px (rowHeightPx `Prelude.div` 2 - triangleH))
-        left (px borderW)
-
-        width (px 0)
-        height (px 0)
-        borderTop solid (px triangleH) transparent
-        borderBottom solid (px triangleH) transparent
-        borderLeft solid (px triangleW) Color.mossGreen
+      ".cell:first-child::before" ? width (px 5)
 
     nthChild "odd" & do
       backgroundColor Color.wildSand
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 1653ea7..c87a2c1 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -54,10 +54,15 @@ data Key =
 
   -- Payments
 
-  | Add
+  | Name
+  | Cost
+  | Frequency
+  | InvalidFrequency
+  | AddPayment
   | PaymentNotDeleted
   | Punctual
   | Monthly
+
   | SingularMonthlyCount
   | PluralMonthlyCount
   | PaymentsTitle
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 8a640d1..f4087a4 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -200,10 +200,30 @@ m l CostRequired =
 
 -- Payments
 
-m l Add =
+m l Name =
   case l of
-    English -> "Add"
-    French  -> "Ajouter"
+    English -> "Name"
+    French  -> "Nom"
+
+m l Cost =
+  case l of
+    English -> "Cost"
+    French  -> "Coût"
+
+m l Frequency =
+  case l of
+    English -> "Frequency"
+    French  -> "Fréquence"
+
+m l InvalidFrequency =
+  case l of
+    English -> "Invalid frequency"
+    French  -> "Fréquence invalide"
+
+m l AddPayment =
+  case l of
+    English -> "Add a payment"
+    French  -> "Ajouter un paiement"
 
 m l PaymentNotDeleted =
   case l of
@@ -213,12 +233,12 @@ m l PaymentNotDeleted =
 m l Punctual =
   case l of
     English -> "Punctual"
-    French  -> "Ponctuel"
+    French  -> "Ponctuelle"
 
 m l Monthly =
   case l of
     English -> "Monthly"
-    French  -> "Mensuel"
+    French  -> "Mensuelle"
 
 m l SingularMonthlyCount =
   case l of
@@ -227,7 +247,7 @@ m l SingularMonthlyCount =
 
 m l PluralMonthlyCount =
   case l of
-    English -> "{1} monthly payments totalling {2}"
+    English -> "{1} monthly payments worth {2}"
     French  -> "{1} paiements mensuels comptabilisant {2}"
 
 m l PaymentsTitle =
@@ -253,7 +273,7 @@ m l SearchText =
 m l Worth =
   case l of
     English -> "{1} worth {2}"
-    French  -> "{1} valant {2}"
+    French  -> "{1} comptabilisant {2}"
 
 -- Statistics
 
@@ -348,13 +368,13 @@ m l InvalidInt =
 
 m l SmallerIntThan =
   case l of
-    English -> "Integer bigger than {1} required"
-    French  -> "Entier supérieur à {1} requis"
+    English -> "Integer bigger than {1} or equal required"
+    French  -> "Entier supérieur ou égal à {1} requis"
 
 m l GreaterIntThan =
   case l of
-    English -> "Integer smaller than {1} required"
-    French  -> "Entier inférieur à {1} requis"
+    English -> "Integer smaller than {1} or equal required"
+    French  -> "Entier inférieur ou égal à {1} requis"
 
 -- Dialog
 
-- 
cgit v1.2.3