Add a chart on payments by month by categories

8 files changed, 184 insertions, 96 deletions

diff --git a/src/client/LoggedIn/Model.elm b/src/client/LoggedIn/Model.elm
index 6c858a6..f4fad94 100644
--- a/src/client/LoggedIn/Model.elm
+++ b/src/client/LoggedIn/Model.elm
@@ -5,17 +5,18 @@ module LoggedIn.Model exposing
 
 import Time exposing (Time)
 
+import LoggedIn.Home.Model as Home
+import LoggedIn.Stat.Model as Stat
+import Model.Category exposing (Categories)
+import Model.Income exposing (Incomes)
 import Model.Init exposing (..)
 import Model.Payment exposing (Payments)
-import Model.User exposing (Users, UserId)
-import Model.Income exposing (Incomes)
-import Model.Category exposing (Categories)
 import Model.PaymentCategory exposing (PaymentCategories)
-
-import LoggedIn.Home.Model as Home
+import Model.User exposing (Users, UserId)
 
 type alias Model =
   { home : Home.Model
+  , stat : Stat.Model
   , users : Users
   , me : UserId
   , payments : Payments
@@ -24,13 +25,14 @@ type alias Model =
   , paymentCategories : PaymentCategories
   }
 
-init : Init -> Model
-init initData =
+init : Time -> Init -> Model
+init time { users, me, payments, incomes, categories, paymentCategories } =
   { home = Home.init
-  , users = initData.users
-  , me = initData.me
-  , payments = initData.payments
-  , incomes = initData.incomes
-  , categories = initData.categories
-  , paymentCategories = initData.paymentCategories
+  , stat = Stat.init time paymentCategories payments
+  , users = users
+  , me = me
+  , payments = payments
+  , incomes = incomes
+  , categories = categories
+  , paymentCategories = paymentCategories
   }
diff --git a/src/client/LoggedIn/Msg.elm b/src/client/LoggedIn/Msg.elm
index d00e2cb..d9b3bce 100644
--- a/src/client/LoggedIn/Msg.elm
+++ b/src/client/LoggedIn/Msg.elm
@@ -4,16 +4,17 @@ module LoggedIn.Msg exposing
 
 import Date exposing (Date)
 
-import Model.Payment exposing (PaymentId)
+import LoggedIn.Home.Msg as Home
+import LoggedIn.Stat.Msg as Stat
+import Model.Category exposing (CategoryId)
 import Model.Frequency exposing (Frequency)
 import Model.Income exposing (IncomeId)
-import Model.Category exposing (CategoryId)
-
-import LoggedIn.Home.Msg as Home
+import Model.Payment exposing (PaymentId)
 
 type Msg =
   NoOp
   | HomeMsg Home.Msg
+  | StatMsg Stat.Msg
   | ValidateCreatePayment PaymentId String Int Date CategoryId Frequency
   | ValidateEditPayment PaymentId String Int Date CategoryId Frequency
   | ValidateDeletePayment PaymentId
diff --git a/src/client/LoggedIn/Stat/Model.elm b/src/client/LoggedIn/Stat/Model.elm
new file mode 100644
index 0000000..bfc66f2
--- /dev/null
+++ b/src/client/LoggedIn/Stat/Model.elm
@@ -0,0 +1,34 @@
+module LoggedIn.Stat.Model exposing
+  ( Model
+  , init
+  , getPaymentsByMonthByCategory
+  )
+
+import Date exposing (Month)
+import List.Extra as List
+import Time exposing (Time)
+
+import Model.Category exposing (CategoryId)
+import Model.Conf exposing (Conf)
+import Model.Payment as Payment exposing (Payments)
+import Model.PaymentCategory as PaymentCategory exposing (PaymentCategories)
+
+type alias Model =
+  { paymentsByMonthByCategory : List ((Month, Int), List (CategoryId, Int))
+  }
+
+init : Time -> PaymentCategories -> Payments -> Model
+init currentTime paymentCategories payments =
+  { paymentsByMonthByCategory = getPaymentsByMonthByCategory currentTime paymentCategories payments
+  }
+
+getPaymentsByMonthByCategory : Time -> PaymentCategories -> Payments -> List ((Month, Int), List (CategoryId, Int))
+getPaymentsByMonthByCategory currentTime paymentCategories payments =
+  Payment.punctual payments
+    |> Payment.groupAndSortByMonth
+    |> List.map (\(m, payments) ->
+         ( m
+         , PaymentCategory.groupPaymentsByCategory paymentCategories payments
+             |> List.map (Tuple.mapSecond (List.sum << List.map .cost))
+         )
+       )
diff --git a/src/client/LoggedIn/Stat/Msg.elm b/src/client/LoggedIn/Stat/Msg.elm
new file mode 100644
index 0000000..d517544
--- /dev/null
+++ b/src/client/LoggedIn/Stat/Msg.elm
@@ -0,0 +1,7 @@
+module LoggedIn.Stat.Msg exposing
+  ( Msg(..)
+  )
+
+type Msg =
+  NoOp
+  | UpdateChart
diff --git a/src/client/LoggedIn/Stat/Update.elm b/src/client/LoggedIn/Stat/Update.elm
new file mode 100644
index 0000000..2415733
--- /dev/null
+++ b/src/client/LoggedIn/Stat/Update.elm
@@ -0,0 +1,24 @@
+module LoggedIn.Stat.Update exposing
+  ( update
+  )
+
+import LoggedData exposing (LoggedData)
+import LoggedIn.Stat.Model as Stat
+import LoggedIn.Stat.Msg as Stat
+
+update : LoggedData -> Stat.Msg -> Stat.Model -> (Stat.Model, Cmd Stat.Msg)
+update loggedData msg model =
+  case msg of
+
+    Stat.NoOp ->
+      ( model
+      , Cmd.none
+      )
+
+    Stat.UpdateChart ->
+      let { currentTime, paymentCategories, payments } = loggedData
+      in  ( { model
+            | paymentsByMonthByCategory = Stat.getPaymentsByMonthByCategory currentTime paymentCategories payments
+            }
+          , Cmd.none
+          )
diff --git a/src/client/LoggedIn/Stat/View.elm b/src/client/LoggedIn/Stat/View.elm
index f57316a..e389c67 100644
--- a/src/client/LoggedIn/Stat/View.elm
+++ b/src/client/LoggedIn/Stat/View.elm
@@ -3,60 +3,75 @@ module LoggedIn.Stat.View exposing
   )
 
 import Date exposing (Month)
-
+import Dict
 import Html exposing (..)
 import Html.Attributes exposing (..)
+import List.Extra as List
+import Time exposing (Time)
 
+import Chart.Api as Chart
 import LoggedData exposing (LoggedData)
-
-import Msg exposing (Msg)
-
-import Model.Payment as Payment exposing (Payments)
-import Model.Conf exposing (Conf)
-import Model.Translations exposing (getMessage, getParamMessage)
-
+import LoggedIn.Stat.Model as Stat
 import LoggedIn.View.Format as Format
+import Model.Category exposing (CategoryId, Categories)
+import Model.Conf exposing (Conf)
+import Model.Payment as Payment exposing (Payments)
+import Model.PaymentCategory as PaymentCategory exposing (PaymentCategories)
+import Model.Translations exposing (Translations, getMessage, getParamMessage)
+import Msg exposing (Msg)
+import Utils.List as List
 import View.Date as Date
 import View.Plural exposing (plural)
 
-import Utils.List as List
+view : LoggedData -> Stat.Model -> Html Msg
+view loggedData { paymentsByMonthByCategory } =
+  div
+    [ class "stat withMargin" ]
+    [ renderChart loggedData paymentsByMonthByCategory ]
 
-view : LoggedData -> Html Msg
-view loggedData =
-  let paymentsByMonth = Payment.groupAndSortByMonth (Payment.punctual loggedData.payments)
-      monthPaymentMean = getMonthPaymentMean loggedData paymentsByMonth
-  in  div
-        [ class "stat withMargin" ]
-        [ h1 [] [ text (getParamMessage [ Format.price loggedData.conf monthPaymentMean ] loggedData.translations "ByMonthsAndMean") ]
-        , ul
-            []
-            ( List.map (monthDetail loggedData) paymentsByMonth)
-        ]
+renderChart : LoggedData -> List ((Month, Int), List (CategoryId, Int)) -> Html msg
+renderChart { currentTime, paymentCategories, categories, conf, translations } paymentsByMonthByCategory =
+  let monthPaymentMean = getMonthPaymentMean currentTime paymentsByMonthByCategory
+      title = getParamMessage [ Format.price conf monthPaymentMean ] translations "ByMonthsAndMean"
+      keys =
+        paymentsByMonthByCategory
+          |> List.map (\((month, year), _) -> Date.shortMonthAndYear month year translations)
+      series =
+        categories
+          |> Dict.toList
+          |> List.map (\(categoryId, category) ->
+               { values =
+                   List.map
+                     (\(_, paymentsByCategory) ->
+                       paymentsByCategory
+                         |> List.find (\(c, _) -> c == categoryId)
+                         |> Maybe.map (toFloat << Tuple.second)
+                         |> Maybe.withDefault 0
+                     )
+                     paymentsByMonthByCategory
+               , color = category.color
+               , label = category.name
+               }
+             )
+      totalSerie =
+        { values =
+            List.transpose (List.map .values series)
+              |> List.map List.sum
+        , color = "black"
+        , label = getMessage translations "Total"
+        }
+  in  Chart.from keys (series ++ [totalSerie])
+        |> Chart.withSize { x = 2000, y = 900 }
+        |> Chart.withTitle title
+        |> Chart.withOrdinate 10 (Format.price conf << truncate)
+        |> Chart.toHtml
 
-getMonthPaymentMean : LoggedData -> List ((Month, Int), Payments) -> Int
-getMonthPaymentMean loggedData paymentsByMonth =
-  paymentsByMonth
+getMonthPaymentMean : Time -> List ((Month, Int), List (CategoryId, Int)) -> Int
+getMonthPaymentMean  currentTime paymentsByMonthByCategory =
+  paymentsByMonthByCategory
     |> List.filter (\((month, year), _) ->
-         let currentDate = Date.fromTime loggedData.currentTime
+         let currentDate = Date.fromTime currentTime
          in  not (Date.month currentDate == month && Date.year currentDate == year)
        )
-    |> List.map (List.sum << List.map .cost << Tuple.second)
+    |> List.map (List.sum << List.map Tuple.second << Tuple.second)
     |> List.mean
-
-monthDetail : LoggedData -> ((Month, Int), Payments) -> Html Msg
-monthDetail loggedData ((month, year), payments) =
-  li
-    []
-    [ text (Date.monthView loggedData.translations month)
-    , text " "
-    , text (toString year)
-    , text " − "
-    , text (paymentsSum loggedData.conf payments)
-    ]
-
-paymentsSum : Conf -> Payments -> String
-paymentsSum conf payments =
-  payments
-    |> List.map .cost
-    |> List.sum
-    |> Format.price conf
diff --git a/src/client/LoggedIn/Update.elm b/src/client/LoggedIn/Update.elm
index 753b1d3..a1d5f7d 100644
--- a/src/client/LoggedIn/Update.elm
+++ b/src/client/LoggedIn/Update.elm
@@ -2,55 +2,60 @@ module LoggedIn.Update exposing
   ( update
   )
 
+import Date exposing (Date)
 import Dict
-import String
-import Task
-
+import Form
 import Http exposing (Error(..))
-import Date exposing (Date)
 import Platform.Cmd exposing (Cmd)
+import String
+import Task
 
-import Form
-
+import LoggedData
+import LoggedIn.Home.Model as Home
+import LoggedIn.Home.Msg as Home
+import LoggedIn.Home.Update as Home
+import LoggedIn.Model as LoggedInModel
+import LoggedIn.Msg as LoggedIn
+import LoggedIn.Stat.Model as Stat
+import LoggedIn.Stat.Msg as Stat
+import LoggedIn.Stat.Update as Stat
 import Model exposing (Model)
-import Model.Payment as Payment exposing (Payment)
+import Model.Category exposing (Category)
 import Model.Frequency exposing (Frequency(..))
 import Model.Income as Income exposing (Income)
-import Model.Category exposing (Category)
+import Model.Payment as Payment exposing (Payment)
 import Model.PaymentCategory as PaymentCategory
-
 import Server
-import LoggedData
-
-import LoggedIn.Msg as LoggedInMsg
-import LoggedIn.Model as LoggedInModel
-
-import LoggedIn.Home.Msg as Home
-import LoggedIn.Home.Update as Home
-import LoggedIn.Home.Model as Home
 
 import Utils.Cmd exposing ((:>))
 
-update : Model -> LoggedInMsg.Msg -> LoggedInModel.Model -> (LoggedInModel.Model, Cmd LoggedInMsg.Msg)
+update : Model -> LoggedIn.Msg -> LoggedInModel.Model -> (LoggedInModel.Model, Cmd LoggedIn.Msg)
 update model msg loggedIn =
-  let loggedData = LoggedData.build model loggedIn
+  let loggedData = LoggedData.build model.currentTime model.translations model.conf loggedIn
   in  case msg of
 
-        LoggedInMsg.NoOp ->
+        LoggedIn.NoOp ->
           ( loggedIn
           , Cmd.none
           )
 
-        LoggedInMsg.HomeMsg homeMsg ->
+        LoggedIn.HomeMsg homeMsg ->
           case Home.update loggedData homeMsg loggedIn.home of
             (home, effects) ->
               ( { loggedIn | home = home }
-              , Cmd.map LoggedInMsg.HomeMsg effects
+              , Cmd.map LoggedIn.HomeMsg effects
+              )
+
+        LoggedIn.StatMsg statMsg ->
+          case Stat.update loggedData statMsg loggedIn.stat of
+            (stat, effects) ->
+              ( { loggedIn | stat = stat }
+              , Cmd.map LoggedIn.StatMsg effects
               )
 
-        LoggedInMsg.ValidateCreatePayment paymentId name cost date category frequency ->
-          update model (LoggedInMsg.HomeMsg <| Home.SearchMsg (Form.Reset (Home.searchInitial frequency))) loggedIn
-            :> update model (LoggedInMsg.HomeMsg <| Home.UpdatePage 1)
+        LoggedIn.ValidateCreatePayment paymentId name cost date category frequency ->
+          update model (LoggedIn.HomeMsg <| Home.SearchMsg (Form.Reset (Home.searchInitial frequency))) loggedIn
+            :> update model (LoggedIn.HomeMsg <| Home.UpdatePage 1)
             :> (\loggedIn ->
                  let newPayment = Payment paymentId name cost date loggedIn.me frequency
                  in  ( { loggedIn
@@ -61,7 +66,7 @@ update model msg loggedIn =
                      )
                )
 
-        LoggedInMsg.ValidateEditPayment paymentId name cost date category frequency ->
+        LoggedIn.ValidateEditPayment paymentId name cost date category frequency ->
           let updatedPayment = Payment paymentId name cost date loggedIn.me frequency
               mbOldPayment = Payment.find paymentId loggedIn.payments
           in  ( { loggedIn
@@ -76,7 +81,7 @@ update model msg loggedIn =
               , Cmd.none
               )
 
-        LoggedInMsg.ValidateDeletePayment paymentId ->
+        LoggedIn.ValidateDeletePayment paymentId ->
           let payments = Payment.delete paymentId loggedIn.payments
               frequency =
                 case Form.getOutput loggedIn.home.search of
@@ -88,7 +93,7 @@ update model msg loggedIn =
                 )
           in  if switchToPunctual
                 then
-                  update model (LoggedInMsg.HomeMsg <| Home.SearchMsg (Form.Reset (Home.searchInitial Punctual))) loggedIn
+                  update model (LoggedIn.HomeMsg <| Home.SearchMsg (Form.Reset (Home.searchInitial Punctual))) loggedIn
                     :> (\loggedIn ->
                          ( { loggedIn | payments = payments }
                          , Cmd.none
@@ -99,34 +104,34 @@ update model msg loggedIn =
                   , Cmd.none
                   )
 
-        LoggedInMsg.ValidateCreateIncome incomeId amount date ->
+        LoggedIn.ValidateCreateIncome incomeId amount date ->
           let newIncome = { userId = loggedIn.me, amount = amount, time = Date.toTime date }
           in  ( { loggedIn | incomes = Dict.insert incomeId newIncome loggedIn.incomes }
               , Cmd.none
               )
 
-        LoggedInMsg.ValidateEditIncome incomeId amount date ->
+        LoggedIn.ValidateEditIncome incomeId amount date ->
           let updateIncome _ = Just <| Income loggedIn.me (Date.toTime date) amount
           in  ( { loggedIn | incomes = Dict.update incomeId updateIncome loggedIn.incomes }
               , Cmd.none
               )
 
-        LoggedInMsg.ValidateDeleteIncome incomeId ->
+        LoggedIn.ValidateDeleteIncome incomeId ->
           ( { loggedIn | incomes = Dict.remove incomeId loggedIn.incomes }
           , Cmd.none
           )
 
-        LoggedInMsg.ValidateCreateCategory categoryId name color ->
+        LoggedIn.ValidateCreateCategory categoryId name color ->
           let newCategory = { name = name, color = color }
           in  ( { loggedIn | categories = Dict.insert categoryId newCategory loggedIn.categories }
               , Cmd.none
               )
 
-        LoggedInMsg.ValidateEditCategory categoryId name color ->
+        LoggedIn.ValidateEditCategory categoryId name color ->
           let updateCategory _ = Just <| Category name color
           in  ( { loggedIn | categories = Dict.update categoryId updateCategory loggedIn.categories } , Cmd.none)
 
-        LoggedInMsg.ValidateDeleteCategory categoryId ->
+        LoggedIn.ValidateDeleteCategory categoryId ->
           ( { loggedIn | categories = Dict.remove categoryId loggedIn.categories }
           , Cmd.none
           )
diff --git a/src/client/LoggedIn/View.elm b/src/client/LoggedIn/View.elm
index ddc85d5..4936c6e 100644
--- a/src/client/LoggedIn/View.elm
+++ b/src/client/LoggedIn/View.elm
@@ -23,11 +23,11 @@ view : Model -> LoggedInModel.Model -> Html Msg
 view model loggedIn =
   div
     [ class "loggedIn" ]
-    [ let loggedData = LoggedData.build model loggedIn
+    [ let loggedData = LoggedData.build model.currentTime model.translations model.conf loggedIn
       in  case model.page of
             Page.Home -> Home.view loggedData loggedIn.home
             Page.Income -> Income.view loggedData
             Page.Categories -> Categories.view loggedData
-            Page.Statistics -> Stat.view loggedData
+            Page.Statistics -> Stat.view loggedData loggedIn.stat
             Page.NotFound -> div [] [ text (getMessage model.translations "PageNotFound") ]
     ]