diff options
Diffstat (limited to 'server/src/Statistics.hs')
| -rw-r--r-- | server/src/Statistics.hs | 35 |
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) |