Fix issue with GHC 9.4

Author: Jaro Reinders

ghcide/session-loader/Development/IDE/Session.hs

@@ -881,7 +881,7 @@ newComponentCache recorder exts _cfp hsc_env old_cis new_cis = do
             ideErrorWithSource
                 (Just "cradle") (Just DiagnosticSeverity_Warning) _cfp
                 (T.pack (Compat.printWithoutUniques (singleMessage err)))
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
                 (Just (fmap GhcDriverMessage err))
 #else
                 Nothing

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

@@ -1076,7 +1076,7 @@ parseHeader dflags filename contents = do
    let loc  = mkRealSrcLoc (Util.mkFastString filename) 1 1
    case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of
      PFailedWithErrorMessages msgs ->
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
         throwE $ diagFromErrMsgs sourceParser dflags $ msgs dflags
 #else
         throwE $ diagFromSDocErrMsgs sourceParser dflags $ msgs dflags
@@ -1094,13 +1094,13 @@ parseHeader dflags filename contents = do
         -- errors are those from which a parse tree just can't
         -- be produced.
         unless (null errs) $
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
             throwE $ diagFromErrMsgs sourceParser dflags errs
 #else
             throwE $ diagFromSDocErrMsgs sourceParser dflags errs
 #endif
 
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
         let warnings = diagFromErrMsgs sourceParser dflags warns
 #else
         let warnings = diagFromSDocErrMsgs sourceParser dflags warns
@@ -1122,7 +1122,7 @@ parseFileContents env customPreprocessor filename ms = do
        contents = fromJust $ ms_hspp_buf ms
    case unP Compat.parseModule (initParserState (initParserOpts dflags) contents loc) of
      PFailedWithErrorMessages msgs ->
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
        throwE $ diagFromErrMsgs sourceParser dflags $ msgs dflags
 #else
        throwE $ diagFromSDocErrMsgs sourceParser dflags $ msgs dflags
@@ -1160,7 +1160,7 @@ parseFileContents env customPreprocessor filename ms = do
                -- errors are those from which a parse tree just can't
                -- be produced.
                unless (null errors) $
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
                  throwE $ diagFromErrMsgs sourceParser dflags errors
 #else
                  throwE $ diagFromSDocErrMsgs sourceParser dflags errors
@@ -1195,7 +1195,7 @@ parseFileContents env customPreprocessor filename ms = do
                srcs2 <- liftIO $ filterM doesFileExist srcs1
 
                let pm = ParsedModule ms parsed' srcs2
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
                    warnings = diagFromErrMsgs sourceParser dflags warns
 #else
                    warnings = diagFromSDocErrMsgs sourceParser dflags warns

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

@@ -10,7 +10,7 @@ import qualified Data.Map                          as M
 import qualified Data.Text                         as T
 import           Development.IDE.Types.Diagnostics
 import           GHC.Driver.Errors.Types           (GhcMessage)
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
 import           GHC.Types.Error                   (diagnosticCode)
 #endif
 import           Ide.Logger                        (Pretty (..), Priority (..),
@@ -65,7 +65,7 @@ instance FromJSON HaskellErrorIndex where
   parseJSON = fmap errorsToIndex <$> parseJSON
 
 initHaskellErrorIndex :: Recorder (WithPriority Log) -> IO (Maybe HaskellErrorIndex)
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
 initHaskellErrorIndex recorder = do
   res <- tryJust handleJSONError $ tryJust handleHttpError $ httpJSON "https://errors.haskell.org/api/errors.json"
   case res of
@@ -86,7 +86,7 @@ initHaskellErrorIndex recorder = pure Nothing
 #endif
 
 heiGetError :: HaskellErrorIndex -> GhcMessage -> Maybe HEIError
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
 heiGetError (HaskellErrorIndex index) msg
   | Just code <- diagnosticCode msg
   = showGhcCode code `M.lookup` index

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

@@ -310,21 +310,21 @@ corePrepExpr _ = GHC.corePrepExpr
 
 renderMessages :: PsMessages -> (Bag WarnMsg, Bag ErrMsg)
 renderMessages msgs =
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
   let renderMsgs extractor = (fmap . fmap) GhcPsMessage . getMessages $ extractor msgs
   in (renderMsgs psWarnings, renderMsgs psErrors)
 #else
   let renderMsgs extractor = (fmap . fmap) renderDiagnosticMessageWithHints . getMessages $ extractor msgs
   in (renderMsgs psWarnings, renderMsgs psErrors)
 #endif
 
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
 pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope GhcMessage)) -> ParseResult a
-#elif MIN_VERSION_ghc(9,3,0)
+#else
 pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a
 #endif
 pattern PFailedWithErrorMessages msgs
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
      <- PFailed (const . fmap (fmap GhcPsMessage) . getMessages . getPsErrorMessages -> msgs)
 #else
      <- PFailed (const . fmap (fmap renderDiagnosticMessageWithHints) . getMessages . getPsErrorMessages -> msgs)

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

@@ -40,21 +40,11 @@ import           GHC.Utils.Logger
 import           GHC.Utils.Outputable
 import           GHC.Utils.Panic.Plain
 
-#if !MIN_VERSION_ghc(9,6,1)
-import           Development.IDE.GHC.Compat.Core (hscTypecheckRename)
-import           GHC.Utils.Error                 (emptyMessages)
-#endif
-
 hscTypecheckRenameWithDiagnostics :: HscEnv -> ModSummary -> HsParsedModule
                    -> IO ((TcGblEnv, RenamedStuff), Messages GhcMessage)
 hscTypecheckRenameWithDiagnostics hsc_env mod_summary rdr_module =
-#if MIN_VERSION_ghc(9,6,1)
     runHsc' hsc_env $ hsc_typecheck True mod_summary (Just rdr_module)
-#else
-    (,emptyMessages) <$> hscTypecheckRename hsc_env mod_summary rdr_module
-#endif
 
-#if MIN_VERSION_ghc(9,6,1)
 -- ============================================================================
 -- DO NOT EDIT - Refer to top of file
 -- ============================================================================
@@ -82,7 +72,11 @@ hsc_typecheck keep_rn mod_summary mb_rdr_module = do
                     Nothing  -> hscParse' mod_summary
             tc_result0 <- tcRnModule' mod_summary keep_rn' hpm
             if hsc_src == HsigFile
+#if MIN_VERSION_ghc(9,5,0)
                 then do (iface, _) <- liftIO $ hscSimpleIface hsc_env Nothing tc_result0 mod_summary
+#else
+                then do (iface, _) <- liftIO $ hscSimpleIface hsc_env tc_result0 mod_summary
+#endif
                         ioMsgMaybe $ hoistTcRnMessage $
                             tcRnMergeSignatures hsc_env hpm tc_result0 iface
                 else return tc_result0
@@ -134,11 +128,19 @@ extract_renamed_stuff mod_summary tc_result = do
 -- ============================================================================
 -- DO NOT EDIT - Refer to top of file
 -- ============================================================================
+#if MIN_VERSION_ghc(9,5,0)
 hscSimpleIface :: HscEnv
                -> Maybe CoreProgram
                -> TcGblEnv
                -> ModSummary
                -> IO (ModIface, ModDetails)
 hscSimpleIface hsc_env mb_core_program tc_result summary
     = runHsc hsc_env $ hscSimpleIface' mb_core_program tc_result summary
-#endif
+#else
+hscSimpleIface :: HscEnv
+               -> TcGblEnv
+               -> ModSummary
+               -> IO (ModIface, ModDetails)
+hscSimpleIface hsc_env tc_result summary
+    = runHsc hsc_env $ hscSimpleIface' tc_result summary
+#endif

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

@@ -118,7 +118,7 @@ pprNoLocMsgEnvelope (MsgEnvelope { errMsgDiagnostic = e
 
 
 
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
 type ErrMsg  = MsgEnvelope GhcMessage
 type WarnMsg  = MsgEnvelope GhcMessage
 #else

ghcide/src/Development/IDE/Types/Diagnostics.hs

@@ -19,7 +19,7 @@ module Development.IDE.Types.Diagnostics (
   ideErrorFromLspDiag,
   showDiagnostics,
   showDiagnosticsColored,
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
   showGhcCode,
 #endif
   IdeResultNoDiagnosticsEarlyCutoff,
@@ -40,7 +40,7 @@ import           Development.IDE.GHC.Compat     (GhcMessage, MsgEnvelope,
                                                  flagSpecName, wWarningFlags)
 import           Development.IDE.Types.Location
 import           GHC.Generics
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
 import           GHC.Types.Error                (DiagnosticCode (..),
                                                  DiagnosticReason (..),
                                                  diagnosticCode,
@@ -99,7 +99,7 @@ ideErrorFromLspDiag lspDiag fdFilePath mbOrigMsg =
   FileDiagnostic {..}
 
 setGhcCode :: Maybe (MsgEnvelope GhcMessage) -> LSP.Diagnostic -> LSP.Diagnostic
-#if MIN_VERSION_ghc(9,6,1)
+#if MIN_VERSION_ghc(9,5,0)
 setGhcCode mbOrigMsg diag =
   let mbGhcCode = do
           origMsg <- mbOrigMsg
@@ -111,11 +111,11 @@ setGhcCode mbOrigMsg diag =
 setGhcCode _ diag = diag
 #endif
 
-#if MIN_VERSION_ghc(9,10,1)
+#if MIN_VERSION_ghc(9,9,0)
 -- DiagnosticCode only got a show instance in 9.10.1
 showGhcCode :: DiagnosticCode -> T.Text
 showGhcCode = T.pack . show
-#elif MIN_VERSION_ghc(9,6,1)
+#elif MIN_VERSION_ghc(9,5,0)
 showGhcCode :: DiagnosticCode -> T.Text
 showGhcCode (DiagnosticCode prefix c) = T.pack $ prefix ++ "-" ++ printf "%05d" c
 #endif