git.iko.soy/typeable/wai
on master help sign in
Defining Reaper API.

Stop exposing IORef.

commit50532f6825c024006479109d7572fca50f8b0002 authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 6 Aug 2014, 15:52 (12 years ago) parentb14f9ca
2 files changed+45−18
compare with master
unifiedsplit
auto-update/Control/Reaper.hs+32−7 auto-update/test/Control/ReaperSpec.hs+13−11
auto-update/Control/Reaper.hs+32−7
@@ -4,16 +4,17 @@
44-- threads. These threads will automatically spawn and die based on the
55-- presence of a workload to process on.
66module Control.Reaper (
7− -- * Type
7+ -- * Settings
88 ReaperSettings
99 , defaultReaperSettings
10− , State(..)
1110 -- * Accessors
1211 , reaperAction
1312 , reaperDelay
1413 , reaperCons
1514 , reaperNull
1615 , reaperEmpty
16+ -- * Type
17+ , Reaper(..)
1718 -- * Creation
1819 , mkReaper
1920 -- * Helper
@@ -24,7 +25,7 @@ import Control.AutoUpdate.Util (atomicModifyIORef')
2425import Control.Concurrent (forkIO, threadDelay)
2526import Control.Exception (mask_)
2627import Control.Monad (join, void)
27−import Data.IORef (IORef, newIORef)
28+import Data.IORef (IORef, newIORef, readIORef)
2829
2930-- | Settings for creating a reaper. This type has two parameters:
3031-- @workload@ gives the entire workload, whereas @item@ gives an
@@ -86,6 +87,17 @@ defaultReaperSettings = ReaperSettings
8687 , reaperEmpty = []
8788 }
8889
90+-- | A data structure to hold reaper APIs.
91+data Reaper workload item = Reaper {
92+ -- | Adding an item to the workload
93+ reaperAdd :: item -> IO ()
94+ -- | Reading workload.
95+ , reaperRead :: IO workload
96+ -- | Stopping the reaper thread if exists.
97+ -- The current workload is returned.
98+ , reaperStop :: IO workload
99+ }
100+
89101-- | State of reaper.
90102data State workload = NoReaper -- ^ No reaper thread
91103 | Workload workload -- ^ The current jobs
@@ -95,11 +107,24 @@ data State workload = NoReaper -- ^ No reaper thread
95107-- for you automatically.
96108--
97109-- Since 0.1.1
98−mkReaper :: ReaperSettings workload item
99− -> IO (item -> IO (), IORef (State workload))
100−mkReaper settings = do
110+mkReaper :: ReaperSettings workload item -> IO (Reaper workload item)
111+mkReaper settings@ReaperSettings{..} = do
101112 stateRef <- newIORef NoReaper
102− return (update settings stateRef, stateRef)
113+ return Reaper {
114+ reaperAdd = update settings stateRef
115+ , reaperRead = readRef stateRef
116+ , reaperStop = stop stateRef
117+ }
118+ where
119+ readRef stateRef = do
120+ mx <- readIORef stateRef
121+ case mx of
122+ NoReaper -> return reaperEmpty
123+ Workload wl -> return wl
124+ stop stateRef = atomicModifyIORef' stateRef $ \mx ->
125+ case mx of
126+ NoReaper -> (NoReaper, reaperEmpty)
127+ Workload x -> (Workload reaperEmpty, x)
103128
104129update :: ReaperSettings workload item -> IORef (State workload) -> item
105130 -> IO ()
auto-update/test/Control/ReaperSpec.hs+13−11
@@ -8,28 +8,30 @@ import Data.IORef
88
99type Item = (Int, IORef Int)
1010
11+action = mkListAction $ \(i, ref) -> do
12+ modifyIORef ref succ
13+ return $ if i > 1
14+ then Just (pred i, ref)
15+ else Nothing
16+
1117spec :: Spec
1218spec = prop "works" $ \is -> do
13− (addItem, wlRef) <- mkReaper defaultReaperSettings
14− { reaperAction = mkListAction $ \(i, ref) -> do
15− modifyIORef ref succ
16− return $ if i > 1
17− then Just (pred i, ref)
18− else Nothing
19+ reaper <- mkReaper defaultReaperSettings
20+ { reaperAction = action
1921 , reaperDelay = 1000
2022 }
2123
22− let mkTest i = do
24+ let mkTestCase i = do
2325 ref <- newIORef 0
2426 let expected = (abs i `mod` 10) + 1
25− addItem (expected, ref)
27+ reaperAdd reaper (expected, ref)
2628 return (expected, ref)
27− tests <- mapM mkTest is
29+ testCases <- mapM mkTestCase is
2830
2931 let test (expected, ref) = do
3032 actual <- readIORef ref
3133 actual `shouldBe` (expected :: Int)
3234 threadDelay 100000
33− mapM_ test tests
34− NoReaper <- readIORef wlRef
35+ mapM_ test testCases
36+ [] <- reaperRead reaper
3537 return ()