Add cumulative incomes by user

13 files changed, 109 insertions, 37 deletions

diff --git a/src/client/elm/LoggedIn/Home/Account/View.elm b/src/client/elm/LoggedIn/Home/Account/View.elm
index bec75d5..dc72791 100644
--- a/src/client/elm/LoggedIn/Home/Account/View.elm
+++ b/src/client/elm/LoggedIn/Home/Account/View.elm
@@ -8,11 +8,11 @@ import Html.Attributes exposing (..)
 import LoggedData exposing (LoggedData)
 
 import LoggedIn.Home.Model as HomeModel
-import LoggedIn.Home.Model.Payer exposing (..)
 import LoggedIn.View.Format as Format
 
 import Model exposing (Model)
 import Model.User exposing (getUserName)
+import Model.Payer exposing (..)
 
 view : LoggedData -> HomeModel.Model -> Html
 view loggedData homeModel =
diff --git a/src/client/elm/LoggedIn/Home/AddPayment/View.elm b/src/client/elm/LoggedIn/Home/AddPayment/View.elm
index 562f69b..96f3a6a 100644
--- a/src/client/elm/LoggedIn/Home/AddPayment/View.elm
+++ b/src/client/elm/LoggedIn/Home/AddPayment/View.elm
@@ -4,7 +4,7 @@ module LoggedIn.Home.AddPayment.View
 
 import Result exposing (..)
 
-import Html as H exposing (..)
+import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 
@@ -31,7 +31,7 @@ import Utils.Either exposing (toMaybeError)
 
 view : LoggedData -> HomeModel.Model -> Html
 view loggedData homeModel =
-  H.form
+  Html.form
     [ let update =
             if homeModel.add.waitingServer
               then
diff --git a/src/client/elm/LoggedIn/Home/Model.elm b/src/client/elm/LoggedIn/Home/Model.elm
index 26af63c..217a851 100644
--- a/src/client/elm/LoggedIn/Home/Model.elm
+++ b/src/client/elm/LoggedIn/Home/Model.elm
@@ -3,10 +3,9 @@ module LoggedIn.Home.Model
   , init
   ) where
 
-import LoggedIn.Home.Model.Payer exposing (Payers)
-
 import Model.User exposing (Users, UserId)
 import Model.Payment exposing (PaymentId, Payments, Frequency(..))
+import Model.Payer exposing (Payers)
 
 import LoggedIn.Home.AddPayment.Model as AddPaymentModel
 
diff --git a/src/client/elm/LoggedIn/Home/View/Paging.elm b/src/client/elm/LoggedIn/Home/View/Paging.elm
index b669b6e..939ee55 100644
--- a/src/client/elm/LoggedIn/Home/View/Paging.elm
+++ b/src/client/elm/LoggedIn/Home/View/Paging.elm
@@ -45,7 +45,7 @@ truncatePages currentPage pages =
         if currentPage <= showedLeftPages then
           [1..showedPages]
         else if currentPage > totalPages - showedRightPages then
-          [(totalPages - showedPages)..totalPages]
+          [(totalPages - showedPages + 1)..totalPages]
         else
           [(currentPage - showedLeftPages)..(currentPage + showedRightPages)]
   in  List.filter (flip List.member pages) truncatedPages
diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm
index f62902a..9e77fde 100644
--- a/src/client/elm/LoggedIn/Income/View.elm
+++ b/src/client/elm/LoggedIn/Income/View.elm
@@ -4,6 +4,7 @@ module LoggedIn.Income.View
 
 import Dict
 import Date
+import Time exposing (Time)
 
 import Html exposing (..)
 import Html.Events exposing (..)
@@ -13,8 +14,10 @@ import Form.Input as Input
 
 import LoggedData exposing (LoggedData)
 
-import Model.Income exposing (IncomeId, Income)
-import Model.Translations exposing (getMessage)
+import Model.Income exposing (IncomeId, Income, userCumulativeIncomeSince)
+import Model.Translations exposing (getMessage, getParamMessage)
+import Model.Payer exposing (useIncomesFrom)
+import Model.User exposing (UserId, User)
 import LoggedIn.Income.Model as IncomeModel
 
 import Mailbox
@@ -28,16 +31,46 @@ import LoggedIn.View.Format as Format
 
 import Utils.Maybe exposing (isJust)
 
+import LoggedIn.View.Date exposing (renderLongDate)
+import View.Events exposing (onSubmitPrevDefault)
+
 view : LoggedData -> IncomeModel.Model -> Html
 view loggedData incomeModel =
   div
     [ class "income" ]
-    [ h1 [] [ text <| getMessage "AddIncome" loggedData.translations ]
+    [ 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 ]
     , incomesView loggedData
     ]
 
+cumulativeIncomesView : LoggedData -> Time -> Html
+cumulativeIncomesView loggedData since =
+  let longDate = renderLongDate (Date.fromTime since) loggedData.translations
+  in  div
+        []
+        [ h1 [] [ text <| getParamMessage [longDate] "CumulativeIncomesSince" loggedData.translations ]
+        , ul
+            []
+            ( Dict.toList loggedData.users
+                |> List.map (\(userId, user) ->
+                     (user.name, userCumulativeIncomeSince loggedData.currentTime since loggedData.incomes userId)
+                   )
+                |> List.sortBy snd
+                |> List.map (\(userName, cumulativeIncome) ->
+                     li
+                       []
+                       [ text userName
+                       , text ": "
+                       , text <| Format.price loggedData.conf cumulativeIncome
+                       ]
+                   )
+            )
+        ]
+
 addIncomeView : LoggedData -> Form () IncomeModel.AddIncome -> Html
 addIncomeView loggedData addIncome =
   let
@@ -49,8 +82,8 @@ addIncomeView loggedData addIncome =
     creation = Form.getFieldAsString "creation" addIncome
     amount = Form.getFieldAsString "amount" addIncome
   in
-    div
-      []
+    Html.form
+      [ onSubmitPrevDefault Mailbox.address Action.NoOp ]
       [ label [] [ text "Creation" ]
       , Input.textInput creation formAddress []
       , errorFor "DateValidationError" creation
diff --git a/src/client/elm/LoggedIn/Stat/View.elm b/src/client/elm/LoggedIn/Stat/View.elm
index f4bc56c..6661a75 100644
--- a/src/client/elm/LoggedIn/Stat/View.elm
+++ b/src/client/elm/LoggedIn/Stat/View.elm
@@ -41,8 +41,22 @@ paymentsDetail loggedData payments =
     , li
         []
         [ text (paymentsSum loggedData.conf payments) ]
+    , li
+        []
+        [ text "Par utilisateur:"
+        , totalPayments loggedData
+        ]
+    ]
+
+totalPayments : LoggedData -> Html
+totalPayments loggedData =
+  ul
+    []
+    [ li [] [ text "Jacques: 1 300€" ]
+    , li [] [ text "Anne: 2 500 €" ]
     ]
 
+
 monthsDetail : LoggedData -> Html
 monthsDetail loggedData =
   ul
diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm
index f364a8b..ea990e2 100644
--- a/src/client/elm/Model/Income.elm
+++ b/src/client/elm/Model/Income.elm
@@ -5,6 +5,7 @@ module Model.Income
   , incomesDecoder
   , incomeIdDecoder
   , incomeDefinedForAll
+  , userCumulativeIncomeSince
   , cumulativeIncomesSince
   ) where
 
@@ -55,6 +56,13 @@ incomeDefinedForAll userIds incomes =
         then head << reverse << List.sort << map .creation << catMaybes <| firstIncomes
         else Nothing
 
+userCumulativeIncomeSince : Time -> Time -> Incomes -> UserId -> Int
+userCumulativeIncomeSince currentTime since incomes userId =
+  incomes
+    |> Dict.values
+    |> List.filter (\income -> income.userId == userId)
+    |> cumulativeIncomesSince currentTime since
+
 cumulativeIncomesSince : Time -> Time -> (List Income) -> Int
 cumulativeIncomesSince currentTime since incomes =
   cumulativeIncome currentTime (getOrderedIncomesSince since incomes)
diff --git a/src/client/elm/LoggedIn/Home/Model/Payer.elm b/src/client/elm/Model/Payer.elm
index be40ffa..a7ce5fa 100644
--- a/src/client/elm/LoggedIn/Home/Model/Payer.elm
+++ b/src/client/elm/Model/Payer.elm
@@ -1,8 +1,10 @@
-module LoggedIn.Home.Model.Payer
+module Model.Payer
   ( Payers
   , Payer
   , ExceedingPayer
   , getOrderedExceedingPayers
+  , useIncomesFrom
+  , getPostPaymentPayer
   ) where
 
 import Json.Decode as Json exposing (..)
@@ -40,16 +42,10 @@ getOrderedExceedingPayers currentTime users incomes payments =
           |> mapValues .preIncomePaymentSum
           |> Dict.toList
           |> exceedingPayersFromAmounts
-      firstPaymentTime =
-        payments
-          |> List.map (Date.toTime << .creation)
-          |> List.sort
-          |> List.head
-      incomesForAllTime = incomeDefinedForAll (Dict.keys users) incomes
-  in  case (firstPaymentTime, incomesForAllTime) of
-        (Just paymentTime, Just incomeTime) ->
-          let since = max paymentTime incomeTime
-              postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers
+      mbSince = useIncomesFrom users incomes payments
+  in  case mbSince of
+        Just since ->
+          let postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers
               mbMaxRatio =
                 postPaymentPayers
                   |> Dict.toList
@@ -66,6 +62,20 @@ getOrderedExceedingPayers currentTime users incomes payments =
         _ ->
           exceedingPayersOnPreIncome
 
+useIncomesFrom : Users -> Incomes -> Payments -> Maybe Time
+useIncomesFrom users incomes payments =
+  let firstPaymentTime =
+        payments
+          |> List.map (Date.toTime << .creation)
+          |> List.sort
+          |> List.head
+      incomesForAllTime = incomeDefinedForAll (Dict.keys users) incomes
+  in  case (firstPaymentTime, incomesForAllTime) of
+        (Just paymentTime, Just incomeTime) ->
+          Just (max paymentTime incomeTime)
+        _ ->
+          Nothing
+
 getPayers : Time -> Users -> Incomes -> Payments -> Payers
 getPayers currentTime users incomes payments =
   let userIds = Dict.keys users
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 90dd842..e2e98a7 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -36,14 +36,19 @@ global = do
   a ? cursor pointer
 
   h1 ? do
-    fontSize (px 20)
+    fontSize (px 24)
     color Color.red
-    marginBottom (em 1)
+    "margin-bottom" -: "3vh"
 
   ul ? do
-    marginBottom (em 1)
-    li ? do
-      marginBottom (em 0.5)
+    "margin-bottom" -: "3vh"
+    "margin-left" -: "1vh"
+    li <? do
+      "margin-bottom" -: "2vh"
       before & do
         content (stringContent "• ")
         color Color.red
+        "margin-right" -: "0.3vw"
+      ul <? do
+        "margin-left" -: "3vh"
+        "margin-top" -: "2vh"
diff --git a/src/server/Design/LoggedIn/Home/Pages.hs b/src/server/Design/LoggedIn/Home/Pages.hs
index 932865c..0572fbf 100644
--- a/src/server/Design/LoggedIn/Home/Pages.hs
+++ b/src/server/Design/LoggedIn/Home/Pages.hs
@@ -12,7 +12,7 @@ import Design.Constants
 
 design :: Css
 design = do
-  padding (px 30) (px 30) (px 30) (px 30)
+  padding (px 40) (px 30) (px 30) (px 30)
   textAlign (alignSide (sideCenter))
   clearFix
 
diff --git a/src/server/Design/LoggedIn/Income.hs b/src/server/Design/LoggedIn/Income.hs
index b7efb9e..99626ba 100644
--- a/src/server/Design/LoggedIn/Income.hs
+++ b/src/server/Design/LoggedIn/Income.hs
@@ -7,4 +7,7 @@ module Design.LoggedIn.Income
 import Clay
 
 design :: Css
-design = h1 ? paddingBottom (px 0)
+design = do
+  h1 ? paddingBottom (px 0)
+  form ? do
+    "margin-bottom" -: "3vh"
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index b42cdcd..43b8faa 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -52,7 +52,6 @@ data Key =
   | CategoryRequired
   | CostRequired
   | DateValidationError
-  | IncomeValidationError
 
   -- Payments
 
@@ -73,6 +72,7 @@ data Key =
 
   -- Income
 
+  | CumulativeIncomesSince
   | AddIncome
   | Income
   | MonthlyNetIncomes
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 1d3fbe6..d4e5454 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -203,11 +203,6 @@ m l DateValidationError =
     English -> "The date must be day/month/year"
     French  -> "La date doit avoir la forme jour/mois/année"
 
-m l IncomeValidationError =
-  case l of
-    English -> "The income must be a positive integer."
-    French  -> "Le revenu doit être un entier positif."
-
 -- Payments
 
 m l Add =
@@ -269,9 +264,14 @@ m l ByMonths =
 
 -- Income
 
+m l CumulativeIncomesSince =
+  case l of
+    English -> "Cumulative incomes since {0}"
+    French  -> "Revenus nets cumulés depuis le {0}"
+
 m l AddIncome =
   case l of
-    English -> "Add a monthly net income"
+    English -> "Add a monthly income"
     French  -> "Ajouter un revenu mensuel net"
 
 m l Income =
@@ -281,7 +281,7 @@ m l Income =
 
 m l MonthlyNetIncomes =
   case l of
-    English -> "Monthly net incomes"
+    English -> "Monthly incomes"
     French  -> "Revenus mensuels nets"
 
 m l IncomeNotDeleted =