aboutsummaryrefslogtreecommitdiff
path: root/server/src/Job/WeeklyReport.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Job/WeeklyReport.hs')
-rw-r--r--server/src/Job/WeeklyReport.hs23
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