aboutsummaryrefslogtreecommitdiff
path: root/server/src/Job/Daemon.hs
blob: 0bc6f6ea533c3b4f28fdc77151404f8c27a2fab3 (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
module Job.Daemon
  ( runDaemons
  ) where

import Control.Concurrent (threadDelay, forkIO, ThreadId)
import Control.Monad (forever)
import Data.Time.Clock (UTCTime)

import Conf (Conf)
import Job.Frequency (Frequency(..), microSeconds)
import Job.Kind (Kind(..))
import Job.Model (getLastExecution, actualizeLastCheck, actualizeLastExecution)
import Job.MonthlyPayment (monthlyPayment)
import Job.WeeklyReport (weeklyReport)
import qualified Model.Query as Query
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 <- Query.run $ do
      actualizeLastCheck kind
      getLastExecution kind
    hasToRun <- case mbLastExecution of
      Just lastExecution -> isLastExecutionTooOld lastExecution
      Nothing -> return True
    if hasToRun
      then runJob mbLastExecution >>= (Query.run . actualizeLastExecution kind)
      else return ()
    threadDelay . microSeconds $ frequency