aboutsummaryrefslogtreecommitdiff
path: root/server/src/Statistics.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Statistics.hs')
-rw-r--r--server/src/Statistics.hs59
1 files changed, 0 insertions, 59 deletions
diff --git a/server/src/Statistics.hs b/server/src/Statistics.hs
deleted file mode 100644
index e463aac..0000000
--- a/server/src/Statistics.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-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)