From 6a0c5087f716ed6c876a666db6573491bfd3e094 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 12 Jun 2016 23:54:17 +0200
Subject: Design income form

---
 src/client/elm/LoggedIn/Home/View/Paging.elm |  8 ++--
 src/client/elm/LoggedIn/Income/Model.elm     | 24 +++++-----
 src/client/elm/LoggedIn/Income/View.elm      | 66 +++++++++++-----------------
 src/client/elm/LoggedIn/Msg.elm              |  6 +--
 src/client/elm/LoggedIn/Update.elm           | 10 ++---
 src/client/elm/LoggedIn/View/Date.elm        |  4 +-
 src/client/elm/Model/Income.elm              | 24 +++++-----
 src/client/elm/Model/Payer.elm               |  4 +-
 src/client/elm/Model/Payment.elm             |  6 +--
 src/client/elm/Model/Translations.elm        |  2 +-
 src/client/elm/Server.elm                    | 20 ++++++---
 src/client/elm/Utils/Date.elm                | 39 ----------------
 src/client/elm/Utils/Http.elm                | 14 +++---
 src/client/elm/View/Color.elm                |  8 ++++
 src/client/elm/View/Form.elm                 | 53 ++++++++++++++++++++++
 src/server/Controller/Income.hs              |  8 ++--
 src/server/Design/Color.hs                   |  3 ++
 src/server/Design/Form.hs                    | 62 ++++++++++++++++++++++++++
 src/server/Design/Global.hs                  |  2 +
 src/server/Design/Helper.hs                  |  1 +
 src/server/Design/LoggedIn/Home/Add.hs       |  3 +-
 src/server/Design/LoggedIn/Income.hs         | 18 +++++++-
 src/server/Main.hs                           |  6 +--
 src/server/Model/Database.hs                 |  4 +-
 src/server/Model/Income.hs                   | 12 ++---
 src/server/Model/Json/AddIncome.hs           | 17 +++++++
 src/server/Model/Json/Income.hs              |  5 +--
 src/server/Model/Message/Key.hs              | 12 ++++-
 src/server/Model/Message/Translations.hs     | 47 +++++++++++++++-----
 29 files changed, 323 insertions(+), 165 deletions(-)
 delete mode 100644 src/client/elm/Utils/Date.elm
 create mode 100644 src/client/elm/View/Color.elm
 create mode 100644 src/client/elm/View/Form.elm
 create mode 100644 src/server/Design/Form.hs
 create mode 100644 src/server/Model/Json/AddIncome.hs

(limited to 'src')

diff --git a/src/client/elm/LoggedIn/Home/View/Paging.elm b/src/client/elm/LoggedIn/Home/View/Paging.elm
index 9166d23..fb78810 100644
--- a/src/client/elm/LoggedIn/Home/View/Paging.elm
+++ b/src/client/elm/LoggedIn/Home/View/Paging.elm
@@ -60,7 +60,7 @@ firstPage homeModel =
         ]
     , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| 1)
     ]
-    [ FontAwesome.fast_backward grey 20 ]
+    [ FontAwesome.fast_backward grey 15 ]
 
 previousPage : HomeModel.Model -> Html Msg
 previousPage homeModel =
@@ -71,7 +71,7 @@ previousPage homeModel =
           then (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| homeModel.currentPage - 1)
           else Msg.NoOp
     ]
-    [ FontAwesome.backward grey 20 ]
+    [ FontAwesome.backward grey 15 ]
 
 nextPage : HomeModel.Model -> Int -> Html Msg
 nextPage homeModel maxPage =
@@ -82,7 +82,7 @@ nextPage homeModel maxPage =
           then (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| homeModel.currentPage + 1)
           else Msg.NoOp
     ]
-    [ FontAwesome.forward grey 20 ]
+    [ FontAwesome.forward grey 15 ]
 
 lastPage : HomeModel.Model -> Int -> Html Msg
 lastPage homeModel maxPage =
@@ -90,7 +90,7 @@ lastPage homeModel maxPage =
     [ class "page"
     , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage <| maxPage)
     ]
-    [ FontAwesome.fast_forward grey 20 ]
+    [ FontAwesome.fast_forward grey 15 ]
 
 paymentsPage : HomeModel.Model -> Int -> Html Msg
 paymentsPage homeModel page =
diff --git a/src/client/elm/LoggedIn/Income/Model.elm b/src/client/elm/LoggedIn/Income/Model.elm
index bc09f0e..873eaf1 100644
--- a/src/client/elm/LoggedIn/Income/Model.elm
+++ b/src/client/elm/LoggedIn/Income/Model.elm
@@ -5,20 +5,20 @@ module LoggedIn.Income.Model exposing
   )
 
 import String exposing (toInt, split)
-import Date exposing (Date)
+import Date
+import Time exposing (Time)
 import Date.Extra.Create exposing (dateFromFields)
-import Utils.Date exposing (numToMonth)
+import Date.Extra.Core exposing (intToMonth)
 
 import Form exposing (Form)
 import Form.Validate as Validate exposing (..)
-import Form.Error exposing (Error(InvalidString))
 
 type alias Model =
-  { addIncome : Form () AddIncome
+  { addIncome : Form String AddIncome
   }
 
 type alias AddIncome =
-  { creation : Date
+  { time : Time
   , amount : Int
   }
 
@@ -27,20 +27,20 @@ init =
   { addIncome = Form.initial [] validate
   }
 
-validate : Validation () AddIncome
+validate : Validation String AddIncome
 validate =
   form2 AddIncome
-    (get "creation" dateValidation)
+    (get "creation" timeValidation)
     (get "amount" (int `andThen` (minInt 1)))
 
-dateValidation : Validation () Date
-dateValidation =
+timeValidation : Validation String Time
+timeValidation =
   customValidation string (\str ->
     case split "/" str of
       [day, month, year] ->
         case (toInt day, toInt month, toInt year) of
           (Ok dayNum, Ok monthNum, Ok yearNum) ->
-            Ok (dateFromFields yearNum (numToMonth monthNum) dayNum 0 0 0 0)
-          _ -> Err InvalidString
-      _ -> Err InvalidString
+            Ok (Date.toTime (dateFromFields yearNum (intToMonth monthNum) dayNum 0 0 0 0))
+          _ -> Err (customError "InvalidDate")
+      _ -> Err (customError "InvalidDate")
   )
diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm
index 036cd80..d5863ab 100644
--- a/src/client/elm/LoggedIn/Income/View.elm
+++ b/src/client/elm/LoggedIn/Income/View.elm
@@ -5,13 +5,15 @@ module LoggedIn.Income.View exposing
 import Dict
 import Date
 import Time exposing (Time)
+import Color
+
+import FontAwesome
 
-import Html.App as Html
 import Html exposing (..)
 import Html.Events exposing (..)
 import Html.Attributes exposing (..)
+import Html.App as Html
 import Form exposing (Form)
-import Form.Input as Input
 
 import Msg exposing (Msg)
 
@@ -29,10 +31,10 @@ import LoggedIn.Income.Msg as IncomeMsg
 import LoggedIn.View.Date exposing (renderShortDate)
 import LoggedIn.View.Format as Format
 
-import Utils.Maybe exposing (isJust)
-
 import LoggedIn.View.Date exposing (renderLongDate)
 import View.Events exposing (onSubmitPrevDefault)
+import View.Form as Form
+import View.Color as Color
 
 view : LoggedData -> IncomeModel.Model -> Html Msg
 view loggedData incomeModel =
@@ -41,9 +43,8 @@ view loggedData incomeModel =
     [ case useIncomesFrom loggedData.users loggedData.incomes loggedData.payments of
         Just since -> cumulativeIncomesView loggedData since
         Nothing -> text ""
-    , h1 [] [ text <| getMessage "AddIncome" loggedData.translations ]
-    , addIncomeView loggedData incomeModel.addIncome
     , h1 [] [ text <| getMessage "MonthlyNetIncomes" loggedData.translations ]
+    , addIncomeView loggedData incomeModel.addIncome
     , incomesView loggedData
     ]
 
@@ -71,45 +72,31 @@ cumulativeIncomesView loggedData since =
             )
         ]
 
-addIncomeView : LoggedData -> Form () IncomeModel.AddIncome -> Html Msg
+addIncomeView : LoggedData -> Form String IncomeModel.AddIncome -> Html Msg
 addIncomeView loggedData addIncome =
-  let
-    errorFor error field =
-      if isJust field.liveError
-        then div [ class "error" ] [ text (getMessage error loggedData.translations) ]
-        else text ""
-    creation = Form.getFieldAsString "creation" addIncome
-    amount = Form.getFieldAsString "amount" addIncome
-    htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.IncomeMsg << IncomeMsg.AddIncomeMsg)
-  in
-    Html.form
-      [ onSubmitPrevDefault Msg.NoOp ]
-      [ label [] [ text (getMessage "Creation" loggedData.translations) ]
-      , htmlMap <| Input.textInput creation []
-      , errorFor "DateValidationError" creation
-
-      , label [] [ text (getMessage "Amount" loggedData.translations) ]
-      , htmlMap <| Input.textInput amount []
-      , errorFor "IncomeValidationError" amount
-
-      , button
-          [ case Form.getOutput addIncome of
-              Just data ->
-                onClick (Msg.UpdateLoggedIn <| LoggedInMsg.AddIncome data.creation data.amount)
-              Nothing ->
-                onClick (Msg.UpdateLoggedIn <| LoggedInMsg.IncomeMsg <| IncomeMsg.AddIncomeMsg <| Form.Submit)
-          ]
-          [ text (getMessage "Add" loggedData.translations) ]
-      ]
+  let htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.IncomeMsg << IncomeMsg.AddIncomeMsg)
+  in  Html.form
+        [ onSubmitPrevDefault Msg.NoOp ]
+        [ Form.textInput loggedData.translations addIncome htmlMap "creation"
+        , Form.textInput loggedData.translations addIncome htmlMap "amount"
+        , button
+            [ case Form.getOutput addIncome of
+                Just data ->
+                  onClick (Msg.UpdateLoggedIn <| LoggedInMsg.AddIncome data.time data.amount)
+                Nothing ->
+                  onClick (Msg.UpdateLoggedIn <| LoggedInMsg.IncomeMsg <| IncomeMsg.AddIncomeMsg <| Form.Submit)
+            ]
+            [ text (getMessage "Add" loggedData.translations) ]
+        ]
 
 incomesView : LoggedData -> Html Msg
 incomesView loggedData =
   ul
-    []
+    [ class "incomes" ]
     ( loggedData.incomes
         |> Dict.toList
         |> List.filter ((==) loggedData.me << .userId << snd)
-        |> List.sortBy (.creation << snd)
+        |> List.sortBy (.time << snd)
         |> List.reverse
         |> List.map (incomeView loggedData)
     )
@@ -118,11 +105,10 @@ incomeView : LoggedData -> (IncomeId, Income) -> Html Msg
 incomeView loggedData (incomeId, income) =
   li
     []
-    [ text <| renderShortDate (Date.fromTime income.creation) loggedData.translations
+    [ text <| renderShortDate (Date.fromTime income.time) loggedData.translations
     , text "    −    "
     , text <| Format.price loggedData.conf income.amount
-    , text "    −    "
     , button
         [ onClick (Msg.UpdateLoggedIn <| LoggedInMsg.DeleteIncome incomeId) ]
-        [ text "x" ]
+        [ FontAwesome.remove Color.chestnutRose 14 ]
     ]
diff --git a/src/client/elm/LoggedIn/Msg.elm b/src/client/elm/LoggedIn/Msg.elm
index b83d486..6f6dab0 100644
--- a/src/client/elm/LoggedIn/Msg.elm
+++ b/src/client/elm/LoggedIn/Msg.elm
@@ -2,7 +2,7 @@ module LoggedIn.Msg exposing
   ( Msg(..)
   )
 
-import Date exposing (Date)
+import Time exposing (Time)
 
 import Model.Payment exposing (Payment, PaymentId, Frequency)
 import Model.Income exposing (IncomeId)
@@ -21,8 +21,8 @@ type Msg =
   | DeletePayment PaymentId
   | ValidateDeletePayment PaymentId
 
-  | AddIncome Date Int
-  | ValidateAddIncome IncomeId Date Int
+  | AddIncome Time Int
+  | ValidateAddIncome IncomeId Time Int
 
   | DeleteIncome IncomeId
   | ValidateDeleteIncome IncomeId
diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm
index 564d6fc..6d8869a 100644
--- a/src/client/elm/LoggedIn/Update.elm
+++ b/src/client/elm/LoggedIn/Update.elm
@@ -106,16 +106,16 @@ update model action loggedIn =
           , Cmd.none
           )
 
-        LoggedInMsg.AddIncome creation amount ->
+        LoggedInMsg.AddIncome time amount ->
           ( loggedIn
-          , Server.addIncome creation amount
+          , Server.addIncome time amount
               |> Task.perform
                    (always LoggedInMsg.NoOp)
-                   (\incomeId -> (LoggedInMsg.ValidateAddIncome incomeId creation amount))
+                   (\incomeId -> (LoggedInMsg.ValidateAddIncome incomeId time amount))
           )
 
-        LoggedInMsg.ValidateAddIncome incomeId creation amount ->
-          let newIncome = { userId = loggedIn.me, creation = (Date.toTime creation), amount = amount }
+        LoggedInMsg.ValidateAddIncome incomeId time amount ->
+          let newIncome = { userId = loggedIn.me, time = time, amount = amount }
           in  ( { loggedIn | incomes = Dict.insert incomeId newIncome loggedIn.incomes }
               , Cmd.none
               )
diff --git a/src/client/elm/LoggedIn/View/Date.elm b/src/client/elm/LoggedIn/View/Date.elm
index 783f10c..8e4e872 100644
--- a/src/client/elm/LoggedIn/View/Date.elm
+++ b/src/client/elm/LoggedIn/View/Date.elm
@@ -5,7 +5,7 @@ module LoggedIn.View.Date exposing
   )
 
 import Date exposing (..)
-import Utils.Date exposing (monthToNum)
+import Date.Extra.Core as Date
 import String
 
 import Model.Translations exposing (..)
@@ -14,7 +14,7 @@ renderShortDate : Date -> Translations -> String
 renderShortDate date translations =
   let params =
         [ String.pad 2 '0' (toString (Date.day date))
-        , String.pad 2 '0' (toString (monthToNum (Date.month date)))
+        , String.pad 2 '0' (toString (Date.monthToInt (Date.month date)))
         , toString (Date.year date)
         ]
   in  getParamMessage params "ShortDate" translations
diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm
index c0039e9..7eaa77f 100644
--- a/src/client/elm/Model/Income.elm
+++ b/src/client/elm/Model/Income.elm
@@ -25,7 +25,7 @@ type alias IncomeId = Int
 
 type alias Income =
   { userId : UserId
-  , creation : Time
+  , time : Float
   , amount : Int
   }
 
@@ -45,15 +45,15 @@ incomeDecoder : Json.Decoder Income
 incomeDecoder =
   Json.object3 Income
     ("userId" := userIdDecoder)
-    ("creation" := timeDecoder)
+    ("day" := timeDecoder)
     ("amount" := Json.int)
 
 incomeDefinedForAll : List UserId -> Incomes -> Maybe Time
 incomeDefinedForAll userIds incomes =
   let userIncomes = List.map (\userId -> List.filter ((==) userId << .userId) << Dict.values <| incomes) userIds
-      firstIncomes = map (head << sortBy .creation) userIncomes
+      firstIncomes = map (head << sortBy .time) userIncomes
   in  if all isJust firstIncomes
-        then head << reverse << List.sort << map .creation << catMaybes <| firstIncomes
+        then head << reverse << List.sort << map .time << catMaybes <| firstIncomes
         else Nothing
 
 userCumulativeIncomeSince : Time -> Time -> Incomes -> UserId -> Int
@@ -70,26 +70,26 @@ cumulativeIncomesSince currentTime since incomes =
 getOrderedIncomesSince : Time -> List Income -> List Income
 getOrderedIncomesSince time incomes =
   let mbStarterIncome = getIncomeAt time incomes
-      orderedIncomesSince = filter (\income -> income.creation >= time) incomes
+      orderedIncomesSince = filter (\income -> income.time >= time) incomes
   in  (maybeToList mbStarterIncome) ++ orderedIncomesSince
 
 getIncomeAt : Time -> List Income -> Maybe Income
 getIncomeAt time incomes =
   case incomes of
     [x] ->
-      if x.creation < time
-        then Just { userId = x.userId, creation = time, amount = x.amount }
+      if x.time < time
+        then Just { userId = x.userId, time = time, amount = x.amount }
         else Nothing
     x1 :: x2 :: xs ->
-      if x1.creation < time && x2.creation > time
-        then Just { userId = x2.userId, creation = time, amount = x2.amount }
+      if x1.time < time && x2.time > time
+        then Just { userId = x2.userId, time = time, amount = x2.amount }
         else getIncomeAt time (x2 :: xs)
     [] ->
       Nothing
 
 cumulativeIncome : Time -> List Income -> Int
 cumulativeIncome currentTime incomes =
-  getIncomesWithDuration currentTime (List.sortBy .creation incomes)
+  getIncomesWithDuration currentTime (List.sortBy .time incomes)
     |> map durationIncome
     |> sum
 
@@ -99,9 +99,9 @@ getIncomesWithDuration currentTime incomes =
     [] ->
       []
     [income] ->
-      [(currentTime - income.creation, income.amount)]
+      [(currentTime - income.time, income.amount)]
     (income1 :: income2 :: xs) ->
-      (income2.creation - income1.creation, income1.amount) :: (getIncomesWithDuration currentTime (income2 :: xs))
+      (income2.time - income1.time, income1.amount) :: (getIncomesWithDuration currentTime (income2 :: xs))
 
 durationIncome : (Float, Int) -> Int
 durationIncome (duration, income) =
diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm
index 2c067bc..fb9940a 100644
--- a/src/client/elm/Model/Payer.elm
+++ b/src/client/elm/Model/Payer.elm
@@ -74,8 +74,8 @@ useIncomesFrom users incomes payments =
           |> List.map (Date.toTime << .creation)
           |> List.sort
           |> List.head
-      incomesForAllTime = incomeDefinedForAll (Dict.keys users) incomes
-  in  case (firstPaymentTime, incomesForAllTime) of
+      mbIncomeTime = incomeDefinedForAll (Dict.keys users) incomes
+  in  case (firstPaymentTime, mbIncomeTime) of
         (Just paymentTime, Just incomeTime) ->
           Just (max paymentTime incomeTime)
         _ ->
diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm
index d9a5d68..7a6c630 100644
--- a/src/client/elm/Model/Payment.elm
+++ b/src/client/elm/Model/Payment.elm
@@ -15,6 +15,7 @@ module Model.Payment exposing
   )
 
 import Date exposing (..)
+import Date.Extra.Core exposing (monthToInt, intToMonth)
 import Json.Decode as Json exposing ((:=))
 import String
 
@@ -22,7 +23,6 @@ import Model.User exposing (UserId, userIdDecoder)
 import Model.Date exposing (dateDecoder)
 
 import Utils.List as List
-import Utils.Date as Date
 
 perPage : Int
 perPage = 8
@@ -91,9 +91,9 @@ monthly userId = List.filter (\p -> p.frequency == Monthly && p.userId == userId
 groupAndSortByMonth : Payments -> List ((Month, Int), Payments)
 groupAndSortByMonth payments =
   payments
-    |> List.groupBy (\payment -> (Date.year payment.creation, Date.monthToNum << Date.month <| payment.creation))
+    |> List.groupBy (\payment -> (Date.year payment.creation, monthToInt << Date.month <| payment.creation))
     |> List.sortBy fst
-    |> List.map (\((year, month), payments) -> ((Date.numToMonth month, year), payments))
+    |> List.map (\((year, month), payments) -> ((intToMonth month, year), payments))
     |> List.reverse
 
 sortedFiltredPunctual : String -> Payments -> Payments
diff --git a/src/client/elm/Model/Translations.elm b/src/client/elm/Model/Translations.elm
index 705cb66..9499dde 100644
--- a/src/client/elm/Model/Translations.elm
+++ b/src/client/elm/Model/Translations.elm
@@ -23,7 +23,7 @@ type alias Translation =
 getTranslation : String -> Translations -> Maybe (List MessagePart)
 getTranslation key translations =
   translations
-    |> List.filter (\translation -> translation.key == key)
+    |> List.filter (\translation -> String.toLower translation.key == String.toLower key)
     |> List.head
     |> Maybe.map .message
 
diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm
index d56bc48..dc47007 100644
--- a/src/client/elm/Server.elm
+++ b/src/client/elm/Server.elm
@@ -9,8 +9,12 @@ module Server exposing
 
 import Task as Task exposing (Task)
 import Http
-import Json.Decode as Json exposing ((:=))
-import Date exposing (Date)
+import Date
+import Json.Decode exposing ((:=))
+import Json.Encode as Json
+import Time exposing (Time)
+
+import Date.Extra.Format as DateFormat
 
 import Utils.Http exposing (..)
 
@@ -34,9 +38,15 @@ deletePayment paymentId =
   delete ("/payment?id=" ++ (toString paymentId))
     |> Task.map (always ())
 
-addIncome : Date -> Int -> Task Http.Error IncomeId
-addIncome creation amount =
-  post ("/income?creation=" ++ (toString << Date.toTime <| creation) ++ "&amount=" ++ (toString amount))
+addIncome : Time -> Int -> Task Http.Error IncomeId
+addIncome time amount =
+  Json.object
+    [ ("day", Json.string (DateFormat.isoDateString (Date.fromTime time)))
+    , ("amount", Json.int amount)
+    ]
+    |> Json.encode 0
+    |> Http.string
+    |> postWithBody "/income"
     |> flip Task.andThen (decodeHttpValue <| "id" := incomeIdDecoder)
 
 deleteIncome : IncomeId -> Task Http.Error ()
diff --git a/src/client/elm/Utils/Date.elm b/src/client/elm/Utils/Date.elm
deleted file mode 100644
index 352e4ce..0000000
--- a/src/client/elm/Utils/Date.elm
+++ /dev/null
@@ -1,39 +0,0 @@
-module Utils.Date exposing
-  ( monthToNum
-  , numToMonth
-  )
-
-import Date exposing (..)
-
-monthToNum : Month -> Int
-monthToNum month =
-  case month of
-    Jan -> 1
-    Feb -> 2
-    Mar -> 3
-    Apr -> 4
-    May -> 5
-    Jun -> 6
-    Jul -> 7
-    Aug -> 8
-    Sep -> 9
-    Oct -> 10
-    Nov -> 11
-    Dec -> 12
-
-numToMonth : Int -> Month
-numToMonth n =
-  case n of
-    1  -> Jan
-    2  -> Feb
-    3  -> Mar
-    4  -> Apr
-    5  -> May
-    6  -> Jun
-    7  -> Jul
-    8  -> Aug
-    9  -> Sep
-    10 -> Oct
-    11 -> Nov
-    12 -> Dec
-    _ -> Jan
diff --git a/src/client/elm/Utils/Http.elm b/src/client/elm/Utils/Http.elm
index 97db053..9bcfad7 100644
--- a/src/client/elm/Utils/Http.elm
+++ b/src/client/elm/Utils/Http.elm
@@ -1,5 +1,6 @@
 module Utils.Http exposing
   ( post
+  , postWithBody
   , delete
   , decodeHttpValue
   , errorKey
@@ -10,17 +11,20 @@ import Task exposing (..)
 import Json.Decode as Json exposing (Decoder)
 
 post : String -> Task Error Value
-post = request "POST"
+post url = postWithBody url empty
+
+postWithBody : String -> Body -> Task Error Value
+postWithBody = request "POST"
 
 delete : String -> Task Error Value
-delete = request "DELETE"
+delete url = request "DELETE" url empty
 
-request : String -> String -> Task Error Value
-request method url =
+request : String -> String -> Body -> Task Error Value
+request method url body =
   { verb = method
   , headers = []
   , url = url
-  , body = empty
+  , body = body
   }
     |> Http.send defaultSettings
     |> mapError promoteError
diff --git a/src/client/elm/View/Color.elm b/src/client/elm/View/Color.elm
new file mode 100644
index 0000000..882dd69
--- /dev/null
+++ b/src/client/elm/View/Color.elm
@@ -0,0 +1,8 @@
+module View.Color exposing
+  ( chestnutRose
+  )
+
+import Color exposing (Color)
+
+chestnutRose : Color
+chestnutRose = Color.rgb 207 92 86
diff --git a/src/client/elm/View/Form.elm b/src/client/elm/View/Form.elm
new file mode 100644
index 0000000..fd21a2c
--- /dev/null
+++ b/src/client/elm/View/Form.elm
@@ -0,0 +1,53 @@
+module View.Form exposing
+  ( textInput
+  )
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+
+import Form exposing (Form)
+import Form.Input as Input
+import Form.Error as FormError exposing (Error(..))
+
+import Msg exposing (Msg)
+
+import LoggedData exposing (LoggedData)
+
+import Model.Translations as Translations exposing (Translations)
+
+import Utils.Maybe exposing (isJust)
+
+textInput : Translations -> Form String a -> (Html Form.Msg -> Html msg) -> String -> Html msg
+textInput translations form htmlMap fieldName =
+  let field = Form.getFieldAsString fieldName form
+  in  div
+        [ classList
+            [ ("textInput", True)
+            , ("error", isJust field.liveError)
+            ]
+        ]
+        [ htmlMap <|
+            Input.textInput
+              field
+              [ id fieldName
+              , classList [ ("filled", isJust field.value) ]
+              ]
+        , label
+            [ for fieldName ]
+            [ text (Translations.getMessage fieldName translations) ]
+        , case field.liveError of
+            Just error -> errorElement translations error
+            Nothing -> text ""
+        ]
+
+errorElement : Translations -> FormError.Error String -> Html msg
+errorElement translations error =
+  case error of
+    CustomError key ->
+      div [ class "errorMessage" ] [ text (Translations.getMessage key translations) ]
+    SmallerIntThan n ->
+      div [ class "errorMessage" ] [ text (Translations.getParamMessage [toString n] "SmallerIntThan" translations) ]
+    GreaterIntThan n ->
+      div [ class "errorMessage" ] [ text (Translations.getParamMessage [toString n] "GreaterIntThan" translations) ]
+    error ->
+      div [ class "errorMessage" ] [ text (Translations.getMessage (toString error) translations) ]
diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs
index 4474d51..70e40ce 100644
--- a/src/server/Controller/Income.hs
+++ b/src/server/Controller/Income.hs
@@ -16,7 +16,6 @@ import Database.Persist
 
 import Data.Text (Text)
 import qualified Data.Text.Lazy as TL
-import Data.Time.Clock (UTCTime)
 
 import qualified Secure
 
@@ -25,6 +24,7 @@ import Json (jsonId)
 import Model.Database
 import qualified Model.Income as Income
 import qualified Model.Message.Key as Key
+import qualified Model.Json.AddIncome as Json
 
 getIncomes :: ActionM ()
 getIncomes =
@@ -32,10 +32,10 @@ getIncomes =
     (liftIO $ map Income.getJsonIncome <$> runDb Income.getIncomes) >>= json
   )
 
-addIncome :: UTCTime -> Int -> ActionM ()
-addIncome creation amount =
+addIncome :: Json.AddIncome -> ActionM ()
+addIncome (Json.AddIncome date amount) =
   Secure.loggedAction (\user ->
-    (liftIO . runDb $ Income.addIncome (entityKey user) creation amount) >>= jsonId
+    (liftIO . runDb $ Income.addIncome (entityKey user) date amount) >>= jsonId
   )
 
 deleteOwnIncome :: Text -> ActionM ()
diff --git a/src/server/Design/Color.hs b/src/server/Design/Color.hs
index 7520e4e..afc601f 100644
--- a/src/server/Design/Color.hs
+++ b/src/server/Design/Color.hs
@@ -10,6 +10,9 @@ white = C.white
 chestnutRose :: C.Color
 chestnutRose = C.rgb 207 92 86
 
+unknown :: C.Color
+unknown = C.rgb 86 92 207
+
 mossGreen :: C.Color
 mossGreen = C.rgb 159 210 165
 
diff --git a/src/server/Design/Form.hs b/src/server/Design/Form.hs
new file mode 100644
index 0000000..bb7d7db
--- /dev/null
+++ b/src/server/Design/Form.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Design.Form
+  ( design
+  ) where
+
+import Data.Monoid ((<>))
+
+import Clay
+
+-- import Design.Constants
+import Design.Color as Color
+-- import qualified Design.Media as Media
+
+
+design :: Css
+design = do
+
+  let inputHeight = 30
+  let inputTop = 22
+  let inputPaddingBottom = 3
+
+  ".textInput" ? do
+    position relative
+    marginBottom (em 1)
+    paddingTop (px inputTop)
+    marginTop (px (-10))
+
+    input ? do
+      position relative
+      zIndex 1
+      backgroundColor transparent
+      paddingBottom (px inputPaddingBottom)
+      borderStyle none
+      borderBottom solid (px 1) Color.dustyGray
+      marginBottom (px 5)
+      height (px inputHeight)
+      lineHeight (px inputHeight)
+      focus & do
+        borderWidth (px 2)
+        paddingBottom (px $ inputPaddingBottom - 1)
+
+    label ? do
+      lineHeight (px inputHeight)
+      position absolute
+      top (px inputTop)
+      left (px 0)
+      color Color.silver
+      transition "all" (sec 0.2) easeIn (sec 0)
+
+    (input # ".filled" |+ label) <> (input # focus |+ label) ? do
+      top (px 0)
+      fontSize (pct 80)
+
+    ".error" & do
+      input ? do
+        borderBottomColor Color.chestnutRose
+
+      ".errorMessage" ? do
+        position absolute
+        color Color.chestnutRose
+        fontSize (pct 80)
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 900994a..864add0 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -11,6 +11,7 @@ import Data.Text.Lazy (Text)
 import qualified Design.Header as HeaderDesign
 import qualified Design.SignIn as SignInDesign
 import qualified Design.LoggedIn as LoggedInDesign
+import qualified Design.Form as Form
 
 import Design.Animation.Keyframes
 
@@ -25,6 +26,7 @@ global = do
   header ? HeaderDesign.design
   ".signIn" ? SignInDesign.design
   ".loggedIn" ? LoggedInDesign.design
+  form ? Form.design
 
   allKeyframes
 
diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs
index 766fbdb..deb0aab 100644
--- a/src/server/Design/Helper.hs
+++ b/src/server/Design/Helper.hs
@@ -30,6 +30,7 @@ clearFix =
 defaultButton :: Color -> Color -> Size a -> (Color -> Color) -> Css
 defaultButton backgroundCol textCol h focusOp = do
   backgroundColor backgroundCol
+  padding (px 0) (px 10) (px 0) (px 10)
   color textCol
   borderRadius radius radius radius radius
   verticalAlign middle
diff --git a/src/server/Design/LoggedIn/Home/Add.hs b/src/server/Design/LoggedIn/Home/Add.hs
index f4e001f..6856af9 100644
--- a/src/server/Design/LoggedIn/Home/Add.hs
+++ b/src/server/Design/LoggedIn/Home/Add.hs
@@ -40,7 +40,8 @@ design = do
       defaultInput inputHeight
       borderRadius radius (px 0) (px 0) radius
       "width" -: "calc(100% - 40px)"
-    "input:focus + label" ? backgroundColor Color.silver
+    input # focus |+ label ?
+      backgroundColor Color.silver
     hover & do
       input ? borderColor Color.silver
       label ? backgroundColor Color.silver
diff --git a/src/server/Design/LoggedIn/Income.hs b/src/server/Design/LoggedIn/Income.hs
index 99626ba..bebd136 100644
--- a/src/server/Design/LoggedIn/Income.hs
+++ b/src/server/Design/LoggedIn/Income.hs
@@ -6,8 +6,24 @@ module Design.LoggedIn.Income
 
 import Clay
 
+import qualified Design.Helper as Helper
+import qualified Design.Constants as Constants
+import qualified Design.Color as Color
+
 design :: Css
 design = do
+
   h1 ? paddingBottom (px 0)
+
   form ? do
-    "margin-bottom" -: "3vh"
+    display flex
+    "alignItems" -: "center"
+    "margin-bottom" -: "4vh"
+    ".textInput" ? marginRight (px 30)
+
+    button ? do
+      Helper.defaultButton Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
+      marginTop (px 3)
+
+  ul # ".incomes" ? button ?
+    marginLeft (px 12)
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 5524ba7..9946961 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -11,7 +11,6 @@ import MonthlyPaymentJob (monthlyPaymentJobListener)
 
 import Data.Text (Text)
 import qualified Data.Text.IO as T
-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 
 import Controller.Index
 import Controller.SignIn
@@ -63,10 +62,7 @@ main = do
 
         get "/incomes" getIncomes
 
-        post "/income" $ do
-          creation <- param "creation" :: ActionM Int
-          amount <- param "amount" :: ActionM Int
-          addIncome (posixSecondsToUTCTime $ (fromIntegral creation) / 1000) amount
+        post "/income" $ jsonData >>= addIncome
 
         delete "/income" $ do
           incomeId <- param "id" :: ActionM Text
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 0915afe..5df925a 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -16,6 +16,7 @@ import Control.Monad.Trans.Resource (runResourceT, ResourceT)
 
 import Data.Text
 import Data.Time.Clock (UTCTime)
+import Data.Time.Calendar (Day)
 import Data.Int (Int64)
 
 import Database.Persist.Sqlite
@@ -55,8 +56,9 @@ Job
   deriving Show
 Income
   userId UserId
-  creation UTCTime
+  date Day
   amount Int
+  createdAt UTCTime
   deletedAt UTCTime Maybe
   deriving Show
 |]
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index c0cac45..119a44f 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -5,7 +5,8 @@ module Model.Income
   , deleteOwnIncome
   ) where
 
-import Data.Time.Clock (UTCTime, getCurrentTime)
+import Data.Time.Clock (getCurrentTime)
+import Data.Time.Calendar (Day)
 
 import Control.Monad.IO.Class (liftIO)
 
@@ -16,15 +17,16 @@ import qualified Model.Json.Income as Json
 
 getJsonIncome :: Entity Income -> Json.Income
 getJsonIncome incomeEntity =
-  Json.Income (entityKey incomeEntity) (incomeUserId income) (incomeCreation income) (incomeAmount income)
+  Json.Income (entityKey incomeEntity) (incomeUserId income) (incomeDate income) (incomeAmount income)
   where income = entityVal incomeEntity
 
 getIncomes :: Persist [Entity Income]
 getIncomes = selectList [IncomeDeletedAt ==. Nothing] []
 
-addIncome :: UserId -> UTCTime -> Int -> Persist IncomeId
-addIncome userId creation amount = do
-  insert (Income userId creation amount Nothing)
+addIncome :: UserId -> Day -> Int -> Persist IncomeId
+addIncome userId day amount = do
+  now <- liftIO getCurrentTime
+  insert (Income userId day amount now Nothing)
 
 deleteOwnIncome :: Entity User -> IncomeId -> Persist Bool
 deleteOwnIncome user incomeId = do
diff --git a/src/server/Model/Json/AddIncome.hs b/src/server/Model/Json/AddIncome.hs
new file mode 100644
index 0000000..6570ba9
--- /dev/null
+++ b/src/server/Model/Json/AddIncome.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.AddIncome
+  ( AddIncome(..)
+  ) where
+
+import GHC.Generics
+
+import Data.Aeson
+import Data.Time.Calendar (Day)
+
+data AddIncome = AddIncome
+  { day :: Day
+  , amount :: Int
+  } deriving (Show, Generic)
+
+instance FromJSON AddIncome
diff --git a/src/server/Model/Json/Income.hs b/src/server/Model/Json/Income.hs
index 6ad331a..e80ab63 100644
--- a/src/server/Model/Json/Income.hs
+++ b/src/server/Model/Json/Income.hs
@@ -7,16 +7,15 @@ module Model.Json.Income
 import GHC.Generics
 
 import Data.Aeson
-import Data.Time.Clock (UTCTime)
+import Data.Time.Calendar (Day)
 
 import Model.Database (IncomeId, UserId)
 
 data Income = Income
   { id :: IncomeId
   , userId :: UserId
-  , creation :: UTCTime
+  , day :: Day
   , amount :: Int
   } deriving (Show, Generic)
 
-instance FromJSON Income
 instance ToJSON Income
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 4a49900..d34eea3 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -51,7 +51,6 @@ data Key =
 
   | CategoryRequired
   | CostRequired
-  | DateValidationError
 
   -- Payments
 
@@ -77,12 +76,21 @@ data Key =
   -- Income
 
   | CumulativeIncomesSince
-  | AddIncome
   | Income
   | MonthlyNetIncomes
   | IncomeNotDeleted
   | Creation
   | Amount
+  | Delete
+
+  -- Form
+
+  | Empty
+  | InvalidString
+  | InvalidDate
+  | InvalidInt
+  | SmallerIntThan
+  | GreaterIntThan
 
   -- Http error
 
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 3ceb7a3..2060611 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -198,11 +198,6 @@ m l CostRequired =
     English -> "Type a positive cost."
     French  -> "Entre un coût positif."
 
-m l DateValidationError =
-  case l of
-    English -> "The date must be day/month/year"
-    French  -> "La date doit avoir la forme jour/mois/année"
-
 -- Payments
 
 m l Add =
@@ -289,11 +284,6 @@ m l CumulativeIncomesSince =
     English -> "Cumulative incomes since {0}"
     French  -> "Revenus nets cumulés depuis le {0}"
 
-m l AddIncome =
-  case l of
-    English -> "Add a monthly income"
-    French  -> "Ajouter un revenu mensuel net"
-
 m l Income =
   case l of
     English -> "Income"
@@ -319,6 +309,43 @@ m l Amount =
     English -> "Amount"
     French  -> "Montant"
 
+m l Delete =
+  case l of
+    English -> "Delete"
+    French  -> "Supprimer"
+
+-- Form error
+
+m l Empty =
+  case l of
+    English -> "Required field"
+    French  -> "Champ requis"
+
+m l InvalidString =
+  case l of
+    English -> "String required"
+    French  -> "Chaîne de caractères requise"
+
+m l InvalidDate =
+  case l of
+    English -> "day/month/year required"
+    French  -> "jour/mois/année requis"
+
+m l InvalidInt =
+  case l of
+    English -> "Integer required"
+    French  -> "Entier requis"
+
+m l SmallerIntThan =
+  case l of
+    English -> "Integer bigger than {0} required"
+    French  -> "Entier supérieur à {0} requis"
+
+m l GreaterIntThan =
+  case l of
+    English -> "Integer smaller than {0} required"
+    French  -> "Entier inférieur à {0} requis"
+
 -- Http error
 
 m l Timeout =
-- 
cgit v1.2.3