X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=086a34c9257465d8ef284f66e5138486dbc91832;hb=f5e627c1912bc66b7b8bb2c1a389b59fb34de883;hp=f4fb5c15021aa7563395feb5a405d7eb38ca032f;hpb=12ac9c23d054e92a82146320e2b061c11a87e3f1;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index f4fb5c1..086a34c 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -81,10 +81,11 @@ import Language.Haskell.LSP.Test.Decoding import Language.Haskell.LSP.Test.Parsing -- | Starts a new session. -runSession :: FilePath -- ^ The filepath to the root directory for the session. +runSession :: String -- ^ The command to run the server. + -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO () -runSession rootDir session = do +runSession serverExe rootDir session = do pid <- getProcessID absRootDir <- canonicalizePath rootDir @@ -95,7 +96,7 @@ runSession rootDir session = do def (Just TraceOff) - runSessionWithHandler listenServer rootDir $ do + runSessionWithHandler listenServer serverExe rootDir $ do -- Wrap the session around initialize and shutdown calls sendRequest Initialize initializeParams @@ -112,15 +113,15 @@ runSession rootDir session = do -- | An internal version of 'runSession' that allows for a custom handler to listen to the server. -- It also does not automatically send initialize and exit messages. runSessionWithHandler :: (Handle -> Session ()) + -> String -> FilePath -> Session a -> IO a -runSessionWithHandler serverHandler rootDir session = do +runSessionWithHandler serverHandler serverExe rootDir session = do absRootDir <- canonicalizePath rootDir - (Just serverIn, Just serverOut, Nothing, serverProc) <- createProcess - (proc "hie" ["--lsp", "-d", "-l", "/tmp/hie-test.log"]) - { std_in = CreatePipe, std_out = CreatePipe } + let createProc = (shell serverExe) { std_in = CreatePipe, std_out = CreatePipe } + (Just serverIn, Just serverOut, Nothing, serverProc) <- createProcess createProc hSetBuffering serverIn NoBuffering hSetBuffering serverOut NoBuffering @@ -132,10 +133,11 @@ runSessionWithHandler serverHandler rootDir session = do let context = SessionContext serverIn absRootDir messageChan reqMap initState = SessionState (IdInt 9) - forkIO $ void $ runSession' meaninglessChan context initState (serverHandler serverOut) + threadId <- forkIO $ void $ runSession' meaninglessChan context initState (serverHandler serverOut) (result, _) <- runSession' messageChan context initState session terminateProcess serverProc + killThread threadId return result