@@ -3,8 +3,18 @@
4-- | This module provides the ability to create reapers: dedicated cleanup
4-- | This module provides the ability to create reapers: dedicated cleanup
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.
6+-- presence of a workload to process on. Example uses include:
8+-- * Killing long-running jobs
9+-- * Closing unused connections in a connection pool
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>
13+-- for imports of "Control.Reaper".
7module Control.Reaper (
14module Control.Reaper (
15+ -- * Example: Regularly cleaning a cache
8 -- * Settings
18 -- * Settings
9 ReaperSettings
19 ReaperSettings
10 , defaultReaperSettings
20 , defaultReaperSettings
@@ -33,7 +43,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef)
33-- be a list of @item@s. This is encouraged by 'defaultReaperSettings' and
43-- be a list of @item@s. This is encouraged by 'defaultReaperSettings' and
34-- 'mkListAction'.
44-- 'mkListAction'.
36−-- Since 0.1.1
46+-- @since 0.1.1
37data ReaperSettings workload item = ReaperSettings
47data ReaperSettings workload item = ReaperSettings
38 { reaperAction :: workload -> IO (workload -> workload)
48 { reaperAction :: workload -> IO (workload -> workload)
39 -- ^ The action to perform on a workload. The result of this is a
49 -- ^ The action to perform on a workload. The result of this is a
@@ -46,38 +56,38 @@ data ReaperSettings workload item = ReaperSettings
46 -- temporary workload. This is incredibly useless; you should
56 -- temporary workload. This is incredibly useless; you should
47 -- definitely override this default.
57 -- definitely override this default.
49− -- Since 0.1.1
59+ -- @since 0.1.1
50 , reaperDelay :: {-# UNPACK #-} !Int
60 , reaperDelay :: {-# UNPACK #-} !Int
51 -- ^ Number of microseconds to delay between calls of 'reaperAction'.
61 -- ^ Number of microseconds to delay between calls of 'reaperAction'.
53 -- Default: 30 seconds.
63 -- Default: 30 seconds.
55− -- Since 0.1.1
65+ -- @since 0.1.1
56 , reaperCons :: item -> workload -> workload
66 , reaperCons :: item -> workload -> workload
57 -- ^ Add an item onto a workload.
67 -- ^ Add an item onto a workload.
59 -- Default: list consing.
69 -- Default: list consing.
61− -- Since 0.1.1
71+ -- @since 0.1.1
62 , reaperNull :: workload -> Bool
72 , reaperNull :: workload -> Bool
63 -- ^ Check if a workload is empty, in which case the worker thread
73 -- ^ Check if a workload is empty, in which case the worker thread
64 -- will shut down.
74 -- will shut down.
66 -- Default: 'null'.
76 -- Default: 'null'.
68− -- Since 0.1.1
78+ -- @since 0.1.1
69 , reaperEmpty :: workload
79 , reaperEmpty :: workload
70 -- ^ An empty workload.
80 -- ^ An empty workload.
72 -- Default: empty list.
82 -- Default: empty list.
74− -- Since 0.1.1
84+ -- @since 0.1.1
77-- | Default @ReaperSettings@ value, biased towards having a list of work
87-- | Default @ReaperSettings@ value, biased towards having a list of work
80−-- Since 0.1.1
90+-- @since 0.1.1
81defaultReaperSettings :: ReaperSettings [item] item
91defaultReaperSettings :: ReaperSettings [item] item
82defaultReaperSettings = ReaperSettings
92defaultReaperSettings = ReaperSettings
83 { reaperAction = \wl -> return (wl ++)
93 { reaperAction = \wl -> return (wl ++)
@@ -104,11 +114,11 @@ data Reaper workload item = Reaper {
104data State workload = NoReaper -- ^ No reaper thread
114data State workload = NoReaper -- ^ No reaper thread
105 | Workload workload -- ^ The current jobs
115 | Workload workload -- ^ The current jobs
107−-- | Create a reaper addition function. This funciton can be used to add
117+-- | Create a reaper addition function. This function can be used to add
108-- new items to the workload. Spawning of reaper threads will be handled
118-- new items to the workload. Spawning of reaper threads will be handled
109-- for you automatically.
119-- for you automatically.
111−-- Since 0.1.1
121+-- @since 0.1.1
112mkReaper :: ReaperSettings workload item -> IO (Reaper workload item)
122mkReaper :: ReaperSettings workload item -> IO (Reaper workload item)
113mkReaper settings@ReaperSettings{..} = do
123mkReaper settings@ReaperSettings{..} = do
114 stateRef <- newIORef NoReaper
124 stateRef <- newIORef NoReaper
@@ -187,7 +197,7 @@ reaper settings@ReaperSettings{..} stateRef tidRef = do
187-- return either a new work item, or @Nothing@ if the work item is
197-- return either a new work item, or @Nothing@ if the work item is
188-- expired.
198-- expired.
190−-- Since 0.1.1
200+-- @since 0.1.1
191mkListAction :: (item -> IO (Maybe item'))
201mkListAction :: (item -> IO (Maybe item'))
192 -> [item]
202 -> [item]
193 -> IO ([item'] -> [item'])
203 -> IO ([item'] -> [item'])
@@ -202,3 +212,68 @@ mkListAction f =
202 Nothing -> front
212 Nothing -> front
203 Just y -> front . (y:)
213 Just y -> front . (y:)
204 go front' xs
214 go front' xs
217+-- In this example code, we use a 'Data.Map.Strict.Map' to cache fibonacci numbers, and a 'Reaper' to prune the cache.
219+-- The @main@ function first creates a 'Reaper', with fields to initialize the
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.
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')
229+-- @clean@ simply removes items cached for more than 10 seconds.
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.
236+-- import "Data.Time" (UTCTime, getCurrentTime, diffUTCTime)
237+-- import "Control.Reaper"
238+-- import "Control.Concurrent" (threadDelay)
239+-- import "Data.Map.Strict" (Map)
240+-- import qualified "Data.Map.Strict" as Map
241+-- import "Control.Monad" (forever)
242+-- import "System.Random" (getStdRandom, randomR)
244+-- fib :: 'Int' -> 'Int'
247+-- fib n = fib (n-1) + fib (n-2)
249+-- type Cache = 'Data.Map.Strict.Map' 'Int' ('Int', 'Data.Time.Clock.UTCTime')
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
256+-- , 'reaperAction' = clean
257+-- , 'reaperDelay' = 1000000 * 2 -- Clean every 2 seconds
258+-- , 'reaperNull' = Map.'Data.Map.Strict.null'
261+-- fibArg <- 'System.Random.getStdRandom' ('System.Random.randomR' (30,34))
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
273+-- -- Remove items > 10 seconds old
274+-- clean :: Cache -> IO (Cache -> Cache)
276+-- currentTime <- 'Data.Time.Clock.getCurrentTime'
277+-- let pruned = Map.'Data.Map.Strict.filter' (\\(_, createdAt) -> currentTime \`diffUTCTime\` createdAt < 10.0) oldMap
278+-- return (\\newData -> Map.'Data.Map.Strict.union' pruned newData)