Rename only if the current module compiles (#3799)

Prefer `useE` over `useWithStaleE`

Author: sgillespie

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

@@ -14,7 +14,7 @@ import           Control.Monad
 import           Control.Monad.Except                  (ExceptT, throwError)
 import           Control.Monad.IO.Class                (MonadIO, liftIO)
 import           Control.Monad.Trans.Class             (lift)
-import           Data.Bifunctor                        (first)
+import           Data.Either                           (rights)
 import           Data.Foldable                         (fold)
 import           Data.Generics
 import           Data.Hashable
@@ -31,14 +31,11 @@ import qualified Data.Text                             as T
 import           Development.IDE                       (Recorder, WithPriority,
                                                         usePropertyAction)
 import           Development.IDE.Core.PluginUtils
-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.Core
+import           Development.IDE.GHC.Compat
 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 qualified Development.IDE.GHC.ExactPrint        as E
@@ -212,26 +209,29 @@ refsAtName state nfp name = do
             )
     pure $ nameLocs name ast ++ dbRefs
 
-nameLocs :: Name -> (HieAstResult, PositionMapping) -> [Location]
-nameLocs name (HAR _ _ rm _ _, pm) =
-    concatMap (mapMaybe (toCurrentLocation pm . realSrcSpanToLocation . fst))
+nameLocs :: Name -> HieAstResult -> [Location]
+nameLocs name (HAR _ _ rm _ _) =
+    concatMap (map (realSrcSpanToLocation . fst))
               (M.lookup (Right name) rm)
 
 ---------------------------------------------------------------------------------------------------
 -- Util
 
 getNamesAtPos :: MonadIO m => IdeState -> NormalizedFilePath -> Position -> ExceptT PluginError m [Name]
 getNamesAtPos state nfp pos = do
-    (HAR{hieAst}, pm) <- handleGetHieAst state nfp
-    pure $ getNamesAtPoint hieAst pos pm
+    HAR{hieAst} <- handleGetHieAst state nfp
+    pure $ getNamesAtPoint' hieAst pos
 
 handleGetHieAst ::
     MonadIO m =>
     IdeState ->
     NormalizedFilePath ->
-    ExceptT PluginError m (HieAstResult, PositionMapping)
+    ExceptT PluginError m HieAstResult
 handleGetHieAst state nfp =
-    fmap (first removeGenerated) $ runActionE "Rename.GetHieAst" state $ useWithStaleE GetHieAst nfp
+    -- We explicitly do not want to allow a stale version here - we only want to rename if
+    -- the module compiles, otherwise we can't guarantee that we'll rename everything,
+    -- which is bad (see https://github.com/haskell/haskell-language-server/issues/3799)
+    fmap removeGenerated $ runActionE "Rename.GetHieAst" state $ useE GetHieAst 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.
@@ -246,6 +246,11 @@ removeGenerated HAR{..} = HAR{hieAst = go hieAst,..}
 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
 
+-- | A variant 'getNamesAtPoint' that does not expect a 'PositionMapping'
+getNamesAtPoint' :: HieASTs a -> Position -> [Name]
+getNamesAtPoint' hf pos =
+  concat $ pointCommand hf pos (rights . M.keys . getNodeIds)
+
 locToUri :: Location -> Uri
 locToUri (Location uri _) = uri