Update haskell-lsp
[lsp-test.git] / src / Language / Haskell / LSP / Test.hs
index bb4d05721b82b2f43110ff087a6ad7237206b1be..696f84aa4df05bae70d411feb75675de2f2a076e 100644 (file)
@@ -23,7 +23,7 @@ module Language.Haskell.LSP.Test
   , runSessionWithConfig
   , SessionConfig(..)
   , defaultConfig
-  , module Language.Haskell.LSP.Types.Capabilities
+  , C.fullCaps
   -- ** Exceptions
   , module Language.Haskell.LSP.Test.Exceptions
   , withTimeout
@@ -52,9 +52,11 @@ module Language.Haskell.LSP.Test
   , waitForDiagnostics
   , waitForDiagnosticsSource
   , noDiagnostics
+  , getCurrentDiagnostics
   -- ** Commands
   , executeCommand
   -- ** Code Actions
+  , getCodeActions
   , getAllCodeActions
   , executeCodeAction
   -- ** Completions
@@ -63,6 +65,7 @@ module Language.Haskell.LSP.Test
   , getReferences
   -- ** Definitions
   , getDefinitions
+  , getTypeDefinitions
   -- ** Renaming
   , rename
   -- ** Hover
@@ -89,9 +92,11 @@ import Data.Default
 import qualified Data.HashMap.Strict as HashMap
 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 Language.Haskell.LSP.Types.Capabilities
+import Language.Haskell.LSP.Types
+import Language.Haskell.LSP.Types.Lens hiding
+  (id, capabilities, message, executeCommand, applyEdit, rename)
+import qualified Language.Haskell.LSP.Types.Lens as LSP
+import qualified Language.Haskell.LSP.Types.Capabilities as C
 import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.VFS
 import Language.Haskell.LSP.Test.Compat
@@ -103,7 +108,7 @@ import Language.Haskell.LSP.Test.Server
 import System.IO
 import System.Directory
 import System.FilePath
-import qualified Yi.Rope as Rope
+import qualified Data.Rope.UTF16 as Rope
 
 -- | Starts a new session.
 --
@@ -114,7 +119,7 @@ import qualified Yi.Rope as Rope
 -- >       params = TextDocumentPositionParams doc
 -- >   hover <- request TextDocumentHover params
 runSession :: String -- ^ The command to run the server.
-           -> ClientCapabilities -- ^ The capabilities that the client should declare.
+           -> C.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
@@ -123,7 +128,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.
-                     -> ClientCapabilities -- ^ The capabilities that the client should declare.
+                     -> C.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
@@ -137,6 +142,7 @@ runSessionWithConfig config serverExe caps rootDir session = do
                                           Nothing
                                           caps
                                           (Just TraceOff)
+                                          Nothing
   withServer serverExe (logStdErr config) $ \serverIn serverOut _ ->
     runSessionWithHandles serverIn serverOut listenServer config caps rootDir $ do
 
@@ -150,6 +156,10 @@ runSessionWithConfig config serverExe caps rootDir session = do
 
       sendNotification Initialized InitializedParams
 
+      case lspConfig config of
+        Just cfg -> sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
+        Nothing -> return ()
+
       -- Run the actual test
       result <- session
 
@@ -341,7 +351,7 @@ waitForDiagnosticsSource src = do
     matches d = d ^. source == Just (T.pack src)
 
 -- | Expects a 'PublishDiagnosticsNotification' and throws an
--- 'UnexpectedDiagnosticsException' if there are any diagnostics
+-- 'UnexpectedDiagnostics' exception if there are any diagnostics
 -- returned.
 noDiagnostics :: Session ()
 noDiagnostics = do
@@ -349,22 +359,33 @@ noDiagnostics = do
   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
-  ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc)
+  ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc) :: Session DocumentSymbolsResponse
   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.
 getAllCodeActions :: TextDocumentIdentifier -> Session [CAResult]
 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
     go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
@@ -377,6 +398,16 @@ getAllCodeActions doc = do
           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
@@ -418,9 +449,9 @@ applyEdit doc edit = do
   caps <- asks sessionCapabilities
 
   let supportsDocChanges = fromMaybe False $ do
-        let ClientCapabilities mWorkspace _ _ = caps
-        WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
-        WorkspaceEditClientCapabilities mDocChanges <- mEdit
+        let mWorkspace = C._workspace caps
+        C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
+        C.WorkspaceEditClientCapabilities mDocChanges <- mEdit
         mDocChanges
 
   let wEdit = if supportsDocChanges
@@ -464,6 +495,14 @@ getDefinitions doc pos =
   let params = TextDocumentPositionParams doc pos
   in getResponseResult <$> request TextDocumentDefinition params
 
+-- | Returns the type definition(s) for the term at the specified position.
+getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
+               -> Position -- ^ The position the term is at.
+               -> Session [Location] -- ^ The location(s) of the definitions
+getTypeDefinitions doc pos =
+  let params = TextDocumentPositionParams doc pos
+  in getResponseResult <$> request TextDocumentTypeDefinition params
+
 -- | Renames the term at the specified position.
 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
 rename doc pos newName = do