Skip to content

Handle file renaming #4957

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.

Sign up for GitHub

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

Open
VeryMilkyJoe wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Handle file renaming #4957

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
1873226
Change of module decl and imports on rename
VeryMilkyJoe Jun 7, 2026
674a1b9
Change of module decl and imports on rename
VeryMilkyJoe Jun 7, 2026
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
10 changes: 10 additions & 0 deletions ghcide/src/Development/IDE/Core/FileStore.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ module Development.IDE.Core.FileStore(
getFileContents,
getUriContents,
getVersionedTextDoc,
getVersionedTextDocForNormalizedFilePath,
setFileModified,
setSomethingModified,
fileStoreRules,
Expand All @@ -25,6 +26,7 @@ module Development.IDE.Core.FileStore(
) where

import Control.Concurrent.STM.Stats (STM, atomically)
import Control.Concurrent.STM.TQueue (writeTQueue)
import Control.Exception
import Control.Lens ((^.))
import Control.Monad.Extra
Expand Down Expand Up @@ -256,6 +258,14 @@ getVersionedTextDoc doc = do
Nothing -> 0
return (VersionedTextDocumentIdentifier uri ver)

getVersionedTextDocForNormalizedFilePath :: NormalizedFilePath -> Action VersionedTextDocumentIdentifier
getVersionedTextDocForNormalizedFilePath nfp = do
mvf <- getVirtualFile nfp
let ver = case mvf of
Just (VirtualFile lspver _ _ _) -> lspver
Nothing -> 0
return (VersionedTextDocumentIdentifier (fromNormalizedUri $ filePathToUri' nfp) ver)

fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
fileStoreRules recorder isWatched = do
getModificationTimeRule recorder
Expand Down
3 changes: 3 additions & 0 deletions haskell-language-server.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -595,9 +595,12 @@ library hls-rename-plugin
exposed-modules:
Ide.Plugin.Rename
Ide.Plugin.Rename.ModuleName
Ide.Plugin.Rename.ModuleRename
hs-source-dirs: plugins/hls-rename-plugin/src
build-depends:
, extra ^>=1.8.1
, aeson
, text-rope ^>=0.3
, containers
, filepath
, ghc
Expand Down
63 changes: 57 additions & 6 deletions plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,32 +4,37 @@
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE LambdaCase #-}

module Ide.Plugin.Rename (descriptor, Log) where

import Control.Applicative ((<|>))
import Control.Lens ((^.))
import Control.Monad
import Control.Monad.Except (ExceptT, throwError)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (mapExceptT)
import Data.Either (rights)
import Data.Foldable (fold)
import Data.Foldable (fold, minimumBy)
import Data.Generics
import Data.Hashable
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty ((:|)),
groupWith)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Mod.Word
import Data.Ord (comparing)
import qualified Data.Text as T
import Development.IDE (Recorder, WithPriority,
usePropertyAction)
import Development.IDE.Core.FileStore (getVersionedTextDoc)
import Development.IDE.Core.PluginUtils
import Development.IDE.Core.Rules (usePropertyAction)
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service hiding (Log)
import Development.IDE.Core.Shake hiding (Log)
Expand All @@ -38,8 +43,10 @@ import Development.IDE.GHC.Compat.ExactPrint
import Development.IDE.GHC.Error
import Development.IDE.GHC.ExactPrint hiding (Log)
import qualified Development.IDE.GHC.ExactPrint as E
import Development.IDE.GHC.Util (evalGhcEnv)
import Development.IDE.Plugin.CodeAction
import Development.IDE.Spans.AtPoint
import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))
import Development.IDE.Types.Location
import GHC.Iface.Ext.Types (HieAST (..),
HieASTs (..),
Expand All @@ -49,11 +56,11 @@ import GHC.Iface.Ext.Utils (generateReferencesMap)
import HieDb ((:.) (..))
import HieDb.Query
import HieDb.Types (RefRow (refIsGenerated))
import Ide.Logger (Pretty (..),
cmapWithPrio)
import Ide.Logger
import Ide.Plugin.Error
import Ide.Plugin.Properties
import qualified Ide.Plugin.Rename.ModuleName as ModuleName
import qualified Ide.Plugin.Rename.ModuleRename as ModuleRename
import Ide.PluginUtils
import Ide.Types
import qualified Language.LSP.Protocol.Lens as L
Expand All @@ -65,11 +72,13 @@ instance Hashable (Mod a) where hash n = hash (unMod n)
data Log
= LogExactPrint E.Log
| LogModuleName ModuleName.Log
| LogModuleRename ModuleRename.Log

instance Pretty Log where
pretty = \ case
LogExactPrint msg -> pretty msg
LogModuleName msg -> pretty msg
LogModuleRename msg -> pretty msg

descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor recorder pluginId = mkExactprintPluginDescriptor exactPrintRecorder $
Expand All @@ -78,6 +87,7 @@ descriptor recorder pluginId = mkExactprintPluginDescriptor exactPrintRecorder $
[ mkPluginHandler SMethod_TextDocumentRename renameProvider
, mkPluginHandler SMethod_TextDocumentPrepareRename prepareRenameProvider
, mkPluginHandler SMethod_TextDocumentCodeLens (ModuleName.codeLens moduleNameRecorder)
, mkPluginHandler SMethod_WorkspaceWillRenameFiles (renameModuleProvider recorder)
]
, pluginCommands = [PluginCommand ModuleName.updateModuleNameCommand "Set name of module to match with file path" (ModuleName.command moduleNameRecorder)]
, pluginConfigDescriptor = defaultConfigDescriptor
Expand Down Expand Up @@ -107,6 +117,35 @@ prepareRenameProvider state _pluginId (PrepareRenameParams (TextDocumentIdentifi
[] -> InR Null
srcSpan : _ -> InL $ PrepareRenameResult $ InL (realSrcSpanToRange srcSpan)

renameModuleProvider :: Recorder (WithPriority Log)-> PluginMethodHandler IdeState Method_WorkspaceWillRenameFiles
renameModuleProvider recorder state _ (RenameFilesParams renames) = do
renameResults <- mapM renameFile renames
pure $ InL $ List.foldl' combineTextEdits (WorkspaceEdit mempty mempty mempty) $ catMaybes renameResults
where
recorder' = cmapWithPrio LogModuleRename recorder

renameFile (FileRename oldUri newUri) = do
oldNfp <- fmap toNormalizedFilePath $ uriToFilePathE $ Uri oldUri
newNfp <- fmap toNormalizedFilePath $ uriToFilePathE $ Uri newUri
pm <- runActionE "Rename.GetParsedModule" state
(useE GetParsedModule oldNfp)
let oldModuleNameM = moduleNameString . unLoc <$> (hsmodName $ unLoc $ pm_parsed_source pm)
newModulePathM <- guessModuleName newNfp oldNfp
case (oldModuleNameM, newModulePathM) of
(Just oldModulePath, Just newModulePath) -> do
modDeclEdit <- ModuleRename.renameModuleDeclaration recorder' state oldNfp newModulePath
importEdits <- ModuleRename.applyRenameToImports recorder' state (T.pack oldModulePath) newModulePath $ oldNfp
pure $ Just $ combineTextEdits modDeclEdit importEdits
_ -> do
logWith recorder' Info $ ModuleRename.NoModuleName newNfp
pure Nothing

guessModuleName newNfp oldNfp = do
(session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession oldNfp
srcPaths <- liftIO $ evalGhcEnv (hscEnv session) $ importPaths <$> getSessionDynFlags
correctNames <- mapExceptT liftIO $ ModuleName.potentialModuleNames (cmapWithPrio LogModuleName recorder) state (fromNormalizedFilePath newNfp) srcPaths
pure $ minimumBy (comparing T.length) <$> NE.nonEmpty correctNames

renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename
renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) pos newNameText) = do
nfp <- getNormalizedFilePathE uri
Expand Down Expand Up @@ -261,6 +300,18 @@ 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

combineTextEdits :: WorkspaceEdit -> WorkspaceEdit -> WorkspaceEdit
combineTextEdits (WorkspaceEdit c1 dc1 ca1) (WorkspaceEdit c2 dc2 ca2) =
WorkspaceEdit c dc ca
where
c = liftA2 (Map.unionWith (<>)) c1 c2 <|> c1 <|> c2
dc = dc1 <> dc2
-- We know this might result in information loss due to the monad instance of map,
-- but we do not expect our use of workspacedit combination to contain two changeAnnotations
-- for the same edit.
ca = ca1 <> ca2


{- Note [Generated references]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC inserts `Use`s of record constructor everywhere where its record selectors are used,
Expand Down
44 changes: 25 additions & 19 deletions plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ModuleName.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,8 @@ module Ide.Plugin.Rename.ModuleName (
codeLens,
updateModuleNameCommand,
command,
potentialModuleNames,
codeModuleName,
) where

import Control.Monad (forM_, void)
Expand Down Expand Up @@ -102,12 +104,11 @@ data Action = Replace
action :: Recorder (WithPriority Log) -> IdeState -> Uri -> ExceptT PluginError (HandlerM c) [Action]
action recorder state uri = do
nfp <- getNormalizedFilePathE uri
fp <- uriToFilePathE uri

contents <- liftIO $ runAction "ModuleName.getFileContents" state $ getFileContents nfp
let emptyModule = maybe True (T.null . T.strip . Rope.toText) contents

correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nfp fp
correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nfp
logWith recorder Debug (CorrectNames correctNames)
let bestName = minimumBy (comparing T.length) <$> NE.nonEmpty correctNames
logWith recorder Debug (BestName bestName)
Expand All @@ -127,33 +128,34 @@ action recorder state uri = do
-- | Possible module names, as derived by the position of the module in the
-- source directories. There may be more than one possible name, if the source
-- directories are nested inside each other.
pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FilePath -> ExceptT PluginError IO [T.Text]
pathModuleNames recorder state normFilePath filePath
pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> ExceptT PluginError IO [T.Text]
pathModuleNames recorder state nfp
| firstLetter isLower $ takeFileName filePath = return ["Main"]
| otherwise = do
(session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession normFilePath
(session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession nfp
srcPaths <- liftIO $ evalGhcEnv (hscEnv session) $ importPaths <$> getSessionDynFlags
logWith recorder Debug (SrcPaths srcPaths)

potentialModuleNames recorder state filePath srcPaths
-- Append a `pathSeparator` to make the path looks like a directory,
-- and then we can drop it uniformly.
-- See https://github.com/haskell/haskell-language-server/pull/3092 for details.
let paths = map (normalise . (<> pure pathSeparator)) srcPaths
logWith recorder Debug (NormalisedPaths paths)
where
filePath = fromNormalizedFilePath nfp

-- TODO, this can be avoid if the filePath is already absolute,
-- we can avoid the toAbsolute call in the future.
-- see Note [Root Directory]
let mdlPath = (toAbsolute $ rootDir state) filePath
logWith recorder Debug (AbsoluteFilePath mdlPath)
potentialModuleNames :: Recorder (WithPriority Log) -> IdeState -> [Char] -> [FilePath] -> ExceptT PluginError IO [T.Text]
potentialModuleNames recorder state filePath srcPaths = do
let paths = map (normalise . (<> pure pathSeparator)) srcPaths
logWith recorder Debug (NormalisedPaths paths)

let suffixes = mapMaybe (`stripPrefix` mdlPath) paths
pure (map moduleNameFrom suffixes)
where
firstLetter :: (Char -> Bool) -> FilePath -> Bool
firstLetter _ [] = False
firstLetter pred (c:_) = pred c
-- TODO, this can be avoid if the filePath is already absolute,
-- we can avoid the toAbsolute call in the future.
-- see Note [Root Directory]
let mdlPath = (toAbsolute $ rootDir state) filePath
logWith recorder Debug (AbsoluteFilePath mdlPath)

let suffixes = mapMaybe (`stripPrefix` mdlPath) paths
pure (map moduleNameFrom suffixes)
where
moduleNameFrom =
T.pack
. intercalate "."
Expand All @@ -163,6 +165,10 @@ pathModuleNames recorder state normFilePath filePath
. splitDirectories
. dropExtension

firstLetter :: (Char -> Bool) -> FilePath -> Bool
firstLetter _ [] = False
firstLetter pred (c:_) = pred c

-- | The module name, as stated in the module
codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, T.Text))
codeModuleName state nfp = runMaybeT $ do
Expand Down
Loading
Loading