@@ -5,14 +5,14 @@
5-- threads. These threads will automatically spawn and die based on the
5-- threads. These threads will automatically spawn and die based on the
6-- presence of a workload to process on. Example uses include:
6-- presence of a workload to process on. Example uses include:
8−-- * Killing long-running jobs (see example below)
8+-- * Killing long-running jobs
9-- * Closing unused connections in a connection pool
9-- * Closing unused connections in a connection pool
10−-- * Pruning a cache of old items
10+-- * Pruning a cache of old items (see example below)
12-- For real-world usage, search the <https://github.com/yesodweb/wai WAI family of packages>
12-- For real-world usage, search the <https://github.com/yesodweb/wai WAI family of packages>
13-- for imports of "Control.Reaper".
13-- for imports of "Control.Reaper".
14module Control.Reaper (
14module Control.Reaper (
15− -- * Example: A small jobs system
15+ -- * Example: Regularly cleaning a cache
16 -- $example1
16 -- $example1
18 -- * Settings
18 -- * Settings
@@ -214,71 +214,66 @@ mkListAction f =
214 go front' xs
214 go front' xs
216-- $example1
216-- $example1
217−-- In this example code, we create a small jobs system.
217+-- In this example code, we use a 'Data.Map.Strict.Map' to cache fibonacci numbers, and a 'Reaper' to prune the cache.
218−-- The @main@ function first creates a 'Reaper' to manage our jobs,
219−-- then starts 10 jobs that each take 1 to 10 seconds to complete.
220−-- Each Job is added to the Reaper's workload (a list of Jobs).
222−-- Every second, the 'Reaper' will traverse the list of jobs, removing completed ones,
219+-- The @main@ function first creates a 'Reaper', with fields to initialize the
223−-- and killing ones that have run longer than 5 seconds.
220+-- cache ('reaperEmpty'), add items to it ('reaperCons'), and prune it ('reaperAction').
221+-- The reaper will run every two seconds ('reaperDelay'), but will stop running while
222+-- 'reaperNull' is true.
225−-- Once all jobs are completed or killed, the 'Reaper''s own thread will die.
224+-- @main@ then loops infinitely ('Control.Monad.forever'). Each second it calculates the fibonacci number
225+-- for a value between 30 and 34, first trying the cache ('reaperRead' and 'Data.Map.Strict.lookup'),
226+-- then falling back to manually calculating it (@fib@)
227+-- and updating the cache with the result ('reaperAdd')
227−-- @
229+-- @clean@ simply removes items cached for more than 10 seconds.
228−-- {-\# LANGUAGE MultiWayIf #-}
230+-- This function is where you would perform IO-related cleanup,
231+-- like killing threads or closing connections, if that was the purpose of your reaper.
230-- module Main where
234-- module Main where
232−-- import "Data.Time"
236+-- import "Data.Time" (UTCTime, getCurrentTime, diffUTCTime)
233−-- import "System.Random"
234-- import "Control.Reaper"
237-- import "Control.Reaper"
235−-- import "Control.Concurrent"
238+-- import "Control.Concurrent" (threadDelay)
239+-- import "Data.Map.Strict" (Map)
240+-- import qualified "Data.Map.Strict" as Map
236−-- import "Control.Monad"
241+-- import "Control.Monad" (forever)
237−-- import "Data.IORef"
242+-- import "System.Random" (getStdRandom, randomR)
244+-- fib :: 'Int' -> 'Int'
247+-- fib n = fib (n-1) + fib (n-2)
239−-- -- In this example code, we add Jobs (the individual items) to our Reaper's workload (a list of Jobs)
240−-- data Job = Job { jobID :: 'Int'
241−-- , jobStarted :: 'Data.Time.Clock.UTCTime'
249+-- type Cache = 'Data.Map.Strict.Map' 'Int' ('Int', 'Data.Time.Clock.UTCTime')
242−-- , jobThreadId :: 'ThreadId'
243−-- , jobFinished :: 'IORef' 'Bool'
246-- main :: IO ()
251-- main :: IO ()
247-- main = do
252-- main = do
248-- reaper <- 'mkReaper' 'defaultReaperSettings'
253-- reaper <- 'mkReaper' 'defaultReaperSettings'
254+-- { 'reaperEmpty' = Map.'Data.Map.Strict.empty'
255+-- , 'reaperCons' = \\(k, v, time) workload -> Map.'Data.Map.Strict.insert' k (v, time) workload
249−-- { 'reaperAction' = 'mkListAction' maybeReapJob
256+-- , 'reaperAction' = clean
250−-- , 'reaperDelay' = 1000000 -- Check for completed/valid jobs every second.
257+-- , 'reaperDelay' = 1000000 * 2 -- Clean every 2 seconds
258+-- , 'reaperNull' = Map.'Data.Map.Strict.null'
252−-- 'forM_' [1..10] $ \\i -> do
260+-- forever $ do
253−-- job <- startJob i
261+-- fibArg <- 'System.Random.getStdRandom' ('System.Random.randomR' (30,34))
254−-- ('reaperAdd' reaper) job
262+-- cache <- 'reaperRead' reaper
263+-- let cachedResult = Map.'Data.Map.Strict.lookup' fibArg cache
264+-- case cachedResult of
265+-- 'Just' (fibResult, _createdAt) -> 'putStrLn' $ "Found in cache: `fib " ++ 'show' fibArg ++ "` " ++ 'show' fibResult
267+-- let fibResult = fib fibArg
268+-- 'putStrLn' $ "Calculating `fib " ++ 'show' fibArg ++ "` " ++ 'show' fibResult
269+-- time <- 'Data.Time.Clock.getCurrentTime'
270+-- ('reaperAdd' reaper) (fibArg, fibResult, time)
271+-- 'threadDelay' 1000000 -- 1 second
256−-- 'threadDelay' 1500000 -- Sleep 15 seconds, so that jobs can be completed or killed.
273+-- -- Remove items > 10 seconds old
257−--
274+-- clean :: Cache -> IO (Cache -> Cache)
258−-- -- Start a variable-length task that takes between 1 and 10 seconds
275+-- clean oldMap = do
259−-- startJob :: Int -> IO Job
260−-- startJob aJobID = do
261−-- startTime <- 'Data.Time.Clock.getCurrentTime'
262−-- finishedRef <- 'newIORef' 'False'
263−-- threadID <- 'forkIO' $ do
264−-- secondsToWait <- 'System.Random.getStdRandom' ('System.Random.randomR' (1,10))
265−-- 'threadDelay' (secondsToWait * 1000000)
266−-- 'Data.IORef.atomicWriteIORef' finishedRef 'True' -- Mark the job as complete.
267−-- 'return' $ Job aJobID startTime threadID finishedRef
269−-- -- Remove completed jobs, and also kill ones that have run longer than 5 seconds.
270−-- maybeReapJob :: Job -> IO (Maybe Job)
271−-- maybeReapJob job = do
272-- currentTime <- 'Data.Time.Clock.getCurrentTime'
276-- currentTime <- 'Data.Time.Clock.getCurrentTime'
273−-- let runningTime = currentTime \`diffUTCTime\` (jobStarted job)
277+-- let pruned = Map.'Data.Map.Strict.filter' (\\(_, createdAt) -> currentTime \`diffUTCTime\` createdAt < 10.0) oldMap
274−-- jobDone <- 'readIORef' (jobFinished job)
278+-- return (\\newData -> Map.'Data.Map.Strict.union' pruned newData)
276−-- if | jobDone -> do
277−-- 'putStrLn' $ "Completed job #" ++ 'show' (jobID job)
278−-- 'return' 'Nothing'
279−-- | runningTime > 5.0 -> do
280−-- 'killThread' (jobThreadId job)
281−-- 'putStrLn' $ "Killed job #" ++ 'show' (jobID job)
282−-- 'return' 'Nothing'
283−-- | otherwise -> 'return' ('Just' job)