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

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

import           Conf               (Conf)
import           Job.Frequency      (Frequency (..), microSeconds)
import           Job.Kind           (Kind (..))
import           Job.Model          (actualizeLastCheck, actualizeLastExecution,
                                     getLastExecution)
import           Job.MonthlyPayment (monthlyPayment)
import           Job.WeeklyReport   (weeklyReport)
import qualified Model.Query        as Query
import           Util.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