Fix renaming data constructors with fields (resolves #2915, resolves #4083)

cabal.project

@@ -8,7 +8,7 @@ packages:
          ./hls-test-utils
 
 
-index-state: 2025-06-07T14:57:40Z
+index-state: 2025-06-16T09:44:13Z
 
 tests: True
 test-show-details: direct

ghcide/ghcide.cabal

@@ -75,7 +75,7 @@ library
     , hashable
     , hie-bios                     ^>=0.15.0
     , hie-compat                   ^>=0.3.0.0
-    , hiedb                        ^>= 0.6.0.2
+    , hiedb                        ^>= 0.7.0.0
     , hls-graph                    == 2.11.0.0
     , hls-plugin-api               == 2.11.0.0
     , implicit-hie                 >= 0.1.4.0 && < 0.1.5

haskell-language-server.cabal

@@ -407,7 +407,7 @@ library hls-call-hierarchy-plugin
     , containers
     , extra
     , ghcide                == 2.11.0.0
-    , hiedb                 ^>= 0.6.0.2
+    , hiedb                 ^>= 0.7.0.0
     , hls-plugin-api        == 2.11.0.0
     , lens
     , lsp                    >=2.7
@@ -594,7 +594,7 @@ library hls-rename-plugin
     , containers
     , ghcide                == 2.11.0.0
     , hashable
-    , hiedb                 ^>= 0.6.0.2
+    , hiedb                 ^>= 0.7.0.0
     , hie-compat
     , hls-plugin-api        == 2.11.0.0
     , haskell-language-server:hls-refactor-plugin

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

@@ -25,7 +25,6 @@ import           Data.List.NonEmpty                    (NonEmpty ((:|)),
 import qualified Data.Map                              as M
 import           Data.Maybe
 import           Data.Mod.Word
-import qualified Data.Set                              as S
 import qualified Data.Text                             as T
 import           Development.IDE                       (Recorder, WithPriority,
                                                         usePropertyAction)
@@ -42,7 +41,9 @@ import qualified Development.IDE.GHC.ExactPrint        as E
 import           Development.IDE.Plugin.CodeAction
 import           Development.IDE.Spans.AtPoint
 import           Development.IDE.Types.Location
+import           HieDb                                 ((:.) (..))
 import           HieDb.Query
+import           HieDb.Types                           (RefRow (refIsGenerated))
 import           Ide.Plugin.Error
 import           Ide.Plugin.Properties
 import           Ide.PluginUtils
@@ -196,6 +197,8 @@ refsAtName state nfp name = do
     dbRefs <- case nameModule_maybe name of
         Nothing -> pure []
         Just mod -> liftIO $ mapMaybe rowToLoc <$> withHieDb (\hieDb ->
+            -- See Note [Generated references]
+            filter (\(refRow HieDb.:. _) -> refIsGenerated refRow) <$>
             findReferences
                 hieDb
                 True
@@ -230,15 +233,29 @@ handleGetHieAst state nfp =
     -- which is bad (see https://github.com/haskell/haskell-language-server/issues/3799)
     fmap removeGenerated $ runActionE "Rename.GetHieAst" state $ useE GetHieAst nfp
 
--- | We don't want to rename in code generated by GHC as this gives false positives.
--- So we restrict the HIE file to remove all the generated code.
+{- Note [Generated references]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+GHC inserts `Use`s of record constructor everywhere where its record selectors are used,
+which leads to record fields being renamed whenever corresponding constructor is renamed.
+see https://github.com/haskell/haskell-language-server/issues/2915
+To work around this, we filter out compiler-generated references.
+-}
 removeGenerated :: HieAstResult -> HieAstResult
-removeGenerated HAR{..} = HAR{hieAst = go hieAst,..}
+removeGenerated HAR{..} =
+    HAR{hieAst = sourceOnlyAsts, refMap = sourceOnlyRefMap, ..}
   where
-    go :: HieASTs a -> HieASTs a
-    go hf =
-      HieASTs (fmap goAst (getAsts hf))
-    goAst (Node nsi sp xs) = Node (SourcedNodeInfo $ M.restrictKeys (getSourcedNodeInfo nsi) (S.singleton SourceInfo)) sp (map goAst xs)
+    goAsts :: HieASTs a -> HieASTs a
+    goAsts (HieASTs asts) = HieASTs (fmap goAst asts)
+
+    goAst :: HieAST a -> HieAST a
+    goAst (Node (SourcedNodeInfo sniMap) sp children) =
+        let sourceOnlyNodeInfos = SourcedNodeInfo $ M.delete GeneratedInfo sniMap
+        in Node sourceOnlyNodeInfos sp $ map goAst children
+
+    sourceOnlyAsts = goAsts hieAst
+    -- Also need to regenerate the RefMap, because the one in HAR
+    -- is generated from HieASTs containing GeneratedInfo
+    sourceOnlyRefMap = generateReferencesMap $ getAsts sourceOnlyAsts
 
 collectWith :: (Hashable a, Eq b) => (a -> b) -> HashSet a -> [(b, HashSet a)]
 collectWith f = map (\(a :| as) -> (f a, HS.fromList (a:as))) . groupWith f . HS.toList

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

@@ -24,6 +24,11 @@ tests :: TestTree
 tests = testGroup "Rename"
     [ goldenWithRename "Data constructor" "DataConstructor" $ \doc ->
         rename doc (Position 0 15) "Op"
+    , goldenWithRename "Data constructor with fields" "DataConstructorWithFields" $ \doc ->
+        rename doc (Position 1 13) "FooRenamed"
+    , knownBrokenForGhcVersions [GHC96, GHC98] "renaming Constructor{..} with RecordWildcard removes .." $
+        goldenWithRename "Data constructor with fields" "DataConstructorWithFieldsRecordWildcards" $ \doc ->
+          rename doc (Position 1 13) "FooRenamed"
     , goldenWithRename "Exported function" "ExportedFunction" $ \doc ->
         rename doc (Position 2 1) "quux"
     , goldenWithRename "Field Puns" "FieldPuns" $ \doc ->
@@ -113,7 +118,7 @@ goldenWithRename title path act =
     goldenWithHaskellDoc (def { plugins = M.fromList [("rename", def { plcConfig = "crossModule" .= True })] })
        renamePlugin title testDataDir path "expected" "hs" act
 
-renameExpectError :: (TResponseError Method_TextDocumentRename) -> TextDocumentIdentifier -> Position -> Text -> Session ()
+renameExpectError :: TResponseError Method_TextDocumentRename -> TextDocumentIdentifier -> Position -> Text -> Session ()
 renameExpectError expectedError doc pos newName = do
   let params = RenameParams Nothing doc pos newName
   rsp <- request SMethod_TextDocumentRename params

plugins/hls-rename-plugin/test/testdata/DataConstructorWithFields.expected.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE NamedFieldPuns #-}
+data Foo = FooRenamed { a :: Int, b :: Bool }
+
+foo1 :: Foo
+foo1 = FooRenamed { a = 1, b = True }
+
+foo2 :: Foo
+foo2 = FooRenamed 1 True
+
+fun1 :: Foo -> Int
+fun1 FooRenamed {a} = a
+
+fun2 :: Foo -> Int
+fun2 FooRenamed {a = i} = i

plugins/hls-rename-plugin/test/testdata/DataConstructorWithFields.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE NamedFieldPuns #-}
+data Foo = Foo { a :: Int, b :: Bool }
+
+foo1 :: Foo
+foo1 = Foo { a = 1, b = True }
+
+foo2 :: Foo
+foo2 = Foo 1 True
+
+fun1 :: Foo -> Int
+fun1 Foo {a} = a
+
+fun2 :: Foo -> Int
+fun2 Foo {a = i} = i

plugins/hls-rename-plugin/test/testdata/DataConstructorWithFieldsRecordWildcards.expected.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE RecordWildCards #-}
+data Foo = FooRenamed { a :: Int, b :: Bool }
+
+fun :: Foo -> Int
+fun FooRenamed {..} = a

plugins/hls-rename-plugin/test/testdata/DataConstructorWithFieldsRecordWildcards.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE RecordWildCards #-}
+data Foo = Foo { a :: Int, b :: Bool }
+
+fun :: Foo -> Int
+fun Foo {..} = a

stack-lts22.yaml

@@ -21,7 +21,7 @@ allow-newer-deps:
 extra-deps:
   - Diff-0.5
   - floskell-0.11.1
-  - hiedb-0.6.0.2
+  - hiedb-0.7.0.0
   - hie-bios-0.15.0
   - implicit-hie-0.1.4.0
   - lsp-2.7.0.0

stack.yaml

@@ -22,7 +22,7 @@ allow-newer-deps:
 
 extra-deps:
   - floskell-0.11.1
-  - hiedb-0.6.0.2
+  - hiedb-0.7.0.0
   - implicit-hie-0.1.4.0
   - hie-bios-0.15.0
   - hw-fingertree-0.1.2.1