aboutsummaryrefslogtreecommitdiff
path: root/server/src/Payer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Payer.hs')
-rw-r--r--server/src/Payer.hs87
1 files changed, 0 insertions, 87 deletions
diff --git a/server/src/Payer.hs b/server/src/Payer.hs
deleted file mode 100644
index ab8312e..0000000
--- a/server/src/Payer.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-module Payer
- ( getExceedingPayers
- ) where
-
-import Data.Map (Map)
-import qualified Data.Map as M
-
-import Common.Model (ExceedingPayer (..), User (..), UserId)
-
-data Payer = Payer
- { _payer_userId :: UserId
- , _payer_preIncomePayments :: Int
- , _payer_postIncomePayments :: Int
- , _payer_income :: Int
- }
-
-data PostPaymentPayer = PostPaymentPayer
- { _postPaymentPayer_userId :: UserId
- , _postPaymentPayer_preIncomePayments :: Int
- , _postPaymentPayer_cumulativeIncome :: Int
- , _postPaymentPayer_ratio :: Float
- }
-
-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 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_income = M.findWithDefault 0 userId cumulativeIncome
- }
- )
-
-exceedingPayersFromAmounts :: [(UserId, Int)] -> [ExceedingPayer]
-exceedingPayersFromAmounts userAmounts =
- case mbMinAmount of
- Nothing ->
- []
- Just minAmount ->
- filter (\payer -> _exceedingPayer_amount payer > 0)
- . map (\userAmount ->
- ExceedingPayer
- { _exceedingPayer_userId = fst userAmount
- , _exceedingPayer_amount = snd userAmount - minAmount
- }
- )
- $ userAmounts
- where mbMinAmount = safeMinimum . map snd $ userAmounts
-
-getPostPaymentPayer :: Payer -> PostPaymentPayer
-getPostPaymentPayer payer =
- PostPaymentPayer
- { _postPaymentPayer_userId = _payer_userId payer
- , _postPaymentPayer_preIncomePayments = _payer_preIncomePayments payer
- , _postPaymentPayer_cumulativeIncome = _payer_income payer
- , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral $ _payer_income payer)
- }
-
-getFinalDiff :: Float -> PostPaymentPayer -> Int
-getFinalDiff maxRatio payer =
- let postIncomeDiff =
- truncate $ -1.0 * (maxRatio - _postPaymentPayer_ratio payer) * (fromIntegral . _postPaymentPayer_cumulativeIncome $ payer)
- in postIncomeDiff + _postPaymentPayer_preIncomePayments payer
-
-safeMinimum :: (Ord a) => [a] -> Maybe a
-safeMinimum [] = Nothing
-safeMinimum xs = Just . minimum $ xs
-
-safeMaximum :: (Ord a) => [a] -> Maybe a
-safeMaximum [] = Nothing
-safeMaximum xs = Just . maximum $ xs