@@ -72,24 +72,25 @@ initialize timeout = do
7272 ref <- I.newIORef []
7373 void . forkIO $ E.handle ignoreStop $ forever $ do
7474 threadDelay timeout
75− ms <- I.atomicModifyIORef ref (\x -> ([], x))
76− ms' <- go ms id
77− I.atomicModifyIORef ref (\x -> (ms' x, ()))
75+ -- FIXME: isn't mask_ necessary?
76+ old <- I.atomicModifyIORef ref (\x -> ([], x))
77+ merge <- prune old id
78+ I.atomicModifyIORef ref (\new -> (merge new, ()))
7879 return $ Manager ref
7980 where
8081 ignoreStop TimeoutManagerStopped = return ()
8182
82− go [] front = return front
83− go (m@(Handle onTimeout iactive):rest) front = do
84− state <- I.atomicModifyIORef iactive (\x -> (go' x, x))
83+ prune [] front = return front
84+ prune (m@(Handle onTimeout iactive):rest) front = do
85+ state <- I.atomicModifyIORef iactive (\x -> (inactivate x, x))
8586 case state of
8687 Inactive -> do
8788 onTimeout `E.catch` ignoreAll
88− go rest front
89− Canceled -> go rest front
90− _ -> go rest (front . (:) m)
91− go' Active = Inactive
92− go' x = x
89+ prune rest front
90+ Canceled -> prune rest front
91+ _ -> prune rest (front . (:) m)
92+ inactivate Active = Inactive
93+ inactivate x = x
9394
9495----------------------------------------------------------------
9596
@@ -98,9 +99,9 @@ stopManager (Manager ihandles) = E.mask_ $ do
9899 -- Put an undefined value in the IORef to kill the worker thread (yes, it's
99100 -- a bit of a hack)
100101 !handles <- I.atomicModifyIORef ihandles $ \h -> (E.throw TimeoutManagerStopped, h)
101− mapM_ go handles
102+ mapM_ fire handles
102103 where
103− go (Handle onTimeout _) = onTimeout `E.catch` ignoreAll
104+ fire (Handle onTimeout _) = onTimeout `E.catch` ignoreAll
104105
105106ignoreAll :: E.SomeException -> IO ()
106107ignoreAll _ = return ()