From 47c2a4d6b68c54eed5f7b45671b1ccaf8c0db200 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 20 Jan 2020 19:47:23 +0100
Subject: Show payment stats

---
 server/src/Statistics.hs | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)
 create mode 100644 server/src/Statistics.hs

(limited to 'server/src/Statistics.hs')

diff --git a/server/src/Statistics.hs b/server/src/Statistics.hs
new file mode 100644
index 0000000..371fba2
--- /dev/null
+++ b/server/src/Statistics.hs
@@ -0,0 +1,34 @@
+module Statistics
+  ( compute
+  ) where
+
+import qualified Data.List          as L
+import qualified Data.Map           as M
+import qualified Data.Time.Calendar as Calendar
+
+import           Common.Model       (Payment (..), PaymentStats)
+
+compute :: [Payment] -> PaymentStats
+compute payments =
+
+  M.toList $ foldl
+    (\m p -> M.alter (alter p) (startOfMonth $ _payment_date p) m)
+    M.empty
+    payments
+
+  where
+
+    initMonthStats =
+      M.fromList
+      . map (\category -> (category, 0))
+      . L.nub
+      $ map _payment_category payments
+
+    alter p Nothing           = Just (addPayment p initMonthStats)
+    alter p (Just monthStats) = Just (addPayment p monthStats)
+
+    addPayment p monthStats = M.adjust ((+) (_payment_cost p)) (_payment_category p) monthStats
+
+    startOfMonth day =
+      let (y, m, _) = Calendar.toGregorian day
+      in  Calendar.fromGregorian y m 1
-- 
cgit v1.2.3