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


From 79e1d8b0099d61b580a499311f1714b1b7eb07b5 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 27 Jan 2020 22:07:18 +0100
Subject: Show total incom by month in statistics

---
 server/src/Statistics.hs | 35 ++++++++++++++++++++++++++++++-----
 1 file changed, 30 insertions(+), 5 deletions(-)

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

diff --git a/server/src/Statistics.hs b/server/src/Statistics.hs
index 371fba2..e463aac 100644
--- a/server/src/Statistics.hs
+++ b/server/src/Statistics.hs
@@ -1,23 +1,44 @@
 module Statistics
-  ( compute
+  ( paymentsAndIncomes
   ) where
 
+import           Control.Arrow      ((&&&))
 import qualified Data.List          as L
+import           Data.Map           (Map)
 import qualified Data.Map           as M
+import qualified Data.Maybe         as Maybe
 import qualified Data.Time.Calendar as Calendar
 
-import           Common.Model       (Payment (..), PaymentStats)
+import           Common.Model       (Income (..), MonthStats (..), Payment (..),
+                                     Stats)
 
-compute :: [Payment] -> PaymentStats
-compute payments =
+paymentsAndIncomes :: [Payment] -> [Income] -> Stats
+paymentsAndIncomes payments incomes =
 
-  M.toList $ foldl
+  map toMonthStat . M.toList $ foldl
     (\m p -> M.alter (alter p) (startOfMonth $ _payment_date p) m)
     M.empty
     payments
 
   where
 
+    toMonthStat (start, paymentsByCategory) =
+      MonthStats start paymentsByCategory (incomesAt start)
+
+    incomesAt day =
+      M.map (incomeAt day) lastToFirstIncomesByUser
+
+    incomeAt day lastToFirstIncome =
+      Maybe.maybe 0 _income_amount
+      . Maybe.listToMaybe
+      . dropWhile (\i -> _income_date i > day)
+      $ lastToFirstIncome
+
+    lastToFirstIncomesByUser =
+      M.map (reverse . L.sortOn _income_date)
+      . groupBy _income_userId
+      $ incomes
+
     initMonthStats =
       M.fromList
       . map (\category -> (category, 0))
@@ -32,3 +53,7 @@ compute payments =
     startOfMonth day =
       let (y, m, _) = Calendar.toGregorian day
       in  Calendar.fromGregorian y m 1
+
+groupBy :: Ord k => (a -> k) -> [a] -> Map k [a]
+groupBy key =
+  M.fromListWith (++) . map (key &&& pure)
-- 
cgit v1.2.3