Optimize and refactor payments

1 files changed, 19 insertions, 4 deletions

diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs
index 1a478dc..34bbd3a 100644
--- a/server/src/Job/WeeklyReport.hs
+++ b/server/src/Job/WeeklyReport.hs
@@ -15,11 +15,26 @@ import qualified View.Mail.WeeklyReport as WeeklyReport
 weeklyReport :: Conf -> Maybe UTCTime -> IO UTCTime
 weeklyReport conf mbLastExecution = do
   now <- getCurrentTime
+
   case mbLastExecution of
-    Nothing -> return ()
+    Nothing ->
+      return ()
+
     Just lastExecution -> do
-      (payments, incomes, users) <- Query.run $
-        (,,) <$> PaymentPersistence.listPunctual <*> IncomePersistence.listAll <*> UserPersistence.list
-      _ <- SendMail.sendMail conf (WeeklyReport.mail conf users payments incomes lastExecution now)
+      (weekPayments, paymentRange, preIncomeRepartition, postIncomeRepartition, weekIncomes, users) <- Query.run $ do
+        users <- UserPersistence.list
+        paymentRange <- PaymentPersistence.getRange
+        weekPayments <- PaymentPersistence.listModifiedSince lastExecution
+        weekIncomes <- IncomePersistence.listModifiedSince lastExecution
+        (preIncomeRepartition, postIncomeRepartition) <-
+          PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
+        return (weekPayments, paymentRange, preIncomeRepartition, postIncomeRepartition, weekIncomes, users)
+
+      _ <-
+        SendMail.sendMail
+          conf
+          (WeeklyReport.mail conf users weekPayments preIncomeRepartition postIncomeRepartition (fst <$> paymentRange) weekIncomes lastExecution now)
+
       return ()
+
   return now