From 86a96decdb8892b10c5314eb916ef15a64204450 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 13 Nov 2016 00:49:32 +0100
Subject: Send weekly activity at start of week about previous week

---
 src/server/Job/Daemon.hs | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)
 create mode 100644 src/server/Job/Daemon.hs

(limited to 'src/server/Job/Daemon.hs')

diff --git a/src/server/Job/Daemon.hs b/src/server/Job/Daemon.hs
new file mode 100644
index 0000000..8259b18
--- /dev/null
+++ b/src/server/Job/Daemon.hs
@@ -0,0 +1,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
-- 
cgit v1.2.3