Skip to content

Commit fd535c2

Browse files
author
izuzu
committed
Resolve PR comments
This commit addresses the following comments: - Validating the new name during alias renaming - Replacing repeated code with utility functions - Inlining `case` expressions - Adding explicit tests for when the cursor is at the end of an alias
1 parent c5ca3b1 commit fd535c2

3 files changed

Lines changed: 102 additions & 37 deletions

File tree

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -146,7 +146,7 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) l
146146
Nothing ->
147147
nameBasedRename state pluginId nfp lspPos newNameText
148148

149-
-- | Name-based rename: the original rename logic.
149+
-- | Logic for renaming all occurrences of a 'Name'.
150150
nameBasedRename ::
151151
IdeState ->
152152
PluginId ->

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

Lines changed: 83 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,10 @@
1+
{-# LANGUAGE CPP #-}
12
{-# LANGUAGE DataKinds #-}
23
{-# LANGUAGE OverloadedStrings #-}
3-
{-# OPTIONS_GHC -Wall -Werror #-}
4+
{-# OPTIONS_GHC -Wall -Werror #-}
45

56
{-| Logic for renaming qualified import aliases.
67
7-
For example:
8-
9-
> -- Before: ---------------------------
10-
> import qualified Data.List as L
11-
> bar = L.take
12-
> -- After: ----------------------------
13-
> import qualified Data.List as List
14-
> bar = List.take
15-
168
The basic approach is this:
179
1810
1. Get the parsed AST and see if there is an import alias at the cursor.
@@ -38,7 +30,7 @@ module Ide.Plugin.Rename.ImportAlias
3830
) where
3931

4032
import Control.Lens ((&), (+~), (.~), (^.))
41-
import Control.Monad (guard)
33+
import Control.Monad (guard, when)
4234
import Control.Monad.Except (ExceptT,
4335
MonadError (throwError))
4436
import Control.Monad.IO.Class (MonadIO, liftIO)
@@ -54,7 +46,9 @@ import Development.IDE.Core.RuleTypes
5446
import Development.IDE.Core.Service hiding (Log)
5547
import Development.IDE.Core.Shake hiding (Log)
5648
import Development.IDE.GHC.Compat hiding (importDecl)
49+
import Development.IDE.GHC.Compat.Util (stringToStringBuffer)
5750
import GHC.Data.FastString (lengthFS)
51+
import qualified GHC.Utils.Error as GHC
5852
import Ide.Plugin.Error
5953
import qualified Language.LSP.Protocol.Lens as L
6054
import Language.LSP.Protocol.Message
@@ -125,8 +119,17 @@ resolveAliasAtPos getNamesAtPosFn state nfp lspPos pos exports imports hsDecls =
125119
case disambiguateAliasUse tcModule namesAtPos candidates of
126120
[] -> pure Nothing
127121
[alias] -> pure $ toLSPRange (range, alias)
128-
aliases -> throwError $ PluginInvalidParams $
129-
ambiguousAliasErrorMessage aliases
122+
aliases@(alias1 : alias2 : _) -> throwError $ PluginInvalidParams $
123+
let aliasCount = T.pack (show (length aliases))
124+
aliasText = moduleNameText (aliasName alias1)
125+
module1 = moduleNameText (aliasModuleName alias1)
126+
module2 = moduleNameText (aliasModuleName alias2)
127+
in "Alias " <> quote aliasText
128+
<> " is ambiguous (matching " <> aliasCount
129+
<> " imports, including " <> quote module1
130+
<> " and " <> quote module2
131+
<> "). Try renaming " <> quote aliasText
132+
<> " in one of these import declarations directly."
130133

131134
-- | Build a 'WorkspaceEdit' renaming an import alias and all its use sites.
132135
aliasBasedRename ::
@@ -140,6 +143,8 @@ aliasBasedRename ::
140143
T.Text ->
141144
ExceptT PluginError m (MessageResult Method_TextDocumentRename)
142145
aliasBasedRename state nfp uri importAlias exports hsDecls newNameText = do
146+
when (not (isValidAlias newNameText)) $
147+
throwError (PluginInvalidParams (quote newNameText <> " is an invalid import alias."))
143148
let ImportAlias{aliasDeclRange, aliasIsShared} = importAlias
144149
virtualFile <- runActionE "rename.getVirtualFile" state
145150
$ handleMaybeM (PluginInternalError
@@ -160,7 +165,7 @@ aliasBasedRename state nfp uri importAlias exports hsDecls newNameText = do
160165
verTxtDocId <- liftIO $ runAction "rename.getVersionedTextDoc" state $
161166
getVersionedTextDoc (TextDocumentIdentifier uri)
162167
let fileChanges = Just $ M.singleton (verTxtDocId ^. L.uri) allEdits
163-
-- TODO: Replace 'Nothing' with meaningful details for the workspace edit.
168+
-- TODO: Replace 'Nothing' with meaningful details (`ChangeAnnotation`).
164169
workspaceEdit = WorkspaceEdit fileChanges Nothing Nothing
165170
pure $ InL workspaceEdit
166171

@@ -179,7 +184,10 @@ findAliasDeclAtPos pos imports = listToMaybe $ do
179184
guard (rangeContainsPositionInclusive aliasDeclRange pos)
180185
let aliasModuleName = unLoc (ideclName importDecl)
181186
aliasName = unLoc locatedAlias
182-
aliasIsShared = length (filter (== aliasName) allAliases) > 1
187+
aliasIsShared = case filter (== aliasName) allAliases of
188+
[] -> False
189+
[_] -> False
190+
(_ : _ : _) -> True
183191
[ImportAlias{aliasModuleName, aliasName, aliasDeclRange, aliasIsShared}]
184192

185193
-- | Find the text range and matching 'ImportAlias' for the name qualifier at
@@ -193,8 +201,7 @@ findAliasUseAtPos ::
193201
Maybe (VFS.CodePointRange, [ImportAlias])
194202
findAliasUseAtPos pos exports imports hsDecls =
195203
let qualifiersAtPos = do
196-
locatedRdrName :: XRec GhcPs RdrName <-
197-
listify (const True) exports ++ listify (const True) hsDecls
204+
locatedRdrName <- locateRdrNames exports hsDecls
198205
Qual qualifier _ <- [unLoc locatedRdrName]
199206
RealSrcSpan qualifiedNameSpan _ <- [getLoc locatedRdrName]
200207
let qualifiedNameRange = realSrcSpanToCodePointRange qualifiedNameSpan
@@ -229,8 +236,7 @@ aliasUseSiteRanges ::
229236
aliasUseSiteRanges importAlias exports hsDecls = nubOrd $ do
230237
let ImportAlias{aliasName} = importAlias
231238
aliasLength = fromIntegral (moduleNameLength aliasName)
232-
locatedRdrName :: XRec GhcPs RdrName <-
233-
listify (const True) exports ++ listify (const True) hsDecls
239+
locatedRdrName <- locateRdrNames exports hsDecls
234240
Qual qualifier _ <- [unLoc locatedRdrName]
235241
guard (qualifier == aliasName)
236242
RealSrcSpan qualifiedNameSpan _ <- [getLoc locatedRdrName]
@@ -275,8 +281,7 @@ aliasUseSiteRangesDisambiguated tcModule importAlias exports hsDecls = nubOrd $
275281
let rdrEnv = tcg_rdr_env (tmrTypechecked tcModule)
276282
ImportAlias{aliasModuleName, aliasName} = importAlias
277283
aliasLength = fromIntegral (moduleNameLength aliasName)
278-
locatedRdrName :: XRec GhcPs RdrName <-
279-
listify (const True) exports ++ listify (const True) hsDecls
284+
locatedRdrName <- locateRdrNames exports hsDecls
280285
rdrName@(Qual qualifier name) <- [unLoc locatedRdrName]
281286
guard (qualifier == aliasName)
282287
nameGREElement <- pickGREs rdrName $ lookupGlobalRdrEnv rdrEnv name
@@ -289,23 +294,56 @@ aliasUseSiteRangesDisambiguated tcModule importAlias exports hsDecls = nubOrd $
289294
& VFS.end .~ (qualifierStart & VFS.character +~ aliasLength)
290295
[qualifierRange]
291296

292-
ambiguousAliasErrorMessage :: [ImportAlias] -> T.Text
293-
ambiguousAliasErrorMessage aliases@(alias1 : alias2 : _) =
294-
let aliasCount = T.pack (show (length aliases))
295-
aliasText = T.pack (moduleNameString (aliasName alias1))
296-
module1 = T.pack (moduleNameString (aliasModuleName alias1))
297-
module2 = T.pack (moduleNameString (aliasModuleName alias2))
298-
quote t = "‘" <> t <> "’"
299-
in ("Alias " <> quote aliasText
300-
<> " is ambiguous (matching " <> aliasCount
301-
<> " imports, including " <> quote module1 <> " and " <> quote module2
302-
<> "). Try renaming " <> quote aliasText
303-
<> " in one of these import declarations directly.")
304-
ambiguousAliasErrorMessage _ = ""
305-
306297
---------------------------------------------------------------------------------------------------
307298
-- Utility functions
308299

300+
-- | Locate 'RdrName' identifiers in the given export list and declarations.
301+
locateRdrNames ::
302+
Maybe (XRec GhcPs [LIE GhcPs]) ->
303+
[LHsDecl GhcPs] ->
304+
[XRec GhcPs RdrName]
305+
locateRdrNames exports hsDecls =
306+
listify (const True) exports ++ listify (const True) hsDecls
307+
308+
-- | Check whether the given text is a valid alias.
309+
-- Allows Unicode characters the same way GHC does.
310+
-- REVIEW: If this looks good, we can add it to the existing name-based renaming
311+
-- logic too (and move the CPP stuff to @Compat@).
312+
isValidAlias :: T.Text -> Bool
313+
isValidAlias t = case unP parseIdentifier parseState of
314+
POk _ _ -> True
315+
_ -> False
316+
where
317+
filename = ""
318+
location = mkRealSrcLoc filename 1 1
319+
buffer = stringToStringBuffer (T.unpack (t <> ".f"))
320+
parseState = initParserState minimalParserOpts buffer location
321+
322+
minimalParserOpts :: ParserOpts
323+
#if MIN_VERSION_ghc(9,13,0)
324+
minimalParserOpts = mkParserOpts mempty emptyDiagOpts False False False False
325+
#else
326+
minimalParserOpts = mkParserOpts mempty emptyDiagOpts [] False False False False
327+
#endif
328+
329+
emptyDiagOpts :: GHC.DiagOpts
330+
#if MIN_VERSION_ghc(9,7,0)
331+
emptyDiagOpts = GHC.emptyDiagOpts
332+
#else
333+
emptyDiagOpts = GHC.DiagOpts mempty mempty False False Nothing defaultSDocContext
334+
#endif
335+
336+
-- >>> isValidAlias (T.pack "M") == True
337+
-- >>> isValidAlias (T.pack "M.F") == True
338+
-- >>> isValidAlias (T.pack "m") == False
339+
-- >>> isValidAlias (T.pack "m.F") == False
340+
-- >>> isValidAlias (T.pack "m.f") == False
341+
-- >>> isValidAlias (T.pack "M.F hiding ()") == False
342+
-- >>> isValidAlias (T.pack "Just . M") == False
343+
-- >>> isValidAlias (T.pack "Dz") == True
344+
-- >>> isValidAlias (T.pack "𝐹") == True
345+
-- >>> isValidAlias (T.pack "𝑓") == False
346+
309347
-- | Check whether a 'CodePointRange' contains a 'CodePointPosition' (inclusive
310348
-- start, inclusive end).
311349
-- NOTE: The use of inclusive end allows the user to place the cursor at the end
@@ -326,6 +364,15 @@ rangeToTextEdit virtualFile newText range = TextEdit
326364
<$> VFS.codePointRangeToRange virtualFile range
327365
<*> Just newText
328366

329-
-- | Returns the length in Unicode code points for a 'ModuleName'.
367+
-- | Return the length in Unicode code points for a 'ModuleName'.
330368
moduleNameLength :: ModuleName -> Int
331369
moduleNameLength = lengthFS . moduleNameFS
370+
371+
-- | Return the module name as a 'Text' value.
372+
moduleNameText :: ModuleName -> T.Text
373+
moduleNameText = T.pack . moduleNameString
374+
375+
-- | Surround the given text with curly single quotation marks (like GHC does in
376+
-- compiler messages).
377+
quote :: T.Text -> T.Text
378+
quote t = "‘" <> t <> "’"

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

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -125,7 +125,25 @@ renameTests = testGroup "Identifier"
125125
, goldenWithRename "Import alias declaration" "ImportAlias" $ \doc ->
126126
rename doc (Position 1 14) "G"
127127
, goldenWithRename "Import alias at use site" "ImportAlias" $ \doc ->
128+
rename doc (Position 5 6) "G"
129+
, goldenWithRename "Import alias declaration (cursor at end)" "ImportAlias" $ \doc ->
130+
rename doc (Position 1 18) "G"
131+
, goldenWithRename "Import alias at use site (cursor at end)" "ImportAlias" $ \doc ->
128132
rename doc (Position 5 10) "G"
133+
, testCase "Import alias declaration (cursor at invalid Unicode position)" $ runRenameSession "" $ do
134+
doc <- openDoc "ImportAlias.hs" "haskell"
135+
expectNoMoreDiagnostics 3 doc "typecheck"
136+
renameErr <- expectRenameError doc (Position 5 7) "G"
137+
liftIO $ do
138+
renameErr ^. L.code @?= InR ErrorCodes_InvalidParams
139+
renameErr ^. L.message @?= "rename: Invalid Params: The cursor position is inside a Unicode surrogate pair."
140+
, testCase "Import alias (invalid new alias)" $ runRenameSession "" $ do
141+
doc <- openDoc "ImportAlias.hs" "haskell"
142+
expectNoMoreDiagnostics 3 doc "typecheck"
143+
renameErr <- expectRenameError doc (Position 5 6) "Just . G"
144+
liftIO $ do
145+
renameErr ^. L.code @?= InR ErrorCodes_InvalidParams
146+
renameErr ^. L.message @?= "rename: Invalid Params: ‘Just . G’ is an invalid import alias."
129147
, goldenWithRename "Import alias declaration (shared by unrelated imports)" "ImportAliasShared" $ \doc ->
130148
rename doc (Position 3 31) "Maybe"
131149
, goldenWithRename "Import alias at use site (shared by unrelated imports)" "ImportAliasShared" $ \doc ->

0 commit comments

Comments
 (0)