Fix refs at name

Reverts to the old implementation of refs at name. also fixes the filter for generated references which was causing problems on cross module renames.

Author: vidit-od

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

@@ -27,6 +27,7 @@ import qualified Data.Map                              as M
 import           Data.Maybe
 import           Data.Mod.Word
 import qualified Data.Text                             as T
+import           HieDb                                 ((:.) (..))
 import           Development.IDE                       (Recorder, WithPriority,
                                                         usePropertyAction)
 import           Development.IDE.Core.FileStore        (getVersionedTextDoc)
@@ -42,7 +43,6 @@ import qualified Development.IDE.GHC.ExactPrint        as E
 import           Development.IDE.Plugin.CodeAction
 import           Development.IDE.Spans.AtPoint
 import           Development.IDE.Types.Location
-import           GHC                                   (isGoodSrcSpan)
 import           GHC.Iface.Ext.Types                   (HieAST (..),
                                                         HieASTs (..),
                                                         NodeOrigin (..),
@@ -296,29 +296,28 @@ refsAtName ::
     NormalizedFilePath ->
     Name ->
     ExceptT PluginError m [Location]
-refsAtName state nfp targetName = do
-    HAR{refMap} <- handleGetHieAst state nfp
-
-    let localRefs =
-            case M.lookup (Right targetName) refMap of
-            Nothing    -> []
-            Just spans -> [ realSrcSpanToLocation sp | (sp, _) <- spans]
-
-    let defLoc = nameSrcSpan targetName
-        defLocations = case srcSpanToLocation defLoc of
-            Just loc | isGoodSrcSpan defLoc -> [loc]
-            _                               -> []
-
-    -- Only query HieDb if it's a global name
-    globalRefs <-
-        case nameModule_maybe targetName of
-            Nothing -> pure []
-            Just mod -> do
-                ShakeExtras{withHieDb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras
-                liftIO $ withHieDb $ \hieDb ->
-                    fmap (mapMaybe rowToLoc) $ findReferences hieDb True (nameOccName targetName) (Just $ moduleName mod) (Just $ moduleUnit mod) []
-
-    pure (defLocations ++ localRefs ++ globalRefs)
+refsAtName state nfp name = do
+    ShakeExtras{withHieDb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras
+    ast <- handleGetHieAst state nfp
+    dbRefs <- case nameModule_maybe name of
+        Nothing -> pure []
+        Just mod -> liftIO $ mapMaybe rowToLoc <$> withHieDb (\hieDb ->
+            -- See Note [Generated references]
+            filter (\(refRow HieDb.:. _) -> not (refIsGenerated refRow)) <$>
+            findReferences
+                hieDb
+                True
+                (nameOccName name)
+                (Just $ moduleName mod)
+                (Just $ moduleUnit mod)
+                [fromNormalizedFilePath nfp]
+            )
+    pure $ nameLocs name ast ++ dbRefs
+
+nameLocs :: Name -> HieAstResult -> [Location]
+nameLocs name (HAR _ _ rm _ _) =
+    concatMap (map (realSrcSpanToLocation . fst))
+              (M.lookup (Right name) rm)
 ---------------------------------------------------------------------------------------------------
 -- Util
 
@@ -371,10 +370,35 @@ getNamesAtPoint' hf pos =
   concat $ pointCommand hf pos (rights . M.keys . getNodeIds)
 
 -- | A variant of `getNamesAtPoint'` that also returns source spans.
+-- | A variant of `getNamesAtPoint'` that also returns source spans,
+--   trimmed to just the unqualified identifier (excluding any "Module." prefix).
 getNamesSpansAtPoint' :: HieASTs a -> Position -> [([Name], RealSrcSpan)]
 getNamesSpansAtPoint' hf pos =
   pointCommand hf pos $
-    \astNode -> (rights . M.keys . getNodeIds $ astNode, nodeSpan astNode)
+    \astNode ->
+        let names    = rights . M.keys . getNodeIds $ astNode
+            srcSpan  = nodeSpan astNode
+            trimmed  = trimQualifierSpan names srcSpan
+        in (names, trimmed)
+
+-- | Advance the start column of a span past any "Qualifier." prefix,
+--   using the OccName length of the first Name to find where the
+--   identifier begins.
+trimQualifierSpan :: [Name] -> RealSrcSpan -> RealSrcSpan
+trimQualifierSpan (n:_) sp
+    | qualLen > 0
+    = mkRealSrcSpan
+        (mkRealSrcLoc file startLine (startCol + qualLen))
+        (realSrcSpanEnd sp)
+    | otherwise = sp
+  where
+    spanLen  = srcLocCol (realSrcSpanEnd sp) - srcLocCol (realSrcSpanStart sp)
+    identLen = length (occNameString (nameOccName n))
+    qualLen  = spanLen - identLen
+    file     = srcSpanFile sp
+    startLine = srcLocLine (realSrcSpanStart sp)
+    startCol  = srcLocCol  (realSrcSpanStart sp)
+trimQualifierSpan [] sp = sp
 
 locToUri :: Location -> Uri
 locToUri (Location uri _) = uri
@@ -407,16 +431,14 @@ exportNameLocs pm names = do
 #else
                     IEVar _ ieWrapped  -> matchWrapped (getLoc export) ieWrapped
 #endif
-                    IEThingAll{}       -> unsupported
-                    IEThingWith{}      -> unsupported
-                    IEModuleContents{} -> unsupported
-                    IEThingAbs{}       -> unsupported
-                    IEGroup{}          -> unsupported
-                    IEDoc{}            -> unsupported
-                    IEDocNamed{}       -> unsupported
+                    IEThingAll{}       -> pure []
+                    IEThingWith{}      -> pure []
+                    IEModuleContents{} -> pure []
+                    IEThingAbs{}       -> pure []
+                    IEGroup{}          -> pure []
+                    IEDoc{}            -> pure []
+                    IEDocNamed{}       -> pure []
   where
-    unsupported = throwError $ PluginInternalError "Renaming is unsupported for complex export forms"
-
     matchWrapped :: SrcSpan -> LIEWrappedName GhcPs -> ExceptT PluginError (HandlerM config) [Location]
     matchWrapped l ieWrapped =
         case unwrapIEWrappedName (unLoc ieWrapped) of