From 1fed0f9ac79033efdb78cff295671224162778f6 Mon Sep 17 00:00:00 2001 From: Jaro Reinders Date: Tue, 22 Oct 2024 21:30:49 +0200 Subject: [PATCH] Fix issue with GHC 9.4 --- .../session-loader/Development/IDE/Session.hs | 2 +- ghcide/src/Development/IDE/Core/Compile.hs | 12 +++++----- .../Development/IDE/Core/HaskellErrorIndex.hs | 6 ++--- ghcide/src/Development/IDE/GHC/Compat.hs | 8 +++---- .../src/Development/IDE/GHC/Compat/Driver.hs | 24 ++++++++++--------- .../Development/IDE/GHC/Compat/Outputable.hs | 2 +- .../src/Development/IDE/Types/Diagnostics.hs | 10 ++++---- 7 files changed, 33 insertions(+), 31 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index d89141c857..2b99862cad 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/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 diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 54df1cdd12..194c3b5358 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/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 diff --git a/ghcide/src/Development/IDE/Core/HaskellErrorIndex.hs b/ghcide/src/Development/IDE/Core/HaskellErrorIndex.hs index 9e51aa4348..55660cb6ef 100644 --- a/ghcide/src/Development/IDE/Core/HaskellErrorIndex.hs +++ b/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 diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 7367c03f26..5f66625ee5 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -310,7 +310,7 @@ 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 @@ -318,13 +318,13 @@ renderMessages 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) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Driver.hs b/ghcide/src/Development/IDE/GHC/Compat/Driver.hs index 05aa30ceb2..5b872fe461 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Driver.hs +++ b/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,6 +128,7 @@ 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 @@ -141,4 +136,11 @@ hscSimpleIface :: HscEnv -> 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 \ No newline at end of file diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 269353e1ed..d1053ebffc 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/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 diff --git a/ghcide/src/Development/IDE/Types/Diagnostics.hs b/ghcide/src/Development/IDE/Types/Diagnostics.hs index 60dcce3c6c..8f19b13d8a 100644 --- a/ghcide/src/Development/IDE/Types/Diagnostics.hs +++ b/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