projects
/
lsp-test.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
c922377
)
Add server shutdown check to throw exception
author
jneira
<atreyu.bbb@gmail.com>
Tue, 9 Jul 2019 10:25:44 +0000
(12:25 +0200)
committer
jneira
<atreyu.bbb@gmail.com>
Tue, 9 Jul 2019 10:25:44 +0000
(12:25 +0200)
src/Language/Haskell/LSP/Test/Session.hs
patch
|
blob
|
history
diff --git
a/src/Language/Haskell/LSP/Test/Session.hs
b/src/Language/Haskell/LSP/Test/Session.hs
index 415402a7ce261f98c0eb5b4ad707aad65288f54b..ae8ba1e0fbb15917697bd8e2f3589ebcf59a0862 100644
(file)
--- a/
src/Language/Haskell/LSP/Test/Session.hs
+++ b/
src/Language/Haskell/LSP/Test/Session.hs
@@
-48,6
+48,7
@@
import Data.Conduit as Conduit
import Data.Conduit.Parser as Parser
import Data.Default
import Data.Foldable
import Data.Conduit.Parser as Parser
import Data.Default
import Data.Foldable
+import Data.IORef
import Data.List
import qualified Data.Map as Map
import qualified Data.Text as T
import Data.List
import qualified Data.Map as Map
import qualified Data.Text as T
@@
-193,6
+194,10
@@
runSessionWithHandles :: Handle -- ^ Server in
-> Session a
-> IO a
runSessionWithHandles serverIn serverOut serverHandler config caps rootDir session = do
-> Session a
-> IO a
runSessionWithHandles serverIn serverOut serverHandler config caps rootDir session = do
+ -- We use this IORef to make exception non-fatal when the server is supposed to shutdown.
+
+ exitOk <- newIORef False
+
absRootDir <- canonicalizePath rootDir
hSetBuffering serverIn NoBuffering
absRootDir <- canonicalizePath rootDir
hSetBuffering serverIn NoBuffering
@@
-210,12
+215,14
@@
runSessionWithHandles serverIn serverOut serverHandler config caps rootDir sessi
let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config caps
initState = SessionState (IdInt 0) mempty mempty 0 False Nothing
let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config caps
initState = SessionState (IdInt 0) mempty mempty 0 False Nothing
- launchServerHandler = forkIO $ catch (serverHandler serverOut context)
- (throwTo mainThreadId :: SessionException -> IO())
+ 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
(result, _) <- bracket
launchServerHandler
(\tid -> do runSession context initState sendExitMessage
- killThread tid)
+ killThread tid
+ atomicWriteIORef exitOk True)
(const $ runSession context initState session)
return result
(const $ runSession context initState session)
return result