diff options
author | Joris | 2021-01-03 13:40:40 +0100 |
---|---|---|
committer | Joris | 2021-01-03 13:54:20 +0100 |
commit | 11052951b74b9ad4b6a9412ae490086235f9154b (patch) | |
tree | 64526ac926c1bf470ea113f6cac8a33158684e8d /server/src/Statistics.hs | |
parent | 371449b0e312a03162b78797b83dee9d81706669 (diff) |
Rewrite in Rust
Diffstat (limited to 'server/src/Statistics.hs')
-rw-r--r-- | server/src/Statistics.hs | 59 |
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) |