Example usage of Data.Reaper

main.hs

{-# LANGUAGE MultiWayIf #-}

module Main where

import Data.Time
import System.Random
import Control.Reaper
import Control.Concurrent
import Control.Monad
import Data.IORef

-- In this example code, we add Jobs (the individual items) to our Reaper's workload (a list of Jobs)
data Job = Job { jobID :: Int
               , jobStarted :: UTCTime
               , jobThreadId :: ThreadId
               , jobFinished :: IORef Bool
               }

main :: IO ()
main = do
  reaper <- mkReaper defaultReaperSettings
            { reaperAction = mkListAction maybeReapJob
            , reaperDelay = 1000000 -- Check for completed/valid jobs every second.
            }
  forM_ [1..10] $ \i -> do
    job <- startJob i
    (reaperAdd reaper) job

  threadDelay 1500000 -- Sleep 15 seconds, so that jobs can be completed or killed.

-- Start a variable-length task that takes between 1 and 10 seconds
startJob :: Int -> IO Job
startJob aJobID = do
  startTime <- getCurrentTime
  finishedRef <- newIORef False
  threadID <- forkIO $ do
    secondsToWait <- getStdRandom (randomR (1,10))
    threadDelay (secondsToWait * 1000000) 
    atomicWriteIORef finishedRef True -- Mark the job as complete.
  return $ Job aJobID startTime threadID finishedRef

-- Remove completed jobs, and also kill ones that have run longer than 5 seconds.
maybeReapJob :: Job -> IO (Maybe Job)
maybeReapJob job = do
  currentTime <- getCurrentTime 
  let runningTime = currentTime `diffUTCTime` (jobStarted job)
  jobDone <- readIORef (jobFinished job)

  if | jobDone -> do
        putStrLn $ "Completed job #" ++ show (jobID job)
        return Nothing
     | runningTime > 5.0 -> do
         killThread (jobThreadId job)
         putStrLn $ "Killed job #" ++ show (jobID job)
         return Nothing
     | otherwise -> return (Just job)