aboutsummaryrefslogtreecommitdiff
path: root/server/src/Job/WeeklyReport.hs
blob: 282f2f1fcee41264084b68918fc906dd85e1c1c2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
module Job.WeeklyReport
  ( weeklyReport
  ) where

import qualified Data.Map               as M
import qualified Data.Time.Clock              as Clock
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, _))  ->
              IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) (Clock.utctDay now)

            _ ->
              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