Skip to content

Commit cfbbef1

Browse files
committed
Edit .cabal file on rename
On WillRename Notification, edit the responsible .cabal file to change the module name entry of the renamed module to the new name.
1 parent 765b727 commit cfbbef1

7 files changed

Lines changed: 402 additions & 50 deletions

File tree

‎haskell-language-server.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -261,6 +261,7 @@ library hls-cabal-plugin
261261
Ide.Plugin.Cabal.CabalAdd.Command
262262
Ide.Plugin.Cabal.CabalAdd.CodeAction
263263
Ide.Plugin.Cabal.CabalAdd.Types
264+
Ide.Plugin.Cabal.CabalAdd.Rename
264265
Ide.Plugin.Cabal.Orphans
265266
Ide.Plugin.Cabal.Outline
266267
Ide.Plugin.Cabal.Parse
@@ -309,6 +310,7 @@ test-suite hls-cabal-plugin-tests
309310
Definition
310311
Outline
311312
Utils
313+
Workspace
312314
build-depends:
313315
, bytestring
314316
, Cabal-syntax >= 3.7

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs‎

Lines changed: 61 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,20 +6,26 @@
66

77
module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where
88

9+
import Control.Applicative ((<|>))
910
import Control.Lens ((^.))
11+
import Control.Monad.Except (runExceptT)
1012
import Control.Monad.Extra
1113
import Control.Monad.IO.Class
1214
import Control.Monad.Trans.Class (lift)
15+
import Control.Monad.Trans.Except (ExceptT)
1316
import Control.Monad.Trans.Maybe (runMaybeT)
17+
import Data.Foldable (foldl')
1418
import Data.HashMap.Strict (HashMap)
1519
import qualified Data.List as List
20+
import qualified Data.Map.Strict as Map
1621
import qualified Data.Maybe as Maybe
1722
import qualified Data.Text ()
1823
import qualified Data.Text as T
1924
import Development.IDE as D
2025
import Development.IDE.Core.FileStore (getVersionedTextDoc)
2126
import Development.IDE.Core.PluginUtils
2227
import Development.IDE.Core.Shake (restartShakeSession)
28+
import qualified Development.IDE.Core.Shake as Shake
2329
import Development.IDE.Graph (Key)
2430
import Development.IDE.LSP.HoverDefinition (foundHover)
2531
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
@@ -33,6 +39,7 @@ import Distribution.PackageDescription.Configuration (flattenPackageDe
3339
import qualified Distribution.Parsec.Position as Syntax
3440
import qualified Ide.Plugin.Cabal.CabalAdd.CodeAction as CabalAdd
3541
import qualified Ide.Plugin.Cabal.CabalAdd.Command as CabalAdd
42+
import qualified Ide.Plugin.Cabal.CabalAdd.Rename as Rename
3643
import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
3744
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
3845
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
@@ -70,7 +77,11 @@ data Log
7077
| LogCompletionContext Types.Context Position
7178
| LogCompletions Types.Log
7279
| LogCabalAdd CabalAdd.Log
73-
deriving (Show)
80+
| LogDidRename Rename.Log
81+
| LogShake Shake.Log
82+
| LogSessionRestart
83+
| LogNoCabalFile FilePath
84+
| LogCabalRenameFailed T.Text PluginError
7485

7586
instance Pretty Log where
7687
pretty = \case
@@ -95,6 +106,11 @@ instance Pretty Log where
95106
<+> pretty position
96107
LogCompletions logs -> pretty logs
97108
LogCabalAdd logs -> pretty logs
109+
LogDidRename logs -> pretty logs
110+
LogSessionRestart -> "Restarting shake session globally"
111+
LogShake logs -> pretty logs
112+
LogNoCabalFile file -> "Cannot find responsible cabal file for" <+> pretty file
113+
LogCabalRenameFailed file err -> "Rename of file" <+> pretty file <+> "failed with error:" <+> pretty err
98114

99115
{- | Some actions in cabal files can be triggered from haskell files.
100116
This descriptor allows us to hook into the diagnostics of haskell source files and
@@ -128,6 +144,7 @@ descriptor recorder plId =
128144
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
129145
, mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition
130146
, mkPluginHandler LSP.SMethod_TextDocumentHover hover
147+
, mkPluginHandler LSP.SMethod_WorkspaceWillRenameFiles $ renameModulesHandler recorder
131148
]
132149
, pluginNotificationHandlers =
133150
mconcat
@@ -165,7 +182,6 @@ descriptor recorder plId =
165182
log' = logWith recorder
166183
ruleRecorder = cmapWithPrio LogRule recorder
167184
ofInterestRecorder = cmapWithPrio LogOfInterest recorder
168-
169185
whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
170186
whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath'
171187

@@ -300,6 +316,38 @@ cabalAddModuleCodeAction recorder state plId (CodeActionParams _ _ (TextDocument
300316
pure $ InL $ fmap InR actions
301317
Nothing -> pure $ InL []
302318

319+
renameModulesHandler :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState LSP.Method_WorkspaceWillRenameFiles
320+
renameModulesHandler recorder ideState _plId (RenameFilesParams renames) = do
321+
renamedEdits <- traverse (renameModuleHelper recorder ideState) renames
322+
pure $ InL $ foldl' combineTextEdits (WorkspaceEdit mempty mempty mempty) renamedEdits
323+
324+
renameModuleHelper :: Recorder (WithPriority Log) -> IdeState -> FileRename -> ExceptT PluginError (HandlerM Config) WorkspaceEdit
325+
renameModuleHelper recorder ideState (FileRename oldUri newUri) = do
326+
caps <- lift pluginGetClientCapabilities
327+
renameResult <- runExceptT $ do
328+
oldHaskellFilePath <- uriToFilePathE $ Uri oldUri
329+
newHaskellFilePath <- uriToFilePathE $ Uri newUri
330+
mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile oldHaskellFilePath
331+
case mbCabalFile of
332+
Nothing -> do
333+
logWith recorder Debug $ LogNoCabalFile oldHaskellFilePath
334+
pure mempty
335+
Just cabalFilePath ->
336+
Rename.renameHandler
337+
(cmapWithPrio LogDidRename recorder)
338+
ideState
339+
caps
340+
oldHaskellFilePath
341+
newHaskellFilePath
342+
cabalFilePath
343+
ideState
344+
case renameResult of
345+
Left err -> do
346+
logWith recorder Debug $ LogCabalRenameFailed oldUri err
347+
pure mempty
348+
Right edit -> do
349+
pure edit
350+
303351
{- | Handler for hover messages.
304352
305353
If the cursor is hovering on a dependency, add a documentation link to that dependency.
@@ -410,3 +458,14 @@ computeCompletionsAt recorder ide prefInfo fp fields matcher = do
410458
pos = Types.completionCursorPosition prefInfo
411459
context fields = Completions.getContext completerRecorder prefInfo fields
412460
completerRecorder = cmapWithPrio LogCompletions recorder
461+
462+
combineTextEdits :: WorkspaceEdit -> WorkspaceEdit -> WorkspaceEdit
463+
combineTextEdits (WorkspaceEdit c1 dc1 ca1) (WorkspaceEdit c2 dc2 ca2) =
464+
WorkspaceEdit c dc ca
465+
where
466+
c = liftA2 (Map.unionWith (<>)) c1 c2 <|> c1 <|> c2
467+
dc = dc1 <> dc2
468+
-- We know this might result in information loss due to the monad instance of map,
469+
-- but we do not expect our use of workspacedit combination to contain two changeAnnotations
470+
-- for the same edit.
471+
ca = ca1 <> ca2

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -248,7 +248,7 @@ addDependencySuggestCodeAction ::
248248
GenericPackageDescription ->
249249
IO [J.CodeAction]
250250
addDependencySuggestCodeAction plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do
251-
buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath
251+
buildTargets <- liftIO $ getBuildTargets (flattenPackageDescription gpd) cabalFilePath haskellFilePath
252252
case buildTargets of
253253
-- If there are no build targets found, run the `cabal-add` command with default behaviour
254254
[] -> pure $ mkCodeActionForDependency cabalFilePath Nothing <$> suggestions
@@ -267,17 +267,6 @@ addDependencySuggestCodeAction plId verTxtDocId suggestions haskellFilePath caba
267267
-}
268268
buildTargetToStringRepr target = render $ CabalPretty.pretty $ buildTargetComponentName target
269269

270-
{- | Finds the build targets that are used in `cabal-add`.
271-
Note the unorthodox usage of `readBuildTargets`:
272-
If the relative path to the haskell file is provided,
273-
`readBuildTargets` will return the build targets, this
274-
module is mentioned in (either exposed-modules or other-modules).
275-
-}
276-
getBuildTargets :: GenericPackageDescription -> FilePath -> FilePath -> IO [BuildTarget]
277-
getBuildTargets gpd cabalFilePath haskellFilePath = do
278-
let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath
279-
readBuildTargets (verboseNoStderr silent) (flattenPackageDescription gpd) [haskellFileRelativePath]
280-
281270
mkCodeActionForDependency :: FilePath -> Maybe String -> (T.Text, T.Text) -> J.CodeAction
282271
mkCodeActionForDependency cabalFilePath target (suggestedDep, suggestedVersion) =
283272
let
@@ -300,6 +289,17 @@ addDependencySuggestCodeAction plId verTxtDocId suggestions haskellFilePath caba
300289
in
301290
J.CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing
302291

292+
{- | Finds the build targets that are used in `cabal-add`.
293+
Note the unorthodox usage of `readBuildTargets`:
294+
If the relative path to the haskell file is provided,
295+
`readBuildTargets` will return the build targets, this
296+
module is mentioned in (either exposed-modules or other-modules).
297+
-}
298+
getBuildTargets :: PackageDescription -> FilePath -> FilePath -> IO [BuildTarget]
299+
getBuildTargets pd cabalFilePath haskellFilePath = do
300+
let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath
301+
readBuildTargets (verboseNoStderr silent) pd [haskellFileRelativePath]
302+
303303
{- | Gives a mentioned number of @(dependency, version)@ pairs
304304
found in the "hidden package" diagnostic message.
305305

0 commit comments

Comments
 (0)