- launchServerHandler = forkIO $ catch (serverHandler serverOut context)
- (throwTo mainThreadId :: SessionException -> IO ())
- (result, _) <- bracket launchServerHandler killThread $
- const $ runSession context initState session
-
+ errorHandler ex = do x <- readIORef exitOk
+ unless x $ throwTo mainThreadId (ex :: SessionException)
+ launchServerHandler = forkIO $ catch (serverHandler serverOut context) errorHandler
+ (result, _) <- bracket
+ launchServerHandler
+ (\tid -> do runSession context initState sendExitMessage
+ killThread tid
+ atomicWriteIORef exitOk True)
+ (const $ runSession context initState session)