Simon Hengel pushed to branch wip/sol/pre-processors-errors at Glasgow Haskell Compiler / GHC Commits: a8fa2945 by Simon Hengel at 2025-07-07T13:22:14+07:00 Respect `-fdiagnostics-as-json` for error messages from pre-processors (fixes #25480) - - - - - 3 changed files: - compiler/GHC/Driver/Errors.hs - compiler/GHC/SysTools/Process.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC/Driver/Errors.hs ===================================== @@ -1,18 +1,34 @@ {-# LANGUAGE ScopedTypeVariables #-} module GHC.Driver.Errors ( - printOrThrowDiagnostics + reportError , printMessages + , printOrThrowDiagnostics , mkDriverPsHeaderMessage ) where import GHC.Driver.Errors.Types import GHC.Prelude +import GHC.Types.SrcLoc import GHC.Types.SourceError import GHC.Types.Error import GHC.Utils.Error -import GHC.Utils.Outputable (hang, ppr, ($$), text, mkErrStyle, sdocStyle, updSDocContext ) +import GHC.Utils.Outputable import GHC.Utils.Logger +reportError :: Logger -> SrcSpan -> SDoc -> IO () +reportError logger span message = do + printMessages logger NoDiagnosticOpts emptyDiagOpts $ singleMessage MsgEnvelope { + errMsgSpan = span + , errMsgContext = alwaysQualify + , errMsgDiagnostic = DiagnosticMessage { + diagMessage = mkDecorated [message] + , diagReason = ErrorWithoutFlag + , diagHints = [] + } + , errMsgSeverity = SevError + , errMsgReason = ResolvedDiagnosticReason ErrorWithoutFlag + } + printMessages :: forall a. (Diagnostic a) => Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO () printMessages logger msg_opts opts msgs = sequence_ [ let style = mkErrStyle name_ppr_ctx ===================================== compiler/GHC/SysTools/Process.hs ===================================== @@ -26,6 +26,8 @@ import GHC.Utils.Logger import GHC.Utils.TmpFs import GHC.Utils.CliOption +import GHC.Driver.Errors (reportError) + import GHC.Types.SrcLoc ( SrcLoc, mkSrcLoc, mkSrcSpan ) import GHC.Data.FastString @@ -286,8 +288,7 @@ builderMainLoop logger filter_fn pgm real_args mb_cwd mb_env = withPipe $ \ (rea BuildMsg msg -> do logInfo logger $ withPprStyle defaultUserStyle msg BuildError loc msg -> do - logMsg logger errorDiagnostic (mkSrcSpan loc loc) - $ withPprStyle defaultUserStyle msg + reportError logger (mkSrcSpan loc loc) msg parseBuildMessages :: [String] -> [BuildMessage] parseBuildMessages str = loop str Nothing ===================================== ghc/GHCi/UI.hs ===================================== @@ -52,7 +52,7 @@ import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Core.PatSyn import GHC.Driver.Flags -import GHC.Driver.Errors +import GHC.Driver.Errors (printOrThrowDiagnostics) import GHC.Driver.Errors.Types import GHC.Driver.Phases import GHC.Driver.Session as DynFlags View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a8fa2945c584d47490f6b37af6c28220... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a8fa2945c584d47490f6b37af6c28220... You're receiving this email because of your account on gitlab.haskell.org.