src/server/MonthlyPaymentJob.hs


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

module MonthlyPaymentJob
  ( monthlyPaymentJobListener
  ) where

import Control.Monad.IO.Class (liftIO)

import Data.Time.Clock

import Database.Persist (entityVal, insert)

import Job (jobListener)

import Model.Database
import qualified Model.Payment as Payment
import Model.JobKind
import Model.Frequency

import Utils.Time (belongToCurrentMonth, timeToDay)

monthlyPaymentJobListener :: IO ()
monthlyPaymentJobListener =
  let lastExecutionTooOld = fmap not . belongToCurrentMonth
      runJob () = monthlyPaymentJob
      msDelay = 1000000 * 60 * 60
  in  jobListener MonthlyPaymentJob lastExecutionTooOld runJob msDelay

monthlyPaymentJob :: Persist ()
monthlyPaymentJob = do
  monthlyPayments <- map entityVal <$> Payment.listMonthly
  now <- liftIO $ getCurrentTime
  actualDay <- liftIO $ timeToDay now
  let punctualPayments = map (\p -> p { paymentFrequency = Punctual, paymentDate = actualDay, paymentCreatedAt = now }) monthlyPayments
  sequence_ $ map insert punctualPayments