Add initialWorkspaceFolders config option

[lsp-test.git] / src / Language / Haskell / LSP / Test.hs

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 80ea0e3b386f60560cabd1accbdbc79d1783ca16..2f99b19c54c26675edac9f6a874b8b404dbf32e1 100644 (file)
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -155,7 +155,16 @@ runSessionWithConfig config' serverExe caps rootDir session = do
   withServer serverExe (logStdErr config) $ \serverIn serverOut serverProc ->
     runSessionWithHandles' (Just serverProc) serverIn serverOut config caps rootDir session
 
-
+-- | Starts a new session, using the specified handles to communicate with the
+-- server. You can use this to host the server within the same process.
+-- An example with haskell-lsp might look like:
+--
+-- > (hinRead, hinWrite) <- createPipe
+-- > (houtRead, houtWrite) <- createPipe
+-- > 
+-- > forkIO $ void $ runWithHandles hinRead houtWrite initCallbacks handlers def
+-- > Test.runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
+-- >   -- ...
 runSessionWithHandles :: Handle -- ^ The input handle
                       -> Handle -- ^ The output handle
                       -> SessionConfig
@@ -188,7 +197,7 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio
                                           Nothing
                                           caps
                                           (Just TraceOff)
-                                          Nothing
+                                          (List <$> initialWorkspaceFolders config)
   runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
     -- Wrap the session around initialize and shutdown calls
     -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
@@ -196,7 +205,7 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio
 
     -- Because messages can be sent in between the request and response,
     -- collect them and then...
-    (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId initReqId)
+    (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId SInitialize initReqId)
 
     case initRspMsg ^. LSP.result of
       Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error)
@@ -229,10 +238,9 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio
   listenServer serverOut context = do
     msgBytes <- getNextMessage serverOut
 
-    msg <- modifyMVar (requestMap context) $ \reqMap -> do
-      let (msg, newReqMap) = decodeFromServerMsg reqMap msgBytes
+    msg <- modifyMVar (requestMap context) $ \reqMap ->
+      pure $ decodeFromServerMsg reqMap msgBytes
     writeChan (messageChan context) (ServerMessage msg)
-      pure (newReqMap, msg)
 
     case msg of
       (FromServerRsp SShutdown _) -> return ()
@@ -296,7 +304,7 @@ getDocumentEdit doc = do
 -- @
 -- Note: will skip any messages in between the request and the response.
 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
-request m = sendRequest m >=> skipManyTill anyMessage . responseForId
+request m = sendRequest m >=> skipManyTill anyMessage . responseForId m
 
 -- | The same as 'sendRequest', but discard the response.
 request_ :: SClientMethod (m :: Method FromClient Request) -> MessageParams m -> Session ()