Add getCodeActions, getCurrentDiagnostics, bump

[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 ed60e585822a9c51da7b4a63e35252b2d2179f3b..ec290ff9833b0d79af1e861f825d7850a407caf3 100644 (file)
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -23,7 +23,7 @@ module Language.Haskell.LSP.Test
   , runSessionWithConfig
   , SessionConfig(..)
   , defaultConfig
   , runSessionWithConfig
   , SessionConfig(..)
   , defaultConfig

-  , module Language.Haskell.LSP.Test.Capabilities
+  , module Language.Haskell.LSP.Types.Capabilities

   -- ** Exceptions
   , module Language.Haskell.LSP.Test.Exceptions
   , withTimeout
   -- ** Exceptions
   , module Language.Haskell.LSP.Test.Exceptions
   , withTimeout


@@ -52,9 +52,11 @@ module Language.Haskell.LSP.Test
   , waitForDiagnostics
   , waitForDiagnosticsSource
   , noDiagnostics
   , waitForDiagnostics
   , waitForDiagnosticsSource
   , noDiagnostics

+  , getCurrentDiagnostics

   -- ** Commands
   , executeCommand
   -- ** Code Actions
   -- ** Commands
   , executeCommand
   -- ** Code Actions

+  , getCodeActions

   , getAllCodeActions
   , executeCodeAction
   -- ** Completions
   , getAllCodeActions
   , executeCodeAction
   -- ** Completions


@@ -91,10 +93,9 @@ import qualified Data.Map as Map
 import Data.Maybe
 import Language.Haskell.LSP.Types hiding (id, capabilities, message)
 import qualified Language.Haskell.LSP.Types as LSP
 import Data.Maybe
 import Language.Haskell.LSP.Types hiding (id, capabilities, message)
 import qualified Language.Haskell.LSP.Types as LSP

-import qualified Language.Haskell.LSP.Types.Capabilities as LSP
+import Language.Haskell.LSP.Types.Capabilities

 import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.VFS
 import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.VFS

-import Language.Haskell.LSP.Test.Capabilities

 import Language.Haskell.LSP.Test.Compat
 import Language.Haskell.LSP.Test.Decoding
 import Language.Haskell.LSP.Test.Exceptions
 import Language.Haskell.LSP.Test.Compat
 import Language.Haskell.LSP.Test.Decoding
 import Language.Haskell.LSP.Test.Exceptions


@@ -115,7 +116,7 @@ import qualified Yi.Rope as Rope
 -- >       params = TextDocumentPositionParams doc
 -- >   hover <- request TextDocumentHover params
 runSession :: String -- ^ The command to run the server.
 -- >       params = TextDocumentPositionParams doc
 -- >   hover <- request TextDocumentHover params
 runSession :: String -- ^ The command to run the server.

-           -> LSP.ClientCapabilities -- ^ The capabilities that the client should declare.
+           -> ClientCapabilities -- ^ The capabilities that the client should declare.

            -> FilePath -- ^ The filepath to the root directory for the session.
            -> Session a -- ^ The session to run.
            -> IO a
            -> FilePath -- ^ The filepath to the root directory for the session.
            -> Session a -- ^ The session to run.
            -> IO a


@@ -124,7 +125,7 @@ runSession = runSessionWithConfig def
 -- | Starts a new sesion with a custom configuration.
 runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
                      -> String -- ^ The command to run the server.
 -- | Starts a new sesion with a custom configuration.
 runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
                      -> String -- ^ The command to run the server.

-                     -> LSP.ClientCapabilities -- ^ The capabilities that the client should declare.
+                     -> ClientCapabilities -- ^ The capabilities that the client should declare.

                      -> FilePath -- ^ The filepath to the root directory for the session.
                      -> Session a -- ^ The session to run.
                      -> IO a
                      -> FilePath -- ^ The filepath to the root directory for the session.
                      -> Session a -- ^ The session to run.
                      -> IO a


@@ -350,25 +351,36 @@ noDiagnostics = do
   when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
 
 -- | Returns the symbols in a document.
   when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
 
 -- | Returns the symbols in a document.

-getDocumentSymbols :: TextDocumentIdentifier -> Session [SymbolInformation]
+getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])

 getDocumentSymbols doc = do
 getDocumentSymbols doc = do

-  ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc)
+  ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc) :: Session DocumentSymbolsResponse

   maybe (return ()) (throw . UnexpectedResponseError rspLid) mErr
   maybe (return ()) (throw . UnexpectedResponseError rspLid) mErr

-  let (Just (List symbols)) = mRes
-  return symbols
+  case mRes of
+    Just (DSDocumentSymbols (List xs)) -> return (Left xs)
+    Just (DSSymbolInformation (List xs)) -> return (Right xs)
+    Nothing -> Prelude.error "No result and no error in DocumentSymbolsResponse"
+
+-- | Returns the code actions in the specified range.
+getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult]
+getCodeActions doc range = do
+  ctx <- getCodeActionContext doc
+  rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx)
+
+  case rsp ^. result of
+    Just (List xs) -> return xs
+    _ -> throw (UnexpectedResponseError (rsp ^. LSP.id) (fromJust $ rsp ^. LSP.error))

 
 -- | Returns all the code actions in a document by 
 -- querying the code actions at each of the current 
 -- diagnostics' positions.
 
 -- | Returns all the code actions in a document by 
 -- querying the code actions at each of the current 
 -- diagnostics' positions.

-getAllCodeActions :: TextDocumentIdentifier -> Session [CommandOrCodeAction]
+getAllCodeActions :: TextDocumentIdentifier -> Session [CAResult]

 getAllCodeActions doc = do
 getAllCodeActions doc = do

-  curDiags <- fromMaybe [] . Map.lookup (doc ^. uri) . curDiagnostics <$> get
-  let ctx = CodeActionContext (List curDiags) Nothing
+  ctx <- getCodeActionContext doc

 
 

-  foldM (go ctx) [] curDiags
+  foldM (go ctx) [] =<< getCurrentDiagnostics doc

 
   where
 
   where

-    go :: CodeActionContext -> [CommandOrCodeAction] -> Diagnostic -> Session [CommandOrCodeAction]
+    go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]

     go ctx acc diag = do
       ResponseMessage _ rspLid mRes mErr <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx)
 
     go ctx acc diag = do
       ResponseMessage _ rspLid mRes mErr <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx)
 


@@ -378,6 +390,16 @@ getAllCodeActions doc = do
           let Just (List cmdOrCAs) = mRes
             in return (acc ++ cmdOrCAs)
 
           let Just (List cmdOrCAs) = mRes
             in return (acc ++ cmdOrCAs)
 

+getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
+getCodeActionContext doc = do
+  curDiags <- getCurrentDiagnostics doc
+  return $ CodeActionContext (List curDiags) Nothing
+
+-- | Returns the current diagnostics that have been sent to the client.
+-- Note that this does not wait for more to come in.
+getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
+getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (doc ^. uri) . curDiagnostics <$> get
+

 -- | Executes a command.
 executeCommand :: Command -> Session ()
 executeCommand cmd = do
 -- | Executes a command.
 executeCommand :: Command -> Session ()
 executeCommand cmd = do


@@ -419,9 +441,9 @@ applyEdit doc edit = do
   caps <- asks sessionCapabilities
 
   let supportsDocChanges = fromMaybe False $ do
   caps <- asks sessionCapabilities
 
   let supportsDocChanges = fromMaybe False $ do

-        let LSP.ClientCapabilities mWorkspace _ _ = caps
-        LSP.WorkspaceClientCapabilities _ mEdit _ _ _ _ <- mWorkspace
-        LSP.WorkspaceEditClientCapabilities mDocChanges <- mEdit
+        let ClientCapabilities mWorkspace _ _ = caps
+        WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
+        WorkspaceEditClientCapabilities mDocChanges <- mEdit

         mDocChanges
 
   let wEdit = if supportsDocChanges
         mDocChanges
 
   let wEdit = if supportsDocChanges