X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=430ac5b9153df91469590b6f772b14b2aaf6ccc9;hb=6fa77d1acd9f1c76383ac179b36bacd9d22f2819;hp=8dd252c80c332335d0b9b206a6ae62bb6123940f;hpb=c7db2307c2d3dcc310fa5241756c2fbca7d00eea;p=lsp-test.git

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 8dd252c..430ac5b 100644
--- 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)
@@ -221,7 +230,7 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio
   where
   -- | Asks the server to shutdown and exit politely
   exitServer :: Session ()
-  exitServer = request_ SShutdown (Nothing :: Maybe Value) >> sendNotification SExit Empty
+  exitServer = request_ SShutdown Empty >> sendNotification SExit Empty
 
   -- | Listens to the server output until the shutdown ack,
   -- makes sure it matches the record and signals any semaphores
@@ -229,9 +238,8 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio
   listenServer serverOut context = do
     msgBytes <- getNextMessage serverOut
 
-    reqMap <- readMVar $ requestMap context
-
-    let msg = fst $ decodeFromServerMsg reqMap msgBytes
+    msg <- modifyMVar (requestMap context) $ \reqMap ->
+      pure $ decodeFromServerMsg reqMap msgBytes
     writeChan (messageChan context) (ServerMessage msg)
 
     case msg of
@@ -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 ()