From 54628c70cb33de5e4309c35b9f6b57bbe9f7a07b Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 24 Nov 2019 16:19:53 +0100
Subject: Compute cumulative income with a DB query

---
 server/src/Job/WeeklyReport.hs | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

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

diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs
index 34bbd3a..16be396 100644
--- a/server/src/Job/WeeklyReport.hs
+++ b/server/src/Job/WeeklyReport.hs
@@ -2,8 +2,11 @@ module Job.WeeklyReport
   ( weeklyReport
   ) where
 
+import qualified Data.Map               as M
 import           Data.Time.Clock        (UTCTime, getCurrentTime)
 
+import           Common.Model           (User (..))
+
 import           Conf                   (Conf)
 import qualified Model.Query            as Query
 import qualified Persistence.Income     as IncomePersistence
@@ -21,19 +24,27 @@ weeklyReport conf mbLastExecution = do
       return ()
 
     Just lastExecution -> do
-      (weekPayments, paymentRange, preIncomeRepartition, postIncomeRepartition, weekIncomes, users) <- Query.run $ do
+      (weekPayments, cumulativeIncome, preIncomeRepartition, postIncomeRepartition, weekIncomes, users) <- Query.run $ do
         users <- UserPersistence.list
         paymentRange <- PaymentPersistence.getRange
+        incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users)
+        cumulativeIncome <-
+          case (incomeDefinedForAll, paymentRange) of
+            (Just incomeStart, Just (paymentStart, paymentEnd))  ->
+              IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) paymentEnd
+
+            _ ->
+              return M.empty
         weekPayments <- PaymentPersistence.listModifiedSince lastExecution
         weekIncomes <- IncomePersistence.listModifiedSince lastExecution
         (preIncomeRepartition, postIncomeRepartition) <-
           PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
-        return (weekPayments, paymentRange, preIncomeRepartition, postIncomeRepartition, weekIncomes, users)
+        return (weekPayments, cumulativeIncome, preIncomeRepartition, postIncomeRepartition, weekIncomes, users)
 
       _ <-
         SendMail.sendMail
           conf
-          (WeeklyReport.mail conf users weekPayments preIncomeRepartition postIncomeRepartition (fst <$> paymentRange) weekIncomes lastExecution now)
+          (WeeklyReport.mail conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition lastExecution now)
 
       return ()
 
-- 
cgit v1.2.3