1 files changed, 87 insertions, 0 deletions
diff --git a/server/src/Payer.hs b/server/src/Payer.hs
new file mode 100644
index 0000000..ab8312e
--- /dev/null
+++ b/server/src/Payer.hs
@@ -0,0 +1,87 @@
+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