@@ -4,14 +4,18 @@ module Timeout
44 , initialize
55 , register
66 , tickle
7+ , pause
8+ , resume
79 ) where
810
911import qualified Data.IORef as I
1012import Control.Concurrent (forkIO, threadDelay)
1113import Control.Monad (forever)
14+import qualified Control.Exception as E
1215
1316newtype Manager = Manager (I.IORef [Handle])
14−data Handle = Handle (IO ()) (I.IORef Bool)
17+data Handle = Handle (IO ()) (I.IORef State)
18+data State = Active | Inactive | Paused
1519
1620initialize :: Int -> IO Manager
1721initialize timeout = do
@@ -25,19 +29,26 @@ initialize timeout = do
2529 where
2630 go [] front = return front
2731 go (m@(Handle onTimeout iactive):rest) front = do
28− active <- I.atomicModifyIORef iactive (\x -> (False, x))
29− if active
30− then go rest (front . (:) m)
31− else do
32− onTimeout
32+ state <- I.atomicModifyIORef iactive (\x -> (go' x, x))
33+ case state of
34+ Inactive -> do
35+ onTimeout `E.catch` ignoreAll
3336 go rest front
37+ _ -> go rest (front . (:) m)
38+ go' Active = Inactive
39+ go' x = x
40+
41+ignoreAll :: E.SomeException -> IO ()
42+ignoreAll _ = return ()
3443
3544register :: Manager -> IO () -> IO Handle
3645register (Manager ref) onTimeout = do
37− iactive <- I.newIORef True
46+ iactive <- I.newIORef Active
3847 let h = Handle onTimeout iactive
3948 I.atomicModifyIORef ref (\x -> (h : x, ()))
4049 return h
4150
42−tickle :: Handle -> IO ()
43−tickle (Handle _ iactive) = I.writeIORef iactive True
51+tickle, pause, resume :: Handle -> IO ()
52+tickle (Handle _ iactive) = I.writeIORef iactive Active
53+pause (Handle _ iactive) = I.writeIORef iactive Paused
54+resume = tickle