164afa5 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

wai-handler-devel: Propagate UserInterrupt to main thread (fixes #151)

164afa5Simon Hengel14 years ago

wai-handler-devel/Network/Wai/Handler/DevelServer.hs+16−1

@@ -19,7 +19,8 @@ import Data.Text.Lazy.Encoding (encodeUtf8)

19import qualified Data.ByteString.Lazy.Char8 as L8

20import Control.Exception (Exception, SomeException, toException, fromException, finally, mask)

21import qualified Control.Exception as E

22−import Control.Concurrent (forkIO, threadDelay, killThread)

22+import Control.Concurrent (ThreadId, myThreadId, threadDelay, killThread)

23+import qualified Control.Concurrent as Concurrent

24import Data.Maybe

25import Data.Maybe

25import Control.Monad

26import Control.Monad

@@ -46,6 +47,20 @@ runQuit :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath])

46 -> IO ()

47 -> IO ()

47runQuit port modu func extras = runQuitWithReloadActions port modu func extras []

48runQuit port modu func extras = runQuitWithReloadActions port modu func extras []

50+-- |

51+-- A version of `Concurrent.forkIO` that re-throws any uncaught

52+-- `E.UserInterrupt` from the child thread in the parent thread.

53+--

54+-- We need this because using hint (or the GHC API) causes @UserInterrupt@ to

55+-- occur in the thread that runs `runInterpreter` instead of the main thread.

56+forkIO :: IO () -> IO ThreadId

57+forkIO action = do

58+ threadId <- myThreadId

59+ Concurrent.forkIO (action `E.catch` \e -> case e of

60+ E.UserInterrupt -> E.throwTo threadId e

61+ _ -> E.throwIO e

62+ )

63+

49runQuitWithReloadActions :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath])

64runQuitWithReloadActions :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath])

50 -> [IO (IO ())] -> IO ()

65 -> [IO (IO ())] -> IO ()

51runQuitWithReloadActions port modu func extras actions = do

66runQuitWithReloadActions port modu func extras actions = do