Simon Hengel pushed to branch wip/sol/remove-ddump-json at Glasgow Haskell Compiler / GHC Commits: 2ae6c686 by Simon Hengel at 2025-08-22T22:54:49+07:00 Get rid of MessageClass - - - - - 71d60bcd by Simon Hengel at 2025-08-22T22:57:14+07:00 Remove JSON logging - - - - - 12 changed files: - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Monad.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Utils/Error.hs - compiler/GHC/Utils/Logger.hs - ghc/GHCi/UI.hs - testsuite/tests/ghc-api/T7478/T7478.hs Changes: ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -362,18 +362,22 @@ we aren't using annotations heavily. ************************************************************************ -} -msg :: MessageClass -> SDoc -> CoreM () -msg msg_class doc = do +msg :: Message -> CoreM () +msg msg = do logger <- getLogger name_ppr_ctx <- getNamePprCtx - let sty = case msg_class of - MCDiagnostic _ _ _ _ -> err_sty - MCDump -> dump_sty - _ -> user_sty - err_sty = mkErrStyle name_ppr_ctx - user_sty = mkUserStyle name_ppr_ctx AllTheWay - dump_sty = mkDumpStyle name_ppr_ctx - liftIO $ logMsg logger (Message msg_class (withPprStyle sty doc)) + let m = case msg of + UnsafeMCDiagnostic span severity reason code doc json -> UnsafeMCDiagnostic span severity reason code (err_sty doc) json + MCDump doc -> MCDump (dump_sty doc) + MCOutput doc -> MCOutput (user_sty doc) + MCFatal doc -> MCFatal (user_sty doc) + MCInteractive doc -> MCInteractive (user_sty doc) + MCInfo doc -> MCInfo (user_sty doc) + + err_sty = withPprStyle $ mkErrStyle name_ppr_ctx + user_sty = withPprStyle $ mkUserStyle name_ppr_ctx AllTheWay + dump_sty = withPprStyle $ mkDumpStyle name_ppr_ctx + liftIO $ logMsg logger m -- | Output a String message to the screen putMsgS :: String -> CoreM () @@ -381,7 +385,7 @@ putMsgS = putMsg . text -- | Output a message to the screen putMsg :: SDoc -> CoreM () -putMsg = msg MCInfo +putMsg = msg . MCInfo diagnostic :: DiagnosticReason -> SDoc -> CoreM () diagnostic reason doc = do @@ -406,7 +410,7 @@ fatalErrorMsgS = fatalErrorMsg . text -- | Output a fatal error to the screen. Does not cause the compiler to die. fatalErrorMsg :: SDoc -> CoreM () -fatalErrorMsg = msg MCFatal +fatalErrorMsg = msg . MCFatal -- | Output a string debugging message at verbosity level of @-v@ or higher debugTraceMsgS :: String -> CoreM () @@ -414,4 +418,4 @@ debugTraceMsgS = debugTraceMsg . text -- | Outputs a debugging message at verbosity level of @-v@ or higher debugTraceMsg :: SDoc -> CoreM () -debugTraceMsg = msg MCDump +debugTraceMsg = msg . MCDump ===================================== compiler/GHC/Driver/Errors.hs ===================================== @@ -47,18 +47,15 @@ printMessages logger msg_opts opts = mapM_ (printMessage logger msg_opts opts) . printMessage :: forall a. (Diagnostic a) => Logger -> DiagnosticOpts a -> DiagOpts -> MsgEnvelope a -> IO () printMessage logger msg_opts opts message = do - decorated <- decorateDiagnostic logflags messageClass location doc - if log_diags_as_json then do - let - rendered :: String - rendered = renderWithContext (log_default_user_context logflags) decorated - - jsonMessage :: JsonDoc - jsonMessage = jsonDiagnostic rendered message - - logJsonMsg logger messageClass jsonMessage - else do - logMsg logger (Message messageClass decorated) + decorated <- decorateDiagnostic logflags location severity reason code doc + let + rendered :: String + rendered = renderWithContext (log_default_user_context logflags) decorated + + jsonMessage :: JsonDoc + jsonMessage = jsonDiagnostic rendered message + + logMsg logger $ UnsafeMCDiagnostic location severity reason code decorated jsonMessage where logflags :: LogFlags logflags = logFlags logger @@ -66,9 +63,6 @@ printMessage logger msg_opts opts message = do doc :: SDoc doc = updSDocContext (\_ -> ctx) (messageWithHints diagnostic) - messageClass :: MessageClass - messageClass = UnsafeMCDiagnostic location severity (errMsgReason message) (diagnosticCode diagnostic) - style :: PprStyle style = mkErrStyle (errMsgContext message) @@ -84,6 +78,12 @@ printMessage logger msg_opts opts message = do severity :: Severity severity = errMsgSeverity message + reason :: ResolvedDiagnosticReason + reason = errMsgReason message + + code :: Maybe DiagnosticCode + code = diagnosticCode diagnostic + messageWithHints :: a -> SDoc messageWithHints e = let main_msg = formatBulleted $ diagnosticMessage msg_opts e @@ -93,21 +93,18 @@ printMessage logger msg_opts opts message = do hs -> main_msg $$ hang (text "Suggested fixes:") 2 (formatBulleted $ mkDecorated . map ppr $ hs) - log_diags_as_json :: Bool - log_diags_as_json = log_diagnostics_as_json (logFlags logger) - -decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO SDoc -decorateDiagnostic logflags msg_class srcSpan msg = addCaret +decorateDiagnostic :: LogFlags -> SrcSpan -> Severity -> ResolvedDiagnosticReason -> Maybe DiagnosticCode -> SDoc -> IO SDoc +decorateDiagnostic logflags span severity reason code doc = addCaret where -- Pretty print the warning flag, if any (#10752) message :: SDoc - message = mkLocMessageWarningGroups (log_show_warn_groups logflags) msg_class srcSpan msg + message = formatDiagnostic (log_show_warn_groups logflags) span severity reason code doc addCaret :: IO SDoc addCaret = do caretDiagnostic <- if log_show_caret logflags - then getCaretDiagnostic msg_class srcSpan + then getCaretDiagnostic severity span else pure empty return $ getPprStyle $ \style -> withPprStyle (setStyleColoured True style) ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1846,7 +1846,8 @@ markUnsafeInfer tcg_env whyUnsafe = do badInst ins | checkOverlap (overlapMode (is_flag ins)) = [formatLocMessage (nameSrcSpan $ getName $ is_dfun ins) $ ppr (overlapMode $ is_flag ins) <+> - text "overlap mode isn't allowed in Safe Haskell"] + text "overlap mode isn't allowed in Safe Haskell" + ] | otherwise = [] -- | Figure out the final correct safe haskell mode ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -1447,11 +1447,11 @@ withDeferredDiagnostics f = do let deferDiagnostics _dflags !msg = do let action = logMsg logger msg case msg of - Message (MCDiagnostic _ SevWarning _reason _code) _ + MCDiagnostic _ SevWarning _reason _code -> atomicModifyIORef' warnings $ \(!i) -> (action: i, ()) - Message (MCDiagnostic _ SevError _reason _code) _ + MCDiagnostic _ SevError _reason _code -> atomicModifyIORef' errors $ \(!i) -> (action: i, ()) - Message MCFatal _ + MCFatal _ -> atomicModifyIORef' fatals $ \(!i) -> (action: i, ()) _ -> action ===================================== compiler/GHC/Driver/Monad.hs ===================================== @@ -23,8 +23,6 @@ module GHC.Driver.Monad ( modifyLogger, pushLogHookM, popLogHookM, - pushJsonLogHookM, - popJsonLogHookM, putLogMsgM, putMsgM, withTimingM, @@ -47,7 +45,6 @@ import GHC.Utils.Exception import GHC.Utils.Error import GHC.Utils.Logger -import GHC.Types.Error ( Message ) import GHC.Types.SourceError import Control.Monad @@ -123,12 +120,6 @@ pushLogHookM = modifyLogger . pushLogHook popLogHookM :: GhcMonad m => m () popLogHookM = modifyLogger popLogHook -pushJsonLogHookM :: GhcMonad m => (LogJsonAction -> LogJsonAction) -> m () -pushJsonLogHookM = modifyLogger . pushJsonLogHook - -popJsonLogHookM :: GhcMonad m => m () -popJsonLogHookM = modifyLogger popJsonLogHook - -- | Put a log message putMsgM :: GhcMonad m => SDoc -> m () putMsgM doc = do ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -96,7 +96,6 @@ import GHC.Types.TypeEnv import GHC.Types.Unique.DSet import GHC.Types.TyThing import GHC.Types.PkgQual -import GHC.Types.Error (Message(..)) import GHC.Unit.External import GHC.Unit.Module @@ -1119,7 +1118,7 @@ showIface logger dflags unit_state name_cache filename = do neverQualifyModules neverQualifyPackages alwaysPrintPromTick - logMsg logger $ Message MCDump + logMsg logger $ MCDump $ withPprStyle (mkDumpStyle name_ppr_ctx) $ pprModIface unit_state iface ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -72,7 +72,6 @@ import GHC.Types.Name.Env import GHC.Types.SrcLoc import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM -import GHC.Types.Error (Message(..)) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -1639,7 +1638,7 @@ addEnvPaths name list maybePutSDoc :: Logger -> SDoc -> IO () maybePutSDoc logger s = when (logVerbAtLeast logger 2) $ - logMsg logger $ Message + logMsg logger $ MCInteractive $ withPprStyle defaultUserStyle s ===================================== compiler/GHC/Types/Error.hs ===================================== @@ -26,8 +26,7 @@ module GHC.Types.Error -- * Classifying Messages - , Message (..) - , MessageClass (MCDiagnostic, ..) + , Message (MCDiagnostic, ..) , Severity (..) , Diagnostic (..) , UnknownDiagnostic (..) @@ -71,7 +70,6 @@ module GHC.Types.Error , mapDecoratedSDoc , pprMessageBag - , mkLocMessageWarningGroups , formatLocMessage , formatFatalLocMessage , formatDiagnostic @@ -478,27 +476,25 @@ data MsgEnvelope e = MsgEnvelope -- See Note [Warnings controlled by multiple flags] } deriving (Functor, Foldable, Traversable) -data Message = Message MessageClass SDoc - -- | The class for a diagnostic message. The main purpose is to classify a -- message within GHC, to distinguish it from a debug/dump message vs a proper -- diagnostic, for which we include a 'DiagnosticReason'. -data MessageClass - = MCOutput - | MCFatal - | MCInteractive +data Message + = MCOutput SDoc + | MCFatal SDoc + | MCInteractive SDoc - | MCDump + | MCDump SDoc -- ^ Log message intended for compiler developers -- No file\/line\/column stuff - | MCInfo + | MCInfo SDoc -- ^ Log messages intended for end users. -- No file\/line\/column stuff. - | UnsafeMCDiagnostic SrcSpan Severity ResolvedDiagnosticReason (Maybe DiagnosticCode) + | UnsafeMCDiagnostic SrcSpan Severity ResolvedDiagnosticReason (Maybe DiagnosticCode) SDoc JsonDoc -- ^ Diagnostics from the compiler. This constructor is very powerful as - -- it allows the construction of a 'MessageClass' with a completely + -- it allows the construction of a 'Message' with a completely -- arbitrary permutation of 'Severity' and 'DiagnosticReason'. As such, -- users are encouraged to use higher level primitives -- instead. Use this constructor directly only if you need to construct @@ -512,8 +508,8 @@ data MessageClass -- should always have a 'DiagnosticCode'. See Note [Diagnostic codes]. {-# COMPLETE MCOutput, MCFatal, MCInteractive, MCDump, MCInfo, MCDiagnostic #-} -pattern MCDiagnostic :: SrcSpan -> Severity -> ResolvedDiagnosticReason -> Maybe DiagnosticCode -> MessageClass -pattern MCDiagnostic span severity reason code <- UnsafeMCDiagnostic span severity reason code +pattern MCDiagnostic :: SrcSpan -> Severity -> ResolvedDiagnosticReason -> Maybe DiagnosticCode -> Message +pattern MCDiagnostic span severity reason code <- UnsafeMCDiagnostic span severity reason code _diagnostic _json {- Note [Suppressing Messages] @@ -638,23 +634,9 @@ showMsgEnvelope err = pprMessageBag :: Bag SDoc -> SDoc pprMessageBag msgs = vcat (punctuate blankLine (bagToList msgs)) --- | Make an error message with location info, specifying whether to show --- warning groups (if applicable). -mkLocMessageWarningGroups - :: Bool -- ^ Print warning groups (if applicable)? - -> MessageClass -- ^ What kind of message? - -> SrcSpan -- ^ location - -> SDoc -- ^ message - -> SDoc -mkLocMessageWarningGroups show_warn_groups msg_class locn msg - = case msg_class of - MCDiagnostic span severity reason code -> formatDiagnostic show_warn_groups span severity reason code msg - MCFatal -> formatFatalLocMessage locn msg - _ -> formatLocMessage locn msg - formatFatalLocMessage :: SrcSpan -> SDoc -> SDoc formatFatalLocMessage locn msg = sdocOption sdocColScheme $ \col_scheme -> - let msg_title = coloured (fatalColour col_scheme) $ text "fatal" + let msg_title = coloured (Col.sFatal col_scheme) $ text "fatal" in formatLocMessageWarningGroups locn msg_title empty empty msg formatLocMessage :: SrcSpan -> SDoc -> SDoc @@ -769,16 +751,7 @@ formatLocMessageWarningGroups locn msg_title code_doc warning_flag_doc msg code_doc <+> warning_flag_doc in coloured (Col.sMessage col_scheme) - (hang (coloured (Col.sHeader col_scheme) header) 4 - msg) - -getMessageClassColour :: MessageClass -> Col.Scheme -> Col.PprColour -getMessageClassColour (MCDiagnostic _span severity _reason _code) = getSeverityColour severity -getMessageClassColour MCFatal = fatalColour -getMessageClassColour _ = const mempty - -fatalColour :: Col.Scheme -> Col.PprColour -fatalColour = Col.sFatal + $ hang (coloured (Col.sHeader col_scheme) header) 4 msg getSeverityColour :: Severity -> Col.Scheme -> Col.PprColour getSeverityColour severity = case severity of @@ -786,9 +759,9 @@ getSeverityColour severity = case severity of SevWarning -> Col.sWarning SevIgnore -> const mempty -getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc +getCaretDiagnostic :: Severity -> SrcSpan -> IO SDoc getCaretDiagnostic _ (UnhelpfulSpan _) = pure empty -getCaretDiagnostic msg_class (RealSrcSpan span _) = +getCaretDiagnostic severity (RealSrcSpan span _) = caretDiagnostic <$> getSrcLine (srcSpanFile span) row where getSrcLine fn i = @@ -821,7 +794,7 @@ getCaretDiagnostic msg_class (RealSrcSpan span _) = caretDiagnostic Nothing = empty caretDiagnostic (Just srcLineWithNewline) = sdocOption sdocColScheme$ \col_scheme -> - let sevColour = getMessageClassColour msg_class col_scheme + let sevColour = getSeverityColour severity col_scheme marginColour = Col.sMargin col_scheme in coloured marginColour (text marginSpace) <> ===================================== compiler/GHC/Utils/Error.hs ===================================== @@ -14,7 +14,7 @@ module GHC.Utils.Error ( -- * Messages Diagnostic(..), MsgEnvelope(..), - MessageClass(..), + Message(..), SDoc, DecoratedSDoc(unDecorated), Messages, @@ -313,7 +313,7 @@ ghcExit logger val fatalErrorMsg :: Logger -> SDoc -> IO () fatalErrorMsg logger msg = - logMsg logger $ Message MCFatal (withPprStyle defaultErrStyle msg) + logMsg logger $ MCFatal (withPprStyle defaultErrStyle msg) compilationProgressMsg :: Logger -> SDoc -> IO () compilationProgressMsg logger msg = do @@ -474,11 +474,11 @@ printOutputForUser logger name_ppr_ctx msg = logOutput logger (withUserStyle name_ppr_ctx AllTheWay msg) logInfo :: Logger -> SDoc -> IO () -logInfo logger = logMsg logger . Message MCInfo +logInfo logger = logMsg logger . MCInfo -- | Like 'logInfo' but with 'SevOutput' rather then 'SevInfo' logOutput :: Logger -> SDoc -> IO () -logOutput logger = logMsg logger . Message MCOutput +logOutput logger = logMsg logger . MCOutput prettyPrintGhcErrors :: ExceptionMonad m => Logger -> m a -> m a ===================================== compiler/GHC/Utils/Logger.hs ===================================== @@ -24,7 +24,6 @@ module GHC.Utils.Logger -- * Logger setup , initLogger , LogAction - , LogJsonAction , DumpAction , TraceAction , DumpFormat (..) @@ -32,8 +31,6 @@ module GHC.Utils.Logger -- ** Hooks , popLogHook , pushLogHook - , popJsonLogHook - , pushJsonLogHook , popDumpHook , pushDumpHook , popTraceHook @@ -55,11 +52,9 @@ module GHC.Utils.Logger , putLogMsg , defaultLogAction , defaultLogActionWithHandles - , defaultLogJsonAction , defaultLogActionHPrintDoc , defaultLogActionHPutStrDoc , logMsg - , logJsonMsg , logDumpMsg -- * Dumping @@ -86,8 +81,8 @@ import GHC.Types.Error import qualified GHC.Utils.Ppr as Pretty import GHC.Utils.Outputable -import GHC.Utils.Json import GHC.Utils.Panic +import GHC.Utils.Json (renderJSON) import GHC.Data.EnumSet (EnumSet) import qualified GHC.Data.EnumSet as EnumSet @@ -181,11 +176,6 @@ type LogAction = LogFlags -> Message -> IO () -type LogJsonAction = LogFlags - -> MessageClass - -> JsonDoc - -> IO () - type DumpAction = LogFlags -> PprStyle -> DumpFlag @@ -223,9 +213,6 @@ data Logger = Logger { log_hook :: [LogAction -> LogAction] -- ^ Log hooks stack - , json_log_hook :: [LogJsonAction -> LogJsonAction] - -- ^ Json log hooks stack - , dump_hook :: [DumpAction -> DumpAction] -- ^ Dump hooks stack @@ -261,7 +248,6 @@ initLogger = do dumps <- newMVar Map.empty return $ Logger { log_hook = [] - , json_log_hook = [] , dump_hook = [] , trace_hook = [] , generated_dumps = dumps @@ -273,10 +259,6 @@ initLogger = do putLogMsg :: Logger -> LogAction putLogMsg logger = foldr ($) defaultLogAction (log_hook logger) --- | Log a JsonDoc -putJsonLogMsg :: Logger -> LogJsonAction -putJsonLogMsg logger = foldr ($) defaultLogJsonAction (json_log_hook logger) - -- | Dump something putDumpFile :: Logger -> DumpAction putDumpFile logger = @@ -301,15 +283,6 @@ popLogHook logger = case log_hook logger of [] -> panic "popLogHook: empty hook stack" _:hs -> logger { log_hook = hs } --- | Push a json log hook -pushJsonLogHook :: (LogJsonAction -> LogJsonAction) -> Logger -> Logger -pushJsonLogHook h logger = logger { json_log_hook = h:json_log_hook logger } - -popJsonLogHook :: Logger -> Logger -popJsonLogHook logger = case json_log_hook logger of - [] -> panic "popJsonLogHook: empty hook stack" - _:hs -> logger { json_log_hook = hs} - -- | Push a dump hook pushDumpHook :: (DumpAction -> DumpAction) -> Logger -> Logger pushDumpHook h logger = logger { dump_hook = h:dump_hook logger } @@ -353,22 +326,6 @@ makeThreadSafe logger = do $ pushTraceHook trc $ logger -defaultLogJsonAction :: LogJsonAction -defaultLogJsonAction logflags msg_class jsdoc = - case msg_class of - MCOutput -> printOut msg - MCDump -> printOut (msg $$ blankLine) - MCInteractive -> putStrSDoc msg - MCInfo -> printErrs msg - MCFatal -> printErrs msg - MCDiagnostic _ SevIgnore _ _ -> pure () -- suppress the message - MCDiagnostic _span _sev _rea _code -> printErrs msg - where - printOut = defaultLogActionHPrintDoc logflags False stdout - printErrs = defaultLogActionHPrintDoc logflags False stderr - putStrSDoc = defaultLogActionHPutStrDoc logflags False stdout - msg = renderJSON jsdoc - -- | The default 'LogAction' prints to 'stdout' and 'stderr'. -- -- To replicate the default log action behaviour with different @out@ and @err@ @@ -381,13 +338,17 @@ defaultLogAction = defaultLogActionWithHandles stdout stderr defaultLogActionWithHandles :: Handle {-^ Handle for standard output -} -> Handle {-^ Handle for standard errors -} -> LogAction defaultLogActionWithHandles out err logflags message = case message of - Message MCOutput msg -> printOut msg - Message MCDump msg -> printOut (msg $$ blankLine) - Message MCInteractive msg -> putStrSDoc msg - Message MCInfo msg -> printErrs msg - Message MCFatal msg -> printErrs msg - Message (MCDiagnostic _ SevIgnore _ _) _ -> pure () -- suppress the message - Message (MCDiagnostic _span _sev _rea _code) msg -> printErrs msg + MCOutput msg -> printOut msg + MCDump msg -> printOut (msg $$ blankLine) + MCInteractive msg -> putStrSDoc msg + MCInfo msg -> printErrs msg + MCFatal msg -> printErrs msg + MCDiagnostic _ SevIgnore _ _ -> pure () -- suppress the message + UnsafeMCDiagnostic _span _severity _reason _code doc json -> do + if log_diagnostics_as_json logflags then do + printErrs (renderJSON json) + else do + printErrs doc where printOut = defaultLogActionHPrintDoc logflags False out printErrs = defaultLogActionHPrintDoc logflags False err @@ -438,10 +399,10 @@ dumpSDocWithStyle dumps log_action sty logflags flag hdr doc = -- write the dump to stdout writeDump Nothing = do - let (doc', msg_class) - | null hdr = (doc, MCOutput) - | otherwise = (mkDumpDoc hdr doc, MCDump) - log_action logflags (Message msg_class (withPprStyle sty doc')) + let message + | null hdr = MCOutput (withPprStyle sty doc) + | otherwise = MCDump (withPprStyle sty $ mkDumpDoc hdr doc) + log_action logflags message -- | Run an action with the handle of a 'DumpFlag' if we are outputting to a @@ -534,9 +495,6 @@ defaultTraceAction logflags title doc x = logMsg :: Logger -> Message -> IO () logMsg logger = putLogMsg logger (logFlags logger) -logJsonMsg :: Logger -> MessageClass -> JsonDoc -> IO () -logJsonMsg logger mc = putJsonLogMsg logger (logFlags logger) mc - -- | Dump something logDumpFile :: Logger -> PprStyle -> DumpFlag -> String -> DumpFormat -> SDoc -> IO () logDumpFile logger = putDumpFile logger (logFlags logger) @@ -547,7 +505,7 @@ logTraceMsg logger hdr doc a = putTraceMsg logger (logFlags logger) hdr doc a -- | Log a dump message (not a dump file) logDumpMsg :: Logger -> String -> SDoc -> IO () -logDumpMsg logger hdr doc = logMsg logger $ Message MCDump +logDumpMsg logger hdr doc = logMsg logger $ MCDump (withPprStyle defaultDumpStyle (mkDumpDoc hdr doc)) ===================================== ghc/GHCi/UI.hs ===================================== @@ -836,7 +836,7 @@ ghciLogAction lastErrLocations old_log_action dflags msg = do old_log_action dflags msg case msg of - Message (MCDiagnostic srcSpan SevError _reason _code) _ -> case srcSpan of + MCDiagnostic srcSpan SevError _reason _code -> case srcSpan of RealSrcSpan rsp _ -> modifyIORef lastErrLocations (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))]) _ -> return () ===================================== testsuite/tests/ghc-api/T7478/T7478.hs ===================================== @@ -24,7 +24,7 @@ compileInGhc targets handlerOutput = do flags0 <- getSessionDynFlags let flags = flags0 {verbosity = 1 } setSessionDynFlags flags - let collectSrcError _flags (Message MCOutput msg) + let collectSrcError _flags (MCOutput msg) = handlerOutput $ GHC.showSDocForUser flags emptyUnitState alwaysQualify msg collectSrcError _ _ = return () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7cb010c8b8e0bf8c1239818328a95e... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7cb010c8b8e0bf8c1239818328a95e... You're receiving this email because of your account on gitlab.haskell.org.