src/server/Job/Daemon.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
34
35
36
37
38
39
40

module Job.Daemon
  ( runDaemons
  ) where

import Data.Time.Clock (UTCTime)

import Control.Concurrent (threadDelay, forkIO, ThreadId)
import Control.Monad (forever)

import Model.Database

import Job.Kind (Kind(..))
import Job.Frequency (Frequency(..), microSeconds)
import Job.Model (getLastExecution, actualizeLastCheck, actualizeLastExecution)
import Job.MonthlyPayment (monthlyPayment)
import Job.WeeklyReport (weeklyReport)

import Conf (Conf)

import Utils.Time (belongToCurrentMonth, belongToCurrentWeek)

runDaemons :: Conf -> IO ()
runDaemons conf = do
  _ <- runDaemon MonthlyPayment EveryHour (fmap not . belongToCurrentMonth) monthlyPayment
  _ <- runDaemon WeeklyReport EveryHour (fmap not . belongToCurrentWeek) (weeklyReport conf)
  return ()

runDaemon :: Kind -> Frequency -> (UTCTime -> IO Bool) -> (Maybe UTCTime -> IO UTCTime) -> IO ThreadId
runDaemon kind frequency isLastExecutionTooOld runJob =
  forkIO . forever $ do
    mbLastExecution <- runDb $ do
      actualizeLastCheck kind
      getLastExecution kind
    hasToRun <- case mbLastExecution of
      Just lastExecution -> isLastExecutionTooOld lastExecution
      Nothing -> return True
    if hasToRun
      then runJob mbLastExecution >>= (runDb . actualizeLastExecution kind)
      else return ()
    threadDelay . microSeconds $ frequency