Factor job listener

1 files changed, 15 insertions, 21 deletions

diff --git a/src/server/MonthlyPaymentJob.hs b/src/server/MonthlyPaymentJob.hs
index f754b81..1b331af 100644
--- a/src/server/MonthlyPaymentJob.hs
+++ b/src/server/MonthlyPaymentJob.hs
@@ -2,37 +2,27 @@ module MonthlyPaymentJob
   ( monthlyPaymentJobListener
   ) where
 
+import Control.Monad.IO.Class (liftIO)
+
 import Data.Time.Clock
 import Data.Time.LocalTime
 import Data.Time.Calendar
 
-import Control.Concurrent (threadDelay)
-
 import Database.Persist (entityVal, insert)
 
+import Job (jobListener)
+
 import Model.Database
 import Model.Payment (getMonthlyPayments)
 import Model.JobKind
-import Model.Job
 import Model.Frequency
 
 monthlyPaymentJobListener :: IO ()
-monthlyPaymentJobListener = do
-  mbLastExecution <- runDb $ getLastExecution MonthlyPaymentJob
-  runThisMonth <- case mbLastExecution of
-    Just lastExecution -> belongToCurrentMonth lastExecution
-    Nothing -> return False
-  if not runThisMonth
-    then runDb (monthlyJob >> actualizeLastExecution MonthlyPaymentJob)
-    else return ()
-  sleepOneHour
-  monthlyPaymentJobListener
-
-monthlyJob :: Persist ()
-monthlyJob = do
-  monthlyPayments <- map entityVal <$> getMonthlyPayments
-  let punctualPayments = map (\p -> p { paymentFrequency = Punctual }) monthlyPayments
-  sequence_ $ map insert punctualPayments
+monthlyPaymentJobListener =
+  let lastExecutionTooOld = fmap not . belongToCurrentMonth
+      runJob () = monthlyPaymentJob
+      msDelay = 1000000 * 60 * 60
+  in  jobListener MonthlyPaymentJob lastExecutionTooOld runJob msDelay
 
 belongToCurrentMonth :: UTCTime -> IO Bool
 belongToCurrentMonth time = do
@@ -46,5 +36,9 @@ getLocalMonth time = do
   let (_, month, _) = toGregorian . localDay $ utcToLocalTime timeZone time
   return month
 
-sleepOneHour :: IO ()
-sleepOneHour = threadDelay (1000000 * 60 * 60)
+monthlyPaymentJob :: Persist ()
+monthlyPaymentJob = do
+  monthlyPayments <- map entityVal <$> getMonthlyPayments
+  now <- liftIO $ getCurrentTime
+  let punctualPayments = map (\p -> p { paymentFrequency = Punctual, paymentCreation = now }) monthlyPayments
+  sequence_ $ map insert punctualPayments