X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=151eef7f1687fa0a357058f00f92d425a962d437;hp=1b2e7ba867a6ebc4356b008e29a7c4ce53eee962;hb=20750dca8684bcb05a7c91e8654257ad36e57ebe;hpb=d126623dc6895d325e3d204d74e2a22d4f515587 diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index 1b2e7ba..151eef7 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -8,7 +8,7 @@ Module : Language.Haskell.LSP.Test Description : A functional testing framework for LSP servers. Maintainer : luke_lau@icloud.com Stability : experimental -Portability : POSIX +Portability : non-portable Provides the framework to start functionally testing . @@ -163,8 +163,7 @@ runSessionWithConfig config serverExe caps rootDir session = do Nothing -> return () -- Run the actual test - result <- session - return result + session where -- | Asks the server to shutdown and exit politely exitServer :: Session () @@ -189,7 +188,7 @@ runSessionWithConfig config serverExe caps rootDir session = do documentContents :: TextDocumentIdentifier -> Session T.Text documentContents doc = do vfs <- vfs <$> get - let file = vfs Map.! toNormalizedUri (doc ^. uri) + let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri) return $ Rope.toText $ Language.Haskell.LSP.VFS._text file -- | Parses an ApplyEditRequest, checks that it is for the passed document @@ -274,7 +273,7 @@ sendNotification TextDocumentDidOpen params = do n :: DidOpenTextDocumentNotification n = NotificationMessage "2.0" TextDocumentDidOpen params' oldVFS <- vfs <$> get - newVFS <- liftIO $ openVFS oldVFS n + let (newVFS,_) = openVFS oldVFS n modify (\s -> s { vfs = newVFS }) sendMessage n @@ -284,7 +283,7 @@ sendNotification TextDocumentDidClose params = do n :: DidCloseTextDocumentNotification n = NotificationMessage "2.0" TextDocumentDidClose params' oldVFS <- vfs <$> get - newVFS <- liftIO $ closeVFS oldVFS n + let (newVFS,_) = closeVFS oldVFS n modify (\s -> s { vfs = newVFS }) sendMessage n @@ -293,7 +292,7 @@ sendNotification TextDocumentDidChange params = do n :: DidChangeTextDocumentNotification n = NotificationMessage "2.0" TextDocumentDidChange params' oldVFS <- vfs <$> get - newVFS <- liftIO $ changeFromClientVFS oldVFS n + let (newVFS,_) = changeFromClientVFS oldVFS n modify (\s -> s { vfs = newVFS }) sendMessage n @@ -378,7 +377,7 @@ noDiagnostics = do -- | Returns the symbols in a document. getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation]) getDocumentSymbols doc = do - ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc) :: Session DocumentSymbolsResponse + ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse maybe (return ()) (throw . UnexpectedResponseError rspLid) mErr case mRes of Just (DSDocumentSymbols (List xs)) -> return (Left xs) @@ -389,7 +388,7 @@ getDocumentSymbols doc = do getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult] getCodeActions doc range = do ctx <- getCodeActionContext doc - rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx) + rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx Nothing) case rsp ^. result of Just (List xs) -> return xs @@ -407,7 +406,7 @@ getAllCodeActions doc = do where go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult] go ctx acc diag = do - ResponseMessage _ rspLid mRes mErr <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx) + ResponseMessage _ rspLid mRes mErr <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing) case mErr of Just e -> throw (UnexpectedResponseError rspLid e) @@ -429,7 +428,7 @@ getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. executeCommand :: Command -> Session () executeCommand cmd = do let args = decode $ encode $ fromJust $ cmd ^. arguments - execParams = ExecuteCommandParams (cmd ^. command) args + execParams = ExecuteCommandParams (cmd ^. command) args Nothing request_ WorkspaceExecuteCommand execParams -- | Executes a code action. @@ -450,10 +449,10 @@ executeCodeAction action = do -- | Adds the current version to the document, as tracked by the session. getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier getVersionedDoc (TextDocumentIdentifier uri) = do - fs <- vfs <$> get + fs <- vfsMap . vfs <$> get let ver = case fs Map.!? toNormalizedUri uri of - Just (VirtualFile v _ _) -> Just v + Just vf -> Just (virtualFileVersion vf) _ -> Nothing return (VersionedTextDocumentIdentifier uri ver) @@ -488,7 +487,7 @@ applyEdit doc edit = do -- | Returns the completions for the position in the document. getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem] getCompletions doc pos = do - rsp <- request TextDocumentCompletion (TextDocumentPositionParams doc pos) + rsp <- request TextDocumentCompletion (TextDocumentPositionParams doc pos Nothing) case getResponseResult rsp of Completions (List items) -> return items @@ -501,7 +500,7 @@ getReferences :: TextDocumentIdentifier -- ^ The document to lookup in. -> Session [Location] -- ^ The locations of the references. getReferences doc pos inclDecl = let ctx = ReferenceContext inclDecl - params = ReferenceParams doc pos ctx + params = ReferenceParams doc pos ctx Nothing in getResponseResult <$> request TextDocumentReferences params -- | Returns the definition(s) for the term at the specified position. @@ -509,7 +508,7 @@ getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in. -> Position -- ^ The position the term is at. -> Session [Location] -- ^ The location(s) of the definitions getDefinitions doc pos = do - let params = TextDocumentPositionParams doc pos + let params = TextDocumentPositionParams doc pos Nothing rsp <- request TextDocumentDefinition params :: Session DefinitionResponse case getResponseResult rsp of SingleLoc loc -> pure [loc] @@ -520,13 +519,13 @@ 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 + let params = TextDocumentPositionParams doc pos Nothing in getResponseResult <$> request TextDocumentTypeDefinition params -- | Renames the term at the specified position. rename :: TextDocumentIdentifier -> Position -> String -> Session () rename doc pos newName = do - let params = RenameParams doc pos (T.pack newName) + let params = RenameParams doc pos (T.pack newName) Nothing rsp <- request TextDocumentRename params :: Session RenameResponse let wEdit = getResponseResult rsp req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit) @@ -535,13 +534,13 @@ rename doc pos newName = do -- | Returns the hover information at the specified position. getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover) getHover doc pos = - let params = TextDocumentPositionParams doc pos + let params = TextDocumentPositionParams doc pos Nothing in getResponseResult <$> request TextDocumentHover params -- | Returns the highlighted occurences of the term at the specified position getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight] getHighlights doc pos = - let params = TextDocumentPositionParams doc pos + let params = TextDocumentPositionParams doc pos Nothing in getResponseResult <$> request TextDocumentDocumentHighlight params -- | Checks the response for errors and throws an exception if needed. @@ -554,14 +553,14 @@ getResponseResult rsp = fromMaybe exc (rsp ^. result) -- | Applies formatting to the specified document. formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session () formatDoc doc opts = do - let params = DocumentFormattingParams doc opts + let params = DocumentFormattingParams doc opts Nothing edits <- getResponseResult <$> request TextDocumentFormatting params applyTextEdits doc edits -- | Applies formatting to the specified range in a document. formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session () formatRange doc opts range = do - let params = DocumentRangeFormattingParams doc range opts + let params = DocumentRangeFormattingParams doc range opts Nothing edits <- getResponseResult <$> request TextDocumentRangeFormatting params applyTextEdits doc edits @@ -574,6 +573,6 @@ applyTextEdits doc edits = -- | Returns the code lenses for the specified document. getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens] getCodeLenses tId = do - rsp <- request TextDocumentCodeLens (CodeLensParams tId) :: Session CodeLensResponse + rsp <- request TextDocumentCodeLens (CodeLensParams tId Nothing) :: Session CodeLensResponse case getResponseResult rsp of List res -> pure res