projects
/
lsp-test.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Use ProcessHandle in withServer to allow kill it by client code
[lsp-test.git]
/
src
/
Language
/
Haskell
/
LSP
/
Test
/
Session.hs
diff --git
a/src/Language/Haskell/LSP/Test/Session.hs
b/src/Language/Haskell/LSP/Test/Session.hs
index 1777f15f2750a913e812df81c7a42d7c6156fee1..8612148ce870a56b1e3cc1587567607dc60f4955 100644
(file)
--- a/
src/Language/Haskell/LSP/Test/Session.hs
+++ b/
src/Language/Haskell/LSP/Test/Session.hs
@@
-65,6
+65,8
@@
import Language.Haskell.LSP.Test.Exceptions
import System.Console.ANSI
import System.Directory
import System.IO
import System.Console.ANSI
import System.Directory
import System.IO
+import System.Process
+import System.Timeout
-- | A session representing one instance of launching and connecting to a server.
--
-- | A session representing one instance of launching and connecting to a server.
--
@@
-186,14
+188,15
@@
runSession context state session = runReaderT (runStateT conduit state) context
-- It also does not automatically send initialize and exit messages.
runSessionWithHandles :: Handle -- ^ Server in
-> Handle -- ^ Server out
-- It also does not automatically send initialize and exit messages.
runSessionWithHandles :: Handle -- ^ Server in
-> Handle -- ^ Server out
+ -> ProcessHandle -- ^ Server process
-> (Handle -> SessionContext -> IO ()) -- ^ Server listener
-> SessionConfig
-> ClientCapabilities
-> FilePath -- ^ Root directory
-> (Handle -> SessionContext -> IO ()) -- ^ Server listener
-> SessionConfig
-> ClientCapabilities
-> FilePath -- ^ Root directory
- -> Session () -- ^ To exit
Server
+ -> Session () -- ^ To exit
the Server properly
-> Session a
-> IO a
-> Session a
-> IO a
-runSessionWithHandles serverIn serverOut serverHandler config caps rootDir exitServer session = do
+runSessionWithHandles serverIn serverOut server
Proc server
Handler config caps rootDir exitServer session = do
absRootDir <- canonicalizePath rootDir
absRootDir <- canonicalizePath rootDir
@@
-216,7
+219,10
@@
runSessionWithHandles serverIn serverOut serverHandler config caps rootDir exitS
errorHandler = throwTo mainThreadId :: SessionException -> IO()
serverLauncher = forkIO $ catch (serverHandler serverOut context) errorHandler
errorHandler = throwTo mainThreadId :: SessionException -> IO()
serverLauncher = forkIO $ catch (serverHandler serverOut context) errorHandler
- serverFinalizer tid = runSession' exitServer >> killThread tid
+ server = (Just serverIn, Just serverOut, Nothing, serverProc)
+ serverFinalizer tid = finally (timeout (messageTimeout config * 1000000)
+ (runSession' exitServer))
+ (cleanupProcess server >> killThread tid)
(result, _) <- bracket serverLauncher serverFinalizer (const $ runSession' session)
return result
(result, _) <- bracket serverLauncher serverFinalizer (const $ runSession' session)
return result