Skip to content

Commit aba72d9

Browse files
vidit-odvidit-od
committed
crossModule renaming
1 parent fe6551b commit aba72d9

File tree

1 file changed

+155
-48
lines changed
  • plugins/hls-rename-plugin/src/Ide/Plugin

1 file changed

+155
-48
lines changed

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

Lines changed: 155 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,8 @@ module Ide.Plugin.Rename (descriptor, E.Log) where
1010

1111
import Control.Lens ((^.))
1212
import Control.Monad
13-
import Control.Monad.Except (ExceptT, throwError)
13+
import Control.Monad.Except (ExceptT, MonadError,
14+
throwError)
1415
import Control.Monad.IO.Class (MonadIO, liftIO)
1516
import Control.Monad.Trans.Class (lift)
1617
import Data.Either (rights)
@@ -45,9 +46,7 @@ import GHC.Iface.Ext.Types (HieAST (..),
4546
NodeOrigin (..),
4647
SourcedNodeInfo (..))
4748
import GHC.Iface.Ext.Utils (generateReferencesMap)
48-
import HieDb ((:.) (..))
4949
import HieDb.Query
50-
import HieDb.Types (RefRow (refIsGenerated))
5150
import Ide.Plugin.Error
5251
import Ide.Plugin.Properties
5352
import Ide.PluginUtils
@@ -86,6 +85,8 @@ prepareRenameProvider state _pluginId (PrepareRenameParams (TextDocumentIdentifi
8685
renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename
8786
renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) pos newNameText) = do
8887
nfp <- getNormalizedFilePathE uri
88+
crossModuleEnabled <- liftIO $ runAction "rename: config" state $ usePropertyAction #crossModule pluginId properties
89+
pm <- runActionE "Rename.GetParsedModule" state (useE GetParsedModule nfp)
8990
directOldNames <- getNamesAtPos state nfp pos
9091
directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames
9192

@@ -99,16 +100,43 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) p
99100
where
100101
matchesDirect n = occNameFS (nameOccName n) `elem` directFS
101102
directFS = map (occNameFS . nameOccName) directOldNames
102-
103103
case oldNames of
104104
-- There were no Names at given position (e.g. rename triggered within a comment or on a keyword)
105105
[] -> throwError $ PluginInvalidParams "No symbol to rename at given position"
106106
_ -> do
107-
refs <- HS.fromList . concat <$> mapM (refsAtName state nfp) oldNames
107+
refs' <- HS.fromList . concat <$> mapM (refsAtName state nfp) oldNames
108+
exportRefs <- exportNameLocs pm oldNames
109+
isExported <- or <$> mapM (isNameExplicitExported pm) oldNames
110+
let refs = HS.union refs' (HS.fromList exportRefs)
111+
currentModule = fmap unLoc $ hsmodName $ unLoc $ pm_parsed_source pm
112+
isLocallyDefined name =
113+
case (nameModule_maybe name, currentModule) of
114+
(Just nameModule, Just curMod) -> moduleName nameModule == curMod
115+
-- No module means local
116+
(Nothing, _) -> True
117+
-- Has module but current has none = not local
118+
(Just _, Nothing) -> False
119+
renamingLocalDeclaration = not (null directOldNames) && not (null oldNames) && all isLocallyDefined oldNames
120+
121+
-- We have to show CrossModule Disabled error ONLY when
122+
-- 1. CrossModule is Disabled
123+
-- 2. User Tries to rename Exported variable
124+
-- We still allow local variable renaming in Disabled CrossModule mode.
125+
when (not crossModuleEnabled && ((not renamingLocalDeclaration) || isExported)) $ throwError $ PluginInternalError "Cross-module rename is disabled."
126+
127+
-- if CrossModule renaming requires Explicit Export list
128+
-- if variable is imported somewhere else && No explicit export => ERROR
129+
-- if variable is locally used => No ERROR
130+
let hasExplicitExportList = isJust (hsmodExports (unLoc $ pm_parsed_source pm))
131+
refFiles <- forM (HS.toList refs) $ \loc -> do
132+
(file, _) <- locToFilePos loc
133+
pure file
134+
let hasExternalRefs = any (/= nfp) refFiles
135+
when ( crossModuleEnabled && not hasExplicitExportList && hasExternalRefs && renamingLocalDeclaration ) $ throwError $ PluginInvalidParams
136+
"Cannot rename symbol: module has no explicit export list and the symbol is referenced from other modules."
108137

109138
-- Validate rename
110-
crossModuleEnabled <- liftIO $ runAction "rename: config" state $ usePropertyAction #crossModule pluginId properties
111-
unless crossModuleEnabled $ failWhenImportOrExport state nfp refs oldNames
139+
-- Indirect names are assumed safe once the direct ones are
112140
when (any isBuiltInSyntax oldNames) $ throwError $ PluginInternalError "Invalid rename of built-in syntax"
113141

114142
-- Perform rename
@@ -120,25 +148,49 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) p
120148
fileEdits <- mapM getFileEdit filesRefs
121149
pure $ InL $ fold fileEdits
122150

123-
-- | Limit renaming across modules.
124-
failWhenImportOrExport ::
125-
IdeState ->
126-
NormalizedFilePath ->
127-
HashSet Location ->
128-
[Name] ->
129-
ExceptT PluginError (HandlerM config) ()
130-
failWhenImportOrExport state nfp refLocs names = do
131-
pm <- runActionE "Rename.GetParsedModule" state
132-
(useE GetParsedModule nfp)
151+
-- | Check if a name is exported from the module
152+
-- Crossmodule Renaming happens only if names are Explicit Exported
153+
isNameExplicitExported ::
154+
Monad m =>
155+
ParsedModule ->
156+
Name ->
157+
ExceptT PluginError m Bool
158+
isNameExplicitExported pm name = do
133159
let hsMod = unLoc $ pm_parsed_source pm
134-
case (unLoc <$> hsmodName hsMod, hsmodExports hsMod) of
135-
(mbModName, _) | not $ any (\n -> nameIsLocalOrFrom (replaceModName n mbModName) n) names
136-
-> throwError $ PluginInternalError "Renaming of an imported name is unsupported"
137-
(_, Just (L _ exports)) | any ((`HS.member` refLocs) . unsafeSrcSpanToLoc . getLoc) exports
138-
-> throwError $ PluginInternalError "Renaming of an exported name is unsupported"
139-
(Just _, Nothing) -> throwError $ PluginInternalError "Explicit export list required for renaming"
140-
_ -> pure ()
141160

161+
case hsmodExports hsMod of
162+
Nothing -> pure False
163+
Just exports -> do
164+
let exportedOccNames = getExportedOccNames exports
165+
nameOcc = nameOccName name
166+
pure $ nameOcc `elem` exportedOccNames
167+
168+
-- | Extract all OccNames from an export list
169+
getExportedOccNames ::
170+
XRec GhcPs [LIE GhcPs] ->
171+
[OccName]
172+
getExportedOccNames exports =
173+
concatMap extractFromExport (unLoc exports)
174+
where
175+
extractFromExport ::
176+
LIE GhcPs ->
177+
[OccName]
178+
extractFromExport lie = case unLocA lie of
179+
#if MIN_VERSION_ghc(9,10,0)
180+
IEVar _ ieWrapped _ -> handle ieWrapped
181+
IEThingAbs _ ieWrapped _ -> handle ieWrapped
182+
IEThingAll _ ieWrapped _ -> handle ieWrapped
183+
IEThingWith _ ieWrapped _ _ _ -> handle ieWrapped
184+
#else
185+
IEVar _ ieWrapped -> handle ieWrapped
186+
IEThingAbs _ ieWrapped -> handle ieWrapped
187+
IEThingAll _ ieWrapped -> handle ieWrapped
188+
IEThingWith _ ieWrapped _ _ -> handle ieWrapped
189+
#endif
190+
IEModuleContents{} -> []
191+
_ -> []
192+
where
193+
handle ieWrapped = maybeToList $ fmap rdrNameOcc $ unwrapIEWrappedName (unLoc ieWrapped)
142194
---------------------------------------------------------------------------------------------------
143195
-- Source renaming
144196

@@ -183,7 +235,9 @@ replaceRefs newName refs = everywhere $
183235
replace _ = Unqual newName
184236

185237
isRef :: SrcSpan -> Bool
186-
isRef = (`HS.member` refs) . unsafeSrcSpanToLoc
238+
isRef srcSpan = case srcSpanToLocation srcSpan of
239+
Just loc -> loc `HS.member` refs
240+
Nothing -> False
187241

188242
---------------------------------------------------------------------------------------------------
189243
-- Reference finding
@@ -195,23 +249,33 @@ refsAtName ::
195249
NormalizedFilePath ->
196250
Name ->
197251
ExceptT PluginError m [Location]
198-
refsAtName state nfp name = do
199-
ShakeExtras{withHieDb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras
252+
refsAtName state nfp targetName = do
253+
-- Get local references from current file's HieAST
200254
ast <- handleGetHieAst state nfp
201-
dbRefs <- case nameModule_maybe name of
202-
Nothing -> pure []
203-
Just mod -> liftIO $ mapMaybe rowToLoc <$> withHieDb (\hieDb ->
204-
-- See Note [Generated references]
205-
filter (\(refRow HieDb.:. _) -> refIsGenerated refRow) <$>
206-
findReferences
207-
hieDb
208-
True
209-
(nameOccName name)
210-
(Just $ moduleName mod)
211-
(Just $ moduleUnit mod)
212-
[fromNormalizedFilePath nfp]
213-
)
214-
pure $ nameLocs name ast ++ dbRefs
255+
let localRefs = nameLocs targetName ast
256+
257+
-- Query HieDb for global matches (by OccName)
258+
ShakeExtras{withHieDb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras
259+
dbCandidates <- liftIO $ withHieDb $ \hieDb ->
260+
fmap (mapMaybe rowToLoc) $
261+
case nameModule_maybe targetName of
262+
Just mod -> findReferences hieDb True (nameOccName targetName) (Just $ moduleName mod) (Just $ moduleUnit mod) []
263+
Nothing -> findReferences hieDb True (nameOccName targetName) Nothing Nothing []
264+
265+
-- Filter candidates by exact Name identity
266+
filteredDbRefs <- filterM (matchesExactName state targetName) dbCandidates
267+
pure $ localRefs ++ filteredDbRefs
268+
269+
matchesExactName ::
270+
MonadIO m =>
271+
IdeState ->
272+
Name ->
273+
Location ->
274+
ExceptT PluginError m Bool
275+
matchesExactName state targetName loc = do
276+
(file, pos) <- locToFilePos loc
277+
namesAtPos <- getNamesAtPos state file pos
278+
pure $ targetName `elem` namesAtPos
215279

216280
nameLocs :: Name -> HieAstResult -> [Location]
217281
nameLocs name (HAR _ _ rm _ _) =
@@ -272,19 +336,62 @@ getNamesAtPoint' hf pos =
272336
locToUri :: Location -> Uri
273337
locToUri (Location uri _) = uri
274338

275-
unsafeSrcSpanToLoc :: SrcSpan -> Location
276-
unsafeSrcSpanToLoc srcSpan =
339+
srcSpanToLocE :: MonadError PluginError m => SrcSpan -> m Location
340+
srcSpanToLocE srcSpan =
277341
case srcSpanToLocation srcSpan of
278-
Nothing -> error "Invalid conversion from UnhelpfulSpan to Location"
279-
Just location -> location
342+
Nothing -> throwError $ PluginInternalError "Invalid SrcSpan conversion"
343+
Just loc -> pure loc
280344

281345
locToFilePos :: Monad m => Location -> ExceptT PluginError m (NormalizedFilePath, Position)
282346
locToFilePos (Location uri (Range pos _)) = (,pos) <$> getNormalizedFilePathE uri
283347

284-
replaceModName :: Name -> Maybe ModuleName -> Module
285-
replaceModName name mbModName =
286-
mkModule (moduleUnit $ nameModule name) (fromMaybe (mkModuleName "Main") mbModName)
348+
-- | Collect locations of simple exported identifiers (IEVar / IEName).
349+
-- Only supports variable exports; complex export forms are rejected.
350+
exportNameLocs ::
351+
ParsedModule ->
352+
[Name] ->
353+
ExceptT PluginError (HandlerM config) [Location]
354+
exportNameLocs pm names = do
355+
let hsMod = unLoc $ pm_parsed_source pm
287356

357+
case hsmodExports hsMod of
358+
Nothing -> pure []
359+
Just exports ->
360+
fmap concat $ forM (unLoc exports) $ \export ->
361+
case unLocA export of
362+
#if MIN_VERSION_ghc(9,10,0)
363+
IEVar _ ieWrapped _ -> matchWrapped (getLoc export) ieWrapped
364+
#else
365+
IEVar _ ieWrapped -> matchWrapped (getLoc export) ieWrapped
366+
#endif
367+
IEThingAll{} -> unsupported
368+
IEThingWith{} -> unsupported
369+
IEModuleContents{} -> unsupported
370+
IEThingAbs{} -> unsupported
371+
IEGroup{} -> unsupported
372+
IEDoc{} -> unsupported
373+
IEDocNamed{} -> unsupported
374+
where
375+
unsupported = throwError $ PluginInternalError "Renaming is unsupported for complex export forms"
376+
377+
matchWrapped :: SrcSpan -> LIEWrappedName GhcPs -> ExceptT PluginError (HandlerM config) [Location]
378+
matchWrapped l ieWrapped =
379+
case unwrapIEWrappedName (unLoc ieWrapped) of
380+
Just rdr
381+
| any (matchesRdr rdr) names
382+
-> do
383+
loc <- srcSpanToLocE l
384+
pure [loc]
385+
_ -> pure []
386+
387+
matchesRdr rdr name = occNameFS (rdrNameOcc rdr) == occNameFS (nameOccName name)
388+
389+
-- | Extract a RdrName from an IEWrappedName when possible.
390+
unwrapIEWrappedName :: IEWrappedName GhcPs -> Maybe RdrName
391+
unwrapIEWrappedName ie =
392+
case ie of
393+
IEName _ (L _ rdr) -> Just rdr
394+
_ -> Nothing
288395
---------------------------------------------------------------------------------------------------
289396
-- Config
290397

0 commit comments

Comments
 (0)