Restore eval plugin build for GHC 9.2

The eval plugin is building again and working partially. The codelens
(and evaluation) only happen for code in module comment, code appearing
in the top level comments / haddock are ignored. I need to walk the AST
to locate them.

Author: guibou

cabal-ghc921.project

@@ -47,7 +47,6 @@ constraints:
     -alternateNumberFormat
     -brittany
     -class
-    -eval
     -haddockComments
     -hlint
     -retrie

ghcide/src/Development/IDE/Core/Compile.hs

@@ -95,6 +95,14 @@ import           System.IO.Extra                   (fixIO, newTempFileWithin)
 
 -- GHC API imports
 -- GHC API imports
+#if MIN_VERSION_ghc(9,2,0)
+import           GHC                               (Anchor (anchor),
+                                                    EpaComment (EpaComment),
+                                                    EpaCommentTok (EpaBlockComment, EpaLineComment),
+                                                    epAnnComments,
+                                                    priorComments)
+import           GHC.Hs                            (LEpaComment)
+#endif
 import           GHC                               (GetDocsFailure (..),
                                                     mgModSummaries,
                                                     parsedSource)
@@ -873,7 +881,12 @@ parseFileContents env customPreprocessor filename ms = do
      PFailedWithErrorMessages msgs -> throwE $ diagFromErrMsgs "parser" dflags $ msgs dflags
      POk pst rdr_module ->
          let
+#if MIN_VERSION_ghc(9,2,1)
+             -- TODO: we need to export the annotations here 
+             hpm_annotations = ()
+#else
              hpm_annotations = mkApiAnns pst
+#endif
              (warns, errs) = getMessages' pst dflags
          in
            do

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

@@ -51,12 +51,18 @@ import qualified GHC.Parser.Annotation           as Anno
 import qualified GHC.Parser.Lexer                as Lexer
 import           GHC.Types.SrcLoc                (PsSpan (..))
 #if MIN_VERSION_ghc(9,2,0)
-import           GHC                             (pm_extra_src_files,
+import           GHC                             (Anchor (anchor),
+                                                  EpAnnComments (priorComments),
+                                                  EpaComment (EpaComment),
+                                                  EpaCommentTok (..),
+                                                  epAnnComments,
+                                                  pm_extra_src_files,
                                                   pm_mod_summary,
                                                   pm_parsed_source)
 import qualified GHC
 import qualified GHC.Driver.Config               as Config
-import           GHC.Hs                          (hpm_module, hpm_src_files)
+import           GHC.Hs                          (LEpaComment, hpm_module,
+                                                  hpm_src_files)
 import           GHC.Parser.Lexer                hiding (initParserState)
 #endif
 #else
@@ -100,6 +106,8 @@ initParserState =
 #endif
 
 #if MIN_VERSION_ghc(9,2,0)
+-- GHC 9.2 does not have ApiAnns anymore packaged in ParsedModule. Now the
+-- annotations are found in the ast.
 type ApiAnns = ()
 #else
 type ApiAnns = Anno.ApiAnns

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

@@ -72,12 +72,20 @@ import           GHC                             (ClsInst,
                                                   getInteractiveDynFlags,
                                                   isImport, isStmt, load,
                                                   parseName, pprFamInst,
-                                                  pprInstance, setLogAction,
-                                                  setTargets, typeKind)
+                                                  pprInstance, setTargets,
+                                                  typeKind)
+#if MIN_VERSION_ghc(9,2,0)
+import           GHC                             (Fixity, pushLogHookM)
+#else
+import           GHC                             (setLogAction)
+#endif
 import qualified GHC.LanguageExtensions.Type     as LangExt (Extension (..))
 
 import           Development.IDE.Core.FileStore  (setSomethingModified)
 import           Development.IDE.Types.Shake     (toKey)
+#if MIN_VERSION_ghc(9,2,0)
+import           GHC.Types.SrcLoc                (UnhelpfulSpanReason (UnhelpfulInteractive))
+#endif
 import           Ide.Plugin.Eval.Code            (Statement, asStatements,
                                                   evalSetup, myExecStmt,
                                                   propSetup, resultRange,
@@ -103,7 +111,8 @@ import           System.FilePath                 (takeFileName)
 import           System.IO                       (hClose)
 import           UnliftIO.Temporary              (withSystemTempFile)
 
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+#elif MIN_VERSION_ghc(9,0,0)
 import           GHC.Driver.Session              (unitDatabases, unitState)
 import           GHC.Types.SrcLoc                (UnhelpfulSpanReason (UnhelpfulInteractive))
 #else
@@ -244,13 +253,8 @@ runEvalCmd st EvalParams{..} =
                         $ idflags
                 setInteractiveDynFlags $ df'
 #if MIN_VERSION_ghc(9,0,0)
-                        { unitState =
-                            unitState
-                                df
-                        , unitDatabases =
-                            unitDatabases
-                                df
-                        , packageFlags =
+                        {
+                        packageFlags =
                             packageFlags
                                 df
                         , useColor = Never
@@ -272,7 +276,11 @@ runEvalCmd st EvalParams{..} =
 #endif
 
                 -- set up a custom log action
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+                pushLogHookM . const $ \_df _wr _sev _span _doc ->
+                    defaultLogActionHPutStrDoc _df True logHandle _doc
+                    -- TODO: check the True
+#elif MIN_VERSION_ghc(9,0,0)
                 setLogAction $ \_df _wr _sev _span _doc ->
                     defaultLogActionHPutStrDoc _df logHandle _doc
 #else
@@ -683,7 +691,9 @@ doTypeCmd dflags arg = do
 
 parseExprMode :: Text -> (TcRnExprMode, T.Text)
 parseExprMode rawArg = case T.break isSpace rawArg of
+#if !MIN_VERSION_ghc(9,0,0)
     ("+v", rest) -> (TM_NoInst, T.strip rest)
+#endif
     ("+d", rest) -> (TM_Default, T.strip rest)
     _            -> (TM_Inst, rawArg)
 

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs

@@ -36,6 +36,9 @@ import           Development.IDE.GHC.Compat
 import qualified Development.IDE.GHC.Compat           as SrcLoc
 import qualified Development.IDE.GHC.Compat.Util      as FastString
 import           Development.IDE.Graph                (alwaysRerun)
+#if MIN_VERSION_ghc(9,2,0)
+import           GHC.Parser.Annotation
+#endif
 import           Ide.Plugin.Eval.Types
 
 
@@ -53,22 +56,34 @@ queueForEvaluation ide nfp = do
     EvaluatingVar var <- getIdeGlobalState ide
     modifyIORef var (Set.insert nfp)
 
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+getAnnotations :: Development.IDE.GHC.Compat.Located HsModule -> [LEpaComment]
+getAnnotations (L _ (HsModule { hsmodAnn = anns'})) = priorComments $ epAnnComments anns'
+
+apiAnnComments' :: ParsedModule -> [SrcLoc.RealLocated EpaCommentTok]
+apiAnnComments' pm = do
+  L span' (EpaComment c span) <- getAnnotations $ pm_parsed_source pm
+  pure (L (anchor span') c)
+
+pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcLoc.RealSrcSpan
+pattern RealSrcSpanAlready x = x
+#elif MIN_VERSION_ghc(9,0,0)
+apiAnnComments' :: ParsedModule -> [SrcLoc.RealLocated AnnotationComment]
+apiAnnComments' = apiAnnRogueComments . pm_annotations
+
 pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcLoc.RealSrcSpan
 pattern RealSrcSpanAlready x = x
-apiAnnComments' :: SrcLoc.ApiAnns -> [SrcLoc.RealLocated AnnotationComment]
-apiAnnComments' = apiAnnRogueComments
 #else
-apiAnnComments' :: SrcLoc.ApiAnns -> [SrcLoc.Located AnnotationComment]
-apiAnnComments' = concat . Map.elems . snd
+apiAnnComments' :: ParsedModule -> [SrcLoc.Located AnnotationComment]
+apiAnnComments' = concat . Map.elems . snd . pm_annotations
 
 pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcSpan
 pattern RealSrcSpanAlready x = SrcLoc.RealSrcSpan x Nothing
 #endif
 
 evalParsedModuleRule :: Rules ()
 evalParsedModuleRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetEvalComments nfp -> do
-    (ParsedModule{..}, posMap) <- useWithStale_ GetParsedModuleWithComments nfp
+    (pm, posMap) <- useWithStale_ GetParsedModuleWithComments nfp
     let comments = foldMap (\case
                 L (RealSrcSpanAlready real) bdy
                     | FastString.unpackFS (srcSpanFile real) ==
@@ -79,15 +94,24 @@ evalParsedModuleRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetEvalComments
 
                         -- since Haddock parsing is unset explicitly in 'getParsedModuleWithComments',
                         -- we can concentrate on these two
+#if MIN_VERSION_ghc(9,2,0)
+                        case bdy of
+                            EpaLineComment cmt ->
+                                mempty { lineComments = Map.singleton curRan (RawLineComment cmt) }
+                            EpaBlockComment cmt ->
+                                mempty { blockComments = Map.singleton curRan $ RawBlockComment cmt }
+                            _ -> mempty
+#else
                         case bdy of
                             AnnLineComment cmt ->
                                 mempty { lineComments = Map.singleton curRan (RawLineComment cmt) }
                             AnnBlockComment cmt ->
                                 mempty { blockComments = Map.singleton curRan $ RawBlockComment cmt }
                             _ -> mempty
+#endif
                 _ -> mempty
             )
-            $ apiAnnComments' pm_annotations
+            $ apiAnnComments' pm
         -- we only care about whether the comments are null
         -- this is valid because the only dependent is NeedsCompilation
         fingerPrint = fromString $ if nullComments comments then "" else "1"