Skip to content

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

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 7 commits into from
Jun 20, 2025
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion cabal.project
Original file line number Diff line number Diff line change
@@ -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
2 changes: 1 addition & 1 deletion ghcide/ghcide.cabal
Original file line number Diff line number Diff line change
@@ -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
4 changes: 2 additions & 2 deletions haskell-language-server.cabal
Original file line number Diff line number Diff line change
@@ -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
33 changes: 25 additions & 8 deletions plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs
Original file line number Diff line number Diff line change
@@ -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
7 changes: 6 additions & 1 deletion plugins/hls-rename-plugin/test/Main.hs
Original file line number Diff line number Diff line change
@@ -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 .." $
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Fyi this is a separate new issue I discovered while testing this PR that affects ghc 9.6 and 9.8.
I opened a separate issue to track that: #4636

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
Original file line number Diff line number Diff line change
@@ -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
Original file line number Diff line number Diff line change
@@ -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
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
data Foo = FooRenamed { a :: Int, b :: Bool }

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

fun :: Foo -> Int
fun Foo {..} = a
2 changes: 1 addition & 1 deletion stack-lts22.yaml
Original file line number Diff line number Diff line change
@@ -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
2 changes: 1 addition & 1 deletion stack.yaml
Original file line number Diff line number Diff line change
@@ -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

Unchanged files with check annotations Beta

{ source_version = ver
, old_value = m_old
, get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
, get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs

Check warning on line 805 in ghcide/src/Development/IDE/Core/Rules.hs

GitHub Actions / Hlint check run

Suggestion in getModIfaceFromDiskRule in module Development.IDE.Core.Rules: Use fmap ▫︎ Found: "\\ fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs" ▫︎ Perhaps: "fmap (map (snd . fromJust . hirCoreFp)) . uses_ GetModIface"
, get_module_graph = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph f
, regenerate = regenerateHiFile session f ms
}
Just fileDiags -> do
pure $ Just $ filter diagRangeOverlaps fileDiags
where
diagRangeOverlaps = \fileDiag ->

Check warning on line 219 in ghcide/src/Development/IDE/Core/PluginUtils.hs

GitHub Actions / Hlint check run

Warning in activeDiagnosticsInRangeMT in module Development.IDE.Core.PluginUtils: Redundant lambda ▫︎ Found: "diagRangeOverlaps\n = \\ fileDiag\n -> rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)" ▫︎ Perhaps: "diagRangeOverlaps fileDiag\n = rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)"
rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)
-- | Just like 'activeDiagnosticsInRangeMT'. See the docs of 'activeDiagnosticsInRangeMT' for details.
import Data.Time (UTCTime (..))
import Data.Tuple.Extra (dupe)
import Debug.Trace
import Development.IDE.Core.FileStore (resetInterfaceStore)

Check warning on line 73 in ghcide/src/Development/IDE/Core/Compile.hs

GitHub Actions / Hlint check run

Warning in module Development.IDE.Core.Compile: Use fewer imports ▫︎ Found: "import Development.IDE.Core.FileStore ( resetInterfaceStore )\nimport Development.IDE.Core.FileStore ( shareFilePath )\n" ▫︎ Perhaps: "import Development.IDE.Core.FileStore\n ( resetInterfaceStore, shareFilePath )\n"
import Development.IDE.Core.Preprocessor
import Development.IDE.Core.ProgressReporting (progressUpdate)
import Development.IDE.Core.RuleTypes
tcs = tcg_tcs ts :: [TyCon]
hie_asts = GHC.enrichHie all_binds (tmrRenamed tcm) top_ev_binds insts tcs
pure $ Just $

Check warning on line 826 in ghcide/src/Development/IDE/Core/Compile.hs

GitHub Actions / Hlint check run

Suggestion in generateHieAsts in module Development.IDE.Core.Compile: Redundant $ ▫︎ Found: "Just $ hie_asts" ▫︎ Perhaps: "Just hie_asts"
#if MIN_VERSION_ghc(9,11,0)
hie_asts (tcg_type_env ts)
#else
convImport (L _ i) = (
(ideclPkgQual i)

Check warning on line 1106 in ghcide/src/Development/IDE/Core/Compile.hs

GitHub Actions / Hlint check run

Suggestion in getModSummaryFromImports in module Development.IDE.Core.Compile: Redundant bracket ▫︎ Found: "((ideclPkgQual i), reLoc $ ideclName i)" ▫︎ Perhaps: "(ideclPkgQual i, reLoc $ ideclName i)"
, reLoc $ ideclName i)
msrImports = implicit_imports ++ imps
{-# LANGUAGE DeriveAnyClass #-}

Check warning on line 1 in ghcide/session-loader/Development/IDE/Session/Diagnostics.hs

GitHub Actions / Hlint check run

Warning in module Development.IDE.Session.Diagnostics: Use module export list ▫︎ Found: "module Development.IDE.Session.Diagnostics where" ▫︎ Perhaps: "module Development.IDE.Session.Diagnostics (\n module Development.IDE.Session.Diagnostics\n ) where" ▫︎ Note: an explicit list is usually better
module Development.IDE.Session.Diagnostics where
import Control.Applicative
surround start s end = do
guard (listToMaybe s == Just start)
guard (listToMaybe (reverse s) == Just end)
pure $ drop 1 $ take (length s - 1) s

Check warning on line 92 in ghcide/session-loader/Development/IDE/Session/Diagnostics.hs

GitHub Actions / Hlint check run

Warning in parseMultiCradleErr in module Development.IDE.Session.Diagnostics: Use drop1 ▫︎ Found: "drop 1" ▫︎ Perhaps: "drop1"
multiCradleErrMessage :: MultiCradleErr -> [String]
multiCradleErrMessage e =
[] -> error $ "GHC version could not be parsed: " <> version
((runTime, _):_)
| compileTime == runTime -> do
atomicModifyIORef' cradle_files (\xs -> (cfp:xs,()))

Check warning on line 630 in ghcide/session-loader/Development/IDE/Session.hs

GitHub Actions / Hlint check run

Warning in loadSessionWithOptions in module Development.IDE.Session: Use atomicModifyIORef'_ ▫︎ Found: "atomicModifyIORef' cradle_files (\\ xs -> (cfp : xs, ()))" ▫︎ Perhaps: "atomicModifyIORef'_ cradle_files ((:) cfp)"
session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
| otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[])
-- Failure case, either a cradle error or the none cradle
x <- map errMsgDiagnostic closure_errs
DriverHomePackagesNotClosed us <- pure x
pure us
isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units

Check warning on line 897 in ghcide/session-loader/Development/IDE/Session.hs

GitHub Actions / Hlint check run

Suggestion in newComponentCache in module Development.IDE.Session: Redundant bracket ▫︎ Found: "(homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units" ▫︎ Perhaps: "homeUnitId_ (componentDynFlags ci) `OS.member` bad_units"
-- Whenever we spin up a session on Linux, dynamically load libm.so.6
-- in. We need this in case the binary is statically linked, in which
-- case the interactive session will fail when trying to load
{-# LANGUAGE CPP #-}

Check warning on line 1 in exe/Wrapper.hs

GitHub Actions / Hlint check run

Warning in module Main: Use module export list ▫︎ Found: "module Main where" ▫︎ Perhaps: "module Main (\n module Main\n ) where" ▫︎ Note: an explicit list is usually better
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}