Skip to content

Commit 1873226

Browse files
VeryMilkyJoeVeryMilkyJoe
committed
Change of module decl and imports on rename
Add handling of WillRename Notification which changes the module declaration and all imports of the module to rename to the new name.
1 parent 28c8760 commit 1873226

5 files changed

Lines changed: 228 additions & 25 deletions

File tree

‎ghcide/src/Development/IDE/Core/FileStore.hs‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ module Development.IDE.Core.FileStore(
77
getFileContents,
88
getUriContents,
99
getVersionedTextDoc,
10+
getVersionedTextDocForNormalizedFilePath,
1011
setFileModified,
1112
setSomethingModified,
1213
fileStoreRules,
@@ -25,6 +26,7 @@ module Development.IDE.Core.FileStore(
2526
) where
2627

2728
import Control.Concurrent.STM.Stats (STM, atomically)
29+
import Control.Concurrent.STM.TQueue (writeTQueue)
2830
import Control.Exception
2931
import Control.Lens ((^.))
3032
import Control.Monad.Extra
@@ -256,6 +258,14 @@ getVersionedTextDoc doc = do
256258
Nothing -> 0
257259
return (VersionedTextDocumentIdentifier uri ver)
258260

261+
getVersionedTextDocForNormalizedFilePath :: NormalizedFilePath -> Action VersionedTextDocumentIdentifier
262+
getVersionedTextDocForNormalizedFilePath nfp = do
263+
mvf <- getVirtualFile nfp
264+
let ver = case mvf of
265+
Just (VirtualFile lspver _ _ _) -> lspver
266+
Nothing -> 0
267+
return (VersionedTextDocumentIdentifier (fromNormalizedUri $ filePathToUri' nfp) ver)
268+
259269
fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
260270
fileStoreRules recorder isWatched = do
261271
getModificationTimeRule recorder

‎haskell-language-server.cabal‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -595,9 +595,12 @@ library hls-rename-plugin
595595
exposed-modules:
596596
Ide.Plugin.Rename
597597
Ide.Plugin.Rename.ModuleName
598+
Ide.Plugin.Rename.ModuleRename
598599
hs-source-dirs: plugins/hls-rename-plugin/src
599600
build-depends:
601+
, extra ^>=1.8.1
600602
, aeson
603+
, text-rope ^>=0.3
601604
, containers
602605
, filepath
603606
, ghc

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

Lines changed: 59 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -4,32 +4,39 @@
44
{-# LANGUAGE OverloadedLabels #-}
55
{-# LANGUAGE OverloadedStrings #-}
66
{-# LANGUAGE RecordWildCards #-}
7-
{-# OPTIONS_GHC -Wno-orphans #-}
7+
{-# OPTIONS_GHC -Wno-orphans #-}
88
{-# LANGUAGE LambdaCase #-}
99

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

12+
import Control.Applicative ((<|>))
1213
import Control.Lens ((^.))
1314
import Control.Monad
1415
import Control.Monad.Except (ExceptT, throwError)
1516
import Control.Monad.IO.Class (MonadIO, liftIO)
1617
import Control.Monad.Trans.Class (lift)
18+
import Control.Monad.Trans.Except (mapExceptT)
19+
import Control.Monad.Trans.Maybe (hoistMaybe,
20+
maybeToExceptT)
1721
import Data.Either (rights)
18-
import Data.Foldable (fold)
22+
import Data.Foldable (fold, minimumBy)
1923
import Data.Generics
2024
import Data.Hashable
2125
import Data.HashSet (HashSet)
2226
import qualified Data.HashSet as HS
27+
import Data.List (foldl')
2328
import Data.List.NonEmpty (NonEmpty ((:|)),
2429
groupWith)
30+
import qualified Data.List.NonEmpty as NE
2531
import qualified Data.Map as M
32+
import qualified Data.Map.Strict as Map
2633
import Data.Maybe
2734
import Data.Mod.Word
35+
import Data.Ord (comparing)
2836
import qualified Data.Text as T
29-
import Development.IDE (Recorder, WithPriority,
30-
usePropertyAction)
3137
import Development.IDE.Core.FileStore (getVersionedTextDoc)
3238
import Development.IDE.Core.PluginUtils
39+
import Development.IDE.Core.Rules (usePropertyAction)
3340
import Development.IDE.Core.RuleTypes
3441
import Development.IDE.Core.Service hiding (Log)
3542
import Development.IDE.Core.Shake hiding (Log)
@@ -38,8 +45,10 @@ import Development.IDE.GHC.Compat.ExactPrint
3845
import Development.IDE.GHC.Error
3946
import Development.IDE.GHC.ExactPrint hiding (Log)
4047
import qualified Development.IDE.GHC.ExactPrint as E
48+
import Development.IDE.GHC.Util (evalGhcEnv)
4149
import Development.IDE.Plugin.CodeAction
4250
import Development.IDE.Spans.AtPoint
51+
import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))
4352
import Development.IDE.Types.Location
4453
import GHC.Iface.Ext.Types (HieAST (..),
4554
HieASTs (..),
@@ -49,11 +58,11 @@ import GHC.Iface.Ext.Utils (generateReferencesMap)
4958
import HieDb ((:.) (..))
5059
import HieDb.Query
5160
import HieDb.Types (RefRow (refIsGenerated))
52-
import Ide.Logger (Pretty (..),
53-
cmapWithPrio)
61+
import Ide.Logger
5462
import Ide.Plugin.Error
5563
import Ide.Plugin.Properties
5664
import qualified Ide.Plugin.Rename.ModuleName as ModuleName
65+
import qualified Ide.Plugin.Rename.ModuleRename as ModuleRename
5766
import Ide.PluginUtils
5867
import Ide.Types
5968
import qualified Language.LSP.Protocol.Lens as L
@@ -65,11 +74,13 @@ instance Hashable (Mod a) where hash n = hash (unMod n)
6574
data Log
6675
= LogExactPrint E.Log
6776
| LogModuleName ModuleName.Log
77+
| LogModuleRename ModuleRename.Log
6878

6979
instance Pretty Log where
7080
pretty = \ case
7181
LogExactPrint msg -> pretty msg
7282
LogModuleName msg -> pretty msg
83+
LogModuleRename msg -> pretty msg
7384

7485
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
7586
descriptor recorder pluginId = mkExactprintPluginDescriptor exactPrintRecorder $
@@ -78,6 +89,7 @@ descriptor recorder pluginId = mkExactprintPluginDescriptor exactPrintRecorder $
7889
[ mkPluginHandler SMethod_TextDocumentRename renameProvider
7990
, mkPluginHandler SMethod_TextDocumentPrepareRename prepareRenameProvider
8091
, mkPluginHandler SMethod_TextDocumentCodeLens (ModuleName.codeLens moduleNameRecorder)
92+
, mkPluginHandler SMethod_WorkspaceWillRenameFiles (renameModuleProvider recorder)
8193
]
8294
, pluginCommands = [PluginCommand ModuleName.updateModuleNameCommand "Set name of module to match with file path" (ModuleName.command moduleNameRecorder)]
8395
, pluginConfigDescriptor = defaultConfigDescriptor
@@ -107,6 +119,35 @@ prepareRenameProvider state _pluginId (PrepareRenameParams (TextDocumentIdentifi
107119
[] -> InR Null
108120
srcSpan : _ -> InL $ PrepareRenameResult $ InL (realSrcSpanToRange srcSpan)
109121

122+
renameModuleProvider :: Recorder (WithPriority Log)-> PluginMethodHandler IdeState Method_WorkspaceWillRenameFiles
123+
renameModuleProvider recorder state _ (RenameFilesParams renames) = do
124+
renameResults <- mapM renameFile renames
125+
pure $ InL $ foldl' combineTextEdits (WorkspaceEdit mempty mempty mempty) $ catMaybes renameResults
126+
where
127+
recorder' = cmapWithPrio LogModuleRename recorder
128+
129+
renameFile (FileRename oldUri newUri) = do
130+
oldNfp <- fmap toNormalizedFilePath $ uriToFilePathE $ Uri oldUri
131+
newNfp <- fmap toNormalizedFilePath $ uriToFilePathE $ Uri newUri
132+
pm <- runActionE "Rename.GetParsedModule" state
133+
(useE GetParsedModule oldNfp)
134+
let oldModuleNameM = moduleNameString . unLoc <$> (hsmodName $ unLoc $ pm_parsed_source pm)
135+
newModulePathM <- guessModuleName newNfp oldNfp
136+
case (oldModuleNameM, newModulePathM) of
137+
(Just oldModulePath, Just newModulePath) -> do
138+
modDeclEdit <- ModuleRename.renameModuleDeclaration recorder' state oldNfp newModulePath
139+
importEdits <- ModuleRename.applyRenameToImports recorder' state (T.pack oldModulePath) newModulePath $ oldNfp
140+
pure $ Just $ combineTextEdits modDeclEdit importEdits
141+
_ -> do
142+
logWith recorder' Info $ ModuleRename.NoModuleName newNfp
143+
pure Nothing
144+
145+
guessModuleName newNfp oldNfp = do
146+
(session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession oldNfp
147+
srcPaths <- liftIO $ evalGhcEnv (hscEnv session) $ importPaths <$> getSessionDynFlags
148+
correctNames <- mapExceptT liftIO $ ModuleName.potentialModuleNames (cmapWithPrio LogModuleName recorder) state (fromNormalizedFilePath newNfp) srcPaths
149+
pure $ minimumBy (comparing T.length) <$> NE.nonEmpty correctNames
150+
110151
renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename
111152
renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) pos newNameText) = do
112153
nfp <- getNormalizedFilePathE uri
@@ -261,6 +302,18 @@ handleGetHieAst state nfp =
261302
-- which is bad (see https://github.com/haskell/haskell-language-server/issues/3799)
262303
fmap removeGenerated $ runActionE "Rename.GetHieAst" state $ useE GetHieAst nfp
263304

305+
combineTextEdits :: WorkspaceEdit -> WorkspaceEdit -> WorkspaceEdit
306+
combineTextEdits (WorkspaceEdit c1 dc1 ca1) (WorkspaceEdit c2 dc2 ca2) =
307+
WorkspaceEdit c dc ca
308+
where
309+
c = liftA2 (Map.unionWith (<>)) c1 c2 <|> c1 <|> c2
310+
dc = dc1 <> dc2
311+
-- We know this might result in information loss due to the monad instance of map,
312+
-- but we do not expect our use of workspacedit combination to contain two changeAnnotations
313+
-- for the same edit.
314+
ca = ca1 <> ca2
315+
316+
264317
{- Note [Generated references]
265318
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
266319
GHC inserts `Use`s of record constructor everywhere where its record selectors are used,

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

Lines changed: 25 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,8 @@ module Ide.Plugin.Rename.ModuleName (
1515
codeLens,
1616
updateModuleNameCommand,
1717
command,
18+
potentialModuleNames,
19+
codeModuleName,
1820
) where
1921

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

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

110-
correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nfp fp
111+
correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nfp
111112
logWith recorder Debug (CorrectNames correctNames)
112113
let bestName = minimumBy (comparing T.length) <$> NE.nonEmpty correctNames
113114
logWith recorder Debug (BestName bestName)
@@ -127,33 +128,34 @@ action recorder state uri = do
127128
-- | Possible module names, as derived by the position of the module in the
128129
-- source directories. There may be more than one possible name, if the source
129130
-- directories are nested inside each other.
130-
pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FilePath -> ExceptT PluginError IO [T.Text]
131-
pathModuleNames recorder state normFilePath filePath
131+
pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> ExceptT PluginError IO [T.Text]
132+
pathModuleNames recorder state nfp
132133
| firstLetter isLower $ takeFileName filePath = return ["Main"]
133134
| otherwise = do
134-
(session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession normFilePath
135+
(session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession nfp
135136
srcPaths <- liftIO $ evalGhcEnv (hscEnv session) $ importPaths <$> getSessionDynFlags
136137
logWith recorder Debug (SrcPaths srcPaths)
137-
138+
potentialModuleNames recorder state filePath srcPaths
138139
-- Append a `pathSeparator` to make the path looks like a directory,
139140
-- and then we can drop it uniformly.
140141
-- See https://github.com/haskell/haskell-language-server/pull/3092 for details.
141-
let paths = map (normalise . (<> pure pathSeparator)) srcPaths
142-
logWith recorder Debug (NormalisedPaths paths)
142+
where
143+
filePath = fromNormalizedFilePath nfp
143144

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

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

156+
let suffixes = mapMaybe (`stripPrefix` mdlPath) paths
157+
pure (map moduleNameFrom suffixes)
158+
where
157159
moduleNameFrom =
158160
T.pack
159161
. intercalate "."
@@ -163,6 +165,10 @@ pathModuleNames recorder state normFilePath filePath
163165
. splitDirectories
164166
. dropExtension
165167

168+
firstLetter :: (Char -> Bool) -> FilePath -> Bool
169+
firstLetter _ [] = False
170+
firstLetter pred (c:_) = pred c
171+
166172
-- | The module name, as stated in the module
167173
codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, T.Text))
168174
codeModuleName state nfp = runMaybeT $ do

0 commit comments

Comments
 (0)