From 06aef4efc7a5d9fd43b938cd45c7aa6a38bf2b77 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Tue, 10 Jul 2018 14:55:31 +0100 Subject: [PATCH] Add applyEdit and getVersionedDoc helpers --- src/Language/Haskell/LSP/Test.hs | 53 ++++++++++++++++++++++++ src/Language/Haskell/LSP/Test/Session.hs | 18 +++++++- stack.yaml | 2 +- test/Test.hs | 36 +++++++++++++--- 4 files changed, 100 insertions(+), 9 deletions(-) diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index eda3cd2..4b0226c 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -66,6 +66,7 @@ module Language.Haskell.LSP.Test , documentContents , getDocumentEdit , getDocUri + , getVersionedDoc -- ** Symbols , getDocumentSymbols -- ** Diagnostics @@ -76,6 +77,8 @@ module Language.Haskell.LSP.Test -- ** Code Actions , getAllCodeActions , executeCodeAction + -- ** Edits + , applyEdit ) where import Control.Applicative @@ -94,6 +97,7 @@ 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 qualified Language.Haskell.LSP.Types.Capabilities as LSP import Language.Haskell.LSP.Messages import Language.Haskell.LSP.VFS import Language.Haskell.LSP.Test.Compat @@ -313,6 +317,7 @@ getDocUri file = do let fp = rootDir context file return $ filePathToUri fp +-- | Waits for diagnostics to be published and returns them. waitForDiagnostics :: Session [Diagnostic] waitForDiagnostics = do diagsNot <- skipManyTill anyMessage message :: Session PublishDiagnosticsNotification @@ -335,6 +340,9 @@ getDocumentSymbols doc = do let (Just (List symbols)) = mRes return symbols +-- | 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 doc = do curDiags <- fromMaybe [] . Map.lookup (doc ^. uri) . curDiagnostics <$> get @@ -353,12 +361,17 @@ getAllCodeActions doc = do let Just (List cmdOrCAs) = mRes in return (acc ++ cmdOrCAs) +-- | Executes a command. executeCommand :: Command -> Session () executeCommand cmd = do let args = decode $ encode $ fromJust $ cmd ^. arguments execParams = ExecuteCommandParams (cmd ^. command) args sendRequest_ WorkspaceExecuteCommand execParams +-- | Executes a code action. +-- Matching with the specification, if a code action +-- contains both an edit and a command, the edit will +-- be applied first. executeCodeAction :: CodeAction -> Session () executeCodeAction action = do maybe (return ()) handleEdit $ action ^. edit @@ -366,5 +379,45 @@ executeCodeAction action = do where handleEdit :: WorkspaceEdit -> Session () handleEdit e = + -- Its ok to pass in dummy parameters here as they aren't used let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams e) in updateState (ReqApplyWorkspaceEdit req) + +-- | Adds the current version to the document, as tracked by the session. +getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier +getVersionedDoc (TextDocumentIdentifier uri) = do + fs <- vfs <$> get + let ver = + case fs Map.!? uri of + Just (VirtualFile v _) -> Just v + _ -> Nothing + return (VersionedTextDocumentIdentifier uri ver) + +-- | Applys an edit to the document and returns the updated document version. +applyEdit :: TextEdit -> TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier +applyEdit edit doc = do + + verDoc <- getVersionedDoc doc + + caps <- asks (capabilities . config) + + let supportsDocChanges = fromMaybe False $ do + let LSP.ClientCapabilities mWorkspace _ _ = caps + LSP.WorkspaceClientCapabilities _ mEdit _ _ _ _ <- mWorkspace + LSP.WorkspaceEditClientCapabilities mDocChanges <- mEdit + mDocChanges + + let wEdit = if supportsDocChanges + then + let docEdit = TextDocumentEdit verDoc (List [edit]) + in WorkspaceEdit Nothing (Just (List [docEdit])) + else + let changes = HashMap.singleton (doc ^. uri) (List [edit]) + in WorkspaceEdit (Just changes) Nothing + + let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit) + updateState (ReqApplyWorkspaceEdit req) + + -- version may have changed + getVersionedDoc doc + diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index 10f63b2..8e297de 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -44,6 +44,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.HashMap.Strict as HashMap import Data.Maybe +import Data.Function import Language.Haskell.LSP.Messages import Language.Haskell.LSP.TH.ClientCapabilities import Language.Haskell.LSP.Types hiding (error) @@ -205,6 +206,8 @@ updateState (NotPublishDiagnostics n) = do updateState (ReqApplyWorkspaceEdit r) = do + oldVFS <- vfs <$> get + allChangeParams <- case r ^. params . edit . documentChanges of Just (List cs) -> do mapM_ (checkIfNeedsOpened . (^. textDocument . uri)) cs @@ -215,7 +218,6 @@ updateState (ReqApplyWorkspaceEdit r) = do return $ concatMap (uncurry getChangeParams) (HashMap.toList cs) Nothing -> error "No changes!" - oldVFS <- vfs <$> get newVFS <- liftIO $ changeFromServerVFS oldVFS r modify (\s -> s { vfs = newVFS }) @@ -225,6 +227,18 @@ updateState (ReqApplyWorkspaceEdit r) = do -- TODO: Don't do this when replaying a session forM_ mergedParams (sendMessage . NotificationMessage "2.0" TextDocumentDidChange) + -- Update VFS to new document versions + let sortedVersions = map (sortBy (compare `on` (^. textDocument . version))) groupedParams + latestVersions = map ((^. textDocument) . last) sortedVersions + bumpedVersions = map (version . _Just +~ 1) latestVersions + + forM_ bumpedVersions $ \(VersionedTextDocumentIdentifier uri v) -> + modify $ \s -> + let oldVFS = vfs s + update (VirtualFile oldV t) = VirtualFile (fromMaybe oldV v) t + newVFS = Map.adjust update uri oldVFS + in s { vfs = newVFS } + where checkIfNeedsOpened uri = do oldVFS <- vfs <$> get ctx <- ask @@ -245,7 +259,7 @@ updateState (ReqApplyWorkspaceEdit r) = do let changeEvents = map (\e -> TextDocumentContentChangeEvent (Just (e ^. range)) Nothing (e ^. newText)) edits in DidChangeTextDocumentParams docId (List changeEvents) - textDocumentVersions uri = map (VersionedTextDocumentIdentifier uri) [0..] + textDocumentVersions uri = map (VersionedTextDocumentIdentifier uri . Just) [0..] textDocumentEdits uri edits = map (\(v, e) -> TextDocumentEdit v (List [e])) $ zip (textDocumentVersions uri) edits diff --git a/stack.yaml b/stack.yaml index adf9f08..b53edf8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,7 +6,7 @@ extra-deps: - github: Bubba/haskell-lsp-client commit: b7cf14eb48837a73032e867dab90db1708220c66 - github: Bubba/haskell-lsp - commit: 47176f14738451b36b061b2314a2acb05329fde4 + commit: 0772972aec20df9413b6c3b4b4f0abfa6d4c1535 subdirs: - . - ./haskell-lsp-types diff --git a/test/Test.hs b/test/Test.hs index 90be1e2..b5abae5 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -33,12 +33,9 @@ main = hspec $ do rsp <- initializeResponse liftIO $ rsp ^. result `shouldNotBe` Nothing - it "can register specific capabilities" $ do - let caps = def { _workspace = Just workspaceCaps } - workspaceCaps = def { _didChangeConfiguration = Just configCaps } - configCaps = DidChangeConfigurationClientCapabilities (Just True) - conf = def { capabilities = caps } - runSessionWithConfig conf "hie --lsp" "test/data/renamePass" $ return () + it "can register specific capabilities" $ + runSessionWithConfig (def { capabilities = didChangeCaps }) + "hie --lsp" "test/data/renamePass" $ return () describe "withTimeout" $ do it "times out" $ @@ -202,6 +199,33 @@ main = hspec $ do mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4) mainSymbol ^. containerName `shouldBe` Nothing + describe "applyEdit" $ do + it "increments the version" $ runSessionWithConfig (def { capabilities = docChangesCaps }) "hie --lsp" "test/data/renamePass" $ do + doc <- openDoc "Desktop/simple.hs" "haskell" + VersionedTextDocumentIdentifier _ (Just oldVersion) <- getVersionedDoc doc + let edit = TextEdit (Range (Position 1 1) (Position 1 3)) "foo" + VersionedTextDocumentIdentifier _ (Just newVersion) <- applyEdit edit doc + liftIO $ newVersion `shouldBe` oldVersion + 1 + it "changes the document contents" $ runSession "hie --lsp" "test/data/renamePass" $ do + doc <- openDoc "Desktop/simple.hs" "haskell" + let edit = TextEdit (Range (Position 0 0) (Position 0 2)) "foo" + applyEdit edit doc + contents <- documentContents doc + liftIO $ contents `shouldSatisfy` T.isPrefixOf "foodule" + + +didChangeCaps :: ClientCapabilities +didChangeCaps = def { _workspace = Just workspaceCaps } + where + workspaceCaps = def { _didChangeConfiguration = Just configCaps } + configCaps = DidChangeConfigurationClientCapabilities (Just True) + +docChangesCaps :: ClientCapabilities +docChangesCaps = def { _workspace = Just workspaceCaps } + where + workspaceCaps = def { _workspaceEdit = Just editCaps } + editCaps = WorkspaceEditClientCapabilities (Just True) + data ApplyOneParams = AOP { file :: Uri , start_pos :: Position -- 2.30.2