diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 7d253131d6..21a49156ff 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -7,6 +7,7 @@ module Development.IDE.Core.FileStore( getFileContents, getUriContents, getVersionedTextDoc, + getVersionedTextDocForNormalizedFilePath, setFileModified, setSomethingModified, fileStoreRules, @@ -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 @@ -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 diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index def5d32e13..af513bec83 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -261,6 +261,7 @@ library hls-cabal-plugin Ide.Plugin.Cabal.CabalAdd.Command Ide.Plugin.Cabal.CabalAdd.CodeAction Ide.Plugin.Cabal.CabalAdd.Types + Ide.Plugin.Cabal.CabalAdd.Rename Ide.Plugin.Cabal.Orphans Ide.Plugin.Cabal.Outline Ide.Plugin.Cabal.Parse @@ -595,9 +596,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 diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index dadc5503fc..0b41f33197 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -6,13 +6,18 @@ module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where +import Control.Applicative ((<|>)) import Control.Lens ((^.)) +import Control.Monad.Except (runExceptT) import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Maybe (runMaybeT) +import Data.Foldable (foldl') import Data.HashMap.Strict (HashMap) import qualified Data.List as List +import qualified Data.Map.Strict as Map import qualified Data.Maybe as Maybe import qualified Data.Text () import qualified Data.Text as T @@ -20,6 +25,7 @@ import Development.IDE as D import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.PluginUtils import Development.IDE.Core.Shake (restartShakeSession) +import qualified Development.IDE.Core.Shake as Shake import Development.IDE.Graph (Key) import Development.IDE.LSP.HoverDefinition (foundHover) import qualified Development.IDE.Plugin.Completions.Logic as Ghcide @@ -33,6 +39,7 @@ import Distribution.PackageDescription.Configuration (flattenPackageDe import qualified Distribution.Parsec.Position as Syntax import qualified Ide.Plugin.Cabal.CabalAdd.CodeAction as CabalAdd import qualified Ide.Plugin.Cabal.CabalAdd.Command as CabalAdd +import qualified Ide.Plugin.Cabal.CabalAdd.Rename as Rename import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes import qualified Ide.Plugin.Cabal.Completion.Completions as Completions @@ -70,7 +77,11 @@ data Log | LogCompletionContext Types.Context Position | LogCompletions Types.Log | LogCabalAdd CabalAdd.Log - deriving (Show) + | LogDidRename Rename.Log + | LogShake Shake.Log + | LogSessionRestart + | LogNoCabalFile FilePath + | LogCabalRenameFailed T.Text PluginError instance Pretty Log where pretty = \case @@ -95,6 +106,11 @@ instance Pretty Log where <+> pretty position LogCompletions logs -> pretty logs LogCabalAdd logs -> pretty logs + LogDidRename logs -> pretty logs + LogSessionRestart -> "Restarting shake session globally" + LogShake logs -> pretty logs + LogNoCabalFile file -> "Cannot find responsible cabal file for" <+> pretty file + LogCabalRenameFailed file err -> "Rename of file" <+> pretty file <+> "failed with error:" <+> pretty err {- | Some actions in cabal files can be triggered from haskell files. This descriptor allows us to hook into the diagnostics of haskell source files and @@ -128,6 +144,7 @@ descriptor recorder plId = , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder , mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition , mkPluginHandler LSP.SMethod_TextDocumentHover hover + , mkPluginHandler LSP.SMethod_WorkspaceWillRenameFiles $ renameModulesHandler recorder ] , pluginNotificationHandlers = mconcat @@ -165,7 +182,6 @@ descriptor recorder plId = log' = logWith recorder ruleRecorder = cmapWithPrio LogRule recorder ofInterestRecorder = cmapWithPrio LogOfInterest recorder - whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath' @@ -300,6 +316,38 @@ cabalAddModuleCodeAction recorder state plId (CodeActionParams _ _ (TextDocument pure $ InL $ fmap InR actions Nothing -> pure $ InL [] +renameModulesHandler :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState LSP.Method_WorkspaceWillRenameFiles +renameModulesHandler recorder ideState _plId (RenameFilesParams renames) = do + renamedEdits <- traverse (renameModuleHelper recorder ideState) renames + pure $ InL $ foldl' combineTextEdits (WorkspaceEdit mempty mempty mempty) renamedEdits + +renameModuleHelper :: Recorder (WithPriority Log) -> IdeState -> FileRename -> ExceptT PluginError (HandlerM Config) WorkspaceEdit +renameModuleHelper recorder ideState (FileRename oldUri newUri) = do + caps <- lift pluginGetClientCapabilities + renameResult <- runExceptT $ do + oldHaskellFilePath <- uriToFilePathE $ Uri oldUri + newHaskellFilePath <- uriToFilePathE $ Uri newUri + mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile oldHaskellFilePath + case mbCabalFile of + Nothing -> do + logWith recorder Debug $ LogNoCabalFile oldHaskellFilePath + pure mempty + Just cabalFilePath -> + Rename.renameHandler + (cmapWithPrio LogDidRename recorder) + ideState + caps + oldHaskellFilePath + newHaskellFilePath + cabalFilePath + ideState + case renameResult of + Left err -> do + logWith recorder Debug $ LogCabalRenameFailed oldUri err + pure mempty + Right edit -> do + pure edit + {- | Handler for hover messages. 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 pos = Types.completionCursorPosition prefInfo context fields = Completions.getContext completerRecorder prefInfo fields completerRecorder = cmapWithPrio LogCompletions recorder + +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 diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs index d5cb1fb137..996a546ea7 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs @@ -248,7 +248,7 @@ addDependencySuggestCodeAction :: GenericPackageDescription -> IO [J.CodeAction] addDependencySuggestCodeAction plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do - buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath + buildTargets <- liftIO $ getBuildTargets (flattenPackageDescription gpd) cabalFilePath haskellFilePath case buildTargets of -- If there are no build targets found, run the `cabal-add` command with default behaviour [] -> pure $ mkCodeActionForDependency cabalFilePath Nothing <$> suggestions @@ -267,17 +267,6 @@ addDependencySuggestCodeAction plId verTxtDocId suggestions haskellFilePath caba -} buildTargetToStringRepr target = render $ CabalPretty.pretty $ buildTargetComponentName target - {- | Finds the build targets that are used in `cabal-add`. - Note the unorthodox usage of `readBuildTargets`: - If the relative path to the haskell file is provided, - `readBuildTargets` will return the build targets, this - module is mentioned in (either exposed-modules or other-modules). - -} - getBuildTargets :: GenericPackageDescription -> FilePath -> FilePath -> IO [BuildTarget] - getBuildTargets gpd cabalFilePath haskellFilePath = do - let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath - readBuildTargets (verboseNoStderr silent) (flattenPackageDescription gpd) [haskellFileRelativePath] - mkCodeActionForDependency :: FilePath -> Maybe String -> (T.Text, T.Text) -> J.CodeAction mkCodeActionForDependency cabalFilePath target (suggestedDep, suggestedVersion) = let @@ -300,6 +289,17 @@ addDependencySuggestCodeAction plId verTxtDocId suggestions haskellFilePath caba in J.CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing +{- | Finds the build targets that are used in `cabal-add`. + Note the unorthodox usage of `readBuildTargets`: + If the relative path to the haskell file is provided, + `readBuildTargets` will return the build targets, this + module is mentioned in (either exposed-modules or other-modules). +-} +getBuildTargets :: PackageDescription -> FilePath -> FilePath -> IO [BuildTarget] +getBuildTargets pd cabalFilePath haskellFilePath = do + let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath + readBuildTargets (verboseNoStderr silent) pd [haskellFileRelativePath] + {- | Gives a mentioned number of @(dependency, version)@ pairs found in the "hidden package" diagnostic message. diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/Rename.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/Rename.hs new file mode 100644 index 0000000000..bf46554104 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/Rename.hs @@ -0,0 +1,228 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + + +module Ide.Plugin.Cabal.CabalAdd.Rename ( + renameHandler, + Log, +) +where +import Control.Applicative +import Control.Monad (guard) +import qualified Control.Monad.Extra as Maybe +import Control.Monad.Trans +import Control.Monad.Trans.Except (ExceptT, throwE) +import Control.Monad.Trans.Maybe +import Data.ByteString (ByteString) +import qualified Data.Maybe as Maybe +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Development.IDE.Core.Shake as Shake +import qualified Distribution.Client.Add as Add +import Distribution.Client.Rename (RenameConfig (..), + executeRenameConfig) +import Distribution.Fields (Field) +import qualified Distribution.ModuleName as Cabal +import Distribution.PackageDescription +import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import Distribution.Parsec.Position (Position) +import Distribution.Simple.BuildTarget (buildTargetComponentName) +import Ide.Logger +import Ide.Plugin.Cabal.CabalAdd.CodeAction (buildInfoToHsSourceDirs, + getBuildTargets, + mkRelativeModulePathM) +import Ide.Plugin.Cabal.Definition (lookupBuildTargetPackageDescription) +import Ide.Plugin.Error +import Ide.PluginUtils (WithDeletions (IncludeDeletions), + diffText) +import Language.LSP.Protocol.Types (ClientCapabilities, + VersionedTextDocumentIdentifier, + WorkspaceEdit, toNormalizedFilePath, filePathToUri, TextDocumentIdentifier (TextDocumentIdentifier)) +import Development.IDE.Core.PluginUtils (runActionE) +import Development.IDE.Types.Location (toNormalizedUri) +import Development.IDE.Core.FileStore (getUriContents) +import qualified Data.Text.Utf16.Rope.Mixed as Rope +import qualified Data.Text.IO as Text +import Development.IDE.Core.PluginUtils (useWithStaleE) +import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields(..), ParseCabalFile (..)) +import Development.IDE.Core.FileStore (getVersionedTextDoc) +data Log + = LogDidRename FilePath FilePath + | CabalRenameLog T.Text T.Text + deriving (Show) + +instance Pretty Log where + pretty = \case + LogDidRename oldFp newFp -> "Received rename info from:" <+> pretty oldFp <+> "to:" <+> pretty newFp + CabalRenameLog oldModulePath newModulePath -> "Executing rename of module from" <+> pretty oldModulePath <+> "to" <+> pretty newModulePath <+> "in cabal file." + +-------------------------------------------- +-- Rename module in cabal file +-------------------------------------------- + +renameHandler :: + forall m. + (MonadIO m) => + Recorder (WithPriority Log) -> + Shake.IdeState -> + ClientCapabilities -> + -- | the old file path, before the rename + FilePath -> + -- | the new file path, after the rename + FilePath -> + -- | the path to the cabal file, responsible for the renamed module + FilePath -> + Shake.IdeState -> + ExceptT PluginError m WorkspaceEdit +renameHandler recorder _ caps oldHaskellFilePath newHaskellFilePath cabalFilePath ideState = do + logWith recorder Info $ LogDidRename oldHaskellFilePath newHaskellFilePath + (contents, fields, gpd, verTxtDocId) <- runActionE "cabal-plugin.getUriContents" ideState $ do + let nuri = toNormalizedUri $ filePathToUri cabalFilePath + nfp = toNormalizedFilePath cabalFilePath + mContent <- lift $ getUriContents nuri + verTxtDocId <- + runActionE "cabalAdd.getVersionedTextDoc" ideState $ + lift $ + getVersionedTextDoc $ + TextDocumentIdentifier (filePathToUri cabalFilePath) + content <- case mContent of + Just content -> pure content + Nothing -> liftIO $ Rope.fromText <$> Text.readFile cabalFilePath + (fields, _) <- useWithStaleE ParseCabalFields nfp + (gpd, _) <- useWithStaleE ParseCabalFile nfp + pure (content, fields, gpd, verTxtDocId) + cabalFileEdit <- + applyModuleRenameToCabalFile + recorder + (caps, verTxtDocId) + oldHaskellFilePath + newHaskellFilePath + cabalFilePath + (T.encodeUtf8 $ Rope.toText $ contents) + fields + gpd + pure cabalFileEdit + +-- | Apply rename to the given cabal file +-- +-- Replaces the module name corresponding to the old file path with the +-- module name corresponding to the new file path in the given cabal file. +-- Fails if the cabal file cannot be parsed, the file paths cannot be parsed to module names +-- or no occurence of the module can be found in the cabal file. +applyModuleRenameToCabalFile :: + forall m. + (MonadIO m) => + Recorder (WithPriority Log) -> + (ClientCapabilities, VersionedTextDocumentIdentifier) -> + -- | the old file path before the rename + FilePath -> + -- | the new file path after the rename + FilePath -> + -- | the path to the cabal file, responsible for the renamed module + FilePath -> + -- | the responsible cabal file's contents + ByteString -> + -- | the responsible cabal file's fields + [Field Position] -> + GenericPackageDescription -> + ExceptT PluginError m WorkspaceEdit +applyModuleRenameToCabalFile recorder (caps, verTxtDocId) oldHaskellFilePath newHaskellFilePath cabalFilePath cnfOrigContents fields gpd = do + let pd = flattenPackageDescription gpd + compName <- resolveFileTargetE pd cabalFilePath oldHaskellFilePath + buildInfo <- resolveBuildInfoE pd compName + newModulePath <- toRelativeModulePathE (buildInfoToHsSourceDirs buildInfo) cabalFilePath newHaskellFilePath + oldModulePath <- toRelativeModulePathE (buildInfoToHsSourceDirs buildInfo) cabalFilePath oldHaskellFilePath + targetField <- resolveTargetFieldForComponentE pd oldModulePath compName buildInfo + newContents <- maybeToExceptT PluginStaleResolve $ hoistMaybe $ + executeRenameConfig (Add.validateChanges gpd) (renameConfig (Right $ compName) targetField oldModulePath newModulePath) + logWith recorder Info $ CabalRenameLog oldModulePath newModulePath + pure $ diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) IncludeDeletions + where + -- define renameConfig to pass to cabal-add + renameConfig compName targetField from to = RenameConfig + { cnfOrigContents = cnfOrigContents + , cnfFields = fields + , cnfComponent = compName + , cnfTargetField = targetField + , cnfRenameFrom = T.encodeUtf8 from + , cnfRenameTo = T.encodeUtf8 to + } + +-- | Determine the `TargetField` of the given module path +-- +-- Takes a module path and which component the module is a part of and returns whether the module is in the +-- exposed- or the other-modules field of the component. +-- If the module is in neither of the fields, returns Nothing. +findFieldForModule :: T.Text -> ComponentName -> PackageDescription -> BuildInfo -> Maybe Add.TargetField +findFieldForModule modulePath compName pd buildInfo = + let + exposedMods = case compName of + CLibName name -> + case name of + LMainLibName -> + Maybe.maybe [] exposedModules $ library pd + LSubLibName _ -> + concat $ Maybe.concatMapM (getExposedModulesForLib compName) $ subLibraries pd + _ -> [] + in + findInExposedModules exposedMods <|> findInOtherModules (otherModules buildInfo) + where + moduleName = Cabal.fromString (T.unpack modulePath) + + findInOtherModules mods = + Add.OtherModules <$ findInModules mods + + findInExposedModules mods = + Add.ExposedModules <$ findInModules mods + + findInModules mods = + guard $ moduleName `elem` mods + + getExposedModulesForLib :: ComponentName -> Library -> Maybe [Cabal.ModuleName] + getExposedModulesForLib compName lib = + case libName lib of + LSubLibName lName -> + case componentNameString compName of + Just unqualCompName -> if lName == unqualCompName then Just $ exposedModules lib else Nothing + _ -> Nothing + _ -> Nothing + + +--------------------------------------------------------- +-- Rule applications with shortcuts to plugin errors +--------------------------------------------------------- + +-- | Returns the `BuildInfo` for the given component name. +-- If the build info cannot be resolved, throws a PluginError. +resolveBuildInfoE :: Applicative m => PackageDescription -> ComponentName -> ExceptT PluginError m BuildInfo +resolveBuildInfoE pd compName = + maybeToExceptT PluginStaleResolve $ hoistMaybe $ lookupBuildTargetPackageDescription pd (Just compName) + +-- | Determines the `ComponentName` of the given file target. +-- Tries to resolve the file target's component name within the given cabal file. +-- If the component name cannot be uniquely resolved, throws a PluginError, +resolveFileTargetE :: MonadIO m => PackageDescription -> FilePath -> FilePath -> ExceptT PluginError m ComponentName +resolveFileTargetE pd cabalFilePath fileTarget = do + buildTargets <- liftIO $ getBuildTargets pd cabalFilePath fileTarget + case buildTargets of + [buildTarget] -> pure $ buildTargetComponentName buildTarget + [] -> throwE PluginStaleResolve -- todo maybe handle these two cases differently + _ -> throwE PluginStaleResolve + +-- | Returns the field a module name is contained in. +-- +-- Takes a module name and a component name and returns whether the module name is in exposed- or other-modules of that component. +-- If the module name cannot be found in either field, throws a PluginError. +resolveTargetFieldForComponentE :: Applicative m => PackageDescription -> T.Text -> ComponentName -> BuildInfo -> ExceptT PluginError m Add.TargetField +resolveTargetFieldForComponentE pd oldModulePath compName buildInfo = + maybeToExceptT PluginStaleResolve $ + hoistMaybe $ findFieldForModule oldModulePath compName pd buildInfo + +-- | Takes a list of source subdirectories, a cabal source path and a haskell filepath +-- and returns a path to the module in exposed module syntax. +-- +-- The path will be relative to one of the subdirectories, in case the module is contained within one of them. +-- If no module path can be resolved, throws a PluginError. +toRelativeModulePathE :: Applicative m => [FilePath] -> FilePath -> FilePath -> ExceptT PluginError m T.Text +toRelativeModulePathE sourceDirs cabalFilePath oldHaskellFilePath = + maybeToExceptT PluginStaleResolve $ hoistMaybe $ mkRelativeModulePathM sourceDirs cabalFilePath oldHaskellFilePath diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index b8cb7ce0d6..ead62517da 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Ide.Plugin.Cabal.Completion.CabalFields ( findStanzaForColumn , getModulesNames @@ -25,7 +27,10 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Tuple (swap) import qualified Distribution.Fields as Syntax +import Distribution.PackageDescription (LibraryName (LSubLibName), + mkUnqualComponentName) import qualified Distribution.Parsec.Position as Syntax +import Distribution.Types.ComponentName (ComponentName (CBenchName, CExeName, CFLibName, CLibName, CTestName)) import Ide.Plugin.Cabal.Completion.Types import qualified Language.LSP.Protocol.Types as LSP @@ -155,7 +160,6 @@ getOptionalSectionName (x:xs) = case x of Syntax.SecArgName _ name -> Just (T.decodeUtf8 name) _ -> getOptionalSectionName xs -type BuildTargetName = T.Text type ModuleName = T.Text -- | Given a cabal AST returns pairs of all respective target names @@ -186,18 +190,28 @@ type ModuleName = T.Text -- * @getModulesNames@ output: -- -- > [([Just "first-target", Just "second-target"], "Config")] -getModulesNames :: [Syntax.Field any] -> [([Maybe BuildTargetName], ModuleName)] +getModulesNames :: [Syntax.Field any] -> [([Maybe ComponentName], ModuleName)] getModulesNames fields = map swap $ groupSort rawModuleTargetPairs where rawModuleTargetPairs = concatMap getSectionModuleNames sections sections = getSectionsWithModules fields - getSectionModuleNames :: Syntax.Field any -> [(ModuleName, Maybe BuildTargetName)] - getSectionModuleNames (Syntax.Section _ secArgs fields) = map (, getArgsName secArgs) $ concatMap getFieldModuleNames fields + getSectionModuleNames :: Syntax.Field any -> [(ModuleName, Maybe ComponentName)] + getSectionModuleNames (Syntax.Section secName secArgs fields) = map (, getArgsName secName secArgs) $ concatMap getFieldModuleNames fields getSectionModuleNames _ = [] - getArgsName [Syntax.SecArgName _ name] = Just $ T.decodeUtf8 name - getArgsName _ = Nothing -- Can be only a main library, that has no name + getArgsName (Syntax.Name _ secName) [Syntax.SecArgName _ nameBs] = + let + name = mkUnqualComponentName $ T.unpack $ T.decodeUtf8 nameBs + in + case secName of + "library" -> Just $ CLibName $ LSubLibName name + "test-suite" -> Just $ CTestName name + "benchmark" -> Just $ CBenchName name + "executable" -> Just $ CExeName name + "foreign-library" -> Just $ CFLibName name + _ -> Nothing + getArgsName _ _ = Nothing -- Can be only a main library, that has no name -- since it's impossible to have multiple names for a build target getFieldModuleNames field@(Syntax.Field _ modules) = if getFieldName field == T.pack "exposed-modules" || diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs index 5137af2b08..7042c6597c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -9,25 +9,24 @@ module Ide.Plugin.Cabal.Definition where import Control.Lens ((^.)) import Control.Monad.Extra import Control.Monad.IO.Class +import Data.Foldable (asum) import Data.List (find) import qualified Data.Maybe as Maybe import qualified Data.Text as T import Development.IDE as D import Development.IDE.Core.PluginUtils import qualified Distribution.Fields as Syntax -import Distribution.PackageDescription (Benchmark (..), - BuildInfo (..), - Executable (..), - ForeignLib (..), +import Distribution.PackageDescription (Benchmark (Benchmark, benchmarkBuildInfo, benchmarkName), + BuildInfo (hsSourceDirs), + Executable (Executable, buildInfo, exeName), + ForeignLib (ForeignLib, foreignLibBuildInfo, foreignLibName), GenericPackageDescription, - Library (..), - LibraryName (LMainLibName, LSubLibName), + Library (Library, libBuildInfo, libName), PackageDescription (..), - TestSuite (..), - library, - unUnqualComponentName) + TestSuite (TestSuite, testBuildInfo, testName)) import Distribution.PackageDescription.Configuration (flattenPackageDescription) import qualified Distribution.Parsec.Position as Syntax +import Distribution.Types.ComponentName (ComponentName (..)) import Distribution.Utils.Generic (safeHead) import Distribution.Utils.Path (getSymbolicPath) import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields @@ -142,50 +141,48 @@ gotoModulesDefinition nfp gpd cursor fieldsOfInterest = do isModuleName (Just name) (_, moduleName) = name == moduleName isModuleName _ _ = False --- | Gives all `buildInfo`s given a target name. +-- | Gives all 'BuildInfo's given a target name. -- --- `Maybe buildTargetName` is provided, and if it's --- Nothing we assume, that it's a main library. --- Otherwise looks for the provided name. -lookupBuildTargetPackageDescription :: PackageDescription -> Maybe T.Text -> [BuildInfo] +-- Takes a @'Maybe' 'ComponentName'@ and looks for the coresponding Buildinfo if it is Just. +-- If Nothing is passed we assume that we are looking for a main library. +-- If no main library can be found, returns Nothing. +lookupBuildTargetPackageDescription :: PackageDescription -> Maybe ComponentName -> Maybe BuildInfo lookupBuildTargetPackageDescription (PackageDescription {..}) Nothing = case library of - Nothing -> [] -- Target is a main library but no main library was found - Just (Library {libBuildInfo}) -> [libBuildInfo] + Nothing -> Nothing -- Target is a main library but no main library was found + Just (Library {libBuildInfo}) -> Just libBuildInfo lookupBuildTargetPackageDescription (PackageDescription {..}) (Just buildTargetName) = - Maybe.catMaybes $ + asum $ + foldMap libraryNameLookup library : map executableNameLookup executables <> - map subLibraryNameLookup subLibraries <> + map libraryNameLookup subLibraries <> map foreignLibsNameLookup foreignLibs <> map testSuiteNameLookup testSuites <> map benchmarkNameLookup benchmarks where executableNameLookup :: Executable -> Maybe BuildInfo executableNameLookup (Executable {exeName, buildInfo}) = - if T.pack (unUnqualComponentName exeName) == buildTargetName + if CExeName exeName == buildTargetName then Just buildInfo else Nothing - subLibraryNameLookup :: Library -> Maybe BuildInfo - subLibraryNameLookup (Library {libName, libBuildInfo}) = - case libName of - (LSubLibName name) -> - if T.pack (unUnqualComponentName name) == buildTargetName - then Just libBuildInfo - else Nothing - LMainLibName -> Nothing + libraryNameLookup :: Library -> Maybe BuildInfo + libraryNameLookup (Library {libName, libBuildInfo}) = + if CLibName libName == buildTargetName + then Just libBuildInfo + else Nothing foreignLibsNameLookup :: ForeignLib -> Maybe BuildInfo foreignLibsNameLookup (ForeignLib {foreignLibName, foreignLibBuildInfo}) = - if T.pack (unUnqualComponentName foreignLibName) == buildTargetName + if CFLibName foreignLibName == buildTargetName then Just foreignLibBuildInfo else Nothing testSuiteNameLookup :: TestSuite -> Maybe BuildInfo testSuiteNameLookup (TestSuite {testName, testBuildInfo}) = - if T.pack (unUnqualComponentName testName) == buildTargetName + if CTestName testName == buildTargetName then Just testBuildInfo else Nothing benchmarkNameLookup :: Benchmark -> Maybe BuildInfo benchmarkNameLookup (Benchmark {benchmarkName, benchmarkBuildInfo}) = - if T.pack (unUnqualComponentName benchmarkName) == buildTargetName + if CBenchName benchmarkName == buildTargetName then Just benchmarkBuildInfo else Nothing diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index d22e6b6913..b94b0970ce 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -4,32 +4,36 @@ {-# 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 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) @@ -38,8 +42,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 (..), @@ -49,11 +55,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 @@ -65,11 +71,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 $ @@ -78,6 +86,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 @@ -107,6 +116,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 $ 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 @@ -261,6 +299,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, diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ModuleName.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ModuleName.hs index 530a8e0d85..ce9fbd1aa1 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ModuleName.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ModuleName.hs @@ -15,6 +15,8 @@ module Ide.Plugin.Rename.ModuleName ( codeLens, updateModuleNameCommand, command, + potentialModuleNames, + codeModuleName, ) where import Control.Monad (forM_, void) @@ -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) @@ -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 "." @@ -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 diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ModuleRename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ModuleRename.hs new file mode 100644 index 0000000000..5006db87f7 --- /dev/null +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ModuleRename.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +module Ide.Plugin.Rename.ModuleRename (renameModuleDeclaration, applyRenameToImports, Log(..)) where + +import Control.Lens (re) +import Control.Lens.Getter ((^.)) +import Control.Monad (guard, (<=<)) +import qualified Control.Monad.Extra as Maybe +import Control.Monad.Trans +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Maybe +import qualified Data.Maybe as Maybe +import qualified Data.Text as T +import Development.IDE (NormalizedFilePath) +import Development.IDE.Core.FileStore (getVersionedTextDocForNormalizedFilePath) +import Development.IDE.Core.PluginUtils (runActionE) +import Development.IDE.Core.PositionMapping (toCurrentRange) +import Development.IDE.Core.Rules hiding (Log) +import qualified Development.IDE.Core.Rules as Shake +import Development.IDE.Core.RuleTypes (GetModuleGraph (..)) +import qualified Development.IDE.Core.Shake as Shake +import qualified Development.IDE.GHC.Compat as GHC +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Error (realSrcSpanToRange, + srcSpanToRange) +import Development.IDE.Import.DependencyInformation (immediateReverseDependencies) +import Ide.Logger +import Ide.Plugin.Error +import Language.LSP.Protocol.Types (Range, + TextDocumentEdit (..), + TextEdit (..), + VersionedTextDocumentIdentifier, + WorkspaceEdit (..), + _versionedTextDocumentIdentifier, + fromNormalizedFilePath, + type (|?) (InL)) + +data Log + = CorrectNames [T.Text] + | LogRenameDependencies T.Text [NormalizedFilePath] + | NoModuleName NormalizedFilePath + | LogRenameModuleDeclaration NormalizedFilePath + deriving (Show) + +instance Pretty Log where + pretty log = + "ModuleRename." <> case log of + CorrectNames log -> "CorrectNames" <> colon <+> pretty log + LogRenameDependencies oldName fps -> "Rename of" <+> pretty oldName <+> "in files:" <+> (pretty $ map fromNormalizedFilePath fps) + NoModuleName nfp -> "Could not execute rename of" <+> pretty (fromNormalizedFilePath nfp) <+> "as no module path could be determined." + LogRenameModuleDeclaration nfp -> "Renaming module declaration for file" <+> pretty (fromNormalizedFilePath nfp) + +-- | Apply rename to the given module's declaration +-- +-- Rename the module in the given file's module declaration. +-- Fails if . +renameModuleDeclaration :: (MonadIO m) => Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> T.Text -> ExceptT PluginError m WorkspaceEdit +renameModuleDeclaration recorder ideState oldHaskellFilePath newModulePath = do + logWith recorder Info $ LogRenameModuleDeclaration oldHaskellFilePath + verTextDocId <- runActionE "cabal-plugin.getUriContents" ideState $ lift $ getVersionedTextDocForNormalizedFilePath $ oldHaskellFilePath + rangeToRename <- + maybeToExceptT PluginStaleResolve $ + MaybeT $ + liftIO $ + moduleNameRange ideState $ + oldHaskellFilePath + let + edit = mkTextEditInRange newModulePath verTextDocId rangeToRename + pure $ WorkspaceEdit Nothing (Just [InL edit]) Nothing + +-- | Apply rename to all imports of the given module +-- +-- Replaces all imports of the given old module name with the given new module name. +applyRenameToImports :: + (MonadIO m) => + Recorder (WithPriority Log) -> + IdeState -> + -- | The module name before the rename. + T.Text -> + -- | The new module name after the rename. + T.Text -> + -- | The old path to the renamed haskell file. + NormalizedFilePath -> + ExceptT e m WorkspaceEdit +applyRenameToImports recorder ideState oldModulePath newModulePath oldHaskellFilePath = do + moduleGraph <- runActionE "applyRenameToImports" ideState $ lift $ Shake.useNoFile_ GetModuleGraph + let + invertedDepsM = immediateReverseDependencies oldHaskellFilePath moduleGraph + case invertedDepsM of + Just depFilePaths -> do + logWith recorder Debug $ LogRenameDependencies oldModulePath depFilePaths + modImportRanges <- liftIO $ Maybe.mapMaybeM (getRangesForModuleImports ideState oldModulePath) depFilePaths + let + textEdits = concatMap (\(verTextDocId, ranges) -> map (mkTextEditInRange newModulePath verTextDocId) ranges) modImportRanges + pure $ WorkspaceEdit Nothing (Just $ map InL textEdits) Nothing + Nothing -> pure $ WorkspaceEdit Nothing Nothing Nothing + +-- | The module declaration range of the given file path + +-- | Determines all ranges in the given file where the module name is imported +-- +-- Returns the identifier of the file and a list of ranges of the imports if none of the rule applications fail. +-- Otherwise will return Nothing. +getRangesForModuleImports :: IdeState -> T.Text -> NormalizedFilePath -> IO (Maybe (VersionedTextDocumentIdentifier, [Range])) +getRangesForModuleImports state moduleName nfp = runMaybeT $ do + verTextDocId <- MaybeT . fmap Just $ runAction "cabal-plugin.getUriContents" state $ getVersionedTextDocForNormalizedFilePath nfp + (pm, mp) <- MaybeT . runAction "ModuleName.GetParsedModule" state $ Shake.useWithStale GetParsedModule nfp + let + allImports = hsmodImports . unLoc $ GHC.pm_parsed_source pm + modNameImports = + Maybe.mapMaybe + (\imp -> GHC.getLoc (ideclName $ GHC.unLoc imp) <$ guard ((== (mkModuleName $ T.unpack moduleName)) . GHC.unLoc . ideclName $ GHC.unLoc imp)) + allImports + pure $ (verTextDocId, Maybe.mapMaybe (toCurrentRange mp <=< srcSpanToRange) modNameImports) + +-- +-- Inspired by `codeModuleName` in the hls-module-name-plugin. +moduleNameRange :: Shake.IdeState -> NormalizedFilePath -> IO (Maybe Range) +moduleNameRange state nfp = runMaybeT $ do + (pm, mp) <- MaybeT . runAction "ModuleName.GetParsedModule" state $ Shake.useWithStale GetParsedModule nfp + L (locA -> (RealSrcSpan l _)) _ <- MaybeT . pure . hsmodName . unLoc $ GHC.pm_parsed_source pm + range <- MaybeT . pure $ toCurrentRange mp (realSrcSpanToRange l) + pure range + +mkTextEditInRange :: T.Text -> VersionedTextDocumentIdentifier -> Range -> TextDocumentEdit +mkTextEditInRange newText verTextDocId range = + TextDocumentEdit (verTextDocId ^. re _versionedTextDocumentIdentifier) $ fmap InL [TextEdit range newText]