[ghc-9.2] Fix rename plugin (#2593)

* Introduce a Compat layer for retrie Annotated type

* Use GetAnnotatedParsedSource in rename plugin

We already have a cached delta AST at hand

* fix build issues

* remove debugging traces

* Fix hlint

Author: pepeiborra

.github/workflows/test.yml

@@ -202,7 +202,7 @@ jobs:
         name: Test hls-call-hierarchy-plugin test suite
         run: cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS"
 
-      - if: matrix.test && matrix.ghc != '9.2.1'
+      - if: matrix.test
         name: Test hls-rename-plugin test suite
         run: cabal test hls-rename-plugin --test-options="$TEST_OPTS" || cabal test hls-rename-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-rename-plugin --test-options="$TEST_OPTS"
 

cabal-ghc921.project

@@ -65,9 +65,7 @@ constraints:
     -retrie
     -splice
     -stylishhaskell
-    -tactic
-  -- the rename plugin builds, but doesn't work
-    -rename,
+    -tactic,
   ghc-lib-parser ^>= 9.2,
   attoparsec ^>= 0.14.3,
   ghc-exactprint >= 1.3,

ghcide/.hlint.yaml

@@ -95,6 +95,7 @@
     - Development.IDE.GHC.Compat
     - Development.IDE.GHC.Compat.Core
     - Development.IDE.GHC.Compat.Env
+    - Development.IDE.GHC.Compat.ExactPrint
     - Development.IDE.GHC.Compat.Iface
     - Development.IDE.GHC.Compat.Logger
     - Development.IDE.GHC.Compat.Outputable

ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PatternSynonyms   #-}
 
 -- | This module contains compatibility constructs to write type signatures across
 --   multiple ghc-exactprint versions, accepting that anything more ambitious is
@@ -8,15 +9,16 @@ module Development.IDE.GHC.Compat.ExactPrint
     ( ExactPrint
     , exactPrint
     , makeDeltaAst
-#if !MIN_VERSION_ghc(9,2,0)
-    , Annotated(..)
-#endif
+    , Retrie.Annotated, pattern Annotated, astA, annsA
     ) where
 
-import           Language.Haskell.GHC.ExactPrint
 #if !MIN_VERSION_ghc(9,2,0)
-import           Retrie.ExactPrint               (Annotated (..))
+import           Control.Arrow                     ((&&&))
+#else
+import           Development.IDE.GHC.Compat.Parser
 #endif
+import           Language.Haskell.GHC.ExactPrint   as Retrie
+import qualified Retrie.ExactPrint                 as Retrie
 
 #if !MIN_VERSION_ghc(9,2,0)
 class ExactPrint ast where
@@ -26,3 +28,10 @@ class ExactPrint ast where
 instance ExactPrint ast
 #endif
 
+#if !MIN_VERSION_ghc(9,2,0)
+pattern Annotated :: ast -> Anns -> Retrie.Annotated ast
+pattern Annotated {astA, annsA} <- (Retrie.astA &&& Retrie.annsA -> (astA, annsA))
+#else
+pattern Annotated :: ast -> ApiAnns -> Retrie.Annotated ast
+pattern Annotated {astA, annsA} <- ((,()) . Retrie.astA -> (astA, annsA))
+#endif

ghcide/src/Development/IDE/GHC/ExactPrint.hs

@@ -43,7 +43,6 @@ module Development.IDE.GHC.ExactPrint
       GetAnnotatedParsedSource(..),
       ASTElement (..),
       ExceptStringT (..),
-      Annotated(..),
       TransformT,
     )
 where
@@ -82,8 +81,8 @@ import           Ide.PluginUtils
 import           Language.Haskell.GHC.ExactPrint.Parsers
 import           Language.LSP.Types
 import           Language.LSP.Types.Capabilities         (ClientCapabilities)
-import           Retrie.ExactPrint                       hiding (parseDecl,
-                                                          parseExpr,
+import           Retrie.ExactPrint                       hiding (Annotated (..),
+                                                          parseDecl, parseExpr,
                                                           parsePattern,
                                                           parseType)
 #if MIN_VERSION_ghc(9,2,0)
@@ -107,11 +106,7 @@ data GetAnnotatedParsedSource = GetAnnotatedParsedSource
 
 instance Hashable GetAnnotatedParsedSource
 instance NFData GetAnnotatedParsedSource
-#if MIN_VERSION_ghc(9,2,0)
-type instance RuleResult GetAnnotatedParsedSource = ParsedSource
-#else
 type instance RuleResult GetAnnotatedParsedSource = Annotated ParsedSource
-#endif
 
 -- | Get the latest version of the annotated parse source with comments.
 getAnnotatedParsedSourceRule :: Rules ()
@@ -120,9 +115,8 @@ getAnnotatedParsedSourceRule = define $ \GetAnnotatedParsedSource nfp -> do
   return ([], fmap annotateParsedSource pm)
 
 #if MIN_VERSION_ghc(9,2,0)
-annotateParsedSource :: ParsedModule -> ParsedSource
-annotateParsedSource (ParsedModule _ ps _ _) = makeDeltaAst ps
-
+annotateParsedSource :: ParsedModule -> Annotated ParsedSource
+annotateParsedSource (ParsedModule _ ps _ _) = unsafeMkA (makeDeltaAst ps) 0
 #else
 annotateParsedSource :: ParsedModule -> Annotated ParsedSource
 annotateParsedSource = fixAnns

ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs

@@ -145,11 +145,7 @@ data CodeActionArgs = CodeActionArgs
     caaParsedModule :: IO (Maybe ParsedModule),
     caaContents     :: IO (Maybe T.Text),
     caaDf           :: IO (Maybe DynFlags),
-#if !MIN_VERSION_ghc(9,2,0)
     caaAnnSource    :: IO (Maybe (Annotated ParsedSource)),
-#else
-    caaAnnSource    :: IO (Maybe ParsedSource),
-#endif
     caaTmr          :: IO (Maybe TcModuleResult),
     caaHar          :: IO (Maybe HieAstResult),
     caaBindings     :: IO (Maybe Bindings),
@@ -220,11 +216,7 @@ toCodeAction3 get f = ReaderT $ \caa -> get caa >>= flip runReaderT caa . toCode
 instance ToCodeAction r => ToCodeAction (ParsedSource -> r) where
   toCodeAction f = ReaderT $ \caa@CodeActionArgs {caaAnnSource = x} ->
     x >>= \case
-#if !MIN_VERSION_ghc(9,2,0)
       Just s -> flip runReaderT caa . toCodeAction . f . astA $ s
-#else
-      Just s -> flip runReaderT caa . toCodeAction . f $ s
-#endif
       _      -> pure []
 
 instance ToCodeAction r => ToCodeAction (ExportsMap -> r) where
@@ -254,17 +246,11 @@ instance ToCodeAction r => ToCodeAction (Maybe DynFlags -> r) where
 instance ToCodeAction r => ToCodeAction (DynFlags -> r) where
   toCodeAction = toCodeAction2 caaDf
 
-#if !MIN_VERSION_ghc(9,2,0)
 instance ToCodeAction r => ToCodeAction (Maybe (Annotated ParsedSource) -> r) where
   toCodeAction = toCodeAction1 caaAnnSource
 
 instance ToCodeAction r => ToCodeAction (Annotated ParsedSource -> r) where
   toCodeAction = toCodeAction2 caaAnnSource
-#else
--- | this instance returns a delta AST, useful for exactprint transforms
-instance ToCodeAction r => ToCodeAction (Maybe ParsedSource -> r) where
-  toCodeAction = toCodeAction1 caaAnnSource
-#endif
 
 instance ToCodeAction r => ToCodeAction (Maybe TcModuleResult -> r) where
   toCodeAction = toCodeAction1 caaTmr

ghcide/src/Development/IDE/Plugin/Completions.hs

@@ -239,11 +239,7 @@ extendImportHandler' ideState ExtendImport {..}
                   Just p  -> p <> "(" <> newThing <> ")"
             t <- liftMaybe $ snd <$> newImportToEdit
                 n
-#if !MIN_VERSION_ghc(9,2,0)
                 (astA ps)
-#else
-                ps
-#endif
                 (fromMaybe "" contents)
             return (nfp, WorkspaceEdit {_changes=Just (fromList [(doc,List [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing})
   | otherwise =

plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs

@@ -15,8 +15,7 @@ import qualified Data.Map                              as Map
 import qualified Data.Text                             as T
 import           Development.IDE                       hiding (pluginHandlers)
 import           Development.IDE.GHC.Compat
-import           Development.IDE.GHC.ExactPrint        (GetAnnotatedParsedSource (..),
-                                                        annsA, astA)
+import           Development.IDE.GHC.ExactPrint        (GetAnnotatedParsedSource (..))
 import           Ide.Types
 import           Language.Haskell.GHC.ExactPrint
 import           Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs)

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

@@ -1,7 +1,10 @@
-{-# LANGUAGE CPP            #-}
-{-# LANGUAGE DataKinds      #-}
-{-# LANGUAGE GADTs          #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
 
 module Ide.Plugin.Rename (descriptor) where
 
@@ -11,7 +14,7 @@ import           Control.Monad.Trans.Class
 import           Control.Monad.Trans.Except
 import           Data.Containers.ListUtils
 import           Data.Generics
-import           Data.List.Extra                      hiding (nubOrd)
+import           Data.List.Extra                      hiding (nubOrd, replace)
 import qualified Data.Map                             as M
 import           Data.Maybe
 import qualified Data.Text                            as T
@@ -20,11 +23,16 @@ import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.Shake
 import           Development.IDE.GHC.Compat
 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           HieDb.Query
 import           Ide.Plugin.Config
 import           Ide.PluginUtils
@@ -46,7 +54,6 @@ renameProvider state pluginId (RenameParams (TextDocumentIdentifier uri) pos _pr
         workspaceRefs <- refsAtName state nfp oldName
         let filesRefs = groupOn locToUri workspaceRefs
             getFileEdits = ap (getSrcEdits state . renameModRefs newNameText) (locToUri . head)
-
         fileEdits <- mapM getFileEdits filesRefs
         pure $ foldl' (<>) mempty fileEdits
 
@@ -67,14 +74,14 @@ getSrcEdits ::
 getSrcEdits state updateMod uri = do
     ccs <- lift getClientCapabilities
     nfp <- safeUriToNfp uri
-    ~ParsedModule{pm_parsed_source = ps, pm_annotations = apiAnns} <-
+    annotatedAst <-
         handleMaybeM "Error: could not get parsed source" $ liftIO $ runAction
             "Rename.GetParsedModuleWithComments"
             state
-            (use GetParsedModuleWithComments nfp)
+            (use GetAnnotatedParsedSource nfp)
+    let (ps, anns) = (astA annotatedAst, annsA annotatedAst)
 #if !MIN_VERSION_ghc(9,2,1)
-    let anns = relativiseApiAnns ps apiAnns
-        src = T.pack $ exactPrint ps anns
+    let src = T.pack $ exactPrint ps anns
         res = T.pack $ exactPrint (updateMod <$> ps) anns
 #else
     let src = T.pack $ exactPrint ps
@@ -94,12 +101,32 @@ renameModRefs ::
     HsModule GhcPs
     -> HsModule GhcPs
 #endif
+#if MIN_VERSION_ghc(9,2,1)
+renameModRefs newNameText 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
+    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
+#else
 renameModRefs newNameText refs = everywhere $ mkT replace
     where
         replace :: Located RdrName -> Located RdrName
         replace (L srcSpan oldRdrName)
             | isRef srcSpan = L srcSpan $ newRdrName oldRdrName
         replace lOldRdrName = lOldRdrName
+#endif
+
+        isRef :: SrcSpan -> Bool
+        isRef = (`elem` refs) . fromJust . srcSpanToLocation
 
         newRdrName :: RdrName -> RdrName
         newRdrName oldRdrName = case oldRdrName of
@@ -108,9 +135,8 @@ renameModRefs newNameText refs = everywhere $ mkT replace
 
         newOccName = mkTcOcc $ T.unpack newNameText
 
-        isRef :: SrcSpan -> Bool
-        isRef = (`elem` refs) . fromJust . srcSpanToLocation
-
+newRdrName :: RdrName -> RdrName
+newRdrName = error "not implemented"
 -------------------------------------------------------------------------------
 -- Reference finding