Optimize and refactor payments

1 files changed, 12 insertions, 10 deletions

diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
index 7e88d98..1f637bc 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -9,6 +9,7 @@ import           Data.Maybe            (catMaybes, fromMaybe)
 import           Data.Monoid           ((<>))
 import           Data.Text             (Text)
 import qualified Data.Text             as T
+import           Data.Time.Calendar    (Day)
 import           Data.Time.Clock       (UTCTime)
 
 import           Common.Model          (ExceedingPayer (..), Income (..),
@@ -23,10 +24,11 @@ import           Model.IncomeResource  (IncomeResource (..))
 import           Model.Mail            (Mail (Mail))
 import qualified Model.Mail            as M
 import           Model.PaymentResource (PaymentResource (..))
+import qualified Payer                 as Payer
 import           Resource              (Status (..), groupByStatus, statuses)
 
-mail :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
-mail conf users payments incomes start end =
+mail :: Conf -> [User] -> [Payment] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [Income] -> UTCTime -> UTCTime -> Mail
+mail conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end =
   Mail
     { M.from = Conf.noReplyMail conf
     , M.to = map _user_email users
@@ -35,24 +37,24 @@ mail conf users payments incomes start end =
         , " − "
         , Msg.get Msg.WeeklyReport_Title
         ]
-    , M.body = body conf users payments incomes start end
+    , M.body = body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end
     }
 
-body :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Text
-body conf users payments incomes start end =
+body :: Conf -> [User] -> [Payment] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [Income] -> UTCTime -> UTCTime -> Text
+body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end =
   T.intercalate "\n" $
-    [ exceedingPayers conf end users incomes (filter (null . _payment_deletedAt) payments)
+    [ exceedingPayers conf end users incomes preIncomeRepartition postIncomeRepartition firstPayment
     , operations conf users paymentsGroupedByStatus incomesGroupedByStatus
     ]
       where
-        paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ payments
+        paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ weekPayments
         incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ incomes
 
-exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> [Payment] -> Text
-exceedingPayers conf time users incomes payments =
+exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> Text
+exceedingPayers conf time users incomes preIncomeRepartition postIncomeRepartition firstPayment =
   T.intercalate "\n" . map formatPayer $ payers
   where
-    payers = CM.getExceedingPayers time users incomes payments
+    payers = Payer.getExceedingPayers time users incomes preIncomeRepartition postIncomeRepartition firstPayment
     formatPayer p = T.concat
       [ "  * "
       , fromMaybe "" $ _user_name <$> CM.findUser (_exceedingPayer_userId p) users