From f20dfa5b8a04d4ff355c5b5489cc12d0f78d0dc3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 2 Mar 2024 08:31:36 +0100 Subject: [PATCH 1/3] Improve handling of nonsense rename attempts --- haskell-language-server.cabal | 3 + .../src/Ide/Plugin/Rename.hs | 74 ++++++++++--------- plugins/hls-rename-plugin/test/Main.hs | 24 +++++- .../test/testdata/Comment.expected.hs | 1 + .../test/testdata/Comment.hs | 1 + 5 files changed, 66 insertions(+), 37 deletions(-) create mode 100644 plugins/hls-rename-plugin/test/testdata/Comment.expected.hs create mode 100644 plugins/hls-rename-plugin/test/testdata/Comment.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index b140955294..cde1954b92 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -526,6 +526,9 @@ test-suite hls-rename-plugin-tests , hls-plugin-api , haskell-language-server:hls-rename-plugin , hls-test-utils == 2.7.0.0 + , lens + , lsp-types + , text ----------------------------- -- retrie plugin diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index c25da1bd46..378a43aafb 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -57,43 +57,49 @@ import Language.LSP.Server instance Hashable (Mod a) where hash n = hash (unMod n) descriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState -descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $ (defaultPluginDescriptor pluginId "Provides renaming of Haskell identifiers") - { pluginHandlers = mkPluginHandler SMethod_TextDocumentRename renameProvider - , pluginConfigDescriptor = defaultConfigDescriptor - { configCustomConfig = mkCustomConfig properties } - } +descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $ + (defaultPluginDescriptor pluginId "Provides renaming of Haskell identifiers") + { pluginHandlers = mkPluginHandler SMethod_TextDocumentRename renameProvider + , pluginConfigDescriptor = defaultConfigDescriptor + { configCustomConfig = mkCustomConfig properties } + } renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) pos newNameText) = do - nfp <- getNormalizedFilePathE uri - directOldNames <- getNamesAtPos state nfp pos - directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames - - {- References in HieDB are not necessarily transitive. With `NamedFieldPuns`, we can have - indirect references through punned names. To find the transitive closure, we do a pass of - the direct references to find the references for any punned names. - See the `IndirectPuns` test for an example. -} - indirectOldNames <- concat . filter ((>1) . length) <$> - mapM (uncurry (getNamesAtPos state) <=< locToFilePos) directRefs - let oldNames = filter matchesDirect indirectOldNames ++ directOldNames - matchesDirect n = occNameFS (nameOccName n) `elem` directFS - where - directFS = map (occNameFS. nameOccName) directOldNames - refs <- HS.fromList . concat <$> mapM (refsAtName state nfp) oldNames - - -- Validate rename - crossModuleEnabled <- liftIO $ runAction "rename: config" state $ usePropertyAction #crossModule pluginId properties - unless crossModuleEnabled $ failWhenImportOrExport state nfp refs oldNames - when (any isBuiltInSyntax oldNames) $ throwError $ PluginInternalError "Invalid rename of built-in syntax" - - -- Perform rename - let newName = mkTcOcc $ T.unpack newNameText - filesRefs = collectWith locToUri refs - getFileEdit (uri, locations) = do - verTxtDocId <- lift $ getVersionedTextDoc (TextDocumentIdentifier uri) - getSrcEdit state verTxtDocId (replaceRefs newName locations) - fileEdits <- mapM getFileEdit filesRefs - pure $ InL $ fold fileEdits + nfp <- getNormalizedFilePathE uri + directOldNames <- getNamesAtPos state nfp pos + directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames + + {- References in HieDB are not necessarily transitive. With `NamedFieldPuns`, we can have + indirect references through punned names. To find the transitive closure, we do a pass of + the direct references to find the references for any punned names. + See the `IndirectPuns` test for an example. -} + indirectOldNames <- concat . filter ((>1) . length) <$> + mapM (uncurry (getNamesAtPos state) <=< locToFilePos) directRefs + let oldNames = filter matchesDirect indirectOldNames ++ directOldNames + where + matchesDirect n = occNameFS (nameOccName n) `elem` directFS + directFS = map (occNameFS . nameOccName) directOldNames + + case oldNames of + -- There was no symbol at given position (e.g. rename triggered within a comment) + [] -> throwError $ PluginInvalidParams "No symbol to rename at given position" + _ -> do + refs <- HS.fromList . concat <$> mapM (refsAtName state nfp) oldNames + + -- Validate rename + crossModuleEnabled <- liftIO $ runAction "rename: config" state $ usePropertyAction #crossModule pluginId properties + unless crossModuleEnabled $ failWhenImportOrExport state nfp refs oldNames + when (any isBuiltInSyntax oldNames) $ throwError $ PluginInternalError "Invalid rename of built-in syntax" + + -- Perform rename + let newName = mkTcOcc $ T.unpack newNameText + filesRefs = collectWith locToUri refs + getFileEdit (uri, locations) = do + verTxtDocId <- lift $ getVersionedTextDoc (TextDocumentIdentifier uri) + getSrcEdit state verTxtDocId (replaceRefs newName locations) + fileEdits <- mapM getFileEdit filesRefs + pure $ InL $ fold fileEdits -- | Limit renaming across modules. failWhenImportOrExport :: diff --git a/plugins/hls-rename-plugin/test/Main.hs b/plugins/hls-rename-plugin/test/Main.hs index ffedf9c0e0..2ef53dfe25 100644 --- a/plugins/hls-rename-plugin/test/Main.hs +++ b/plugins/hls-rename-plugin/test/Main.hs @@ -2,10 +2,13 @@ module Main (main) where +import Control.Lens ((^.)) import Data.Aeson -import qualified Data.Map as M +import qualified Data.Map as M +import Data.Text (Text) import Ide.Plugin.Config -import qualified Ide.Plugin.Rename as Rename +import qualified Ide.Plugin.Rename as Rename +import qualified Language.LSP.Protocol.Lens as L import System.FilePath import Test.Hls @@ -64,11 +67,26 @@ tests = testGroup "Rename" rename doc (Position 2 17) "BinaryTree" , goldenWithRename "Type variable" "TypeVariable" $ \doc -> rename doc (Position 0 13) "b" + , goldenWithRename "Rename within comment" "Comment" $ \doc -> do + let expectedError = ResponseError + (InR ErrorCodes_InvalidParams) + "rename: Invalid Params: No symbol to rename at given position" + Nothing + renameExpectError expectedError doc (Position 0 10) "ImpossibleRename" ] goldenWithRename :: TestName-> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree goldenWithRename title path act = - goldenWithHaskellDoc (def { plugins = M.fromList [("rename", def { plcConfig = "crossModule" .= True })] }) renamePlugin title testDataDir path "expected" "hs" act + goldenWithHaskellDoc (def { plugins = M.fromList [("rename", def { plcConfig = "crossModule" .= True })] }) + renamePlugin title testDataDir path "expected" "hs" act + +renameExpectError :: ResponseError -> TextDocumentIdentifier -> Position -> Text -> Session () +renameExpectError expectedError doc pos newName = do + let params = RenameParams Nothing doc pos newName + rsp <- request SMethod_TextDocumentRename params + case rsp ^. L.result of + Right _ -> liftIO $ assertFailure $ "Was expecting " <> show expectedError <> ", got success" + Left actualError -> liftIO $ assertEqual "ResponseError" expectedError actualError testDataDir :: FilePath testDataDir = "plugins" "hls-rename-plugin" "test" "testdata" diff --git a/plugins/hls-rename-plugin/test/testdata/Comment.expected.hs b/plugins/hls-rename-plugin/test/testdata/Comment.expected.hs new file mode 100644 index 0000000000..d58fd349a8 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/Comment.expected.hs @@ -0,0 +1 @@ +{- IShouldNotBeRenaemable -} diff --git a/plugins/hls-rename-plugin/test/testdata/Comment.hs b/plugins/hls-rename-plugin/test/testdata/Comment.hs new file mode 100644 index 0000000000..d58fd349a8 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/Comment.hs @@ -0,0 +1 @@ +{- IShouldNotBeRenaemable -} From 8ca038b6fc767895db93a9977bf7d3c656157970 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 2 Mar 2024 09:31:07 +0100 Subject: [PATCH 2/3] Add Method_TextDocumentPrepareRename handler --- haskell-language-server.cabal | 1 + hls-plugin-api/src/Ide/Types.hs | 9 ++++++++- .../hls-rename-plugin/src/Ide/Plugin/Rename.hs | 15 +++++++++++++-- 3 files changed, 22 insertions(+), 3 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index cde1954b92..a65398308d 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -508,6 +508,7 @@ library hls-rename-plugin , mtl , mod , syb + , row-types , text , transformers , unordered-containers diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index c6fd8741a3..bd8f134716 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -475,6 +475,9 @@ instance PluginMethod Request Method_CodeLensResolve where instance PluginMethod Request Method_TextDocumentRename where handlesRequest = pluginEnabledWithFeature plcRenameOn +instance PluginMethod Request Method_TextDocumentPrepareRename where + handlesRequest = pluginEnabledWithFeature plcRenameOn + instance PluginMethod Request Method_TextDocumentHover where handlesRequest = pluginEnabledWithFeature plcHoverOn @@ -599,7 +602,7 @@ class PluginMethod Request m => PluginRequestMethod (m :: Method ClientToServer --- instance PluginRequestMethod Method_TextDocumentCodeAction where combineResponses _method _config (ClientCapabilities _ textDocCaps _ _ _ _) (CodeActionParams _ _ _ _ context) resps = - InL $ fmap compat $ filter wasRequested $ concat $ mapMaybe nullToMaybe $ toList resps + InL $ fmap compat $ concatMap (filter wasRequested) $ mapMaybe nullToMaybe $ toList resps where compat :: (Command |? CodeAction) -> (Command |? CodeAction) compat x@(InL _) = x @@ -657,6 +660,10 @@ instance PluginRequestMethod Method_CodeLensResolve where instance PluginRequestMethod Method_TextDocumentRename where +instance PluginRequestMethod Method_TextDocumentPrepareRename where + -- TODO more intelligent combining? + combineResponses _ _ _ _ (x :| _) = x + instance PluginRequestMethod Method_TextDocumentHover where combineResponses _ _ _ _ (mapMaybe nullToMaybe . toList -> hs :: [Hover]) = if null hs diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index 378a43aafb..04f03cb862 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -53,17 +53,28 @@ import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Language.LSP.Server +import Data.Row instance Hashable (Mod a) where hash n = hash (unMod n) descriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $ (defaultPluginDescriptor pluginId "Provides renaming of Haskell identifiers") - { pluginHandlers = mkPluginHandler SMethod_TextDocumentRename renameProvider + { pluginHandlers = mconcat + [ mkPluginHandler SMethod_TextDocumentRename renameProvider + , mkPluginHandler SMethod_TextDocumentPrepareRename prepareRenameProvider + ] , pluginConfigDescriptor = defaultConfigDescriptor { configCustomConfig = mkCustomConfig properties } } +prepareRenameProvider :: PluginMethodHandler IdeState Method_TextDocumentPrepareRename +prepareRenameProvider state _pluginId (PrepareRenameParams (TextDocumentIdentifier uri) pos _progressToken) = do + nfp <- getNormalizedFilePathE uri + namesUnderCursor <- getNamesAtPos state nfp pos + let renameValid = not $ null namesUnderCursor + pure $ InL $ PrepareRenameResult $ InR $ InR $ #defaultBehavior .== renameValid + renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) pos newNameText) = do nfp <- getNormalizedFilePathE uri @@ -82,7 +93,7 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) p directFS = map (occNameFS . nameOccName) directOldNames case oldNames of - -- There was no symbol at given position (e.g. rename triggered within a comment) + -- There were no Names at given position (e.g. rename triggered within a comment or on a keyword) [] -> throwError $ PluginInvalidParams "No symbol to rename at given position" _ -> do refs <- HS.fromList . concat <$> mapM (refsAtName state nfp) oldNames From 9088a3664d1bcb8261444cc07f3bee32752dce49 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 2 Mar 2024 09:42:29 +0100 Subject: [PATCH 3/3] Comment on impl. decision --- plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index 04f03cb862..757ae5fd26 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -25,6 +25,7 @@ import Data.List.NonEmpty (NonEmpty ((:|)), import qualified Data.Map as M import Data.Maybe import Data.Mod.Word +import Data.Row import qualified Data.Set as S import qualified Data.Text as T import Development.IDE (Recorder, WithPriority, @@ -53,7 +54,6 @@ import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Language.LSP.Server -import Data.Row instance Hashable (Mod a) where hash n = hash (unMod n) @@ -72,6 +72,13 @@ prepareRenameProvider :: PluginMethodHandler IdeState Method_TextDocumentPrepare prepareRenameProvider state _pluginId (PrepareRenameParams (TextDocumentIdentifier uri) pos _progressToken) = do nfp <- getNormalizedFilePathE uri namesUnderCursor <- getNamesAtPos state nfp pos + -- When this handler says that rename is invalid, VSCode shows "The element can't be renamed" + -- and doesn't even allow you to create full rename request. + -- This handler deliberately approximates "things that definitely can't be renamed" + -- to mean "there is no Name at given position". + -- + -- In particular it allows some cases through (e.g. cross-module renames), + -- so that the full rename handler can give more informative error about them. let renameValid = not $ null namesUnderCursor pure $ InL $ PrepareRenameResult $ InR $ InR $ #defaultBehavior .== renameValid