@@ -7,6 +7,7 @@ module Control.Reaper (
77 -- * Type
88 ReaperSettings
99 , defaultReaperSettings
10+ , State(..)
1011 -- * Accessors
1112 , reaperAction
1213 , reaperDelay
@@ -85,29 +86,33 @@ defaultReaperSettings = ReaperSettings
8586 , reaperEmpty = []
8687 }
8788
89+data State workload = NoReaper | Workload workload
90+
8891-- | Create a reaper addition function. This funciton can be used to add
8992-- new items to the workload. Spawning of reaper threads will be handled
9093-- for you automatically.
9194--
9295-- Since 0.1.1
9396reaper :: ReaperSettings workload item
94− -> IO (item -> IO (), IORef (Maybe workload))
97+ -> IO (item -> IO (), IORef (State workload))
9598reaper settings = do
96− stateRef <- newIORef Nothing
99+ stateRef <- newIORef NoReaper
97100 return (update settings stateRef, stateRef)
98101
99−update :: ReaperSettings workload item -> IORef (Maybe workload) -> item
102+update :: ReaperSettings workload item -> IORef (State workload) -> item
100103 -> IO ()
101104update settings@ReaperSettings{..} stateRef item =
102105 mask_ $ join $ atomicModifyIORef' stateRef cons
103106 where
104− cons Nothing = (Just $ reaperCons item reaperEmpty, spawn settings stateRef)
105− cons (Just wl) = (Just $ reaperCons item wl, return ())
107+ cons NoReaper = (Workload $ reaperCons item reaperEmpty
108+ ,spawn settings stateRef)
109+ cons (Workload wl) = (Workload $ reaperCons item wl
110+ ,return ())
106111
107−spawn :: ReaperSettings workload item -> IORef (Maybe workload) -> IO ()
112+spawn :: ReaperSettings workload item -> IORef (State workload) -> IO ()
108113spawn settings stateRef = void . forkIO $ loop settings stateRef
109114
110−loop :: ReaperSettings workload item -> IORef (Maybe workload) -> IO ()
115+loop :: ReaperSettings workload item -> IORef (State workload) -> IO ()
111116loop settings@ReaperSettings{..} stateRef = do
112117 threadDelay reaperDelay
113118 -- Getting the current jobs. Push an empty job to the reference.
@@ -119,15 +124,15 @@ loop settings@ReaperSettings{..} stateRef = do
119124 -- If there is no jobs, this thread finishes.
120125 join $ atomicModifyIORef' stateRef (check merge)
121126 where
122− swapWithEmpty Nothing = error "Control.Reaper.loop: unexpected Nothing (1)"
123− swapWithEmpty (Just wl) = (Just reaperEmpty, wl)
127+ swapWithEmpty NoReaper = error "Control.Reaper.loop: unexpected NoReaper (1)"
128+ swapWithEmpty (Workload wl) = (Workload reaperEmpty, wl)
124129
125− check _ Nothing = error "Control.Reaper.loop: unexpected Nothing (2)"
126− check merge (Just wl)
130+ check _ NoReaper = error "Control.Reaper.loop: unexpected NoReaper (2)"
131+ check merge (Workload wl)
127132 -- If there is no workload, reaper is terminated.
128− | reaperNull wl' = (Nothing, return ())
133+ | reaperNull wl' = (NoReaper, return ())
129134 -- If there are workloads, carry it out.
130− | otherwise = (Just wl', loop settings stateRef)
135+ | otherwise = (Workload wl', loop settings stateRef)
131136 where
132137 wl' = merge wl
133138