Adding UI income read-only

15 files changed, 264 insertions, 78 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)