WAP

Author: jhrcek

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

@@ -25,7 +25,6 @@ import           Data.List.NonEmpty                    (NonEmpty ((:|)),
 import qualified Data.Map                              as M
 import           Data.Maybe
 import           Data.Mod.Word
-import qualified Data.Set                              as S
 import qualified Data.Text                             as T
 import           Development.IDE                       (Recorder, WithPriority,
                                                         usePropertyAction)
@@ -52,7 +51,6 @@ import           Ide.Types
 import qualified Language.LSP.Protocol.Lens            as L
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
-import Data.List
 
 instance Hashable (Mod a) where hash n = hash (unMod n)
 
@@ -103,7 +101,6 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) p
         [] -> throwError $ PluginInvalidParams "No symbol to rename at given position"
         _  -> do
             refs <- HS.fromList . concat <$> mapM (refsAtName state nfp) oldNames
-
             -- Validate rename
             crossModuleEnabled <- liftIO $ runAction "rename: config" state $ usePropertyAction #crossModule pluginId properties
             unless crossModuleEnabled $ failWhenImportOrExport state nfp refs oldNames
@@ -198,22 +195,19 @@ refsAtName state nfp name = do
     ast <- handleGetHieAst state nfp
     dbRefs <- case nameModule_maybe name of
         Nothing -> pure []
-        Just mod -> liftIO $ mapMaybe rowToLoc <$> withHieDb (\hieDb -> do
+        Just mod -> liftIO $ mapMaybe rowToLoc <$> withHieDb (\hieDb ->
             -- GHC inserts `Use`s of record constructor everywhere where its record selectors are used,
             -- which leads to fields being renamed whenever corresponding constructor is renamed.
             -- see https://github.com/haskell/haskell-language-server/issues/2915
             -- To work around this, we filter out compiler-generated references.
-
-            xs <- findReferences
+            filter (\(refRow HieDb.:. _) -> refIsGenerated refRow) <$>
+            findReferences
                 hieDb
                 True
                 (nameOccName name)
                 (Just $ moduleName mod)
                 (Just $ moduleUnit mod)
                 [fromNormalizedFilePath nfp]
-            let (gen,notGen) = partition (\(refRow HieDb.:. _) -> refIsGenerated refRow) xs
-            putStrLn $ "Found " ++ show (length xs) ++ " references in HieDb: " ++ show (length xs) ++ ", of which " ++ show (length gen) ++ " are generated"
-            pure notGen
             )
     pure $ nameLocs name ast ++ dbRefs
 
@@ -244,12 +238,21 @@ handleGetHieAst state nfp =
 -- | We don't want to rename in code generated by GHC as this gives false positives.
 -- So we restrict the HIE file to remove all the generated code.
 removeGenerated :: HieAstResult -> HieAstResult
-removeGenerated HAR{..} = HAR{hieAst = go hieAst,..}
+removeGenerated HAR{..} =
+    HAR{hieAst = sourceOnlyAsts, refMap = sourceOnlyRefMap, ..}
   where
-    go :: HieASTs a -> HieASTs a
-    go hf =
-      HieASTs (fmap goAst (getAsts hf))
-    goAst (Node nsi sp xs) = Node (SourcedNodeInfo $ M.restrictKeys (getSourcedNodeInfo nsi) (S.singleton SourceInfo)) sp (map goAst xs)
+    goAsts :: HieASTs a -> HieASTs a
+    goAsts (HieASTs asts) = HieASTs (fmap goAst asts)
+
+    goAst :: HieAST a -> HieAST a
+    goAst (Node (SourcedNodeInfo sniMap) sp children) =
+        let sourceOnlyNodeInfos = SourcedNodeInfo $ M.delete GeneratedInfo sniMap
+        in Node sourceOnlyNodeInfos sp $ map goAst children
+
+    sourceOnlyAsts = goAsts hieAst
+    -- Also need to regenerate the RefMap, because the one in HAR
+    -- is generated from HieASTs containing GeneratedInfo
+    sourceOnlyRefMap = generateReferencesMap $ getAsts sourceOnlyAsts
 
 collectWith :: (Hashable a, Eq b) => (a -> b) -> HashSet a -> [(b, HashSet a)]
 collectWith f = map (\(a :| as) -> (f a, HS.fromList (a:as))) . groupWith f . HS.toList

plugins/hls-rename-plugin/test/Main.hs

@@ -24,6 +24,8 @@ tests :: TestTree
 tests = testGroup "Rename"
     [ goldenWithRename "Data constructor" "DataConstructor" $ \doc ->
         rename doc (Position 0 15) "Op"
+    , goldenWithRename "Data constructor with fields" "DataConstructorWithFields" $ \doc ->
+        rename doc (Position 1 13) "FooRenamed"
     , goldenWithRename "Exported function" "ExportedFunction" $ \doc ->
         rename doc (Position 2 1) "quux"
     , goldenWithRename "Field Puns" "FieldPuns" $ \doc ->

plugins/hls-rename-plugin/test/testdata/DataConstructorWithFields.expected.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE NamedFieldPuns #-}
+data Foo = FooRenamed { FooRenamed :: Int, FooRenamed :: Bool }
+
+foo1 :: Foo
+foo1 = FooRenamed { a = 1, b = True }
+
+foo2 :: Foo
+foo2 = FooRenamed 1 True
+
+fun1 :: Foo -> Int
+fun1 FooRenamed {a} = a
+
+fun2 :: Foo -> Int
+fun2 FooRenamed {a = i} = i

plugins/hls-rename-plugin/test/testdata/DataConstructorWithFields.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE NamedFieldPuns #-}
+data Foo = Foo { a :: Int, b :: Bool }
+
+foo1 :: Foo
+foo1 = Foo { a = 1, b = True }
+
+foo2 :: Foo
+foo2 = Foo 1 True
+
+fun1 :: Foo -> Int
+fun1 Foo {a} = a
+
+fun2 :: Foo -> Int
+fun2 Foo {a = i} = i