X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=696f84aa4df05bae70d411feb75675de2f2a076e;hp=bb4d05721b82b2f43110ff087a6ad7237206b1be;hb=59380ca81c003f777fdfd48b92fbe873474fb9a8;hpb=4c5ad9975b44f2a0482d98c1e67f2de78e7dd0ca diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index bb4d057..696f84a 100644 --- 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 - , 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