1 files changed, 59 insertions, 0 deletions
diff --git a/server/src/Statistics.hs b/server/src/Statistics.hs
new file mode 100644
index 0000000..e463aac
--- /dev/null
+++ b/server/src/Statistics.hs
@@ -0,0 +1,59 @@
+module Statistics
+  ( 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       (Income (..), MonthStats (..), Payment (..),
+                                     Stats)
+
+paymentsAndIncomes :: [Payment] -> [Income] -> Stats
+paymentsAndIncomes payments incomes =
+
+  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))
+      . 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
+
+groupBy :: Ord k => (a -> k) -> [a] -> Map k [a]
+groupBy key =
+  M.fromListWith (++) . map (key &&& pure)