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
3 changed files:
Changes:
| 1 | 1 | {-# LANGUAGE ScopedTypeVariables #-}
|
| 2 | 2 | module GHC.Driver.Errors (
|
| 3 | - printOrThrowDiagnostics
|
|
| 3 | + reportError
|
|
| 4 | 4 | , printMessages
|
| 5 | + , printOrThrowDiagnostics
|
|
| 5 | 6 | , mkDriverPsHeaderMessage
|
| 6 | 7 | ) where
|
| 7 | 8 | |
| 8 | 9 | import GHC.Driver.Errors.Types
|
| 9 | 10 | import GHC.Prelude
|
| 11 | +import GHC.Types.SrcLoc
|
|
| 10 | 12 | import GHC.Types.SourceError
|
| 11 | 13 | import GHC.Types.Error
|
| 12 | 14 | import GHC.Utils.Error
|
| 13 | -import GHC.Utils.Outputable (hang, ppr, ($$), text, mkErrStyle, sdocStyle, updSDocContext )
|
|
| 15 | +import GHC.Utils.Outputable
|
|
| 14 | 16 | import GHC.Utils.Logger
|
| 15 | 17 | |
| 18 | +reportError :: Logger -> SrcSpan -> SDoc -> IO ()
|
|
| 19 | +reportError logger span message = do
|
|
| 20 | + printMessages logger NoDiagnosticOpts emptyDiagOpts $ singleMessage MsgEnvelope {
|
|
| 21 | + errMsgSpan = span
|
|
| 22 | + , errMsgContext = alwaysQualify
|
|
| 23 | + , errMsgDiagnostic = DiagnosticMessage {
|
|
| 24 | + diagMessage = mkDecorated [message]
|
|
| 25 | + , diagReason = ErrorWithoutFlag
|
|
| 26 | + , diagHints = []
|
|
| 27 | + }
|
|
| 28 | + , errMsgSeverity = SevError
|
|
| 29 | + , errMsgReason = ResolvedDiagnosticReason ErrorWithoutFlag
|
|
| 30 | + }
|
|
| 31 | + |
|
| 16 | 32 | printMessages :: forall a. (Diagnostic a) => Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO ()
|
| 17 | 33 | printMessages logger msg_opts opts msgs
|
| 18 | 34 | = sequence_ [ let style = mkErrStyle name_ppr_ctx
|
| ... | ... | @@ -26,6 +26,8 @@ import GHC.Utils.Logger |
| 26 | 26 | import GHC.Utils.TmpFs
|
| 27 | 27 | import GHC.Utils.CliOption
|
| 28 | 28 | |
| 29 | +import GHC.Driver.Errors (reportError)
|
|
| 30 | + |
|
| 29 | 31 | import GHC.Types.SrcLoc ( SrcLoc, mkSrcLoc, mkSrcSpan )
|
| 30 | 32 | import GHC.Data.FastString
|
| 31 | 33 | |
| ... | ... | @@ -286,8 +288,7 @@ builderMainLoop logger filter_fn pgm real_args mb_cwd mb_env = withPipe $ \ (rea |
| 286 | 288 | BuildMsg msg -> do
|
| 287 | 289 | logInfo logger $ withPprStyle defaultUserStyle msg
|
| 288 | 290 | BuildError loc msg -> do
|
| 289 | - logMsg logger errorDiagnostic (mkSrcSpan loc loc)
|
|
| 290 | - $ withPprStyle defaultUserStyle msg
|
|
| 291 | + reportError logger (mkSrcSpan loc loc) msg
|
|
| 291 | 292 | |
| 292 | 293 | parseBuildMessages :: [String] -> [BuildMessage]
|
| 293 | 294 | parseBuildMessages str = loop str Nothing
|
| ... | ... | @@ -52,7 +52,7 @@ import GHC.Core.DataCon |
| 52 | 52 | import GHC.Core.ConLike
|
| 53 | 53 | import GHC.Core.PatSyn
|
| 54 | 54 | import GHC.Driver.Flags
|
| 55 | -import GHC.Driver.Errors
|
|
| 55 | +import GHC.Driver.Errors (printOrThrowDiagnostics)
|
|
| 56 | 56 | import GHC.Driver.Errors.Types
|
| 57 | 57 | import GHC.Driver.Phases
|
| 58 | 58 | import GHC.Driver.Session as DynFlags
|