From 9ec84e3a20c767f6525639f58cd22715e302b88d Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 26 Jun 2016 12:31:24 +0200
Subject: Add an editable date field for punctual payment creation

---
 src/client/elm/Dialog/AddPayment/View.elm   | 10 ++++--
 src/client/elm/Dialog/Model.elm             | 16 ++++++++--
 src/client/elm/LoggedIn/Home/View/Table.elm |  6 ++--
 src/client/elm/LoggedIn/Income/Model.elm    | 25 +++------------
 src/client/elm/LoggedIn/Income/View.elm     | 13 ++++----
 src/client/elm/LoggedIn/Msg.elm             | 10 +++---
 src/client/elm/LoggedIn/Stat/View.elm       |  4 +--
 src/client/elm/LoggedIn/Update.elm          | 20 ++++++------
 src/client/elm/LoggedIn/View/Date.elm       | 48 -----------------------------
 src/client/elm/Model/Income.elm             |  2 +-
 src/client/elm/Model/Payer.elm              |  6 ++--
 src/client/elm/Model/Payment.elm            |  8 ++---
 src/client/elm/Server.elm                   | 28 +++++++++++------
 src/client/elm/Utils/Form.elm               | 10 ++++++
 src/client/elm/Validation.elm               | 22 +++++++++++++
 src/client/elm/View/Date.elm                | 48 +++++++++++++++++++++++++++++
 src/server/Controller/Income.hs             | 10 +++---
 src/server/Controller/Payment.hs            | 34 ++++++++++----------
 src/server/Main.hs                          | 30 +++++-------------
 src/server/Model/Database.hs                |  3 +-
 src/server/Model/Income.hs                  |  8 ++---
 src/server/Model/Init.hs                    |  4 +--
 src/server/Model/Json/AddIncome.hs          | 17 ----------
 src/server/Model/Json/CreateIncome.hs       | 17 ++++++++++
 src/server/Model/Json/CreatePayment.hs      | 22 +++++++++++++
 src/server/Model/Json/Income.hs             |  2 +-
 src/server/Model/Json/Payment.hs            |  4 +--
 src/server/Model/Message/Key.hs             |  5 +--
 src/server/Model/Message/Translations.hs    | 11 +++++--
 src/server/Model/Payment.hs                 | 31 ++++++++++---------
 src/server/MonthlyPaymentJob.hs             |  9 +++---
 src/server/Utils/Time.hs                    | 23 ++++++--------
 32 files changed, 278 insertions(+), 228 deletions(-)
 delete mode 100644 src/client/elm/LoggedIn/View/Date.elm
 create mode 100644 src/client/elm/Validation.elm
 create mode 100644 src/client/elm/View/Date.elm
 delete mode 100644 src/server/Model/Json/AddIncome.hs
 create mode 100644 src/server/Model/Json/CreateIncome.hs
 create mode 100644 src/server/Model/Json/CreatePayment.hs

(limited to 'src')

diff --git a/src/client/elm/Dialog/AddPayment/View.elm b/src/client/elm/Dialog/AddPayment/View.elm
index 79381dd..96686b8 100644
--- a/src/client/elm/Dialog/AddPayment/View.elm
+++ b/src/client/elm/Dialog/AddPayment/View.elm
@@ -7,8 +7,10 @@ import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 import Html.App as Html
 import Task
+import Date
 
 import Form exposing (Form)
+import Utils.Form as Form
 
 import Dialog
 
@@ -39,15 +41,16 @@ view loggedData frequency =
         , confirmMsg = \model -> (
             case Form.getOutput model.addPayment of
               Just data ->
-                Ok (Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment data.name data.cost data.frequency)
+                Ok (Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment data.name data.cost data.date data.frequency)
               Nothing ->
                 Err (Msg.Dialog <| Dialog.UpdateModel <| DialogMsg.AddPaymentMsg <| Form.Submit)
           )
         , undo = getMessage "Undo" loggedData.translations
         }
+      currentDate = Date.fromTime loggedData.currentTime
   in  button
         [ class "addPayment"
-        , onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.AddPaymentMsg <| Form.Reset (DialogModel.addPaymentInitial frequency)))
+        , onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.AddPaymentMsg <| Form.Reset (DialogModel.addPaymentInitial loggedData.translations currentDate frequency)))
         ]
         [ text (getMessage "AddPayment" loggedData.translations) ]
 
@@ -60,5 +63,8 @@ addPaymentForm loggedData addPayment =
       ]
       [ Form.textInput loggedData.translations addPayment "payment" "name"
       , Form.textInput loggedData.translations addPayment "payment" "cost"
+      , if Form.frequency addPayment == Punctual
+          then Form.textInput loggedData.translations addPayment "payment" "date"
+          else text ""
       , Form.radioInputs loggedData.translations addPayment "payment" "frequency" [ toString Punctual, toString Monthly ]
       ]
diff --git a/src/client/elm/Dialog/Model.elm b/src/client/elm/Dialog/Model.elm
index 9bd6a09..2ac4591 100644
--- a/src/client/elm/Dialog/Model.elm
+++ b/src/client/elm/Dialog/Model.elm
@@ -5,11 +5,16 @@ module Dialog.Model exposing
   , addPaymentInitial
   )
 
+import Date exposing (Date)
+import View.Date as Date
+
 import Form exposing (Form)
 import Form.Field as Field exposing (Field)
 import Form.Validate as Validate exposing (Validation)
+import Validation
 
 import Model.Payment as Payment
+import Model.Translations exposing (Translations)
 
 type alias Model =
   { addPayment : Form String AddPayment
@@ -18,6 +23,7 @@ type alias Model =
 type alias AddPayment =
   { name : String
   , cost : Int
+  , date : Date
   , frequency : Payment.Frequency
   }
 
@@ -26,12 +32,16 @@ init =
   { addPayment = Form.initial [] addPaymentValidation
   }
 
-addPaymentInitial : Payment.Frequency -> List (String, Field)
-addPaymentInitial frequency = [ ("frequency", Field.Radio (toString frequency)) ]
+addPaymentInitial : Translations -> Date -> Payment.Frequency -> List (String, Field)
+addPaymentInitial translations date frequency =
+  [ ("date", Field.Text (Date.shortView date translations))
+  , ("frequency", Field.Radio (toString frequency))
+  ]
 
 addPaymentValidation : Validation String AddPayment
 addPaymentValidation =
-  Validate.form3 AddPayment
+  Validate.form4 AddPayment
     (Validate.get "name" (Validate.string `Validate.andThen` (Validate.nonEmpty)))
     (Validate.get "cost" (Validate.int `Validate.andThen` (Validate.minInt 1)))
+    (Validate.get "date" Validation.date)
     (Validate.get "frequency" Payment.validateFrequency)
diff --git a/src/client/elm/LoggedIn/Home/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm
index 323a45d..fa0a93d 100644
--- a/src/client/elm/LoggedIn/Home/View/Table.elm
+++ b/src/client/elm/LoggedIn/Home/View/Table.elm
@@ -21,7 +21,7 @@ import LoggedIn.Msg as LoggedInMsg
 
 import LoggedIn.Home.Msg as HomeMsg
 import LoggedIn.Home.Model as HomeModel
-import LoggedIn.View.Date exposing (..)
+import View.Date as Date
 import LoggedIn.View.Format as Format
 
 import Model.User exposing (getUserName)
@@ -91,10 +91,10 @@ paymentLine loggedData homeModel frequency payment =
             [ class "cell date" ]
             [ span
                 [ class "shortDate" ]
-                [ text (renderShortDate payment.creation loggedData.translations) ]
+                [ text (Date.shortView payment.date loggedData.translations) ]
             , span
                 [ class "longDate" ]
-                [ text (renderLongDate payment.creation loggedData.translations) ]
+                [ text (Date.longView payment.date loggedData.translations) ]
             ]
         Monthly ->
           text ""
diff --git a/src/client/elm/LoggedIn/Income/Model.elm b/src/client/elm/LoggedIn/Income/Model.elm
index e56e290..d6e5e7a 100644
--- a/src/client/elm/LoggedIn/Income/Model.elm
+++ b/src/client/elm/LoggedIn/Income/Model.elm
@@ -5,14 +5,11 @@ module LoggedIn.Income.Model exposing
   , initForm
   )
 
-import String exposing (toInt, split)
-import Date
-import Time exposing (Time)
-import Date.Extra.Create exposing (dateFromFields)
-import Date.Extra.Core exposing (intToMonth)
+import Date exposing (Date)
 
 import Form exposing (Form)
 import Form.Validate as Validate exposing (..)
+import Validation
 
 type alias Model =
   { addIncome : Form String AddIncome
@@ -20,8 +17,8 @@ type alias Model =
   }
 
 type alias AddIncome =
-  { time : Time
-  , amount : Int
+  { amount : Int
+  , date : Date
   }
 
 init : Model
@@ -36,17 +33,5 @@ initForm = Form.initial [] validate
 validate : Validation String AddIncome
 validate =
   form2 AddIncome
-    (get "creation" timeValidation)
     (get "amount" (int `andThen` (minInt 1)))
-
-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 (Date.toTime (dateFromFields yearNum (intToMonth monthNum) dayNum 0 0 0 0))
-          _ -> Err (customError "InvalidDate")
-      _ -> Err (customError "InvalidDate")
-  )
+    (get "date" Validation.date)
diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm
index 3019fea..02e4467 100644
--- a/src/client/elm/LoggedIn/Income/View.elm
+++ b/src/client/elm/LoggedIn/Income/View.elm
@@ -34,10 +34,9 @@ import LoggedIn.Income.Model as IncomeModel
 import LoggedIn.Msg as LoggedInMsg
 import LoggedIn.Income.Msg as IncomeMsg
 
-import LoggedIn.View.Date exposing (renderShortDate)
+import View.Date as Date
 import LoggedIn.View.Format as Format
 
-import LoggedIn.View.Date exposing (renderLongDate)
 import View.Color as Color
 
 view : LoggedData -> IncomeModel.Model -> Html Msg
@@ -54,7 +53,7 @@ view loggedData incomeModel =
 
 cumulativeIncomesView : LoggedData -> Time -> Html Msg
 cumulativeIncomesView loggedData since =
-  let longDate = renderLongDate (Date.fromTime since) loggedData.translations
+  let longDate = Date.longView (Date.fromTime since) loggedData.translations
   in  div
         []
         [ h1 [] [ text <| getParamMessage [longDate] "CumulativeIncomesSince" loggedData.translations ]
@@ -81,13 +80,13 @@ addIncomeView loggedData addIncome =
   let htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.IncomeMsg << IncomeMsg.AddIncomeMsg)
   in  Html.form
         [ onSubmitPrevDefault Msg.NoOp ]
-        [ htmlMap <| Form.textInput loggedData.translations addIncome "income" "creation"
-        , htmlMap <| Form.textInput loggedData.translations addIncome "income" "amount"
+        [ htmlMap <| Form.textInput loggedData.translations addIncome "income" "amount"
+        , htmlMap <| Form.textInput loggedData.translations addIncome "income" "date"
         , button
             [ class "add"
             , case Form.getOutput addIncome of
                 Just data ->
-                  onClick (Msg.UpdateLoggedIn <| LoggedInMsg.AddIncome data.time data.amount)
+                  onClick (Msg.UpdateLoggedIn <| LoggedInMsg.AddIncome data.amount data.date)
                 Nothing ->
                   onClick (Msg.UpdateLoggedIn <| LoggedInMsg.IncomeMsg <| IncomeMsg.AddIncomeMsg <| Form.Submit)
             ]
@@ -110,7 +109,7 @@ incomeView : LoggedData -> (IncomeId, Income) -> Html Msg
 incomeView loggedData (incomeId, income) =
   li
     []
-    [ text <| renderShortDate (Date.fromTime income.time) loggedData.translations
+    [ text <| Date.shortView (Date.fromTime income.time) loggedData.translations
     , text "    −    "
     , text <| Format.price loggedData.conf income.amount
     , let dialogConfig =
diff --git a/src/client/elm/LoggedIn/Msg.elm b/src/client/elm/LoggedIn/Msg.elm
index c09655f..cbae67f 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 Time exposing (Time)
+import Date exposing (Date)
 
 import Model.Payment exposing (Payment, PaymentId, Frequency)
 import Model.Income exposing (IncomeId)
@@ -15,14 +15,14 @@ type Msg =
   | HomeMsg HomeMsg.Msg
   | IncomeMsg IncomeMsg.Msg
 
-  | AddPayment String Int Frequency
-  | ValidateAddPayment PaymentId String Int Frequency
+  | AddPayment String Int Date Frequency
+  | ValidateAddPayment PaymentId String Int Date Frequency
 
   | DeletePayment PaymentId
   | ValidateDeletePayment PaymentId
 
-  | AddIncome Time Int
-  | ValidateAddIncome IncomeId Time Int
+  | AddIncome Int Date
+  | ValidateAddIncome IncomeId Int Date
 
   | DeleteIncome IncomeId
   | ValidateDeleteIncome IncomeId
diff --git a/src/client/elm/LoggedIn/Stat/View.elm b/src/client/elm/LoggedIn/Stat/View.elm
index 72e1f34..636312d 100644
--- a/src/client/elm/LoggedIn/Stat/View.elm
+++ b/src/client/elm/LoggedIn/Stat/View.elm
@@ -16,7 +16,7 @@ import Model.Conf exposing (Conf)
 import Model.Translations exposing (getMessage, getParamMessage)
 
 import LoggedIn.View.Format as Format
-import LoggedIn.View.Date as Date
+import View.Date as Date
 import View.Plural exposing (plural)
 
 import Utils.List as List
@@ -47,7 +47,7 @@ monthDetail : LoggedData -> ((Month, Int), Payments) -> Html Msg
 monthDetail loggedData ((month, year), payments) =
   li
     []
-    [ text (Date.renderMonth loggedData.translations month)
+    [ text (Date.monthView loggedData.translations month)
     , text " "
     , text (toString year)
     , text " − "
diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm
index 48d87f7..1f09271 100644
--- a/src/client/elm/LoggedIn/Update.elm
+++ b/src/client/elm/LoggedIn/Update.elm
@@ -58,9 +58,9 @@ update model msg loggedIn =
               , Cmd.map LoggedInMsg.IncomeMsg cmd
               )
 
-        LoggedInMsg.AddPayment name cost frequency ->
+        LoggedInMsg.AddPayment name cost date frequency ->
           ( loggedIn
-          , Server.addPayment name cost frequency
+          , Server.createPayment name cost date frequency
               |> Task.perform
                    (\err ->
                      case err of
@@ -69,15 +69,15 @@ update model msg loggedIn =
                        _ ->
                          LoggedInMsg.NoOp
                    )
-                   (\paymentId -> LoggedInMsg.ValidateAddPayment paymentId name cost frequency)
+                   (\paymentId -> LoggedInMsg.ValidateAddPayment paymentId name cost date frequency)
           )
 
-        LoggedInMsg.ValidateAddPayment paymentId name cost frequency ->
+        LoggedInMsg.ValidateAddPayment paymentId name cost date frequency ->
           update model (LoggedInMsg.HomeMsg <| HomeMsg.SearchMsg (Form.Reset (HomeModel.searchInitial frequency))) loggedIn
             :> update model (LoggedInMsg.HomeMsg <| HomeMsg.SearchMsg Form.Submit)
             :> update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdatePage 1)
             :> (\loggedIn ->
-                 let newPayment = Payment paymentId (Date.fromTime model.currentTime) name cost loggedIn.me frequency
+                 let newPayment = Payment paymentId name cost date loggedIn.me frequency
                  in  ( { loggedIn | payments = newPayment :: loggedIn.payments }
                      , Cmd.none
                      )
@@ -115,16 +115,16 @@ update model msg loggedIn =
                   , Cmd.none
                   )
 
-        LoggedInMsg.AddIncome time amount ->
+        LoggedInMsg.AddIncome amount date ->
           ( loggedIn
-          , Server.addIncome time amount
+          , Server.createIncome amount date
               |> Task.perform
                    (always LoggedInMsg.NoOp)
-                   (\incomeId -> (LoggedInMsg.ValidateAddIncome incomeId time amount))
+                   (\incomeId -> (LoggedInMsg.ValidateAddIncome incomeId amount date))
           )
 
-        LoggedInMsg.ValidateAddIncome incomeId time amount ->
-          let newIncome = { userId = loggedIn.me, time = time, amount = amount }
+        LoggedInMsg.ValidateAddIncome incomeId amount date ->
+          let newIncome = { userId = loggedIn.me, amount = amount, time = Date.toTime date }
               loggedInIncome = loggedIn.income
           in  ( { loggedIn
                 | incomes = Dict.insert incomeId newIncome loggedIn.incomes
diff --git a/src/client/elm/LoggedIn/View/Date.elm b/src/client/elm/LoggedIn/View/Date.elm
deleted file mode 100644
index 8e4e872..0000000
--- a/src/client/elm/LoggedIn/View/Date.elm
+++ /dev/null
@@ -1,48 +0,0 @@
-module LoggedIn.View.Date exposing
-  ( renderShortDate
-  , renderLongDate
-  , renderMonth
-  )
-
-import Date exposing (..)
-import Date.Extra.Core as Date
-import String
-
-import Model.Translations exposing (..)
-
-renderShortDate : Date -> Translations -> String
-renderShortDate date translations =
-  let params =
-        [ String.pad 2 '0' (toString (Date.day date))
-        , String.pad 2 '0' (toString (Date.monthToInt (Date.month date)))
-        , toString (Date.year date)
-        ]
-  in  getParamMessage params "ShortDate" translations
-
-renderLongDate : Date -> Translations -> String
-renderLongDate date translations =
-  let params =
-        [ toString (Date.day date)
-        , (getMessage (getMonthKey (Date.month date)) translations)
-        , toString (Date.year date)
-        ]
-  in  getParamMessage params "LongDate" translations
-
-renderMonth : Translations -> Month -> String
-renderMonth translations month = getMessage (getMonthKey month) translations
-
-getMonthKey : Month -> String
-getMonthKey month =
-  case month of
-    Jan -> "January"
-    Feb -> "February"
-    Mar -> "March"
-    Apr -> "April"
-    May -> "May"
-    Jun -> "June"
-    Jul -> "July"
-    Aug -> "August"
-    Sep -> "September"
-    Oct -> "October"
-    Nov -> "November"
-    Dec -> "December"
diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm
index 7eaa77f..06ba772 100644
--- a/src/client/elm/Model/Income.elm
+++ b/src/client/elm/Model/Income.elm
@@ -45,7 +45,7 @@ incomeDecoder : Json.Decoder Income
 incomeDecoder =
   Json.object3 Income
     ("userId" := userIdDecoder)
-    ("day" := timeDecoder)
+    ("date" := timeDecoder)
     ("amount" := Json.int)
 
 incomeDefinedForAll : List UserId -> Incomes -> Maybe Time
diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm
index fb9940a..e5a4b65 100644
--- a/src/client/elm/Model/Payer.elm
+++ b/src/client/elm/Model/Payer.elm
@@ -71,7 +71,7 @@ useIncomesFrom : Users -> Incomes -> Payments -> Maybe Time
 useIncomesFrom users incomes payments =
   let firstPaymentTime =
         payments
-          |> List.map (Date.toTime << .creation)
+          |> List.map (Date.toTime << .date)
           |> List.sort
           |> List.head
       mbIncomeTime = incomeDefinedForAll (Dict.keys users) incomes
@@ -90,7 +90,7 @@ getPayers currentTime users incomes payments =
              ( userId
              , { preIncomePaymentSum =
                    totalPayments
-                     (\p -> (Date.toTime p.creation) < (Maybe.withDefault currentTime incomesDefined))
+                     (\p -> (Date.toTime p.date) < (Maybe.withDefault currentTime incomesDefined))
                      userId
                      payments
                , postIncomePaymentSum =
@@ -98,7 +98,7 @@ getPayers currentTime users incomes payments =
                      (\p ->
                        case incomesDefined of
                          Nothing -> False
-                         Just t -> (Date.toTime p.creation) >= t
+                         Just t -> (Date.toTime p.date) >= t
                      )
                      userId
                      payments
diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm
index ab3cbb7..c89e709 100644
--- a/src/client/elm/Model/Payment.elm
+++ b/src/client/elm/Model/Payment.elm
@@ -33,9 +33,9 @@ type alias Payments = List Payment
 
 type alias Payment =
   { id : PaymentId
-  , creation : Date
   , name : String
   , cost : Int
+  , date : Date
   , userId : UserId
   , frequency : Frequency
   }
@@ -51,9 +51,9 @@ paymentDecoder : Json.Decoder Payment
 paymentDecoder =
   Json.object6 Payment
     ("id" := paymentIdDecoder)
-    ("creation" := dateDecoder)
     ("name" := Json.string)
     ("cost" := Json.int)
+    ("date" := dateDecoder)
     ("userId" := userIdDecoder)
     ("frequency" := frequencyDecoder)
 
@@ -92,7 +92,7 @@ monthly = List.filter ((==) Monthly << .frequency)
 groupAndSortByMonth : Payments -> List ((Month, Int), Payments)
 groupAndSortByMonth payments =
   payments
-    |> List.groupBy (\payment -> (Date.year payment.creation, monthToInt << Date.month <| payment.creation))
+    |> List.groupBy (\payment -> (Date.year payment.date, monthToInt << Date.month <| payment.date))
     |> List.sortBy fst
     |> List.map (\((year, month), payments) -> ((intToMonth month, year), payments))
     |> List.reverse
@@ -101,7 +101,7 @@ search : String -> Frequency -> Payments -> Payments
 search name frequency payments =
   payments
     |> List.filter ((==) frequency << .frequency)
-    |> List.sortBy (Date.toTime << .creation)
+    |> List.sortBy (Date.toTime << .date)
     |> List.filter (searchSuccess name)
     |> List.reverse
 
diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm
index f3ed949..9522d17 100644
--- a/src/client/elm/Server.elm
+++ b/src/client/elm/Server.elm
@@ -1,8 +1,8 @@
 module Server exposing
   ( signIn
-  , addPayment
+  , createPayment
   , deletePayment
-  , addIncome
+  , createIncome
   , deleteIncome
   , signOut
   )
@@ -12,7 +12,7 @@ import Http
 import Date
 import Json.Decode exposing ((:=))
 import Json.Encode as Json
-import Time exposing (Time)
+import Date exposing (Date)
 
 import Date.Extra.Format as DateFormat
 
@@ -28,9 +28,17 @@ signIn email =
   post ("/signIn?email=" ++ email)
     |> Task.map (always ())
 
-addPayment : String -> Int -> Frequency -> Task Http.Error PaymentId
-addPayment name cost frequency =
-  post ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency))
+createPayment : String -> Int -> Date -> Frequency -> Task Http.Error PaymentId
+createPayment name cost date frequency =
+  Json.object
+    [ ("name", Json.string name)
+    , ("cost", Json.int cost)
+    , ("date", Json.string (DateFormat.isoDateString date))
+    , ("frequency", Json.string (toString frequency))
+    ]
+    |> Json.encode 0
+    |> Http.string
+    |> postWithBody "/payment"
     |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
 
 deletePayment : PaymentId -> Task Http.Error ()
@@ -38,11 +46,11 @@ deletePayment paymentId =
   delete ("/payment?id=" ++ (toString paymentId))
     |> Task.map (always ())
 
-addIncome : Time -> Int -> Task Http.Error IncomeId
-addIncome time amount =
+createIncome : Int -> Date -> Task Http.Error IncomeId
+createIncome amount date =
   Json.object
-    [ ("day", Json.string (DateFormat.isoDateString (Date.fromTime time)))
-    , ("amount", Json.int amount)
+    [ ("amount", Json.int amount)
+    , ("date", Json.string (DateFormat.isoDateString date))
     ]
     |> Json.encode 0
     |> Http.string
diff --git a/src/client/elm/Utils/Form.elm b/src/client/elm/Utils/Form.elm
index 6793222..482db5f 100644
--- a/src/client/elm/Utils/Form.elm
+++ b/src/client/elm/Utils/Form.elm
@@ -1,11 +1,21 @@
 module Utils.Form exposing
   ( fieldAsText
+  , frequency
   )
 
 import Form exposing (Form)
 
+import Model.Payment exposing (Frequency(..))
+
 fieldAsText : Form a b -> String -> String
 fieldAsText form field =
   Form.getFieldAsString field form
     |> .value
     |> Maybe.withDefault ""
+
+frequency : Form a b -> Frequency
+frequency form =
+  let field = Form.getFieldAsString "frequency" form
+  in  if field.value == Just (toString Monthly)
+        then Monthly
+        else Punctual
diff --git a/src/client/elm/Validation.elm b/src/client/elm/Validation.elm
new file mode 100644
index 0000000..1729daa
--- /dev/null
+++ b/src/client/elm/Validation.elm
@@ -0,0 +1,22 @@
+module Validation exposing
+  ( date
+  )
+
+import String exposing (toInt, split)
+import Date exposing (Date)
+import Date.Extra.Create exposing (dateFromFields)
+import Date.Extra.Core exposing (intToMonth)
+
+import Form.Validate as Validate exposing (..)
+
+date : Validation String Date
+date =
+  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 (intToMonth monthNum) dayNum 0 0 0 0)
+          _ -> Err (customError "InvalidDate")
+      _ -> Err (customError "InvalidDate")
+  )
diff --git a/src/client/elm/View/Date.elm b/src/client/elm/View/Date.elm
new file mode 100644
index 0000000..21bbfc4
--- /dev/null
+++ b/src/client/elm/View/Date.elm
@@ -0,0 +1,48 @@
+module View.Date exposing
+  ( shortView
+  , longView
+  , monthView
+  )
+
+import Date exposing (..)
+import Date.Extra.Core as Date
+import String
+
+import Model.Translations exposing (..)
+
+shortView : Date -> Translations -> String
+shortView date translations =
+  let params =
+        [ String.pad 2 '0' (toString (Date.day date))
+        , String.pad 2 '0' (toString (Date.monthToInt (Date.month date)))
+        , toString (Date.year date)
+        ]
+  in  getParamMessage params "ShortDate" translations
+
+longView : Date -> Translations -> String
+longView date translations =
+  let params =
+        [ toString (Date.day date)
+        , (getMessage (getMonthKey (Date.month date)) translations)
+        , toString (Date.year date)
+        ]
+  in  getParamMessage params "LongDate" translations
+
+monthView : Translations -> Month -> String
+monthView translations month = getMessage (getMonthKey month) translations
+
+getMonthKey : Month -> String
+getMonthKey month =
+  case month of
+    Jan -> "January"
+    Feb -> "February"
+    Mar -> "March"
+    Apr -> "April"
+    May -> "May"
+    Jun -> "June"
+    Jul -> "July"
+    Aug -> "August"
+    Sep -> "September"
+    Oct -> "October"
+    Nov -> "November"
+    Dec -> "December"
diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs
index 70e40ce..fa575c5 100644
--- a/src/server/Controller/Income.hs
+++ b/src/server/Controller/Income.hs
@@ -2,7 +2,7 @@
 
 module Controller.Income
   ( getIncomes
-  , addIncome
+  , createIncome
   , deleteOwnIncome
   ) where
 
@@ -24,7 +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
+import qualified Model.Json.CreateIncome as Json
 
 getIncomes :: ActionM ()
 getIncomes =
@@ -32,10 +32,10 @@ getIncomes =
     (liftIO $ map Income.getJsonIncome <$> runDb Income.getIncomes) >>= json
   )
 
-addIncome :: Json.AddIncome -> ActionM ()
-addIncome (Json.AddIncome date amount) =
+createIncome :: Json.CreateIncome -> ActionM ()
+createIncome (Json.CreateIncome date amount) =
   Secure.loggedAction (\user ->
-    (liftIO . runDb $ Income.addIncome (entityKey user) date amount) >>= jsonId
+    (liftIO . runDb $ Income.createIncome (entityKey user) date amount) >>= jsonId
   )
 
 deleteOwnIncome :: Text -> ActionM ()
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 294e4c4..55edea5 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Controller.Payment
-  ( getPayments
-  , createPayment
-  , deleteOwnPayment
+  ( list
+  , create
+  , deleteOwn
   ) where
 
 import Web.Scotty
@@ -16,34 +16,32 @@ import Control.Monad.IO.Class (liftIO)
 
 import Data.Text (Text)
 import qualified Data.Text.Lazy as TL
-import qualified Data.Aeson.Types as Json
 
 import qualified Secure
 
-import Json (jsonObject)
+import Json (jsonId)
 
 import Model.Database
-import qualified Model.Payment as P
-import Model.Frequency
+import qualified Model.Payment as Payment
 import Model.Message.Key (Key(PaymentNotDeleted))
+import qualified Model.Json.CreatePayment as Json
 
-getPayments :: ActionM ()
-getPayments =
+list :: ActionM ()
+list =
   Secure.loggedAction (\_ -> do
-    (liftIO $ runDb P.getPayments) >>= json
+    (liftIO $ runDb Payment.list) >>= json
   )
 
-createPayment :: Text -> Int -> Frequency -> ActionM ()
-createPayment name cost frequency =
-  Secure.loggedAction (\user -> do
-    paymentId <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency
-    jsonObject [("id", Json.Number . fromIntegral . keyToInt64 $ paymentId)]
+create :: Json.CreatePayment -> ActionM ()
+create (Json.CreatePayment date name cost frequency) =
+  Secure.loggedAction (\user ->
+    (liftIO . runDb $ Payment.create (entityKey user) date name cost frequency) >>= jsonId
   )
 
-deleteOwnPayment :: Text -> ActionM ()
-deleteOwnPayment paymentId =
+deleteOwn :: Text -> ActionM ()
+deleteOwn paymentId =
   Secure.loggedAction (\user -> do
-    deleted <- liftIO . runDb $ P.deleteOwnPayment user (textToKey paymentId)
+    deleted <- liftIO . runDb $ Payment.deleteOwn user (textToKey paymentId)
     if deleted
       then
         status ok200
diff --git a/src/server/Main.hs b/src/server/Main.hs
index d04a3ac..72e8675 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -14,12 +14,10 @@ import qualified Data.Text.IO as T
 
 import Controller.Index
 import Controller.SignIn
-import Controller.Payment
-import Controller.User
+import Controller.Payment as Payment
 import Controller.Income
 
 import Model.Database (runMigrations)
-import Model.Frequency
 
 import qualified Conf
 
@@ -52,32 +50,18 @@ main = do
 
         post "/signOut" (signOut conf)
 
-        -- Users
+        -- Payments
 
-        get "/users"  getUsers
+        post "/payment" $ jsonData >>= Payment.create
 
-        get "/whoAmI" whoAmI
+        delete "/payment" $ do
+          paymentId <- param "id" :: ActionM Text
+          Payment.deleteOwn paymentId
 
         -- Incomes
 
-        get "/incomes" getIncomes
-
-        post "/income" $ jsonData >>= addIncome
+        post "/income" $ jsonData >>= createIncome
 
         delete "/income" $ do
           incomeId <- param "id" :: ActionM Text
           deleteOwnIncome incomeId
-
-        -- Payments
-
-        get "/payments" getPayments
-
-        post "/payment/add" $ do
-          name <- param "name" :: ActionM Text
-          cost <- param "cost" :: ActionM Int
-          frequency <- param "frequency" :: ActionM Frequency
-          createPayment name cost frequency
-
-        delete "/payment" $ do
-          paymentId <- param "id" :: ActionM Text
-          deleteOwnPayment paymentId
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 5df925a..7e67f9a 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -35,9 +35,10 @@ User
   deriving Show
 Payment
   userId UserId
-  creation UTCTime
+  date Day
   name Text
   cost Int
+  createdAt UTCTime
   deletedAt UTCTime Maybe
   frequency Frequency
   deriving Show
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index 119a44f..62ab0ed 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -1,7 +1,7 @@
 module Model.Income
   ( getJsonIncome
   , getIncomes
-  , addIncome
+  , createIncome
   , deleteOwnIncome
   ) where
 
@@ -23,10 +23,10 @@ getJsonIncome incomeEntity =
 getIncomes :: Persist [Entity Income]
 getIncomes = selectList [IncomeDeletedAt ==. Nothing] []
 
-addIncome :: UserId -> Day -> Int -> Persist IncomeId
-addIncome userId day amount = do
+createIncome :: UserId -> Day -> Int -> Persist IncomeId
+createIncome userId date amount = do
   now <- liftIO getCurrentTime
-  insert (Income userId day amount now Nothing)
+  insert (Income userId date amount now Nothing)
 
 deleteOwnIncome :: Entity User -> IncomeId -> Persist Bool
 deleteOwnIncome user incomeId = do
diff --git a/src/server/Model/Init.hs b/src/server/Model/Init.hs
index 167eead..09ac627 100644
--- a/src/server/Model/Init.hs
+++ b/src/server/Model/Init.hs
@@ -11,7 +11,7 @@ import Database.Persist
 import Model.Database
 
 import Model.Json.Init (Init, Init(Init))
-import Model.Payment (getPayments)
+import qualified Model.Payment as Payment
 import Model.User (getUsers, getJsonUser)
 import Model.Income (getIncomes, getJsonIncome)
 
@@ -21,7 +21,7 @@ getInit :: Entity User -> Persist Init
 getInit user =
   liftIO . runDb $ do
     users <- getUsers
-    payments <- getPayments
+    payments <- Payment.list
     incomes <- getIncomes
     return $ Init
       { Init.users = map getJsonUser users
diff --git a/src/server/Model/Json/AddIncome.hs b/src/server/Model/Json/AddIncome.hs
deleted file mode 100644
index 6570ba9..0000000
--- a/src/server/Model/Json/AddIncome.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# 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/CreateIncome.hs b/src/server/Model/Json/CreateIncome.hs
new file mode 100644
index 0000000..cf9b1c3
--- /dev/null
+++ b/src/server/Model/Json/CreateIncome.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.CreateIncome
+  ( CreateIncome(..)
+  ) where
+
+import GHC.Generics
+
+import Data.Aeson
+import Data.Time.Calendar (Day)
+
+data CreateIncome = CreateIncome
+  { date :: Day
+  , amount :: Int
+  } deriving (Show, Generic)
+
+instance FromJSON CreateIncome
diff --git a/src/server/Model/Json/CreatePayment.hs b/src/server/Model/Json/CreatePayment.hs
new file mode 100644
index 0000000..f117daf
--- /dev/null
+++ b/src/server/Model/Json/CreatePayment.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.CreatePayment
+  ( CreatePayment(..)
+  ) where
+
+import GHC.Generics
+
+import Data.Aeson
+import Data.Time.Calendar (Day)
+import Data.Text (Text)
+
+import Model.Frequency (Frequency)
+
+data CreatePayment = CreatePayment
+  { date :: Day
+  , name :: Text
+  , cost :: Int
+  , frequency :: Frequency
+  } deriving (Show, Generic)
+
+instance FromJSON CreatePayment
diff --git a/src/server/Model/Json/Income.hs b/src/server/Model/Json/Income.hs
index e80ab63..bb1ac97 100644
--- a/src/server/Model/Json/Income.hs
+++ b/src/server/Model/Json/Income.hs
@@ -14,7 +14,7 @@ import Model.Database (IncomeId, UserId)
 data Income = Income
   { id :: IncomeId
   , userId :: UserId
-  , day :: Day
+  , date :: Day
   , amount :: Int
   } deriving (Show, Generic)
 
diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs
index 7f4de15..04c6de8 100644
--- a/src/server/Model/Json/Payment.hs
+++ b/src/server/Model/Json/Payment.hs
@@ -6,16 +6,16 @@ module Model.Json.Payment
 
 import GHC.Generics
 
-import Data.Time
 import Data.Text (Text)
 import Data.Aeson
+import Data.Time.Calendar (Day)
 
 import Model.Database (PaymentId, UserId)
 import Model.Frequency
 
 data Payment = Payment
   { id :: PaymentId
-  , creation :: UTCTime
+  , date :: Day
   , name :: Text
   , cost :: Int
   , userId :: UserId
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 8b957f1..093024b 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -75,6 +75,7 @@ data Key =
 
   | PaymentName
   | PaymentCost
+  | PaymentDate
   | PaymentPunctual
   | PaymentMonthly
 
@@ -90,7 +91,7 @@ data Key =
   | Income
   | MonthlyNetIncomes
   | IncomeNotDeleted
-  | IncomeCreation
+  | IncomeDate
   | IncomeAmount
   | ConfirmDelete
 
@@ -117,4 +118,4 @@ data Key =
   deriving (Enum, Bounded, Show)
 
 instance Json.ToJSON Key where
- toJSON = Json.String . T.pack . show
+  toJSON = Json.String . T.pack . show
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index df3f402..6522d75 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -312,6 +312,11 @@ m l PaymentCost =
     English -> "Cost"
     French  -> "Coût"
 
+m l PaymentDate =
+  case l of
+    English -> "Date"
+    French  -> "Date"
+
 m l PaymentPunctual =
   case l of
     English -> "Punctual"
@@ -344,10 +349,10 @@ m l IncomeNotDeleted =
     English -> "The income could not have been deleted."
     French  -> "Le revenu n'a pas pu être supprimé."
 
-m l IncomeCreation =
+m l IncomeDate =
   case l of
-    English -> "Creation"
-    French  -> "Création"
+    English -> "Date"
+    French  -> "Date"
 
 m l IncomeAmount =
   case l of
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 28f1a09..51ca152 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,14 +1,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Model.Payment
-  ( getPayments
-  , getMonthlyPayments
-  , createPayment
-  , deleteOwnPayment
+  ( list
+  , listMonthly
+  , create
+  , deleteOwn
   ) where
 
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
+import Data.Time.Calendar (Day)
 
 import Control.Monad.IO.Class (liftIO)
 
@@ -18,14 +19,14 @@ import Model.Database
 import Model.Frequency
 import qualified Model.Json.Payment as P
 
-getPayments :: Persist [P.Payment]
-getPayments =
+list :: Persist [P.Payment]
+list =
   map getJsonPayment <$> selectList
     [ PaymentDeletedAt ==. Nothing ]
-    [ Desc PaymentCreation ]
+    []
 
-getMonthlyPayments :: Persist [Entity Payment]
-getMonthlyPayments =
+listMonthly :: Persist [Entity Payment]
+listMonthly =
   selectList
     [ PaymentDeletedAt ==. Nothing
     , PaymentFrequency ==. Monthly
@@ -37,20 +38,20 @@ getJsonPayment paymentEntity =
   let payment = entityVal paymentEntity
   in  P.Payment
         { P.id = entityKey paymentEntity
-        , P.creation = paymentCreation payment
+        , P.date = paymentDate payment
         , P.name = paymentName payment
         , P.cost = paymentCost payment
         , P.userId = paymentUserId payment
         , P.frequency = paymentFrequency payment
         }
 
-createPayment :: UserId -> Text -> Int -> Frequency -> Persist PaymentId
-createPayment userId name cost frequency = do
+create :: UserId -> Day -> Text -> Int -> Frequency -> Persist PaymentId
+create userId date name cost frequency = do
   now <- liftIO getCurrentTime
-  insert (Payment userId now name cost Nothing frequency)
+  insert (Payment userId date name cost now Nothing frequency)
 
-deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool
-deleteOwnPayment user paymentId = do
+deleteOwn :: Entity User -> PaymentId -> Persist Bool
+deleteOwn user paymentId = do
   mbPayment <- get paymentId
   case mbPayment of
     Just payment ->
diff --git a/src/server/MonthlyPaymentJob.hs b/src/server/MonthlyPaymentJob.hs
index f5f6878..c4022c9 100644
--- a/src/server/MonthlyPaymentJob.hs
+++ b/src/server/MonthlyPaymentJob.hs
@@ -11,11 +11,11 @@ import Database.Persist (entityVal, insert)
 import Job (jobListener)
 
 import Model.Database
-import Model.Payment (getMonthlyPayments)
+import qualified Model.Payment as Payment
 import Model.JobKind
 import Model.Frequency
 
-import Utils.Time (belongToCurrentMonth)
+import Utils.Time (belongToCurrentMonth, timeToDay)
 
 monthlyPaymentJobListener :: IO ()
 monthlyPaymentJobListener =
@@ -26,7 +26,8 @@ monthlyPaymentJobListener =
 
 monthlyPaymentJob :: Persist ()
 monthlyPaymentJob = do
-  monthlyPayments <- map entityVal <$> getMonthlyPayments
+  monthlyPayments <- map entityVal <$> Payment.listMonthly
   now <- liftIO $ getCurrentTime
-  let punctualPayments = map (\p -> p { paymentFrequency = Punctual, paymentCreation = now }) monthlyPayments
+  actualDay <- liftIO $ timeToDay now
+  let punctualPayments = map (\p -> p { paymentFrequency = Punctual, paymentDate = actualDay, paymentCreatedAt = now }) monthlyPayments
   sequence_ $ map insert punctualPayments
diff --git a/src/server/Utils/Time.hs b/src/server/Utils/Time.hs
index 0d6ed73..e8c7ac1 100644
--- a/src/server/Utils/Time.hs
+++ b/src/server/Utils/Time.hs
@@ -1,7 +1,6 @@
 module Utils.Time
   ( belongToCurrentMonth
-  , getLocalDate
-  , Date(..)
+  , timeToDay
   ) where
 
 import Data.Time.Clock
@@ -10,18 +9,16 @@ import Data.Time.Calendar
 
 belongToCurrentMonth :: UTCTime -> IO Bool
 belongToCurrentMonth time = do
-  timeMonth <- month <$> getLocalDate time
-  actualMonth <- month <$> (getCurrentTime >>= getLocalDate)
+  timeMonth <- dayMonth <$> timeToDay time
+  actualMonth <- dayMonth <$> (getCurrentTime >>= timeToDay)
   return (timeMonth == actualMonth)
 
-getLocalDate :: UTCTime -> IO Date
-getLocalDate time = do
+timeToDay :: UTCTime -> IO Day
+timeToDay time = do
   timeZone <- getCurrentTimeZone
-  let (y, m, d) = toGregorian . localDay $ utcToLocalTime timeZone time
-  return (Date y m d)
+  return . localDay $ utcToLocalTime timeZone time
 
-data Date = Date
-  { year :: Integer
-  , month :: Int
-  , day :: Int
-  }
+dayMonth :: Day -> Int
+dayMonth day =
+  let (_, month, _) = toGregorian day
+  in  month
-- 
cgit v1.2.3