    module GHC.Driver.Errors (
        printOrThrowDiagnostics
      , printMessages
      , handleFlagWarnings
      , mkDriverPsHeaderMessage
      ) where

    import GHC.Driver.Errors.Types
    import GHC.Data.Bag
    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, ($$), SDocContext,  text, withPprStyle, mkErrStyle, sdocStyle )
    import GHC.Utils.Logger
    import qualified GHC.Driver.CmdLine as CmdLine

    printMessages :: Diagnostic a => Logger -> DiagOpts -> Messages a -> IO ()
    printMessages :: forall a. Diagnostic a => Logger -> DiagOpts -> Messages a -> IO ()
    printMessages Logger
    logger DiagOpts
    opts Messages a
    msgs
      = [IO ()] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [ let style :: PprStyle
    style = PrintUnqualified -> PprStyle
    mkErrStyle PrintUnqualified
    unqual
                        ctx :: SDocContext
    ctx   = (DiagOpts -> SDocContext
    diag_ppr_ctx DiagOpts
    opts) { sdocStyle :: PprStyle
    sdocStyle = PprStyle
    style }
                    in Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
    logMsg Logger
    logger (Severity -> DiagnosticReason -> MessageClass
    MCDiagnostic Severity
    sev (DiagnosticReason -> MessageClass)
    -> (a -> DiagnosticReason) -> a -> MessageClass
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> DiagnosticReason
    forall a. Diagnostic a => a -> DiagnosticReason
    diagnosticReason (a -> MessageClass) -> a -> MessageClass
    forall a b. (a -> b) -> a -> b
    $ a
    dia) SrcSpan
    s (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                       PprStyle -> SDoc -> SDoc
    withPprStyle PprStyle
    style (SDocContext -> a -> SDoc
    forall a. Diagnostic a => SDocContext -> a -> SDoc
    messageWithHints SDocContext
    ctx a
    dia)
                  | MsgEnvelope { errMsgSpan :: forall e. MsgEnvelope e -> SrcSpan
    errMsgSpan      = SrcSpan
    s,
                                  errMsgDiagnostic :: forall e. MsgEnvelope e -> e
    errMsgDiagnostic = a
    dia,
                                  errMsgSeverity :: forall e. MsgEnvelope e -> Severity
    errMsgSeverity = Severity
    sev,
                                  errMsgContext :: forall e. MsgEnvelope e -> PrintUnqualified
    errMsgContext   = PrintUnqualified
    unqual } <- Maybe DiagOpts -> Bag (MsgEnvelope a) -> [MsgEnvelope a]
    forall e. Maybe DiagOpts -> Bag (MsgEnvelope e) -> [MsgEnvelope e]
    sortMsgBag (DiagOpts -> Maybe DiagOpts
    forall a. a -> Maybe a
    Just DiagOpts
    opts)
                                                                           (Messages a -> Bag (MsgEnvelope a)
    forall e. Messages e -> Bag (MsgEnvelope e)
    getMessages Messages a
    msgs) ]
      where
        messageWithHints :: Diagnostic a => SDocContext -> a -> SDoc
        messageWithHints :: forall a. Diagnostic a => SDocContext -> a -> SDoc
    messageWithHints SDocContext
    ctx a
    e =
          let main_msg :: SDoc
    main_msg = SDocContext -> DecoratedSDoc -> SDoc
    formatBulleted SDocContext
    ctx (DecoratedSDoc -> SDoc) -> DecoratedSDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ a -> DecoratedSDoc
    forall a. Diagnostic a => a -> DecoratedSDoc
    diagnosticMessage a
    e
              in case a -> [GhcHint]
    forall a. Diagnostic a => a -> [GhcHint]
    diagnosticHints a
    e of
                   []  -> SDoc
    main_msg
                   [GhcHint
    h] -> SDoc
    main_msg SDoc -> SDoc -> SDoc
    $$ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Suggested fix:") Int
    2 (GhcHint -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GhcHint
    h)
                   [GhcHint]
    hs  -> SDoc
    main_msg SDoc -> SDoc -> SDoc
    $$ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Suggested fixes:") Int
    2
                                           (SDocContext -> DecoratedSDoc -> SDoc
    formatBulleted SDocContext
    ctx (DecoratedSDoc -> SDoc)
    -> ([GhcHint] -> DecoratedSDoc) -> [GhcHint] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> DecoratedSDoc
    mkDecorated ([SDoc] -> DecoratedSDoc)
    -> ([GhcHint] -> [SDoc]) -> [GhcHint] -> DecoratedSDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GhcHint -> SDoc) -> [GhcHint] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GhcHint -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([GhcHint] -> SDoc) -> [GhcHint] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [GhcHint]
    hs)

    handleFlagWarnings :: Logger -> DiagOpts -> [CmdLine.Warn] -> IO ()
    handleFlagWarnings :: Logger -> DiagOpts -> [Warn] -> IO ()
    handleFlagWarnings Logger
    logger DiagOpts
    opts [Warn]
    warns = do
      let -- It would be nicer if warns :: [Located SDoc], but that
          -- has circular import problems.
          bag :: Bag (MsgEnvelope GhcMessage)
    bag = [MsgEnvelope GhcMessage] -> Bag (MsgEnvelope GhcMessage)
    forall a. [a] -> Bag a
    listToBag [ DiagOpts -> SrcSpan -> GhcMessage -> MsgEnvelope GhcMessage
    forall e. Diagnostic e => DiagOpts -> SrcSpan -> e -> MsgEnvelope e
    mkPlainMsgEnvelope DiagOpts
    opts SrcSpan
    loc (GhcMessage -> MsgEnvelope GhcMessage)
    -> GhcMessage -> MsgEnvelope GhcMessage
    forall a b. (a -> b) -> a -> b
    $
                            DriverMessage -> GhcMessage
    GhcDriverMessage (DriverMessage -> GhcMessage) -> DriverMessage -> GhcMessage
    forall a b. (a -> b) -> a -> b
    $
                            DiagnosticMessage -> DriverMessage
    forall a. (Diagnostic a, Typeable a) => a -> DriverMessage
    DriverUnknownMessage (DiagnosticMessage -> DriverMessage)
    -> DiagnosticMessage -> DriverMessage
    forall a b. (a -> b) -> a -> b
    $
                            DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
    mkPlainDiagnostic DiagnosticReason
    reason [GhcHint]
    noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    warn
                          | CmdLine.Warn DiagnosticReason
    reason (L SrcSpan
    loc String
    warn) <- [Warn]
    warns ]

      Logger -> DiagOpts -> Messages GhcMessage -> IO ()
    printOrThrowDiagnostics Logger
    logger DiagOpts
    opts (Bag (MsgEnvelope GhcMessage) -> Messages GhcMessage
    forall e. Bag (MsgEnvelope e) -> Messages e
    mkMessages Bag (MsgEnvelope GhcMessage)
    bag)

    -- | Given a bag of diagnostics, turn them into an exception if
    -- any has 'SevError', or print them out otherwise.
    printOrThrowDiagnostics :: Logger -> DiagOpts -> Messages GhcMessage -> IO ()
    printOrThrowDiagnostics :: Logger -> DiagOpts -> Messages GhcMessage -> IO ()
    printOrThrowDiagnostics Logger
    logger DiagOpts
    opts Messages GhcMessage
    msgs
      | Messages GhcMessage -> Bool
    forall e. Messages e -> Bool
    errorsOrFatalWarningsFound Messages GhcMessage
    msgs
      = Messages GhcMessage -> IO ()
    forall (io :: * -> *) a. MonadIO io => Messages GhcMessage -> io a
    throwErrors Messages GhcMessage
    msgs
      | Bool
    otherwise
      = Logger -> DiagOpts -> Messages GhcMessage -> IO ()
    forall a. Diagnostic a => Logger -> DiagOpts -> Messages a -> IO ()
    printMessages Logger
    logger DiagOpts
    opts Messages GhcMessage
    msgs

    -- | Convert a 'PsError' into a wrapped 'DriverMessage'; use it
    -- for dealing with parse errors when the driver is doing dependency analysis.
    -- Defined here to avoid module loops between GHC.Driver.Error.Types and
    -- GHC.Driver.Error.Ppr
    mkDriverPsHeaderMessage :: MsgEnvelope PsMessage -> MsgEnvelope DriverMessage
    mkDriverPsHeaderMessage :: MsgEnvelope PsMessage -> MsgEnvelope DriverMessage
    mkDriverPsHeaderMessage = (PsMessage -> DriverMessage)
    -> MsgEnvelope PsMessage -> MsgEnvelope DriverMessage
    forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PsMessage -> DriverMessage
    DriverPsHeaderMessage