@@ -1,3 +1,5 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE UnboxedTuples, MagicHash #-}
13module Network.Wai.Handler.Warp.Timeout (
24 Manager
35 , Handle
@@ -12,6 +14,15 @@ module Network.Wai.Handler.Warp.Timeout (
1214 , dummyHandle
1315 ) where
1416
17+import System.Mem.Weak (deRefWeak)
18+#if MIN_VERSION_base(4,6,0)
19+import Control.Concurrent (mkWeakThreadId)
20+#else
21+import GHC.Weak (Weak (..))
22+import GHC.Conc.Sync (ThreadId (..))
23+import GHC.IO (IO (IO))
24+import GHC.Exts (mkWeak#)
25+#endif
1526import Control.Concurrent (forkIO, threadDelay, myThreadId, killThread)
1627import qualified Control.Exception as E
1728import Control.Monad (forever, void)
@@ -68,8 +79,15 @@ register (Manager ref) onTimeout = do
6879
6980registerKillThread :: Manager -> IO Handle
7081registerKillThread m = do
71− tid <- myThreadId
72− register m $ killThread tid
82+ wtid <- myThreadId >>= mkWeakThreadId
83+ register m $ deRefWeak wtid >>= maybe (return ()) killThread
84+
85+#if !MIN_VERSION_base(4,6,0)
86+mkWeakThreadId :: ThreadId -> IO (Weak ThreadId)
87+mkWeakThreadId t@(ThreadId t#) = IO $ \s ->
88+ case mkWeak# t# t Nothing s of
89+ (# s1, w #) -> (# s1, Weak w #)
90+#endif
7391
7492tickle, pause, resume, cancel :: Handle -> IO ()
7593tickle (Handle _ iactive) = I.writeIORef iactive Active