@@ -25,6 +25,7 @@ import Data.List.NonEmpty (NonEmpty ((:|)),
2525import qualified Data.Map as M
2626import Data.Maybe
2727import Data.Mod.Word
28+ import Data.Row
2829import qualified Data.Set as S
2930import qualified Data.Text as T
3031import Development.IDE (Recorder , WithPriority ,
@@ -57,43 +58,66 @@ import Language.LSP.Server
5758instance Hashable (Mod a ) where hash n = hash (unMod n)
5859
5960descriptor :: 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
6685renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename
6786renameProvider 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" $ 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" $ 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.
99123failWhenImportOrExport ::
0 commit comments