diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml index 8aea5f8de4..69815a319e 100644 --- a/.github/workflows/hackage.yml +++ b/.github/workflows/hackage.yml @@ -33,7 +33,7 @@ jobs: "hls-class-plugin", "hls-eval-plugin", "hls-explicit-imports-plugin", "hls-haddock-comments-plugin", "hls-hlint-plugin", "hls-module-name-plugin", "hls-pragmas-plugin", - "hls-refine-imports-plugin", "hls-retrie-plugin", + "hls-refine-imports-plugin", "hls-rename-plugin", "hls-retrie-plugin", "hls-splice-plugin", "hls-tactics-plugin", "hls-call-hierarchy-plugin", "hls-alternate-number-format-plugin", "hls-qualify-imported-names-plugin", "hls-selection-range-plugin", diff --git a/docs/configuration.md b/docs/configuration.md index 5b37f6c290..e91bf55532 100644 --- a/docs/configuration.md +++ b/docs/configuration.md @@ -50,7 +50,7 @@ Here is a list of the additional settings currently supported by `haskell-langua Plugins have a generic config to control their behaviour. The schema of such config is: - `haskell.plugin.${pluginName}.globalOn`: usually with default true. Whether the plugin is enabled at runtime or it is not. That is the option you might use if you want to disable completely a plugin. - - Actual plugin names are: `ghcide-code-actions-fill-holes`, `ghcide-completions`, `ghcide-hover-and-symbols`, `ghcide-type-lenses`, `ghcide-code-actions-type-signatures`, `ghcide-code-actions-bindings`, `ghcide-code-actions-imports-exports`, `eval`, `moduleName`, `pragmas`, `refineImports`, `importLens`, `class`, `tactics` (aka wingman), `hlint`, `haddockComments`, `retrie`, `splice`. + - Actual plugin names are: `ghcide-code-actions-fill-holes`, `ghcide-completions`, `ghcide-hover-and-symbols`, `ghcide-type-lenses`, `ghcide-code-actions-type-signatures`, `ghcide-code-actions-bindings`, `ghcide-code-actions-imports-exports`, `eval`, `moduleName`, `pragmas`, `refineImports`, `importLens`, `class`, `tactics` (aka wingman), `hlint`, `haddockComments`, `retrie`, `rename`, `splice`. - So to disable the import lens with an explicit list of module definitions you could set `haskell.plugin.importLens.globalOn: false` - `haskell.plugin.${pluginName}.${lspCapability}On`: usually with default true. Whether a concrete plugin capability is enabled. - Capabilities are the different ways a lsp server can interact with the editor. The current available capabilities of the server are: `callHierarchy`, `codeActions`, `codeLens`, `diagnostics`, `hover`, `symbols`, `completion`, `rename`. @@ -66,6 +66,8 @@ Plugins have a generic config to control their behaviour. The schema of such con - `eval`: - `haskell.plugin.eval.config.diff`, default true: When reloading haddock test results in changes, mark it with WAS/NOW. - `haskell.plugin.eval.config.exception`, default false: When the command results in an exception, mark it with `*** Exception:`. + - `rename`: + - `haskell.plugin.rename.config.diff`, default false: Enables renaming across modules (experimental) - `ghcide-completions`: - `haskell.plugin.ghcide-completions.config.snippetsOn`, default true: Inserts snippets when using code completions. - `haskell.plugin.ghcide-completions.config.autoExtendOn`, default true: Extends the import list automatically when completing a out-of-scope identifier. diff --git a/docs/features.md b/docs/features.md index dfb0b6b516..74a686b8cd 100644 --- a/docs/features.md +++ b/docs/features.md @@ -19,6 +19,7 @@ Many of these are standard LSP features, but a lot of special features are provi | [Code actions](#code-actions) | `textDocument/codeAction` | | [Code lenses](#code-lenses) | `textDocument/codeLens` | | [Selection range](#selection-range) | `textDocument/selectionRange` | +| [Rename](#rename) | `textDocument/rename` | The individual sections below also identify which [HLS plugin](./what-is-hls.md#hls-plugins) is responsible for providing the given functionality, which is useful if you want to raise an issue report or contribute! Additionally, not all plugins are supported on all versions of GHC, see the [GHC version support page](supported-versions.md) for details. @@ -305,6 +306,18 @@ support. ![Selection range demo](https://user-images.githubusercontent.com/16440269/150301502-4c002605-9f8d-43f5-86d3-28846942c4ff.mov) +## Rename + +Provided by: `hls-rename-plugin` + +Provides renaming of symbols within a module. Experimental cross-module renaming can be enabled via the configuration. + +![Rename Demo](https://user-images.githubusercontent.com/30090176/133072143-d7d03ec7-3db1-474e-ad5e-6f40d75ff7ab.gif) + +Known limitations: + +- Cross-module renaming requires all components to be indexed, which sometimes causes [partial renames in multi-component projects](https://github.com/haskell/haskell-language-server/issues/2193). + ## Missing features The following features are supported by the LSP specification but not implemented in HLS. @@ -315,7 +328,6 @@ Contributions welcome! | Signature help | Unimplemented | `textDocument/signatureHelp` | | Jump to declaration | Unclear if useful | `textDocument/declaration` | | Jump to implementation | Unclear if useful | `textDocument/implementation` | -| Renaming | [Parital implementation](https://github.com/haskell/haskell-language-server/issues/2193) | `textDocument/rename`, `textDocument/prepareRename` | | Folding | Unimplemented | `textDocument/foldingRange` | | Semantic tokens | Unimplemented | `textDocument/semanticTokens` | | Linked editing | Unimplemented | `textDocument/linkedEditingRange` | diff --git a/docs/supported-versions.md b/docs/supported-versions.md index 7094fdc023..1376d5b382 100644 --- a/docs/supported-versions.md +++ b/docs/supported-versions.md @@ -49,6 +49,7 @@ Sometimes a plugin will be supported in the prebuilt binaries but not in a HLS b | `hls-pragmas-plugin` | | | `hls-qualify-imported-names-plugin` | | | `hls-refine-imports-plugin` | | +| `hls-rename-plugin` | | | `hls-retrie-plugin` | 9.2 | | `hls-splice-plugin` | 9.2 | | `hls-stylish-haskell-plugin` | 9.0, 9.2 | diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 599872cebe..0bdff4aa9b 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -17,7 +17,7 @@ module Development.IDE.Spans.AtPoint ( , computeTypeReferences , FOIReferences(..) , defRowToSymbolInfo - , getAstNamesAtPoint + , getNamesAtPoint , toCurrentLocation , rowToLoc ) where @@ -86,7 +86,7 @@ foiReferencesAtPoint file pos (FOIReferences asts) = case HM.lookup file asts of Nothing -> ([],[],[]) Just (HAR _ hf _ _ _,mapping) -> - let names = getAstNamesAtPoint hf pos mapping + let names = getNamesAtPoint hf pos mapping adjustedLocs = HM.foldr go [] asts go (HAR _ _ rf tr _, mapping) xs = refs ++ typerefs ++ xs where @@ -96,8 +96,8 @@ foiReferencesAtPoint file pos (FOIReferences asts) = $ concat $ mapMaybe (`M.lookup` tr) names in (names, adjustedLocs,map fromNormalizedFilePath $ HM.keys asts) -getAstNamesAtPoint :: HieASTs a -> Position -> PositionMapping -> [Name] -getAstNamesAtPoint hf pos mapping = +getNamesAtPoint :: HieASTs a -> Position -> PositionMapping -> [Name] +getNamesAtPoint hf pos mapping = concat $ pointCommand hf posFile (rights . M.keys . getNodeIds) where posFile = fromMaybe pos $ fromCurrentPosition mapping pos diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 13bc2de7a0..e1fe142e93 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -133,7 +133,7 @@ flag refineImports flag rename description: Enable rename plugin - default: False + default: True manual: True flag retrie diff --git a/plugins/hls-rename-plugin/hls-rename-plugin.cabal b/plugins/hls-rename-plugin/hls-rename-plugin.cabal index 9768c82f8a..9b6b7576e9 100644 --- a/plugins/hls-rename-plugin/hls-rename-plugin.cabal +++ b/plugins/hls-rename-plugin/hls-rename-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-rename-plugin -version: 1.0.0.1 +version: 1.0.0.2 synopsis: Rename plugin for Haskell Language Server description: Please see the README on GitHub at @@ -26,13 +26,16 @@ library , ghc , ghc-exactprint , ghcide ^>=1.6 + , hashable , hiedb , hls-plugin-api ^>=1.3 , lsp , lsp-types + , mod , syb , text , transformers + , unordered-containers default-language: Haskell2010 @@ -43,7 +46,10 @@ test-suite tests main-is: Main.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: + , aeson , base + , containers , filepath + , hls-plugin-api , hls-rename-plugin , hls-test-utils ^>=1.2 diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index b9ca9798ea..16273d268b 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -1,188 +1,251 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Ide.Plugin.Rename (descriptor) where +#if MIN_VERSION_ghc(9,2,1) +import GHC.Parser.Annotation (AnnContext, AnnList, AnnParen, AnnPragma) +#endif + import Control.Monad -import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Except -import Data.Containers.ListUtils import Data.Generics -import Data.List.Extra hiding (nubOrd, replace) -import qualified Data.Map as M +import Data.HashSet (HashSet) +import qualified Data.HashSet as HS +import Data.Hashable +import Data.List.Extra +import qualified Data.Map as M import Data.Maybe -import qualified Data.Text as T -import Development.IDE hiding (pluginHandlers) +import Data.Mod.Word +import qualified Data.Text as T import Development.IDE.Core.PositionMapping +import Development.IDE.Core.RuleTypes +import Development.IDE.Core.Service import Development.IDE.Core.Shake -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.ExactPrint +import Development.IDE.GHC.Compat.Parser +import Development.IDE.GHC.Compat.Units +import Development.IDE.GHC.Error +import Development.IDE.GHC.ExactPrint import Development.IDE.Spans.AtPoint -#if MIN_VERSION_ghc(9,2,1) -import GHC.Parser.Annotation (AnnContext, AnnList, - AnnParen, AnnPragma) -#endif -#if MIN_VERSION_ghc(9,0,1) -import GHC.Types.Name -#else -import Name -#endif -import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource)) +import Development.IDE.Types.Location import HieDb.Query import Ide.Plugin.Config +import Ide.Plugin.Properties import Ide.PluginUtils import Ide.Types -import Language.Haskell.GHC.ExactPrint import Language.LSP.Server import Language.LSP.Types +instance Hashable Location +instance Hashable Range +instance Hashable Position +instance Hashable UInt +instance Hashable (Mod a) where hash n = hash (unMod n) + descriptor :: PluginId -> PluginDescriptor IdeState -descriptor pluginId = (defaultPluginDescriptor pluginId) { - pluginHandlers = mkPluginHandler STextDocumentRename renameProvider -} +descriptor pluginId = (defaultPluginDescriptor pluginId) + { pluginHandlers = mkPluginHandler STextDocumentRename renameProvider + , pluginConfigDescriptor = defaultConfigDescriptor + { configCustomConfig = mkCustomConfig properties } + } renameProvider :: PluginMethodHandler IdeState TextDocumentRename renameProvider state pluginId (RenameParams (TextDocumentIdentifier uri) pos _prog newNameText) = response $ do nfp <- safeUriToNfp uri oldName <- getNameAtPos state nfp pos - workspaceRefs <- refsAtName state nfp oldName - let filesRefs = groupOn locToUri workspaceRefs - getFileEdits = ap (getSrcEdits state . renameModRefs newNameText) (locToUri . head) - fileEdits <- mapM getFileEdits filesRefs + refLocs <- refsAtName state nfp oldName + crossModuleEnabled <- lift $ usePropertyLsp #crossModule pluginId properties + unless crossModuleEnabled $ failWhenImportOrExport state nfp refLocs oldName + when (isBuiltInSyntax oldName) $ + throwE ("Invalid rename of built-in syntax: \"" ++ showName oldName ++ "\"") + let newName = mkTcOcc $ T.unpack newNameText + filesRefs = collectWith locToUri refLocs + getFileEdit = flip $ getSrcEdit state . renameRefs newName + fileEdits <- mapM (uncurry getFileEdit) filesRefs pure $ foldl' (<>) mempty fileEdits -------------------------------------------------------------------------------- +-- | Limit renaming across modules. +failWhenImportOrExport :: + (MonadLsp config m) => + IdeState -> + NormalizedFilePath -> + HashSet Location -> + Name -> + ExceptT String m () +failWhenImportOrExport state nfp refLocs name = do + pm <- handleMaybeM ("No parsed module for: " ++ show nfp) $ liftIO $ runAction + "Rename.GetParsedModule" + state + (use GetParsedModule nfp) + let hsMod = unLoc $ pm_parsed_source pm + case (unLoc <$> hsmodName hsMod, hsmodExports hsMod) of + (mbModName, _) | not $ nameIsLocalOrFrom (replaceModName name mbModName) name + -> throwE "Renaming of an imported name is unsupported" + (_, Just (L _ exports)) | any ((`HS.member` refLocs) . unsafeSrcSpanToLoc . getLoc) exports + -> throwE "Renaming of an exported name is unsupported" + (Just _, Nothing) -> throwE "Explicit export list required for renaming" + _ -> pure () + +--------------------------------------------------------------------------------------------------- -- Source renaming --- | Compute a `WorkspaceEdit` by applying a given function to the `ParsedModule` for a given `Uri`. -getSrcEdits :: +-- | Apply a function to a `ParsedSource` for a given `Uri` to compute a `WorkspaceEdit`. +getSrcEdit :: (MonadLsp config m) => IdeState -> -#if MIN_VERSION_ghc(9,0,1) - (HsModule -> HsModule) -> -#else - (HsModule GhcPs -> HsModule GhcPs) -> -#endif + (ParsedSource -> ParsedSource) -> Uri -> ExceptT String m WorkspaceEdit -getSrcEdits state updateMod uri = do +getSrcEdit state updatePs uri = do ccs <- lift getClientCapabilities nfp <- safeUriToNfp uri - annotatedAst <- - handleMaybeM "Error: could not get parsed source" $ liftIO $ runAction - "Rename.GetParsedModuleWithComments" - state - (use GetAnnotatedParsedSource nfp) - let (ps, anns) = (astA annotatedAst, annsA annotatedAst) + annAst <- handleMaybeM ("No parsed source for: " ++ show nfp) $ liftIO $ runAction + "Rename.GetAnnotatedParsedSource" + state + (use GetAnnotatedParsedSource nfp) + let (ps, anns) = (astA annAst, annsA annAst) #if !MIN_VERSION_ghc(9,2,1) let src = T.pack $ exactPrint ps anns - res = T.pack $ exactPrint (updateMod <$> ps) anns + res = T.pack $ exactPrint (updatePs ps) anns #else let src = T.pack $ exactPrint ps - res = T.pack $ exactPrint (updateMod <$> ps) + res = T.pack $ exactPrint (updatePs ps) #endif - pure $ diffText ccs (uri, src) res IncludeDeletions --- | Replace a name at every given `Location` (in a given `HsModule`) with a given new name. -renameModRefs :: - T.Text -> - [Location] -> -#if MIN_VERSION_ghc(9,0,1) - HsModule - -> HsModule -#else - HsModule GhcPs - -> HsModule GhcPs -#endif +-- | Replace names at every given `Location` (in a given `ParsedSource`) with a given new name. +renameRefs :: + OccName -> + HashSet Location -> + ParsedSource -> + ParsedSource #if MIN_VERSION_ghc(9,2,1) -renameModRefs newNameText refs = everywhere $ +renameRefs newName refs = everywhere $ -- there has to be a better way... - mkT (replace @AnnListItem) `extT` - -- replace @AnnList `extT` -- not needed - -- replace @AnnParen `extT` -- not needed - -- replace @AnnPragma `extT` -- not needed - -- replace @AnnContext `extT` -- not needed - -- replace @NoEpAnns `extT` -- not needed - replace @NameAnn + mkT (replaceLoc @AnnListItem) `extT` + -- replaceLoc @AnnList `extT` -- not needed + -- replaceLoc @AnnParen `extT` -- not needed + -- replaceLoc @AnnPragma `extT` -- not needed + -- replaceLoc @AnnContext `extT` -- not needed + -- replaceLoc @NoEpAnns `extT` -- not needed + replaceLoc @NameAnn where - replace :: forall an. Typeable an => LocatedAn an RdrName -> LocatedAn an RdrName - replace (L srcSpan oldRdrName) - | isRef (locA srcSpan) = L srcSpan $ newRdrName oldRdrName - replace lOldRdrName = lOldRdrName + replaceLoc :: forall an. Typeable an => LocatedAn an RdrName -> LocatedAn an RdrName + replaceLoc (L srcSpan oldRdrName) + | isRef (locA srcSpan) = L srcSpan $ replace oldRdrName + replaceLoc lOldRdrName = lOldRdrName #else -renameModRefs newNameText refs = everywhere $ mkT replace +renameRefs newName refs = everywhere $ mkT replaceLoc where - replace :: Located RdrName -> Located RdrName - replace (L srcSpan oldRdrName) - | isRef srcSpan = L srcSpan $ newRdrName oldRdrName - replace lOldRdrName = lOldRdrName + replaceLoc :: Located RdrName -> Located RdrName + replaceLoc (L srcSpan oldRdrName) + | isRef srcSpan = L srcSpan $ replace oldRdrName + replaceLoc lOldRdrName = lOldRdrName #endif - isRef :: SrcSpan -> Bool - isRef = (`elem` refs) . fromJust . srcSpanToLocation + replace :: RdrName -> RdrName + replace (Qual modName _) = Qual modName newName + replace _ = Unqual newName - newRdrName :: RdrName -> RdrName - newRdrName oldRdrName = case oldRdrName of - Qual modName _ -> Qual modName newOccName - _ -> Unqual newOccName + isRef :: SrcSpan -> Bool + isRef = (`elem` refs) . unsafeSrcSpanToLoc - newOccName = mkTcOcc $ T.unpack newNameText -------------------------------------------------------------------------------- +--------------------------------------------------------------------------------------------------- -- Reference finding -- | Note: We only find exact name occurences (i.e. type reference "depth" is 0). -refsAtName :: IdeState -> NormalizedFilePath -> Name -> ExceptT [Char] (LspT Config IO) [Location] +refsAtName :: + MonadIO m => + IdeState -> + NormalizedFilePath -> + Name -> + ExceptT String m (HashSet Location) refsAtName state nfp name = do ShakeExtras{withHieDb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras ast <- safeGetHieAst state nfp - astRefs <- handleMaybe "Error: Could not get name AST references" $ getNameAstLocations name ast dbRefs <- case nameModule_maybe name of Nothing -> pure [] - Just mod -> liftIO $ mapMaybe rowToLoc <$> - withHieDb (\hieDb -> - findReferences - hieDb - True - (nameOccName name) - (Just $ moduleName mod) - (Just $ moduleUnit mod) - [fromNormalizedFilePath nfp] - ) - pure $ nubOrd $ astRefs ++ dbRefs - -getNameAstLocations :: Name -> (HieAstResult, PositionMapping) -> Maybe [Location] -getNameAstLocations name (HAR _ _ rm _ _, mapping) = - mapMaybe (toCurrentLocation mapping . realSrcSpanToLocation . fst) <$> M.lookup (Right name) rm - -------------------------------------------------------------------------------- + Just mod -> liftIO $ mapMaybe rowToLoc <$> withHieDb (\hieDb -> + findReferences + hieDb + True + (nameOccName name) + (Just $ moduleName mod) + (Just $ moduleUnit mod) + [fromNormalizedFilePath nfp] + ) + pure $ HS.fromList $ getNameLocs name ast ++ dbRefs + +getNameLocs :: Name -> (HieAstResult, PositionMapping) -> [Location] +getNameLocs name (HAR _ _ rm _ _, pm) = + mapMaybe (toCurrentLocation pm . realSrcSpanToLocation . fst) + (concat $ M.lookup (Right name) rm) + +--------------------------------------------------------------------------------------------------- -- Util getNameAtPos :: IdeState -> NormalizedFilePath -> Position -> ExceptT String (LspT Config IO) Name getNameAtPos state nfp pos = do - (HAR{hieAst}, mapping) <- safeGetHieAst state nfp - handleMaybe "Error: could not find name at position" $ listToMaybe $ - getAstNamesAtPoint hieAst pos mapping - -nfpToUri :: NormalizedFilePath -> Uri -nfpToUri = filePathToUri . fromNormalizedFilePath - -safeUriToNfp :: (Monad m) => Uri -> ExceptT String m NormalizedFilePath -safeUriToNfp = handleMaybe "Error: Could not get uri" . fmap toNormalizedFilePath . uriToFilePath + (HAR{hieAst}, pm) <- safeGetHieAst state nfp + handleMaybe ("No name at " ++ showPos pos) $ listToMaybe $ getNamesAtPoint hieAst pos pm safeGetHieAst :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m (HieAstResult, PositionMapping) -safeGetHieAst state = handleMaybeM "Error: Could not get AST" . liftIO . - runAction "Rename.GetHieAst" state . useWithStale GetHieAst +safeGetHieAst state nfp = handleMaybeM + ("No AST for file: " ++ show nfp) + (liftIO $ runAction "Rename.GetHieAst" state $ useWithStale GetHieAst nfp) + +safeUriToNfp :: (Monad m) => Uri -> ExceptT String m NormalizedFilePath +safeUriToNfp uri = handleMaybe + ("No filepath for uri: " ++ show uri) + (toNormalizedFilePath <$> uriToFilePath uri) + +-- head is safe since groups are non-empty +collectWith :: (Hashable a, Eq a, Eq b) => (a -> b) -> HashSet a -> [(b, HashSet a)] +collectWith f = map (\a -> (f $ head a, HS.fromList a)) . groupOn f . HS.toList locToUri :: Location -> Uri locToUri (Location uri _) = uri + +nfpToUri :: NormalizedFilePath -> Uri +nfpToUri = filePathToUri . fromNormalizedFilePath + +showName :: Name -> String +showName = occNameString . getOccName + +showPos :: Position -> String +showPos Position{_line, _character} = "line: " ++ show _line ++ " - character: " ++ show _character + +unsafeSrcSpanToLoc :: SrcSpan -> Location +unsafeSrcSpanToLoc srcSpan = + case srcSpanToLocation srcSpan of + Nothing -> error "Invalid conversion from UnhelpfulSpan to Location" + Just location -> location + +replaceModName :: Name -> Maybe ModuleName -> Module +replaceModName name mbModName = + mkModule (moduleUnit $ nameModule name) (fromMaybe (mkModuleName "Main") mbModName) + +--------------------------------------------------------------------------------------------------- +-- Config + +properties :: Properties '[ 'PropertyKey "crossModule" 'TBoolean] +properties = emptyProperties + & defineBooleanProperty #crossModule + "Enable experimental cross-module renaming" False diff --git a/plugins/hls-rename-plugin/test/Main.hs b/plugins/hls-rename-plugin/test/Main.hs index 31baec621c..66bcea6222 100644 --- a/plugins/hls-rename-plugin/test/Main.hs +++ b/plugins/hls-rename-plugin/test/Main.hs @@ -2,6 +2,9 @@ module Main (main) where +import Data.Aeson +import qualified Data.Map as M +import Ide.Plugin.Config import qualified Ide.Plugin.Rename as Rename import System.FilePath import Test.Hls @@ -14,47 +17,51 @@ renamePlugin = Rename.descriptor "rename" tests :: TestTree tests = testGroup "Rename" - [ goldenWithRename "Data constructor" "DataConstructor" $ \doc -> do + [ goldenWithRename "Data constructor" "DataConstructor" $ \doc -> rename doc (Position 0 15) "Op" - , goldenWithRename "Exported function" "ExportedFunction" $ \doc -> do + , goldenWithRename "Exported function" "ExportedFunction" $ \doc -> rename doc (Position 2 1) "quux" - , goldenWithRename "Function argument" "FunctionArgument" $ \doc -> do + , goldenWithRename "Function argument" "FunctionArgument" $ \doc -> rename doc (Position 3 4) "y" - , goldenWithRename "Function name" "FunctionName" $ \doc -> do + , goldenWithRename "Function name" "FunctionName" $ \doc -> rename doc (Position 3 1) "baz" - , goldenWithRename "GADT" "Gadt" $ \doc -> do + , goldenWithRename "GADT" "Gadt" $ \doc -> rename doc (Position 6 37) "Expr" - , goldenWithRename "Hidden function" "HiddenFunction" $ \doc -> do + , goldenWithRename "Hidden function" "HiddenFunction" $ \doc -> rename doc (Position 0 32) "quux" - , goldenWithRename "Imported function" "ImportedFunction" $ \doc -> do + , goldenWithRename "Imported function" "ImportedFunction" $ \doc -> rename doc (Position 3 8) "baz" - , goldenWithRename "Import hiding" "ImportHiding" $ \doc -> do + , goldenWithRename "Import hiding" "ImportHiding" $ \doc -> rename doc (Position 0 22) "hiddenFoo" - , goldenWithRename "Let expression" "LetExpression" $ \doc -> do + , goldenWithRename "Let expression" "LetExpression" $ \doc -> rename doc (Position 5 11) "foobar" - , goldenWithRename "Qualified as" "QualifiedAs" $ \doc -> do + , goldenWithRename "Qualified as" "QualifiedAs" $ \doc -> rename doc (Position 3 10) "baz" - , goldenWithRename "Qualified shadowing" "QualifiedShadowing" $ \doc -> do + , goldenWithRename "Qualified shadowing" "QualifiedShadowing" $ \doc -> rename doc (Position 3 12) "foobar" - , goldenWithRename "Qualified function" "QualifiedFunction" $ \doc -> do + , goldenWithRename "Qualified function" "QualifiedFunction" $ \doc -> rename doc (Position 3 12) "baz" - , goldenWithRename "Realigns do block indentation" "RealignDo" $ \doc -> do + , goldenWithRename "Realigns do block indentation" "RealignDo" $ \doc -> rename doc (Position 0 2) "fooBarQuux" - , goldenWithRename "Record field" "RecordField" $ \doc -> do + , goldenWithRename "Record field" "RecordField" $ \doc -> rename doc (Position 6 9) "number" - , goldenWithRename "Shadowed name" "ShadowedName" $ \doc -> do + , goldenWithRename "Shadowed name" "ShadowedName" $ \doc -> rename doc (Position 1 1) "baz" - , goldenWithRename "Typeclass" "Typeclass" $ \doc -> do + , goldenWithRename "Typeclass" "Typeclass" $ \doc -> rename doc (Position 8 15) "Equal" - , goldenWithRename "Type constructor" "TypeConstructor" $ \doc -> do + , goldenWithRename "Type constructor" "TypeConstructor" $ \doc -> rename doc (Position 2 17) "BinaryTree" - , goldenWithRename "Type variable" "TypeVariable" $ \doc -> do + , goldenWithRename "Type variable" "TypeVariable" $ \doc -> rename doc (Position 0 13) "b" ] -goldenWithRename :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithRename title path = - goldenWithHaskellDoc renamePlugin title testDataDir path "expected" "hs" +goldenWithRename :: TestName-> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree +goldenWithRename title path act = + goldenWithHaskellDoc renamePlugin title testDataDir path "expected" "hs" $ \doc -> do + sendConfigurationChanged $ toJSON $ + def { plugins = M.fromList [("rename", def { plcConfig = "crossModule" .= True })] } + act doc + testDataDir :: FilePath testDataDir = "test" "testdata" diff --git a/plugins/hls-rename-plugin/test/testdata/FunctionArgument.expected.hs b/plugins/hls-rename-plugin/test/testdata/FunctionArgument.expected.hs index bd8d83b334..bc10997ece 100644 --- a/plugins/hls-rename-plugin/test/testdata/FunctionArgument.expected.hs +++ b/plugins/hls-rename-plugin/test/testdata/FunctionArgument.expected.hs @@ -1,4 +1,4 @@ -module FunctionArgument where +module FunctionArgument () where foo :: Int -> Int foo y = y + 1 diff --git a/plugins/hls-rename-plugin/test/testdata/FunctionArgument.hs b/plugins/hls-rename-plugin/test/testdata/FunctionArgument.hs index a6006e6fac..d318cd80c4 100644 --- a/plugins/hls-rename-plugin/test/testdata/FunctionArgument.hs +++ b/plugins/hls-rename-plugin/test/testdata/FunctionArgument.hs @@ -1,4 +1,4 @@ -module FunctionArgument where +module FunctionArgument () where foo :: Int -> Int foo x = x + 1 diff --git a/plugins/hls-rename-plugin/test/testdata/LetExpression.expected.hs b/plugins/hls-rename-plugin/test/testdata/LetExpression.expected.hs index 437fac2c96..213b49c20f 100644 --- a/plugins/hls-rename-plugin/test/testdata/LetExpression.expected.hs +++ b/plugins/hls-rename-plugin/test/testdata/LetExpression.expected.hs @@ -1,4 +1,4 @@ -module Let where +module Let () where import Foo diff --git a/plugins/hls-rename-plugin/test/testdata/LetExpression.hs b/plugins/hls-rename-plugin/test/testdata/LetExpression.hs index cbd5868de6..ec9f58bcea 100644 --- a/plugins/hls-rename-plugin/test/testdata/LetExpression.hs +++ b/plugins/hls-rename-plugin/test/testdata/LetExpression.hs @@ -1,4 +1,4 @@ -module Let where +module Let () where import Foo diff --git a/plugins/hls-rename-plugin/test/testdata/Typeclass.expected.hs b/plugins/hls-rename-plugin/test/testdata/Typeclass.expected.hs index 73199ec83e..6a021a3a52 100644 --- a/plugins/hls-rename-plugin/test/testdata/Typeclass.expected.hs +++ b/plugins/hls-rename-plugin/test/testdata/Typeclass.expected.hs @@ -1,4 +1,4 @@ -module Typeclass where +module Typeclass () where class Equal a where equals :: a -> a -> Bool diff --git a/plugins/hls-rename-plugin/test/testdata/Typeclass.hs b/plugins/hls-rename-plugin/test/testdata/Typeclass.hs index 57667128dd..b92a591321 100644 --- a/plugins/hls-rename-plugin/test/testdata/Typeclass.hs +++ b/plugins/hls-rename-plugin/test/testdata/Typeclass.hs @@ -1,4 +1,4 @@ -module Typeclass where +module Typeclass () where class Equality a where equals :: a -> a -> Bool diff --git a/stack-8.10.6.yaml b/stack-8.10.6.yaml index c7b8c521d3..f3641d1044 100644 --- a/stack-8.10.6.yaml +++ b/stack-8.10.6.yaml @@ -18,6 +18,7 @@ packages: - ./plugins/hls-explicit-imports-plugin - ./plugins/hls-refine-imports-plugin - ./plugins/hls-hlint-plugin + - ./plugins/hls-rename-plugin - ./plugins/hls-retrie-plugin - ./plugins/hls-splice-plugin - ./plugins/hls-tactics-plugin diff --git a/stack-8.10.7.yaml b/stack-8.10.7.yaml index d38a3e874c..ced3a1a646 100644 --- a/stack-8.10.7.yaml +++ b/stack-8.10.7.yaml @@ -19,6 +19,7 @@ packages: - ./plugins/hls-explicit-imports-plugin - ./plugins/hls-refine-imports-plugin - ./plugins/hls-hlint-plugin + - ./plugins/hls-rename-plugin - ./plugins/hls-retrie-plugin - ./plugins/hls-splice-plugin - ./plugins/hls-tactics-plugin diff --git a/stack.yaml b/stack.yaml index 5f4d0a972e..f4551e9ac4 100644 --- a/stack.yaml +++ b/stack.yaml @@ -19,6 +19,7 @@ packages: - ./plugins/hls-explicit-imports-plugin - ./plugins/hls-refine-imports-plugin - ./plugins/hls-hlint-plugin + - ./plugins/hls-rename-plugin - ./plugins/hls-retrie-plugin - ./plugins/hls-splice-plugin - ./plugins/hls-tactics-plugin