1 files changed, 51 insertions, 0 deletions
diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs
new file mode 100644
index 0000000..ff80ddf
--- /dev/null
+++ b/server/src/Job/WeeklyReport.hs
@@ -0,0 +1,51 @@
+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
+import qualified Persistence.Payment    as PaymentPersistence
+import qualified Persistence.User       as UserPersistence
+import qualified SendMail
+import qualified View.Mail.WeeklyReport as WeeklyReport
+
+weeklyReport :: Conf -> Maybe UTCTime -> IO UTCTime
+weeklyReport conf mbLastExecution = do
+  now <- getCurrentTime
+
+  case mbLastExecution of
+    Nothing ->
+      return ()
+
+    Just lastExecution -> 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.listModifiedPunctualSince lastExecution
+        weekIncomes <- IncomePersistence.listModifiedSince lastExecution
+        (preIncomeRepartition, postIncomeRepartition) <-
+          PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
+        return (weekPayments, cumulativeIncome, preIncomeRepartition, postIncomeRepartition, weekIncomes, users)
+
+      _ <-
+        SendMail.sendMail
+          conf
+          (WeeklyReport.mail conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition lastExecution now)
+
+      return ()
+
+  return now