Adding UI income read-only

26 files changed, 458 insertions, 244 deletions

diff --git a/src/client/Main.elm b/src/client/Main.elm
index 0b579d7..621fb97 100644
--- a/src/client/Main.elm
+++ b/src/client/Main.elm
@@ -66,7 +66,8 @@ goLoggedInView =
   Task.andThen getPayments <| \payments ->
   Task.andThen getPaymentsCount <| \paymentsCount ->
   Task.andThen getPayers <| \payers ->
-    Signal.send actions.address (GoLoggedInView users me monthlyPayments payments paymentsCount payers)
+  Task.andThen getIncome <| \income ->
+    Signal.send actions.address (GoLoggedInView users me monthlyPayments payments paymentsCount payers income)
 
 getUsers : Task Http.Error Users
 getUsers = Http.get usersDecoder "/users"
@@ -86,6 +87,9 @@ getPaymentsCount = Http.get ("number" := Json.int) "/payments/count"
 getPayers : Task Http.Error Payers
 getPayers = Http.get payersDecoder "/payments/total"
 
+getIncome : Task Http.Error (Maybe Int)
+getIncome = Http.get (Json.maybe ("income" := Json.int)) "/income"
+
 ---------------------------------------
 
 port serverCommunicationsPort : Signal (Task Http.RawError ())
diff --git a/src/client/Model/View/LoggedIn/Account.elm b/src/client/Model/View/LoggedIn/Account.elm
new file mode 100644
index 0000000..410345c
--- /dev/null
+++ b/src/client/Model/View/LoggedIn/Account.elm
@@ -0,0 +1,19 @@
+module Model.View.LoggedIn.Account
+  ( Account
+  , initAccount
+  ) where
+
+import Model.Payers exposing (..)
+
+type alias Account =
+  { payers : Payers
+  , income : Maybe Int
+  , visibleDetail : Bool
+  }
+
+initAccount : Payers -> Maybe Int -> Account
+initAccount payers income =
+  { payers = payers
+  , income = income
+  , visibleDetail = False
+  }
diff --git a/src/client/Model/View/LoggedInView.elm b/src/client/Model/View/LoggedInView.elm
index cf7f552..12a7294 100644
--- a/src/client/Model/View/LoggedInView.elm
+++ b/src/client/Model/View/LoggedInView.elm
@@ -9,28 +9,29 @@ import Model.Payers exposing (Payers)
 import Model.View.LoggedIn.Add exposing (..)
 import Model.View.LoggedIn.Edition exposing (..)
 import Model.View.LoggedIn.Monthly exposing (..)
+import Model.View.LoggedIn.Account exposing (..)
 
 type alias LoggedInView =
   { users : Users
   , me : UserId
   , add : AddPayment
   , monthly : Monthly
+  , account : Account
   , payments : Payments
   , paymentsCount : Int
-  , payers : Payers
   , paymentEdition : Maybe Edition
   , currentPage : Int
   }
 
-initLoggedInView : Users -> UserId -> Payments -> Payments -> Int -> Payers -> LoggedInView
-initLoggedInView users me monthlyPayments payments paymentsCount payers =
+initLoggedInView : Users -> UserId -> Payments -> Payments -> Int -> Payers -> Maybe Int -> LoggedInView
+initLoggedInView users me monthlyPayments payments paymentsCount payers income =
   { users = users
   , me = me
   , add = initAddPayment Punctual
   , monthly = initMonthly monthlyPayments
+  , account = initAccount payers income
   , payments = payments
   , paymentsCount = paymentsCount
-  , payers = payers
   , paymentEdition = Nothing
   , currentPage = 1
   }
diff --git a/src/client/Update.elm b/src/client/Update.elm
index 23e5c84..4389140 100644
--- a/src/client/Update.elm
+++ b/src/client/Update.elm
@@ -23,7 +23,7 @@ type Action =
   | GoSignInView
   | SignInError String
   | UpdateSignIn SignInAction
-  | GoLoggedInView Users UserId Payments Payments Int Payers
+  | GoLoggedInView Users UserId Payments Payments Int Payers (Maybe Int)
   | UpdateLoggedIn LoggedAction
 
 actions : Signal.Mailbox Action
@@ -38,8 +38,8 @@ updateModel action model =
       { model | currentTime <- time }
     GoSignInView ->
       { model | view <- V.SignInView initSignInView }
-    GoLoggedInView users me monthlyPayments payments paymentsCount payers ->
-      { model | view <- V.LoggedInView (initLoggedInView users me monthlyPayments payments paymentsCount payers) }
+    GoLoggedInView users me monthlyPayments payments paymentsCount payers mbIncome ->
+      { model | view <- V.LoggedInView (initLoggedInView users me monthlyPayments payments paymentsCount payers mbIncome) }
     SignInError msg ->
       let signInView = { initSignInView | result <- Just (Err msg) }
       in  { model | view <- V.SignInView signInView }
diff --git a/src/client/Update/LoggedIn.elm b/src/client/Update/LoggedIn.elm
index 03eb137..07f3426 100644
--- a/src/client/Update/LoggedIn.elm
+++ b/src/client/Update/LoggedIn.elm
@@ -9,12 +9,12 @@ import Dict
 import Model exposing (Model)
 import Model.User exposing (UserId)
 import Model.Payment exposing (..)
-import Model.Payers exposing (..)
 import Model.View.LoggedInView exposing (..)
 import Model.View.LoggedIn.Add exposing (..)
 
 import Update.LoggedIn.Add exposing (..)
 import Update.LoggedIn.Monthly as UM
+import Update.LoggedIn.Account as UA
 
 type LoggedAction =
   UpdateAdd AddPaymentAction
@@ -25,6 +25,7 @@ type LoggedAction =
   | DeletePayment UserId Int Payments
   | UpdatePage Int Payments
   | UpdateMonthly UM.MonthlyAction
+  | UpdateAccount UA.AccountAction
 
 updateLoggedIn : Model -> LoggedAction -> LoggedInView -> LoggedInView
 updateLoggedIn model action loggedInView =
@@ -38,7 +39,7 @@ updateLoggedIn model action loggedInView =
       | payments <- payments
       , currentPage <- 1
       , add <- initAddPayment Punctual
-      , payers <- updatePayers loggedInView.payers userId cost
+      , account <- UA.updateAccount (UA.UpdatePayer userId cost) loggedInView.account
       , paymentsCount <- loggedInView.paymentsCount + 1
       }
     AddMonthlyPayment id name cost ->
@@ -53,7 +54,7 @@ updateLoggedIn model action loggedInView =
     DeletePayment userId cost payments ->
       { loggedInView
       | payments <- payments
-      , payers <- updatePayers loggedInView.payers userId -cost
+      , account <- UA.updateAccount (UA.UpdatePayer userId -cost) loggedInView.account
       , paymentsCount <- loggedInView.paymentsCount - 1
       }
     UpdatePage page payments ->
@@ -63,3 +64,5 @@ updateLoggedIn model action loggedInView =
       }
     UpdateMonthly monthlyAction ->
       { loggedInView | monthly <- UM.updateMonthly monthlyAction loggedInView.monthly }
+    UpdateAccount accountAction ->
+      { loggedInView | account <- UA.updateAccount accountAction loggedInView.account }
diff --git a/src/client/Update/LoggedIn/Account.elm b/src/client/Update/LoggedIn/Account.elm
new file mode 100644
index 0000000..ab07c2e
--- /dev/null
+++ b/src/client/Update/LoggedIn/Account.elm
@@ -0,0 +1,20 @@
+module Update.LoggedIn.Account
+  ( AccountAction(..)
+  , updateAccount
+  ) where
+
+import Model.User exposing (UserId)
+import Model.Payers exposing (..)
+import Model.View.LoggedIn.Account exposing (..)
+
+type AccountAction =
+  ToggleDetail
+  | UpdatePayer UserId Int
+
+updateAccount : AccountAction -> Account -> Account
+updateAccount action account =
+  case action of
+    ToggleDetail ->
+      { account | visibleDetail <- not account.visibleDetail }
+    UpdatePayer userId cost ->
+      { account | payers <- updatePayers account.payers userId cost }
diff --git a/src/client/View/Expand.elm b/src/client/View/Expand.elm
new file mode 100644
index 0000000..53b4fe5
--- /dev/null
+++ b/src/client/View/Expand.elm
@@ -0,0 +1,25 @@
+module View.Expand
+  ( expand
+  , ExpandType(..)
+  ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+
+import View.Icon exposing (renderIcon)
+
+type ExpandType = ExpandUp | ExpandDown
+
+expand : ExpandType -> Bool -> Html
+expand expandType isExpanded =
+  div
+    [ class "expand" ]
+    [ renderIcon (chevronIcon expandType isExpanded) ]
+
+chevronIcon : ExpandType -> Bool -> String
+chevronIcon expandType isExpanded =
+  case (expandType, isExpanded) of
+    (ExpandUp, True)    -> "chevron-down"
+    (ExpandUp, False)   -> "chevron-up"
+    (ExpandDown, True)  -> "chevron-up"
+    (ExpandDown, False) -> "chevron-down"
diff --git a/src/client/View/LoggedIn.elm b/src/client/View/LoggedIn.elm
index e4577a2..20c99d3 100644
--- a/src/client/View/LoggedIn.elm
+++ b/src/client/View/LoggedIn.elm
@@ -9,9 +9,9 @@ import Model exposing (Model)
 import Model.Payment exposing (Payments)
 import Model.View.LoggedInView exposing (LoggedInView)
 
-import View.LoggedIn.ExceedingPayer exposing (exceedingPayers)
 import View.LoggedIn.Add exposing (addPayment)
 import View.LoggedIn.Monthly exposing (monthlyPayments)
+import View.LoggedIn.Account exposing (account)
 import View.LoggedIn.Table exposing (paymentsTable)
 import View.LoggedIn.Paging exposing (paymentsPaging)
 
@@ -23,7 +23,7 @@ renderLoggedIn model loggedInView =
     , div
         [ class "expandables" ]
         [ monthlyPayments model loggedInView
-        , exceedingPayers model loggedInView
+        , account model loggedInView
         ]
     , paymentsTable model loggedInView
     , paymentsPaging loggedInView
diff --git a/src/client/View/LoggedIn/Account.elm b/src/client/View/LoggedIn/Account.elm
new file mode 100644
index 0000000..e2b8e7e
--- /dev/null
+++ b/src/client/View/LoggedIn/Account.elm
@@ -0,0 +1,74 @@
+module View.LoggedIn.Account
+  ( account
+  ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import List
+
+import Update exposing (..)
+import Update.LoggedIn exposing (..)
+import Update.LoggedIn.Account exposing (..)
+
+import Model exposing (Model)
+import Model.User exposing (getUserName)
+import Model.Payers exposing (..)
+import Model.View.LoggedInView exposing (LoggedInView)
+import Model.Translations exposing (getParamMessage, getMessage)
+import Model.View.LoggedIn.Account exposing (Account)
+
+import View.Expand exposing (..)
+import View.Price exposing (price)
+
+account : Model -> LoggedInView -> Html
+account model loggedInView =
+  let account = loggedInView.account
+  in  div
+        [ classList
+            [ ("account", True)
+            , ("detail", account.visibleDetail)
+            ]
+        ]
+        [ exceedingPayers model loggedInView
+        , if account.visibleDetail
+            then income model account
+            else text ""
+        ]
+
+exceedingPayers : Model -> LoggedInView -> Html
+exceedingPayers model loggedInView =
+  button
+    [ class "exceedingPayers"
+    , onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleDetail)
+    ]
+    (  (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers loggedInView.account.payers))
+    ++ [ expand ExpandDown loggedInView.account.visibleDetail ]
+    )
+
+exceedingPayer : Model -> LoggedInView -> ExceedingPayer -> Html
+exceedingPayer model loggedInView payer =
+  div
+    [ class "exceedingPayer" ]
+    [ span
+        [ class "userName" ]
+        [ payer.userId
+            |> getUserName loggedInView.users
+            |> Maybe.withDefault "−"
+            |> text
+        ]
+    , span
+        [ class "amount" ]
+        [ text ("+ " ++ (price model payer.amount)) ]
+    ]
+
+income : Model -> Account -> Html
+income model account =
+  div
+    [ class "income" ]
+    ( case account.income of
+        Nothing ->
+          [ text (getMessage "NoIncome" model.translations) ]
+        Just income ->
+          [ text (getParamMessage [price model income] "Income" model.translations) ]
+    )
diff --git a/src/client/View/LoggedIn/Add.elm b/src/client/View/LoggedIn/Add.elm
index acdda2d..bae3853 100644
--- a/src/client/View/LoggedIn/Add.elm
+++ b/src/client/View/LoggedIn/Add.elm
@@ -50,7 +50,11 @@ addPayment model loggedInView =
 addPaymentName : AddPayment -> Html
 addPaymentName addPayment =
   div
-    [ class ("name " ++ (if isJust addPayment.nameError then "error" else "")) ]
+    [ classList
+        [ ("name", True)
+        , ("error", isJust addPayment.nameError)
+        ]
+    ]
     [ input
         [ id "nameInput"
         , value addPayment.name
@@ -71,7 +75,11 @@ addPaymentName addPayment =
 addPaymentCost : Model -> AddPayment -> Html
 addPaymentCost model addPayment =
   div
-    [ class ("cost " ++ (if isJust addPayment.costError then "error" else "")) ]
+    [ classList
+        [ ("cost", True)
+        , ("error", isJust addPayment.costError)
+        ]
+    ]
     [ input
         [ id "costInput"
         , value addPayment.cost
@@ -97,9 +105,17 @@ paymentFrequency model addPayment =
     , onClick actions.address (UpdateLoggedIn << UpdateAdd <| ToggleFrequency)
     ]
     [ div
-        [ class ("punctual" ++ if addPayment.frequency == Punctual then " selected" else "") ]
+        [ classList
+            [ ("punctual", True)
+            , ("selected", addPayment.frequency == Punctual)
+            ]
+        ]
         [ text (getMessage "Punctual" model.translations) ]
     , div
-        [ class ("monthly" ++ if addPayment.frequency == Monthly then " selected" else "") ]
+        [ classList
+            [ ("monthly", True)
+            , ("selected", addPayment.frequency == Monthly)
+            ]
+        ]
         [ text (getMessage "Monthly" model.translations) ]
     ]
diff --git a/src/client/View/LoggedIn/ExceedingPayer.elm b/src/client/View/LoggedIn/ExceedingPayer.elm
deleted file mode 100644
index ea848b6..0000000
--- a/src/client/View/LoggedIn/ExceedingPayer.elm
+++ /dev/null
@@ -1,35 +0,0 @@
-module View.LoggedIn.ExceedingPayer
-  ( exceedingPayers
-  ) where
-
-import Html exposing (..)
-import Html.Attributes exposing (..)
-import List
-
-import Model exposing (Model)
-import Model.User exposing (getUserName)
-import Model.Payers exposing (..)
-import Model.View.LoggedInView exposing (LoggedInView)
-import Model.Translations exposing (getMessage)
-
-exceedingPayers : Model -> LoggedInView -> Html
-exceedingPayers model loggedInView =
-  div
-    [ class "exceedingPayers" ]
-    (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers loggedInView.payers))
-
-exceedingPayer : Model -> LoggedInView -> ExceedingPayer -> Html
-exceedingPayer model loggedInView payer =
-  div
-    [ class "exceedingPayer" ]
-    [ span
-        [ class "userName" ]
-        [ payer.userId
-            |> getUserName loggedInView.users
-            |> Maybe.withDefault "−"
-            |> text
-        ]
-    , span
-        [ class "amount" ]
-        [ text ("+ " ++ (toString payer.amount) ++ " " ++ (getMessage "MoneySymbol" model.translations)) ]
-    ]
diff --git a/src/client/View/LoggedIn/Monthly.elm b/src/client/View/LoggedIn/Monthly.elm
index 17c354a..518724b 100644
--- a/src/client/View/LoggedIn/Monthly.elm
+++ b/src/client/View/LoggedIn/Monthly.elm
@@ -21,37 +21,40 @@ import Model.Translations exposing (getMessage, getParamMessage)
 import ServerCommunication as SC exposing (serverCommunications)
 
 import View.Icon exposing (renderIcon)
+import View.Expand exposing (..)
+import View.Price exposing (price)
 
 monthlyPayments : Model -> LoggedInView -> Html
 monthlyPayments model loggedInView =
   let monthly = loggedInView.monthly
-  in  if List.isEmpty monthly.payments
-        then
-          text ""
-        else
-          div
-            [ class ("monthlyPayments" ++ if monthly.visibleDetail then " detail" else "") ]
-            [ monthlyCount model monthly
-            , if monthly.visibleDetail then paymentsTable model loggedInView monthly else text ""
+  in  div
+        [ classList
+            [ ("monthlyPayments", True)
+            , ("detail", monthly.visibleDetail)
             ]
+        ]
+        [ monthlyCount model monthly
+        , if monthly.visibleDetail then paymentsTable model loggedInView monthly else text ""
+        ]
 
 monthlyCount : Model -> Monthly -> Html
 monthlyCount model monthly =
   let count = List.length monthly.payments
       total = List.sum << List.map .cost <| monthly.payments
       key = if count > 1 then "PluralMonthlyCount" else "SingularMonthlyCount"
-  in  button
-        [ class "count"
-        , onClick actions.address (UpdateLoggedIn << UpdateMonthly <| ToggleDetail)
-        ]
-        [ text (getParamMessage [toString count, toString total] key model.translations)
-        , div
-            [ class "expand" ]
-            [ if monthly.visibleDetail
-                then renderIcon "chevron-up"
-                else renderIcon "chevron-down"
+  in  if count == 0
+        then
+          div
+            [ class "count" ]
+            [ text (getMessage "NoMonthlyPayment" model.translations) ]
+        else
+          button
+            [ class "count"
+            , onClick actions.address (UpdateLoggedIn << UpdateMonthly <| ToggleDetail)
+            ]
+            [ text (getParamMessage [toString count, price model total] key model.translations)
+            , expand ExpandDown monthly.visibleDetail
             ]
-        ]
 
 paymentsTable : Model -> LoggedInView -> Monthly -> Html
 paymentsTable model loggedInView monthly =
@@ -65,13 +68,20 @@ paymentsTable model loggedInView monthly =
 paymentLine : Model -> LoggedInView -> Payment -> Html
 paymentLine model loggedInView payment =
   a
-    [ class ("row" ++ (if loggedInView.paymentEdition == Just payment.id then " edition" else ""))
+    [ classList
+        [ ("row", True)
+        , ("edition", loggedInView.paymentEdition == Just payment.id)
+        ]
     , onClick actions.address (UpdateLoggedIn (ToggleEdit payment.id))
     ]
     [ div [ class "cell category" ] [ text (payment.name) ]
     , div
-        [ class ("cell cost" ++ if payment.cost < 0 then " refund" else "") ]
-        [ text (toString payment.cost ++ " " ++ getMessage "MoneySymbol" model.translations) ]
+        [ classList
+            [ ("cell cost", True)
+            , ("refund", payment.cost < 0)
+            ]
+        ]
+        [ text (price model payment.cost) ]
     , div
         [ class "cell delete"
         , onClick serverCommunications.address (SC.DeleteMonthlyPayment payment.id)
diff --git a/src/client/View/LoggedIn/Paging.elm b/src/client/View/LoggedIn/Paging.elm
index 5d5f2db..93d7f1d 100644
--- a/src/client/View/LoggedIn/Paging.elm
+++ b/src/client/View/LoggedIn/Paging.elm
@@ -90,7 +90,10 @@ paymentsPage : LoggedInView -> Int -> Html
 paymentsPage loggedInView page =
   let onCurrentPage = page == loggedInView.currentPage
   in  button
-        [ class ("page" ++ (if onCurrentPage then " current" else ""))
+        [ classList
+            [ ("page", True)
+            , ("current", onCurrentPage)
+            ]
         , onClick serverCommunications.address <|
             if onCurrentPage then SC.NoCommunication else SC.UpdatePage page
         ]
diff --git a/src/client/View/LoggedIn/Table.elm b/src/client/View/LoggedIn/Table.elm
index 0c65e50..d98cee6 100644
--- a/src/client/View/LoggedIn/Table.elm
+++ b/src/client/View/LoggedIn/Table.elm
@@ -25,6 +25,7 @@ import Update.LoggedIn exposing (..)
 
 import View.Icon exposing (renderIcon)
 import View.Date exposing (..)
+import View.Price exposing (price)
 
 paymentsTable : Model -> LoggedInView -> Html
 paymentsTable model loggedInView =
@@ -53,13 +54,20 @@ paymentLines model loggedInView =
 paymentLine : Model -> LoggedInView -> Payment -> Html
 paymentLine model loggedInView payment =
   a
-    [ class ("row" ++ (if loggedInView.paymentEdition == Just payment.id then " edition" else ""))
+    [ classList
+        [ ("row", True)
+        , ("edition", loggedInView.paymentEdition == Just payment.id)
+        ]
     , onClick actions.address (UpdateLoggedIn (ToggleEdit payment.id))
     ]
     [ div [ class "cell category" ] [ text payment.name ]
     , div
-        [ class ("cell cost" ++ if payment.cost < 0 then " refund" else "") ]
-        [ text ((toString payment.cost) ++ " " ++ (getMessage "MoneySymbol" model.translations)) ]
+        [ classList
+            [ ("cell cost", True)
+            , ("refund", payment.cost < 0)
+            ]
+        ]
+        [ text (price model payment.cost) ]
     , div
         [ class "cell user" ]
         [ payment.userId
diff --git a/src/client/View/Price.elm b/src/client/View/Price.elm
new file mode 100644
index 0000000..cb8abd2
--- /dev/null
+++ b/src/client/View/Price.elm
@@ -0,0 +1,38 @@
+module View.Price
+  ( price
+  ) where
+
+import String exposing (..)
+
+import Model exposing (Model)
+import Model.Translations exposing (getMessage)
+
+price : Model -> Int -> String
+price model amount =
+  (  formatInt amount
+  ++ " "
+  ++ getMessage "MoneySymbol" model.translations
+  )
+
+formatInt : Int -> String
+formatInt n =
+  abs n
+    |> toString
+    |> toList
+    |> List.reverse
+    |> group 3
+    |> List.intersperse [' ']
+    |> List.concat
+    |> List.reverse
+    |> fromList
+    |> append (if n < 0 then "-" else "")
+
+group : Int -> List a -> List (List a)
+group n xs =
+  if List.length xs <= n
+    then
+      [xs]
+    else
+      let take = List.take n xs
+          drop = List.drop n xs
+      in  take :: (group n drop)
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
index 17f5ae9..da67051 100644
--- a/src/server/Controller/Index.hs
+++ b/src/server/Controller/Index.hs
@@ -1,6 +1,6 @@
 module Controller.Index
-  ( getIndexAction
-  , signOutAction
+  ( getIndex
+  , signOut
   ) where
 
 import Web.Scotty
@@ -11,10 +11,10 @@ import qualified LoginSession
 
 import View.Page (page)
 
-getIndexAction :: ActionM ()
-getIndexAction = html page
+getIndex :: ActionM ()
+getIndex = html page
 
-signOutAction :: ActionM ()
-signOutAction = do
+signOut :: ActionM ()
+signOut = do
   LoginSession.delete
   status ok200
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 85e2a87..02c8a8e 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -1,12 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Controller.Payment
-  ( getPaymentsAction
-  , getMonthlyPaymentsAction
-  , createPaymentAction
-  , deletePaymentAction
-  , getTotalPaymentsAction
-  , getPaymentsCountAction
+  ( getPayments
+  , getMonthlyPayments
+  , createPayment
+  , deletePayment
+  , getTotalPayments
+  , getPaymentsCount
   ) where
 
 import Web.Scotty
@@ -22,40 +22,39 @@ import qualified Data.Aeson.Types as Json
 
 import qualified Secure
 
+import Json (jsonObject)
+
 import Model.Database
-import Model.Payment
+import qualified Model.Payment as P
 import Model.Frequency
 import Model.Json.Number
 import qualified Model.Json.PaymentId as JP
 import Model.Message
 import Model.Message.Key (Key(PaymentNotDeleted))
 
-
-import Json (jsonObject)
-
-getPaymentsAction :: Int -> Int -> ActionM ()
-getPaymentsAction page perPage =
+getPayments :: Int -> Int -> ActionM ()
+getPayments page perPage =
   Secure.loggedAction (\_ -> do
-    (liftIO $ runDb (getPunctualPayments page perPage)) >>= json
+    (liftIO $ runDb (P.getPunctualPayments page perPage)) >>= json
   )
 
-getMonthlyPaymentsAction :: ActionM ()
-getMonthlyPaymentsAction =
+getMonthlyPayments :: ActionM ()
+getMonthlyPayments =
   Secure.loggedAction (\user -> do
-    (liftIO $ runDb (getUserMonthlyPayments (entityKey user))) >>= json
+    (liftIO $ runDb (P.getUserMonthlyPayments (entityKey user))) >>= json
   )
 
-createPaymentAction :: Text -> Int -> Frequency -> ActionM ()
-createPaymentAction name cost frequency =
+createPayment :: Text -> Int -> Frequency -> ActionM ()
+createPayment name cost frequency =
   Secure.loggedAction (\user -> do
-    paymentId <- liftIO . runDb $ createPayment (entityKey user) name cost frequency
+    paymentId <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency
     json (JP.PaymentId paymentId)
   )
 
-deletePaymentAction :: Text -> ActionM ()
-deletePaymentAction paymentId =
+deletePayment :: Text -> ActionM ()
+deletePayment paymentId =
   Secure.loggedAction (\user -> do
-    deleted <- liftIO . runDb $ deleteOwnPayment user (textToKey paymentId)
+    deleted <- liftIO . runDb $ P.deleteOwnPayment user (textToKey paymentId)
     if deleted
       then
         status ok200
@@ -64,14 +63,14 @@ deletePaymentAction paymentId =
         jsonObject [("error", Json.String $ getMessage PaymentNotDeleted)]
   )
 
-getTotalPaymentsAction :: ActionM ()
-getTotalPaymentsAction =
+getTotalPayments :: ActionM ()
+getTotalPayments =
   Secure.loggedAction (\_ -> do
-    (liftIO . runDb $ getTotalPayments) >>= json
+    (liftIO . runDb $ P.getTotalPayments) >>= json
   )
 
-getPaymentsCountAction :: ActionM ()
-getPaymentsCountAction =
+getPaymentsCount :: ActionM ()
+getPaymentsCount =
   Secure.loggedAction (\_ -> do
-    Number <$> (liftIO . runDb $ getPaymentsCount) >>= json
+    Number <$> (liftIO . runDb $ P.getPaymentsCount) >>= json
   )
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
index 4f41c6e..955ad35 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Controller.SignIn
-  ( signInAction
-  , validateSignInAction
+  ( signIn
+  , validateSignIn
   ) where
 
 import Web.Scotty
@@ -38,8 +38,8 @@ import Json (jsonObject)
 
 import qualified View.Mail.SignIn as SignIn
 
-signInAction :: Config -> Text -> ActionM ()
-signInAction config login =
+signIn :: Config -> Text -> ActionM ()
+signIn config login =
   if isValid (TE.encodeUtf8 login)
     then do
       maybeUser <- liftIO . runDb $ getUser login
@@ -63,8 +63,8 @@ errorResponse msg = do
   status badRequest400
   jsonObject [("error", Json.String msg)]
 
-validateSignInAction :: Config -> Text -> ActionM ()
-validateSignInAction config token = do
+validateSignIn :: Config -> Text -> ActionM ()
+validateSignIn config token = do
   maybeSignIn <- liftIO . runDb $ getSignInToken token
   now <- liftIO getCurrentTime
   case maybeSignIn of
diff --git a/src/server/Controller/User.hs b/src/server/Controller/User.hs
index 95e5fa8..bc99ea5 100644
--- a/src/server/Controller/User.hs
+++ b/src/server/Controller/User.hs
@@ -1,25 +1,38 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Controller.User
-  ( getUsersAction
-  , whoAmIAction
+  ( getUsers
+  , whoAmI
+  , getIncome
   ) where
 
 import Web.Scotty
 
 import Control.Monad.IO.Class (liftIO)
 
+import qualified Data.Aeson.Types as Json
+
 import qualified Secure
 
+import Json (jsonObject)
+
 import Model.Database
-import Model.User
+import qualified Model.User as U
 
-getUsersAction :: ActionM ()
-getUsersAction =
+getUsers :: ActionM ()
+getUsers =
   Secure.loggedAction (\_ -> do
-    (liftIO $ map getJsonUser <$> runDb getUsers) >>= json
+    (liftIO $ map U.getJsonUser <$> runDb U.getUsers) >>= json
   )
 
-whoAmIAction :: ActionM ()
-whoAmIAction =
+whoAmI :: ActionM ()
+whoAmI =
   Secure.loggedAction (\user -> do
-    json (getJsonUser user)
+    json (U.getJsonUser user)
+  )
+
+getIncome :: ActionM ()
+getIncome =
+  Secure.loggedAction (\_ -> do
+    jsonObject []
   )
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 7d2b7b6..10e997d 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -26,9 +26,15 @@ radius = px 3
 blockPadding :: Size Abs
 blockPadding = px 15
 
+blockPercentWidth :: Double
+blockPercentWidth = 90
+
 blockMarginBottom :: Size Abs
 blockMarginBottom = px 50
 
+rowHeight :: Size Abs
+rowHeight = px 60
+
 global :: Css
 global = do
 
@@ -38,24 +44,27 @@ global = do
     fontFamily ["Cantarell"] [sansSerif]
 
   header ? do
-    let headerHeight = 150
+    let headerHeight = 80
+    let sidePercent = (pct ((100 - blockPercentWidth) / 2))
 
     h1 ? do
       fontSize (px 45)
-      textAlign (alignSide sideCenter)
-      color C.red
+      textAlign (alignSide sideLeft)
+      backgroundColor C.red
+      color C.white
       lineHeight (px headerHeight)
-
+      marginBottom blockMarginBottom
+      paddingLeft sidePercent
     button # ".signOut" ? do
       let iconHeight = 50
-      let sideMargin = ((headerHeight - iconHeight) `Prelude.div` 2) + 5
+      let sideMargin = ((headerHeight - iconHeight) `Prelude.div` 2)
       position absolute
       top (px sideMargin)
-      right (pct 2)
+      right sidePercent
       height (px iconHeight)
       lineHeight (px iconHeight)
-      backgroundColor C.white
-      color C.red
+      backgroundColor C.red
+      color C.white
       fontSize iconFontSize
       hover & transform (scale 1.2 1.2)
 
@@ -137,6 +146,11 @@ global = do
       centeredWithMargin
       clearFix
 
+      ".expand" ? do
+        position absolute
+        right blockPadding
+        bottom (px 2)
+
       ".monthlyPayments" ? do
         marginBottom blockMarginBottom
 
@@ -144,40 +158,35 @@ global = do
           float floatLeft
           width (pct 55)
 
-        button # ".count" ? do
-          width (pct 100)
-          fontSize (px 18)
+        ".count" ? do
           defaultButton C.blue C.white inputHeight
-          borderRadius radius radius radius radius
-          textAlign (alignSide sideLeft)
-          position relative
-          paddingLeft blockPadding
-          paddingRight blockPadding
-
-          ".expand" ? do
-            float floatRight
-            marginTop (px (-2))
-
-        ".detail" &
-          button # ".count" ?
-            borderRadius radius radius 0 0
-
-      ".exceedingPayers" ? do
-        backgroundColor C.green
-        color C.white
-        fontSize (px 18)
-        borderRadius radius radius radius radius
+          buttonBlock
+          cursor cursorText
+
+        button # ".count" ? cursor pointer
+
+      ".account" ? do
         marginBottom blockMarginBottom
-        paddingLeft blockPadding
-        paddingRight blockPadding
 
         largeScreen $ do
           float floatRight
           width (pct 40)
 
-        ".exceedingPayer" ? do
-          lineHeight (px inputHeight)
-          ".userName" ? marginRight (px 10)
+        ".exceedingPayers" ? do
+          defaultButton C.green C.white inputHeight
+          buttonBlock
+
+          ".exceedingPayer" ? do
+            lineHeight (px inputHeight)
+            ".userName" ? marginRight (px 10)
+
+        ".income" ? do
+          backgroundColor C.lightGrey
+          lineHeight rowHeight
+          padding (px 0) (px 20) (px 0) (px 20)
+
+      ".detail" |> (".count" <> ".exceedingPayers") ?
+        borderRadius radius radius 0 0
 
     ".table" ? do
       display D.table
@@ -187,11 +196,10 @@ global = do
 
       ".header" <> ".row" ? display tableRow
       let headerHeight = (px 70)
-      let rowHeight = (px 60)
 
       ".header" ? do
         fontWeight bold
-        backgroundColor C.red
+        backgroundColor C.blue
         color C.white
         fontSize iconFontSize
         lineHeight headerHeight
@@ -261,7 +269,7 @@ global = do
     form ? do
       let inputHeight = 50
       width (px 500)
-      marginTop (px 50)
+      marginTop (px 100)
       marginLeft auto
       marginRight auto
 
@@ -296,7 +304,6 @@ defaultButton backgroundCol textCol pxHeight = do
   borderRadius radius radius radius radius
   verticalAlign middle
   cursor pointer
-  height (px pxHeight)
   lineHeight (px pxHeight)
   textAlign (alignSide sideCenter)
 
@@ -311,6 +318,16 @@ defaultInput inputHeight = do
 
 centeredWithMargin :: Css
 centeredWithMargin = do
-  width (pct 90)
+  width (pct blockPercentWidth)
   marginLeft auto
   marginRight auto
+
+buttonBlock :: Css
+buttonBlock = do
+  width (pct 100)
+  fontSize (px 18)
+  borderRadius radius radius radius radius
+  textAlign (alignSide sideLeft)
+  position relative
+  paddingLeft blockPadding
+  paddingRight blockPadding
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 1a151fc..8956fa4 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -33,46 +33,43 @@ main = do
         middleware $
           staticPolicy (noDots >-> addBase "public")
 
-        get "/" $
-          getIndexAction
+        get  "/"        getIndex
+        post "/signOut" signOut
+
+        -- SignIn
 
         post "/signIn" $ do
           login <- param "login" :: ActionM Text
-          signInAction config login
+          signIn config login
 
         get "/validateSignIn" $ do
           token <- param "token" :: ActionM Text
-          validateSignInAction config token
+          validateSignIn config token
 
-        post "/signOut" $
-          signOutAction
+        -- Users
 
-        get "/whoAmI" $
-          whoAmIAction
+        get "/users"  getUsers
+        get "/whoAmI" whoAmI
+        get "/income" getIncome
 
-        get "/users" $ do
-          getUsersAction
+        -- Payments
 
         get "/payments" $ do
-          page <- param "page" :: ActionM Int
+          page    <- param "page"    :: ActionM Int
           perPage <- param "perPage" :: ActionM Int
-          getPaymentsAction page perPage
+          getPayments page perPage
 
-        get "/monthlyPayments" $ do
-          getMonthlyPaymentsAction
+        get "/monthlyPayments" getMonthlyPayments
 
         post "/payment/add" $ do
           name <- param "name" :: ActionM Text
           cost <- param "cost" :: ActionM Int
           frequency <- param "frequency" :: ActionM Frequency
-          createPaymentAction name cost frequency
+          createPayment name cost frequency
 
         post "/payment/delete" $ do
           paymentId <- param "id" :: ActionM Text
-          deletePaymentAction paymentId
-
-        get "/payments/total" $ do
-          getTotalPaymentsAction
+          deletePayment paymentId
 
-        get "/payments/count" $ do
-          getPaymentsCountAction
+        get "/payments/total" getTotalPayments
+        get "/payments/count" getPaymentsCount
diff --git a/src/server/Model/Mail.hs b/src/server/Model/Mail.hs
index 20addee..7c1a6ed 100644
--- a/src/server/Model/Mail.hs
+++ b/src/server/Model/Mail.hs
@@ -10,5 +10,4 @@ data Mail = Mail
   , to :: [Text]
   , subject :: Text
   , plainBody :: LT.Text
-  , htmlBody :: LT.Text
   } deriving (Eq, Show)
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 3d915b9..4076768 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -19,8 +19,7 @@ data Key =
   | SignInExpired
   | SignInInvalid
   | SignInMailTitle
-  | HiMail
-  | SignInLinkMail
+  | SignInMail
   | SignInEmailSent
 
   -- Dates
@@ -54,7 +53,13 @@ data Key =
   | MoneySymbol
   | Punctual
   | Monthly
+  | NoMonthlyPayment
   | SingularMonthlyCount
   | PluralMonthlyCount
 
+  -- Income
+
+  | Income
+  | NoIncome
+
   deriving (Enum, Bounded, Show)
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 79d177f..fce979a 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -69,25 +69,35 @@ m l SignInMailTitle =
     English -> T.concat ["Sign in to ", m l SharedCost]
     French  -> T.concat ["Connexion à ", m l SharedCost]
 
-m l HiMail =
-  case l of
-    English -> "Hi {1},"
-    French  -> "Salut {1},"
-
-m l SignInLinkMail =
-  case l of
-    English ->
-      T.concat
-        [ "Click to the following link in order to sign in to Shared Cost:"
-        , m l SharedCost
-        , ":"
-        ]
-    French  ->
-      T.concat
-        [ "Clique sur le lien suivant pour te connecter à "
-        , m l SharedCost
-        , ":"
-        ]
+m l SignInMail =
+  T.intercalate
+    "\n"
+    ( case l of
+        English ->
+          [ "Hi {1},"
+          , ""
+          , T.concat
+              [ "Click to the following link in order to sign in to Shared Cost:"
+              , m l SharedCost
+              , ":"
+              ]
+          , "{2}"
+          , ""
+          , "See you soon!"
+          ]
+        French  ->
+          [ "Salut {1},"
+          , ""
+          , T.concat
+              [ "Clique sur le lien suivant pour te connecter à "
+              , m l SharedCost
+              , ":"
+              ]
+          , "{2}"
+          , ""
+          , "À très vite !"
+          ]
+    )
 
 m l SignInEmailSent =
   case l of
@@ -210,20 +220,34 @@ m l Monthly =
     English -> "Monthly"
     French  -> "Mensuel"
 
+m l NoMonthlyPayment =
+  case l of
+    English -> "No monthly payment"
+    French  -> "Aucun paiement mensuel"
+
 m l SingularMonthlyCount =
   T.concat
     [ case l of
         English -> "{1} monthly payment of {2} "
         French  -> "{1} paiement mensuel de {2} "
     , m l MoneySymbol
-    , "."
     ]
 
 m l PluralMonthlyCount =
   T.concat
     [ case l of
-        English -> "{1} monthly payments totalling {2} "
-        French  -> "{1} paiements mensuels comptabilisant {2} "
-    , m l MoneySymbol
-    , "."
+        English -> "{1} monthly payments totalling {2}"
+        French  -> "{1} paiements mensuels comptabilisant {2}"
     ]
+
+m l Income =
+  T.concat
+    [ case l of
+        English -> "You have a monthly net income of {1}"
+        French  -> "Votre revenu mensuel net est de {1}"
+    ]
+
+m l NoIncome =
+  case l of
+    English -> "Income not given"
+    French  -> "Revenu non renseigné"
diff --git a/src/server/SendMail.hs b/src/server/SendMail.hs
index e57f345..8f62bb1 100644
--- a/src/server/SendMail.hs
+++ b/src/server/SendMail.hs
@@ -24,15 +24,11 @@ sendMail mail = do
   return result
 
 getMimeMail :: Mail -> M.Mail
-getMimeMail (Mail from to subject plainBody htmlBody) =
+getMimeMail (Mail from to subject plainBody) =
   let fromMail = M.emptyMail (address from)
   in  fromMail
         { M.mailTo = map address to
-        , M.mailParts =
-            [ [ M.plainPart plainBody
-              , M.htmlPart htmlBody
-              ]
-            ]
+        , M.mailParts = [ [ M.plainPart plainBody ] ]
         , M.mailHeaders = [("Subject", subject)]
         }
 
diff --git a/src/server/View/Mail/SignIn.hs b/src/server/View/Mail/SignIn.hs
index fc73dae..dca261d 100644
--- a/src/server/View/Mail/SignIn.hs
+++ b/src/server/View/Mail/SignIn.hs
@@ -8,10 +8,6 @@ import Data.Text (Text)
 import qualified Data.Text.Lazy as LT
 import Data.Text.Lazy.Builder (toLazyText, fromText)
 
-import Text.Blaze.Html
-import Text.Blaze.Html5
-import Text.Blaze.Html.Renderer.Text (renderHtml)
-
 import Model.Database (User(..))
 import qualified Model.Mail as M
 import Model.Message.Key
@@ -24,28 +20,10 @@ getMail user url to =
     , M.to = to
     , M.subject = (getMessage SignInMailTitle)
     , M.plainBody = plainBody user url
-    , M.htmlBody = htmlBody user url
     }
 
 plainBody :: User -> Text -> LT.Text
-plainBody user url =
-  LT.intercalate
-    "\n"
-    [ strictToLazy (getParamMessage [userName user] HiMail)
-    , ""
-    , strictToLazy (getMessage SignInLinkMail)
-    , strictToLazy url
-    ]
-
-htmlBody :: User -> Text -> LT.Text
-htmlBody user url =
-  renderHtml . docTypeHtml . body $ do
-    toHtml $ strictToLazy (getParamMessage [userName user] HiMail)
-    br
-    br
-    toHtml $ strictToLazy (getMessage SignInLinkMail)
-    br
-    toHtml url
+plainBody user url = strictToLazy (getParamMessage [userName user, url] SignInMail)
 
 strictToLazy :: Text -> LT.Text
 strictToLazy = toLazyText . fromText