hls-rename-plugin 1.0.0.2 → 1.0.1.0

raw patch · 8 files changed

+116/−50 lines, 8 filesdep +hls-refactor-plugindep ~ghcidedep ~hls-plugin-apidep ~hls-test-utilsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hls-refactor-plugin

Dependency ranges changed: ghcide, hls-plugin-api, hls-test-utils

API changes (from Hackage documentation)

Files

• hls-rename-plugin.cabal +13/−4
• src/Ide/Plugin/Rename.hs +56/−44
• test/Main.hs +13/−2
• test/testdata/FieldPuns.expected.hs +8/−0
• test/testdata/FieldPuns.hs +8/−0
• test/testdata/IndirectPuns.expected.hs +8/−0
• test/testdata/IndirectPuns.hs +8/−0
• test/testdata/hie.yaml +2/−0

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               hls-rename-plugin-version:            1.0.0.2+version:            1.0.1.0 synopsis:           Rename plugin for Haskell Language Server description:   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -17,6 +17,10 @@   test/testdata/*.yaml  library+  if impl(ghc >= 9.3)+    buildable: False+  else+    buildable: True   exposed-modules:  Ide.Plugin.Rename   hs-source-dirs:   src   build-depends:@@ -25,10 +29,11 @@     , extra     , ghc     , ghc-exactprint-    , ghcide                ^>= 1.6 || ^>=1.7+    , ghcide                ^>=1.8     , hashable     , hiedb-    , hls-plugin-api        ^>= 1.3 || ^>=1.4+    , hls-plugin-api        ^>= 1.3 || ^>=1.4 || ^>= 1.5+    , hls-refactor-plugin     , lsp     , lsp-types     , mod@@ -40,6 +45,10 @@   default-language: Haskell2010  test-suite tests+  if impl(ghc >= 9.3)+    buildable: False+  else+    buildable: True   type:             exitcode-stdio-1.0   default-language: Haskell2010   hs-source-dirs:   test@@ -52,4 +61,4 @@     , filepath     , hls-plugin-api     , hls-rename-plugin-    , hls-test-utils             ^>=1.3+    , hls-test-utils             ^>=1.4

@@ -12,7 +12,8 @@ module Ide.Plugin.Rename (descriptor) where  #if MIN_VERSION_ghc(9,2,1)-import           GHC.Parser.Annotation                 (AnnContext, AnnList, AnnParen, AnnPragma)+import           GHC.Parser.Annotation                 (AnnContext, AnnList,+                                                        AnnParen, AnnPragma) #endif  import           Control.Monad@@ -20,14 +21,15 @@ import           Control.Monad.Trans.Class import           Control.Monad.Trans.Except import           Data.Generics+import           Data.Hashable import           Data.HashSet                          (HashSet) import qualified Data.HashSet                          as HS-import           Data.Hashable-import           Data.List.Extra+import           Data.List.Extra                       hiding (length) import qualified Data.Map                              as M import           Data.Maybe import           Data.Mod.Word import qualified Data.Text                             as T+import           Development.IDE                      (Recorder, WithPriority) import           Development.IDE.Core.PositionMapping import           Development.IDE.Core.RuleTypes import           Development.IDE.Core.Service@@ -38,24 +40,21 @@ import           Development.IDE.GHC.Compat.Units import           Development.IDE.GHC.Error import           Development.IDE.GHC.ExactPrint+import qualified Development.IDE.GHC.ExactPrint       as E import           Development.IDE.Spans.AtPoint import           Development.IDE.Types.Location+import           Development.IDE.Plugin.CodeAction import           HieDb.Query-import           Ide.Plugin.Config import           Ide.Plugin.Properties import           Ide.PluginUtils import           Ide.Types 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)+descriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState+descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $ (defaultPluginDescriptor pluginId)     { pluginHandlers = mkPluginHandler STextDocumentRename renameProvider     , pluginConfigDescriptor = defaultConfigDescriptor         { configCustomConfig = mkCustomConfig properties }@@ -63,17 +62,29 @@  renameProvider :: PluginMethodHandler IdeState TextDocumentRename renameProvider state pluginId (RenameParams (TextDocumentIdentifier uri) pos _prog newNameText) =-    response $ do-        nfp <- safeUriToNfp uri-        oldName <- getNameAtPos state nfp pos-        refLocs <- refsAtName state nfp oldName+    pluginResponse $ do+        nfp <- handleUriToNfp uri+        directOldNames <- getNamesAtPos state nfp pos+        directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames++        {- References in HieDB are not necessarily transitive. With `NamedFieldPuns`, we can have+           indirect references through punned names. To find the transitive closure, we do a pass of+           the direct references to find the references for any punned names.+           See the `IndirectPuns` test for an example. -}+        indirectOldNames <- concat . filter ((>1) . Prelude.length) <$>+            mapM (uncurry (getNamesAtPos state) . locToFilePos) directRefs+        let oldNames = indirectOldNames ++ directOldNames+        refs <- HS.fromList . concat <$> mapM (refsAtName state nfp) oldNames++        -- Validate rename         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 ++ "\"")+        unless crossModuleEnabled $ failWhenImportOrExport state nfp refs oldNames+        when (any isBuiltInSyntax oldNames) $ throwE "Invalid rename of built-in syntax"++        -- Perform rename         let newName = mkTcOcc $ T.unpack newNameText-            filesRefs = collectWith locToUri refLocs-            getFileEdit = flip $ getSrcEdit state . renameRefs newName+            filesRefs = collectWith locToUri refs+            getFileEdit = flip $ getSrcEdit state . replaceRefs newName         fileEdits <- mapM (uncurry getFileEdit) filesRefs         pure $ foldl' (<>) mempty fileEdits @@ -83,16 +94,16 @@     IdeState ->     NormalizedFilePath ->     HashSet Location ->-    Name ->+    [Name] ->     ExceptT String m ()-failWhenImportOrExport state nfp refLocs name = do+failWhenImportOrExport state nfp refLocs names = 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+        (mbModName, _) | not $ any (\n -> nameIsLocalOrFrom (replaceModName n mbModName) n) names             -> 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"@@ -111,7 +122,7 @@     ExceptT String m WorkspaceEdit getSrcEdit state updatePs uri = do     ccs <- lift getClientCapabilities-    nfp <- safeUriToNfp uri+    nfp <- handleUriToNfp uri     annAst <- handleMaybeM ("No parsed source for: " ++ show nfp) $ liftIO $ runAction         "Rename.GetAnnotatedParsedSource"         state@@ -127,13 +138,13 @@     pure $ diffText ccs (uri, src) res IncludeDeletions  -- | Replace names at every given `Location` (in a given `ParsedSource`) with a given new name.-renameRefs ::+replaceRefs ::     OccName ->     HashSet Location ->     ParsedSource ->     ParsedSource #if MIN_VERSION_ghc(9,2,1)-renameRefs newName refs = everywhere $+replaceRefs newName refs = everywhere $     -- there has to be a better way...     mkT (replaceLoc @AnnListItem) `extT`     -- replaceLoc @AnnList `extT` -- not needed@@ -148,20 +159,19 @@             | isRef (locA srcSpan) = L srcSpan $ replace oldRdrName         replaceLoc lOldRdrName = lOldRdrName #else-renameRefs newName refs = everywhere $ mkT replaceLoc+replaceRefs newName refs = everywhere $ mkT replaceLoc     where         replaceLoc :: Located RdrName -> Located RdrName         replaceLoc (L srcSpan oldRdrName)             | isRef srcSpan = L srcSpan $ replace oldRdrName         replaceLoc lOldRdrName = lOldRdrName #endif-         replace :: RdrName -> RdrName         replace (Qual modName _) = Qual modName newName         replace _                = Unqual newName          isRef :: SrcSpan -> Bool-        isRef = (`elem` refs) . unsafeSrcSpanToLoc+        isRef = (`HS.member` refs) . unsafeSrcSpanToLoc  --------------------------------------------------------------------------------------------------- -- Reference finding@@ -172,10 +182,10 @@     IdeState ->     NormalizedFilePath ->     Name ->-    ExceptT String m (HashSet Location)+    ExceptT String m [Location] refsAtName state nfp name = do     ShakeExtras{withHieDb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras-    ast <- safeGetHieAst state nfp+    ast <- handleGetHieAst state nfp     dbRefs <- case nameModule_maybe name of         Nothing -> pure []         Just mod -> liftIO $ mapMaybe rowToLoc <$> withHieDb (\hieDb ->@@ -187,32 +197,32 @@                 (Just $ moduleUnit mod)                 [fromNormalizedFilePath nfp]             )-    pure $ HS.fromList $ getNameLocs name ast ++ dbRefs+    pure $ nameLocs name ast ++ dbRefs -getNameLocs :: Name -> (HieAstResult, PositionMapping) -> [Location]-getNameLocs name (HAR _ _ rm _ _, pm) =+nameLocs :: Name -> (HieAstResult, PositionMapping) -> [Location]+nameLocs 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}, pm) <- safeGetHieAst state nfp-    handleMaybe ("No name at " ++ showPos pos) $ listToMaybe $ getNamesAtPoint hieAst pos pm+getNamesAtPos :: MonadIO m => IdeState -> NormalizedFilePath -> Position -> ExceptT String m [Name]+getNamesAtPos state nfp pos = do+    (HAR{hieAst}, pm) <- handleGetHieAst state nfp+    pure $ getNamesAtPoint hieAst pos pm -safeGetHieAst ::+handleGetHieAst ::     MonadIO m =>     IdeState ->     NormalizedFilePath ->     ExceptT String m (HieAstResult, PositionMapping)-safeGetHieAst state nfp = handleMaybeM+handleGetHieAst 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+handleUriToNfp :: (Monad m) => Uri -> ExceptT String m NormalizedFilePath+handleUriToNfp uri = handleMaybe     ("No filepath for uri: " ++ show uri)     (toNormalizedFilePath <$> uriToFilePath uri) @@ -229,14 +239,16 @@ 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++locToFilePos :: Location -> (NormalizedFilePath, Position)+locToFilePos (Location uri (Range pos _)) = (nfp, pos)+    where+        Just nfp = (uriToNormalizedFilePath . toNormalizedUri) uri  replaceModName :: Name -> Maybe ModuleName -> Module replaceModName name mbModName =

@@ -13,14 +13,21 @@ main = defaultTestRunner tests  renamePlugin :: PluginDescriptor IdeState-renamePlugin = Rename.descriptor "rename"+renamePlugin = Rename.descriptor mempty "rename" +-- See https://github.com/wz1000/HieDb/issues/45+recordConstructorIssue :: String+recordConstructorIssue = "HIE references for record fields incorrect with GHC versions >= 9"+ tests :: TestTree tests = testGroup "Rename"     [ goldenWithRename "Data constructor" "DataConstructor" $ \doc ->         rename doc (Position 0 15) "Op"     , goldenWithRename "Exported function" "ExportedFunction" $ \doc ->         rename doc (Position 2 1) "quux"+    , ignoreForGhcVersions [GHC90, GHC92] recordConstructorIssue $+      goldenWithRename "Field Puns" "FieldPuns" $ \doc ->+        rename doc (Position 7 13) "bleh"     , goldenWithRename "Function argument" "FunctionArgument" $ \doc ->         rename doc (Position 3 4) "y"     , goldenWithRename "Function name" "FunctionName" $ \doc ->@@ -33,6 +40,9 @@         rename doc (Position 3 8) "baz"     , goldenWithRename "Import hiding" "ImportHiding" $ \doc ->         rename doc (Position 0 22) "hiddenFoo"+    , ignoreForGhcVersions [GHC90, GHC92] recordConstructorIssue $+      goldenWithRename "Indirect Puns" "IndirectPuns" $ \doc ->+        rename doc (Position 4 23) "blah"     , goldenWithRename "Let expression" "LetExpression" $ \doc ->         rename doc (Position 5 11) "foobar"     , goldenWithRename "Qualified as" "QualifiedAs" $ \doc ->@@ -43,7 +53,8 @@         rename doc (Position 3 12) "baz"     , goldenWithRename "Realigns do block indentation" "RealignDo" $ \doc ->         rename doc (Position 0 2) "fooBarQuux"-    , goldenWithRename "Record field" "RecordField" $ \doc ->+    , ignoreForGhcVersions [GHC90, GHC92] recordConstructorIssue $+      goldenWithRename "Record field" "RecordField" $ \doc ->         rename doc (Position 6 9) "number"     , goldenWithRename "Shadowed name" "ShadowedName" $ \doc ->         rename doc (Position 1 1) "baz"

@@ -0,0 +1,8 @@+{-# LANGUAGE NamedFieldPuns #-}++module FieldPun () where++newtype Foo = Foo { bleh :: Int }++unFoo :: Foo -> Int+unFoo Foo{bleh} = bleh

@@ -0,0 +1,8 @@+{-# LANGUAGE NamedFieldPuns #-}++module FieldPun () where++newtype Foo = Foo { field :: Int }++unFoo :: Foo -> Int+unFoo Foo{field} = field

@@ -0,0 +1,8 @@+{-# LANGUAGE NamedFieldPuns #-}++module IndirectPuns () where++newtype Foo = Foo { blah :: Int }++unFoo :: Foo -> Int+unFoo Foo{blah} = blah

@@ -0,0 +1,8 @@+{-# LANGUAGE NamedFieldPuns #-}++module IndirectPuns () where++newtype Foo = Foo { field :: Int }++unFoo :: Foo -> Int+unFoo Foo{field} = field

@@ -3,6 +3,7 @@     arguments:       - "DataConstructor"       - "ExportedFunction"+      - "FieldPuns"       - "Foo"       - "FunctionArgument"       - "FunctionName"@@ -10,6 +11,7 @@       - "HiddenFunction"       - "ImportHiding"       - "ImportedFunction"+      - "IndirectPuns"       - "LetExpression"       - "QualifiedAs"       - "QualifiedFunction"