blob: e463aacd1fd42c49d568c6766bad8ce2793f3a8d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
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)
|
