Skip to content

Commit 5502b76

Browse files
jhrcekjhrcek
authored
Improve handling of nonsense rename attempts (#4111)
1 parent b377ab3 commit 5502b76

File tree

6 files changed

+93
-38
lines changed

6 files changed

+93
-38
lines changed

‎haskell-language-server.cabal‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -508,6 +508,7 @@ library hls-rename-plugin
508508
, mtl
509509
, mod
510510
, syb
511+
, row-types
511512
, text
512513
, transformers
513514
, unordered-containers
@@ -526,6 +527,9 @@ test-suite hls-rename-plugin-tests
526527
, hls-plugin-api
527528
, haskell-language-server:hls-rename-plugin
528529
, hls-test-utils == 2.7.0.0
530+
, lens
531+
, lsp-types
532+
, text
529533

530534
-----------------------------
531535
-- retrie plugin

‎hls-plugin-api/src/Ide/Types.hs‎

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -475,6 +475,9 @@ instance PluginMethod Request Method_CodeLensResolve where
475475
instance PluginMethod Request Method_TextDocumentRename where
476476
handlesRequest = pluginEnabledWithFeature plcRenameOn
477477

478+
instance PluginMethod Request Method_TextDocumentPrepareRename where
479+
handlesRequest = pluginEnabledWithFeature plcRenameOn
480+
478481
instance PluginMethod Request Method_TextDocumentHover where
479482
handlesRequest = pluginEnabledWithFeature plcHoverOn
480483

@@ -599,7 +602,7 @@ class PluginMethod Request m => PluginRequestMethod (m :: Method ClientToServer
599602
---
600603
instance PluginRequestMethod Method_TextDocumentCodeAction where
601604
combineResponses _method _config (ClientCapabilities _ textDocCaps _ _ _ _) (CodeActionParams _ _ _ _ context) resps =
602-
InL $ fmap compat $ filter wasRequested $ concat $ mapMaybe nullToMaybe $ toList resps
605+
InL $ fmap compat $ concatMap (filter wasRequested) $ mapMaybe nullToMaybe $ toList resps
603606
where
604607
compat :: (Command |? CodeAction) -> (Command |? CodeAction)
605608
compat x@(InL _) = x
@@ -657,6 +660,10 @@ instance PluginRequestMethod Method_CodeLensResolve where
657660

658661
instance PluginRequestMethod Method_TextDocumentRename where
659662

663+
instance PluginRequestMethod Method_TextDocumentPrepareRename where
664+
-- TODO more intelligent combining?
665+
combineResponses _ _ _ _ (x :| _) = x
666+
660667
instance PluginRequestMethod Method_TextDocumentHover where
661668
combineResponses _ _ _ _ (mapMaybe nullToMaybe . toList -> hs :: [Hover]) =
662669
if null hs

‎plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs‎

Lines changed: 58 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ import Data.List.NonEmpty (NonEmpty ((:|)),
2525
import qualified Data.Map as M
2626
import Data.Maybe
2727
import Data.Mod.Word
28+
import Data.Row
2829
import qualified Data.Set as S
2930
import qualified Data.Text as T
3031
import Development.IDE (Recorder, WithPriority,
@@ -57,43 +58,66 @@ import Language.LSP.Server
5758
instance Hashable (Mod a) where hash n = hash (unMod n)
5859

5960
descriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
60-
descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $ (defaultPluginDescriptor pluginId "Provides renaming of Haskell identifiers")
61-
{ pluginHandlers = mkPluginHandler SMethod_TextDocumentRename renameProvider
62-
, pluginConfigDescriptor = defaultConfigDescriptor
63-
{ configCustomConfig = mkCustomConfig properties }
64-
}
61+
descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $
62+
(defaultPluginDescriptor pluginId "Provides renaming of Haskell identifiers")
63+
{ pluginHandlers = mconcat
64+
[ mkPluginHandler SMethod_TextDocumentRename renameProvider
65+
, mkPluginHandler SMethod_TextDocumentPrepareRename prepareRenameProvider
66+
]
67+
, pluginConfigDescriptor = defaultConfigDescriptor
68+
{ configCustomConfig = mkCustomConfig properties }
69+
}
70+
71+
prepareRenameProvider :: PluginMethodHandler IdeState Method_TextDocumentPrepareRename
72+
prepareRenameProvider state _pluginId (PrepareRenameParams (TextDocumentIdentifier uri) pos _progressToken) = do
73+
nfp <- getNormalizedFilePathE uri
74+
namesUnderCursor <- getNamesAtPos state nfp pos
75+
-- When this handler says that rename is invalid, VSCode shows "The element can't be renamed"
76+
-- and doesn't even allow you to create full rename request.
77+
-- This handler deliberately approximates "things that definitely can't be renamed"
78+
-- to mean "there is no Name at given position".
79+
--
80+
-- In particular it allows some cases through (e.g. cross-module renames),
81+
-- so that the full rename handler can give more informative error about them.
82+
let renameValid = not $ null namesUnderCursor
83+
pure $ InL $ PrepareRenameResult $ InR $ InR $ #defaultBehavior .== renameValid
6584

6685
renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename
6786
renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) pos newNameText) = do
68-
nfp <- getNormalizedFilePathE uri
69-
directOldNames <- getNamesAtPos state nfp pos
70-
directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames
71-
72-
{- References in HieDB are not necessarily transitive. With `NamedFieldPuns`, we can have
73-
indirect references through punned names. To find the transitive closure, we do a pass of
74-
the direct references to find the references for any punned names.
75-
See the `IndirectPuns` test for an example. -}
76-
indirectOldNames <- concat . filter ((>1) . length) <$>
77-
mapM (uncurry (getNamesAtPos state) <=< locToFilePos) directRefs
78-
let oldNames = filter matchesDirect indirectOldNames ++ directOldNames
79-
matchesDirect n = occNameFS (nameOccName n) `elem` directFS
80-
where
81-
directFS = map (occNameFS. nameOccName) directOldNames
82-
refs <- HS.fromList . concat <$> mapM (refsAtName state nfp) oldNames
83-
84-
-- Validate rename
85-
crossModuleEnabled <- liftIO $ runAction "rename: config" state $ usePropertyAction #crossModule pluginId properties
86-
unless crossModuleEnabled $ failWhenImportOrExport state nfp refs oldNames
87-
when (any isBuiltInSyntax oldNames) $ throwError $ PluginInternalError "Invalid rename of built-in syntax"
88-
89-
-- Perform rename
90-
let newName = mkTcOcc $ T.unpack newNameText
91-
filesRefs = collectWith locToUri refs
92-
getFileEdit (uri, locations) = do
93-
verTxtDocId <- lift $ getVersionedTextDoc (TextDocumentIdentifier uri)
94-
getSrcEdit state verTxtDocId (replaceRefs newName locations)
95-
fileEdits <- mapM getFileEdit filesRefs
96-
pure $ InL $ fold fileEdits
87+
nfp <- getNormalizedFilePathE uri
88+
directOldNames <- getNamesAtPos state nfp pos
89+
directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames
90+
91+
{- References in HieDB are not necessarily transitive. With `NamedFieldPuns`, we can have
92+
indirect references through punned names. To find the transitive closure, we do a pass of
93+
the direct references to find the references for any punned names.
94+
See the `IndirectPuns` test for an example. -}
95+
indirectOldNames <- concat . filter ((>1) . length) <$>
96+
mapM (uncurry (getNamesAtPos state) <=< locToFilePos) directRefs
97+
let oldNames = filter matchesDirect indirectOldNames ++ directOldNames
98+
where
99+
matchesDirect n = occNameFS (nameOccName n) `elem` directFS
100+
directFS = map (occNameFS . nameOccName) directOldNames
101+
102+
case oldNames of
103+
-- There were no Names at given position (e.g. rename triggered within a comment or on a keyword)
104+
[] -> throwError $ PluginInvalidParams "No symbol to rename at given position"
105+
_ -> do
106+
refs <- HS.fromList . concat <$> mapM (refsAtName state nfp) oldNames
107+
108+
-- Validate rename
109+
crossModuleEnabled <- liftIO $ runAction "rename: config" state $ usePropertyAction #crossModule pluginId properties
110+
unless crossModuleEnabled $ failWhenImportOrExport state nfp refs oldNames
111+
when (any isBuiltInSyntax oldNames) $ throwError $ PluginInternalError "Invalid rename of built-in syntax"
112+
113+
-- Perform rename
114+
let newName = mkTcOcc $ T.unpack newNameText
115+
filesRefs = collectWith locToUri refs
116+
getFileEdit (uri, locations) = do
117+
verTxtDocId <- lift $ getVersionedTextDoc (TextDocumentIdentifier uri)
118+
getSrcEdit state verTxtDocId (replaceRefs newName locations)
119+
fileEdits <- mapM getFileEdit filesRefs
120+
pure $ InL $ fold fileEdits
97121

98122
-- | Limit renaming across modules.
99123
failWhenImportOrExport ::

‎plugins/hls-rename-plugin/test/Main.hs‎

Lines changed: 21 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,13 @@
22

33
module Main (main) where
44

5+
import Control.Lens ((^.))
56
import Data.Aeson
6-
import qualified Data.Map as M
7+
import qualified Data.Map as M
8+
import Data.Text (Text)
79
import Ide.Plugin.Config
8-
import qualified Ide.Plugin.Rename as Rename
10+
import qualified Ide.Plugin.Rename as Rename
11+
import qualified Language.LSP.Protocol.Lens as L
912
import System.FilePath
1013
import Test.Hls
1114

@@ -64,11 +67,26 @@ tests = testGroup "Rename"
6467
rename doc (Position 2 17) "BinaryTree"
6568
, goldenWithRename "Type variable" "TypeVariable" $ \doc ->
6669
rename doc (Position 0 13) "b"
70+
, goldenWithRename "Rename within comment" "Comment" $ \doc -> do
71+
let expectedError = ResponseError
72+
(InR ErrorCodes_InvalidParams)
73+
"rename: Invalid Params: No symbol to rename at given position"
74+
Nothing
75+
renameExpectError expectedError doc (Position 0 10) "ImpossibleRename"
6776
]
6877

6978
goldenWithRename :: TestName-> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
7079
goldenWithRename title path act =
71-
goldenWithHaskellDoc (def { plugins = M.fromList [("rename", def { plcConfig = "crossModule" .= True })] }) renamePlugin title testDataDir path "expected" "hs" act
80+
goldenWithHaskellDoc (def { plugins = M.fromList [("rename", def { plcConfig = "crossModule" .= True })] })
81+
renamePlugin title testDataDir path "expected" "hs" act
82+
83+
renameExpectError :: ResponseError -> TextDocumentIdentifier -> Position -> Text -> Session ()
84+
renameExpectError expectedError doc pos newName = do
85+
let params = RenameParams Nothing doc pos newName
86+
rsp <- request SMethod_TextDocumentRename params
87+
case rsp ^. L.result of
88+
Right _ -> liftIO $ assertFailure $ "Was expecting " <> show expectedError <> ", got success"
89+
Left actualError -> liftIO $ assertEqual "ResponseError" expectedError actualError
7290

7391
testDataDir :: FilePath
7492
testDataDir = "plugins" </> "hls-rename-plugin" </> "test" </> "testdata"

‎plugins/hls-rename-plugin/test/testdata/Comment.expected.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{- IShouldNotBeRenaemable -}

‎plugins/hls-rename-plugin/test/testdata/Comment.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{- IShouldNotBeRenaemable -}

0 commit comments

Comments
 (0)