Show total incom by month in statistics

1 files changed, 30 insertions, 5 deletions

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)