This module provides the ability to create reapers: dedicated cleanup threads. These threads will automatically spawn and die based on the presence of a workload to process on. Example uses include:

• Killing long-running jobs
• Closing unused connections in a connection pool
• Pruning a cache of old items (see example below)

For real-world usage, search the WAI family of packages for imports of Control.Reaper.

In this example code, we use a Map to cache fibonacci numbers, and a Reaper to prune the cache.

NOTE: When using this module as a cache you should keep in mind that while the reaper thread is active running your "reaperAction", the cache will appear empty to concurrently running threads. Any newly created cache entries will be on the temporary worklist, and will merged back into the the main cache only once the "reaperAction" completes (together with the portion of the extant worklist that the cleaner callback decided to retain).

If you're looking for a cache that supports concurrent purging of stale items, but without exposing a transient empty cache during cleanup, this is not the cache implementation you need. This module was primarily designed for cleaning up stuck processes, or idle threads in a thread pool. The cache use-case was not a primary design focus.

The main function first creates a Reaper, with fields to initialize the cache (reaperEmpty), add items to it (reaperCons), and prune it (reaperAction). The reaper will run every two seconds (reaperDelay), but will stop running while reaperNull is true.

main then loops infinitely (forever). Each second it calculates the fibonacci number for a value between 30 and 34, first trying the cache (reaperRead and lookup), then falling back to manually calculating it (fib) and updating the cache with the result (reaperAdd)

clean simply removes items cached for more than 10 seconds. This function is where you would perform IO-related cleanup, like killing threads or closing connections, if that was the purpose of your reaper.

module Main where

import Data.Time (UTCTime, getCurrentTime, diffUTCTime)
import Control.Reaper
import Control.Concurrent (threadDelay)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Control.Monad (forever)
import System.Random (getStdRandom, randomR)

fib :: Int -> Int
fib 0 = 0
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

type Cache = Map Int (Int, UTCTime)

main :: IO ()
main = do
  reaper <- mkReaper defaultReaperSettings
    { reaperEmpty = Map.empty
    , reaperCons = \(k, v, time) workload -> Map.insert k (v, time) workload
    , reaperAction = clean
    , reaperDelay = 1000000 * 2 -- Clean every 2 seconds
    , reaperNull = Map.null
    }
  forever $ do
    fibArg <- getStdRandom (randomR (30,34))
    cache <- reaperRead reaper
    let cachedResult = Map.lookup fibArg cache
    case cachedResult of
      Just (fibResult, _createdAt) -> putStrLn $ "Found in cache: `fib " ++ show fibArg ++ "` " ++ show fibResult
      Nothing -> do
        let fibResult = fib fibArg
        putStrLn $ "Calculating `fib " ++ show fibArg ++ "` " ++ show fibResult
        time <- getCurrentTime
        (reaperAdd reaper) (fibArg, fibResult, time)
    threadDelay 1000000 -- 1 second

-- Remove items > 10 seconds old
clean :: Cache -> IO (Cache -> Cache)
clean oldMap = do
  currentTime <- getCurrentTime
  let pruned = Map.filter (\(_, createdAt) -> currentTime `diffUTCTime` createdAt < 10.0) oldMap
  return (\newData -> Map.union pruned newData)