aboutsummaryrefslogtreecommitdiff
path: root/server/src/Job/Daemon.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Job/Daemon.hs')
-rw-r--r--server/src/Job/Daemon.hs36
1 files changed, 36 insertions, 0 deletions
diff --git a/server/src/Job/Daemon.hs b/server/src/Job/Daemon.hs
new file mode 100644
index 0000000..0bc6f6e
--- /dev/null
+++ b/server/src/Job/Daemon.hs
@@ -0,0 +1,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