CODEWITHSUNDEEP
haskelljob-scheduling
Bill Sun
Bill Sun

Reputation: 165

How to handle long running jobs with System.Cron.Schedule?

I'm trying to learn Haskell. As a first stab, I'm looking to write a daemon that periodically runs a backup job for me.

I'm using System.Cron.Schedule to do the scheduling for me and running the restic executable to do the backup.

As this is a backup job, it can take a log time to run, to prevent the next scheduled backup from running when the previous one hasn't been completed yet, I want to make sure that I can only have 1 instance of the job running. How do prevent a long running job from being run again?

As an simplified example, how do I make the following not spawn another job every minute until the existing job is done?

main :: IO ()
main = do
       tids <- execSchedule $ do
           addJob doBackup "* * * * *"
       print tids

doBackup :: IO ()
doBackup = do
    putStrLn "Backing up system..."
    threadDelay 70000000
    putStrLn "Backup finished"

Upvotes: 4

Views: 685

Answers (1)

HTNW
HTNW

Reputation: 29193

Here's the implementation of @Alec's suggestion. This creates an MVar () (which is basically a semaphore), and then every time your job runs, it checks whether the MVar is free before it continues, and dies otherwise.

import Control.Concurrent.MVar
import Control.Monad

main :: IO ()
main = do sem <- newMVar () -- starts off not taken
          tids <- execSchedule $ addJob (doBackup sem) "* * * * *" -- do x = x
          print tids
          forever $ threadDelay maxBound
       -- all threads exit when main exits. ^ stops that from happening
       -- Control.Monad.forever x = let loop = x >> loop in loop
       -- don't do forever $ return () unless you want a CPU-nomming busyloop


doBackup :: MVar () -> IO ()
doBackup sem = do res <- tryTakeMVar sem
               -- gives Nothing if the sem is taken and Just () if it isn't
               -- you DON'T want takeMVar, since that'll block until sem is
               -- free, essentially queueing the jobs up instead of
               -- canceling the ones that run too early.
                  case res of
                       Nothing -> return () -- already taken? do nothing
                       Just () -> do putStrLn "Backing up system..."
                                     threadDelay 70000000
                                     putStrLn "Backup finished"
                                     putMVar sem () -- release the lock

FYI: this is not exception-safe. See the implementation of withMVar for pointers in that direction.

Upvotes: 3

Related Questions