Skip to content

Commit f20dfa5

Browse files
jhrcekjhrcek
committed
Improve handling of nonsense rename attempts
1 parent b377ab3 commit f20dfa5

File tree

5 files changed

+66
-37
lines changed

5 files changed

+66
-37
lines changed

‎haskell-language-server.cabal

+3
Original file line numberDiff line numberDiff line change
@@ -526,6 +526,9 @@ test-suite hls-rename-plugin-tests
526526
, hls-plugin-api
527527
, haskell-language-server:hls-rename-plugin
528528
, hls-test-utils == 2.7.0.0
529+
, lens
530+
, lsp-types
531+
, text
529532

530533
-----------------------------
531534
-- retrie plugin

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

+40-34
Original file line numberDiff line numberDiff line change
@@ -57,43 +57,49 @@ import Language.LSP.Server
5757
instance Hashable (Mod a) where hash n = hash (unMod n)
5858

5959
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-
}
60+
descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $
61+
(defaultPluginDescriptor pluginId "Provides renaming of Haskell identifiers")
62+
{ pluginHandlers = mkPluginHandler SMethod_TextDocumentRename renameProvider
63+
, pluginConfigDescriptor = defaultConfigDescriptor
64+
{ configCustomConfig = mkCustomConfig properties }
65+
}
6566

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

98104
-- | Limit renaming across modules.
99105
failWhenImportOrExport ::

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

+21-3
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

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{- IShouldNotBeRenaemable -}

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

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{- IShouldNotBeRenaemable -}

0 commit comments

Comments
 (0)