Add a chart on payments by month by categories

4 files changed, 123 insertions, 43 deletions

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