From c0ea63f8c1a8c7123b78798cec99726b113fb1f3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 17 Nov 2019 18:08:28 +0100
Subject: Optimize and refactor payments

---
 server/src/Job/WeeklyReport.hs | 23 +++++++++++++++++++----
 1 file changed, 19 insertions(+), 4 deletions(-)

(limited to 'server/src/Job/WeeklyReport.hs')

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
-- 
cgit v1.2.3