@@ -56,10 +56,11 @@ import GHC.IO (IO (IO))
5656import Control.Concurrent (myThreadId)
5757import qualified Control.Exception as E
5858import GHC.Weak (Weak (..))
59+import Network.Wai.Handler.Warp.IORef (IORef)
60+import qualified Network.Wai.Handler.Warp.IORef as I
5961import System.Mem.Weak (deRefWeak)
6062import Data.Typeable (Typeable)
6163import Control.Reaper
62−import qualified Data.Atomics.Counter.Unboxed as C
6364
6465----------------------------------------------------------------
6566
@@ -70,14 +71,12 @@ type Manager = Reaper [Handle] Handle
7071type TimeoutAction = IO ()
7172
7273-- | A handle used by 'Manager'
73−data Handle = Handle TimeoutAction {-# UNPACK #-} !C.AtomicCounter
74+data Handle = Handle TimeoutAction (IORef State)
7475
75−-- Four states for the AtomicCounter:
76−--
77−-- 1: Active -- Manager turns it to Inactive.
78−-- 2: Inactive -- Manager removes it with timeout action.
79−-- 3: Paused -- Manager does not change it.
80−-- 4: Canceled -- Manager removes it without timeout action.
76+data State = Active -- Manager turns it to Inactive.
77+ | Inactive -- Manager removes it with timeout action.
78+ | Paused -- Manager does not change it.
79+ | Canceled -- Manager removes it without timeout action.
8180
8281----------------------------------------------------------------
8382
@@ -90,15 +89,17 @@ initialize timeout = mkReaper defaultReaperSettings
9089 }
9190 where
9291 prune m@(Handle onTimeout iactive) = do
93− -- Try to change from active to inactive
94− (wasActive, newState) <- C.casCounter iactive 1 2
95− case newState of
96− 2 | not wasActive -> do -- inactive
92+ state <- I.atomicModifyIORef' iactive (\x -> (inactivate x, x))
93+ case state of
94+ Inactive -> do
9795 onTimeout `E.catch` ignoreAll
9896 return Nothing
99− 4 -> return Nothing -- canceled
97+ Canceled -> return Nothing
10098 _ -> return $ Just m
10199
100+ inactivate Active = Inactive
101+ inactivate x = x
102+
102103----------------------------------------------------------------
103104
104105-- | Stopping timeout manager.
@@ -115,7 +116,7 @@ ignoreAll _ = return ()
115116-- | Registering a timeout action.
116117register :: Manager -> TimeoutAction -> IO Handle
117118register mgr onTimeout = do
118− iactive <- C.newCounter 1
119+ iactive <- I.newIORef Active
119120 let h = Handle onTimeout iactive
120121 reaperAdd mgr h
121122 return h
@@ -152,17 +153,17 @@ mkWeakThreadId t@(ThreadId t#) = IO $ \s ->
152153-- | Setting the state to active.
153154-- 'Manager' turns active to inactive repeatedly.
154155tickle :: Handle -> IO ()
155−tickle (Handle _ iactive) = C.writeCounter iactive 1
156+tickle (Handle _ iactive) = I.writeIORef iactive Active
156157
157158-- | Setting the state to canceled.
158159-- 'Manager' eventually removes this without timeout action.
159160cancel :: Handle -> IO ()
160−cancel (Handle _ iactive) = C.writeCounter iactive 4
161+cancel (Handle _ iactive) = I.writeIORef iactive Canceled
161162
162163-- | Setting the state to paused.
163164-- 'Manager' does not change the value.
164165pause :: Handle -> IO ()
165−pause (Handle _ iactive) = C.writeCounter iactive 3
166+pause (Handle _ iactive) = I.writeIORef iactive Paused
166167
167168-- | Setting the paused state to active.
168169-- This is an alias to 'tickle'.