X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=1ed07d5e06211ed583251cd066271385d2310565;hb=8c79bbaf4135321c321b5599ada4a370e5dcb50d;hp=9866be9efd93987f40e0585dc0d4abac034f2cc0;hpb=f2862c89be8f545d0cda5890dce58d31c15127f6;p=lsp-test.git

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 9866be9..1ed07d5 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
@@ -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
@@ -487,8 +496,8 @@ getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol]
 getDocumentSymbols doc = do
   ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) :: Session DocumentSymbolsResponse
   case res of
-    Right (L (List xs)) -> return (Left xs)
-    Right (R (List xs)) -> return (Right xs)
+    Right (InL (List xs)) -> return (Left xs)
+    Right (InR (List xs)) -> return (Right xs)
     Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
 
 -- | Returns the code actions in the specified range.
@@ -534,7 +543,7 @@ executeCommand :: Command -> Session ()
 executeCommand cmd = do
   let args = decode $ encode $ fromJust $ cmd ^. arguments
       execParams = ExecuteCommandParams Nothing (cmd ^. command) args
-  request_ SWorkspaceExecuteCommand execParams
+  void $ sendRequest SWorkspaceExecuteCommand execParams
 
 -- | Executes a code action.
 -- Matching with the specification, if a code action
@@ -595,8 +604,8 @@ getCompletions doc pos = do
   rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing Nothing)
 
   case getResponseResult rsp of
-    L (List items) -> return items
-    R (CompletionList _ (List items)) -> return items
+    InL (List items) -> return items
+    InR (CompletionList _ (List items)) -> return items
 
 -- | Returns the references for the position in the document.
 getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
@@ -647,9 +656,9 @@ getDeclarationyRequest method paramCons doc pos = do
   let params = paramCons doc pos Nothing Nothing
   rsp <- request method params
   case getResponseResult rsp of
-      L loc -> pure (L [loc])
-      R (L (List locs)) -> pure (L locs)
-      R (R (List locLinks)) -> pure (R locLinks)
+      InL loc -> pure (InL [loc])
+      InR (InL (List locs)) -> pure (InL locs)
+      InR (InR (List locLinks)) -> pure (InR locLinks)
 
 -- | Renames the term at the specified position.
 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
@@ -661,7 +670,7 @@ rename doc pos newName = do
   updateState (FromServerMess SWorkspaceApplyEdit req)
 
 -- | Returns the hover information at the specified position.
-getHover :: TextDocumentIdentifier -> Position -> Session Hover
+getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
 getHover doc pos =
   let params = HoverParams doc pos Nothing
   in getResponseResult <$> request STextDocumentHover params