Compute cumulative income with a DB query

1 files changed, 14 insertions, 3 deletions

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 ()