Merge branch 'with-ghcjs' into 'master'

Use Haskell on the frontend

See merge request guyonvarch/shared-cost!2

1 files changed, 37 insertions, 0 deletions

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