diff options
Diffstat (limited to 'server/src/Payer.hs')
| -rw-r--r-- | server/src/Payer.hs | 135 |
1 files changed, 26 insertions, 109 deletions
diff --git a/server/src/Payer.hs b/server/src/Payer.hs index d913afe..ab8312e 100644 --- a/server/src/Payer.hs +++ b/server/src/Payer.hs @@ -1,25 +1,17 @@ module Payer ( getExceedingPayers - , useIncomesFrom - , cumulativeIncomesSince ) where -import qualified Data.List as List -import Data.Map (Map) -import qualified Data.Map as M -import qualified Data.Maybe as Maybe -import Data.Time (NominalDiffTime, UTCTime (..)) -import qualified Data.Time as Time -import Data.Time.Calendar (Day) +import Data.Map (Map) +import qualified Data.Map as M -import Common.Model (ExceedingPayer (..), Income (..), - User (..), UserId) +import Common.Model (ExceedingPayer (..), User (..), UserId) data Payer = Payer { _payer_userId :: UserId , _payer_preIncomePayments :: Int , _payer_postIncomePayments :: Int - , _payer_incomes :: [Income] + , _payer_income :: Int } data PostPaymentPayer = PostPaymentPayer @@ -29,43 +21,29 @@ data PostPaymentPayer = PostPaymentPayer , _postPaymentPayer_ratio :: Float } -getExceedingPayers :: UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [ExceedingPayer] -getExceedingPayers currentTime users incomes preIncomeRepartition postIncomeRepartition firstPayment = +getExceedingPayers :: [User] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> [ExceedingPayer] +getExceedingPayers users cumulativeIncome preIncomeRepartition postIncomeRepartition = let userIds = map _user_id users - payers = getPayers userIds incomes preIncomeRepartition postIncomeRepartition - exceedingPayersOnPreIncome = - exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers - mbSince = useIncomesFrom userIds incomes firstPayment - in case mbSince of - Just since -> - let postPaymentPayers = map (getPostPaymentPayer currentTime since) payers - mbMaxRatio = safeMaximum . map _postPaymentPayer_ratio $ postPaymentPayers - in case mbMaxRatio of - Just maxRatio -> - exceedingPayersFromAmounts - . map (\p -> (_postPaymentPayer_userId p, getFinalDiff maxRatio p)) - $ postPaymentPayers - Nothing -> - exceedingPayersOnPreIncome - _ -> - exceedingPayersOnPreIncome - -useIncomesFrom :: [UserId] -> [Income] -> Maybe Day -> Maybe Day -useIncomesFrom userIds incomes firstPayment = - case (firstPayment, incomeDefinedForAll userIds incomes) of - (Just d1, Just d2) -> Just (max d1 d2) - _ -> Nothing - -dayUTCTime :: Day -> UTCTime -dayUTCTime = flip UTCTime (Time.secondsToDiffTime 0) - -getPayers :: [UserId] -> [Income] -> Map UserId Int -> Map UserId Int -> [Payer] -getPayers userIds incomes preIncomeRepartition postIncomeRepartition = + payers = getPayers userIds cumulativeIncome preIncomeRepartition postIncomeRepartition + postPaymentPayers = map getPostPaymentPayer payers + mbMaxRatio = safeMaximum . map _postPaymentPayer_ratio $ postPaymentPayers + in case mbMaxRatio of + Just maxRatio -> + exceedingPayersFromAmounts + . map (\p -> (_postPaymentPayer_userId p, getFinalDiff maxRatio p)) + $ postPaymentPayers + Nothing -> + exceedingPayersFromAmounts + . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) + $ payers + +getPayers :: [UserId] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> [Payer] +getPayers userIds cumulativeIncome preIncomeRepartition postIncomeRepartition = flip map userIds (\userId -> Payer { _payer_userId = userId , _payer_preIncomePayments = M.findWithDefault 0 userId preIncomeRepartition , _payer_postIncomePayments = M.findWithDefault 0 userId postIncomeRepartition - , _payer_incomes = filter ((==) userId . _income_userId) incomes + , _payer_income = M.findWithDefault 0 userId cumulativeIncome } ) @@ -85,15 +63,14 @@ exceedingPayersFromAmounts userAmounts = $ userAmounts where mbMinAmount = safeMinimum . map snd $ userAmounts -getPostPaymentPayer :: UTCTime -> Day -> Payer -> PostPaymentPayer -getPostPaymentPayer currentTime since payer = +getPostPaymentPayer :: Payer -> PostPaymentPayer +getPostPaymentPayer payer = PostPaymentPayer { _postPaymentPayer_userId = _payer_userId payer , _postPaymentPayer_preIncomePayments = _payer_preIncomePayments payer - , _postPaymentPayer_cumulativeIncome = cumulativeIncome - , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral cumulativeIncome) + , _postPaymentPayer_cumulativeIncome = _payer_income payer + , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral $ _payer_income payer) } - where cumulativeIncome = cumulativeIncomesSince currentTime since (_payer_incomes payer) getFinalDiff :: Float -> PostPaymentPayer -> Int getFinalDiff maxRatio payer = @@ -101,66 +78,6 @@ getFinalDiff maxRatio payer = truncate $ -1.0 * (maxRatio - _postPaymentPayer_ratio payer) * (fromIntegral . _postPaymentPayer_cumulativeIncome $ payer) in postIncomeDiff + _postPaymentPayer_preIncomePayments payer -incomeDefinedForAll :: [UserId] -> [Income] -> Maybe Day -incomeDefinedForAll userIds incomes = - let userIncomes = map (\userId -> filter ((==) userId . _income_userId) $ incomes) userIds - firstIncomes = map (Maybe.listToMaybe . List.sortOn _income_date) userIncomes - in if all Maybe.isJust firstIncomes - then Maybe.listToMaybe . reverse . List.sort . map _income_date . Maybe.catMaybes $ firstIncomes - else Nothing - -cumulativeIncomesSince :: UTCTime -> Day -> [Income] -> Int -cumulativeIncomesSince currentTime since incomes = - getCumulativeIncome currentTime (getOrderedIncomesSince since incomes) - -getOrderedIncomesSince :: Day -> [Income] -> [Income] -getOrderedIncomesSince since incomes = - let mbStarterIncome = getIncomeAt since incomes - orderedIncomesSince = filter (\income -> _income_date income >= since) incomes - in (Maybe.maybeToList mbStarterIncome) ++ orderedIncomesSince - -getIncomeAt :: Day -> [Income] -> Maybe Income -getIncomeAt day incomes = - case incomes of - [x] -> - if _income_date x < day - then Just $ x { _income_date = day } - else Nothing - x1 : x2 : xs -> - if _income_date x1 < day && _income_date x2 >= day - then Just $ x1 { _income_date = day } - else getIncomeAt day (x2 : xs) - [] -> - Nothing - -getCumulativeIncome :: UTCTime -> [Income] -> Int -getCumulativeIncome currentTime incomes = - sum - . map durationIncome - . getIncomesWithDuration currentTime - . List.sortOn incomeTime - $ incomes - -getIncomesWithDuration :: UTCTime -> [Income] -> [(NominalDiffTime, Int)] -getIncomesWithDuration currentTime incomes = - case incomes of - [] -> - [] - [income] -> - [(Time.diffUTCTime currentTime (incomeTime income), _income_amount income)] - (income1 : income2 : xs) -> - (Time.diffUTCTime (incomeTime income2) (incomeTime income1), _income_amount income1) : (getIncomesWithDuration currentTime (income2 : xs)) - -incomeTime :: Income -> UTCTime -incomeTime = dayUTCTime . _income_date - -durationIncome :: (NominalDiffTime, Int) -> Int -durationIncome (duration, income) = - truncate $ duration * fromIntegral income / (nominalDay * 365 / 12) - -nominalDay :: NominalDiffTime -nominalDay = 86400 - safeMinimum :: (Ord a) => [a] -> Maybe a safeMinimum [] = Nothing safeMinimum xs = Just . minimum $ xs |