    {-# LANGUAGE ScopedTypeVariables #-}
    module GHC.Driver.Errors (
        printOrThrowDiagnostics
      , printMessages
      , mkDriverPsHeaderMessage
      ) where

    import GHC.Driver.Errors.Types
    import GHC.Prelude
    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.Logger

    printMessages :: forall a . Diagnostic a => Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO ()
    printMessages :: forall a.
    Diagnostic a =>
    Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO ()
    printMessages Logger
    logger DiagnosticOpts a
    msg_opts DiagOpts
    opts Messages a
    msgs
      = [IO ()] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [ let style :: PprStyle
    style = NamePprCtx -> PprStyle
    mkErrStyle NamePprCtx
    name_ppr_ctx
                        ctx :: SDocContext
    ctx   = (DiagOpts -> SDocContext
    diag_ppr_ctx DiagOpts
    opts) { sdocStyle = style }
                    in (if Bool
    log_diags_as_json
                        then Logger -> MessageClass -> MsgEnvelope a -> IO ()
    forall a. ToJson a => Logger -> MessageClass -> a -> IO ()
    logJsonMsg Logger
    logger (Severity
    -> ResolvedDiagnosticReason -> Maybe DiagnosticCode -> MessageClass
    MCDiagnostic Severity
    sev ResolvedDiagnosticReason
    reason (a -> Maybe DiagnosticCode
    forall a. Diagnostic a => a -> Maybe DiagnosticCode
    diagnosticCode a
    dia)) MsgEnvelope a
    msg
                        else Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
    logMsg Logger
    logger (Severity
    -> ResolvedDiagnosticReason -> Maybe DiagnosticCode -> MessageClass
    MCDiagnostic Severity
    sev ResolvedDiagnosticReason
    reason (a -> Maybe DiagnosticCode
    forall a. Diagnostic a => a -> Maybe DiagnosticCode
    diagnosticCode a
    dia)) SrcSpan
    s (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                      (SDocContext -> SDocContext) -> SDoc -> SDoc
    updSDocContext (\SDocContext
    _ -> SDocContext
    ctx) (a -> SDoc
    Diagnostic a => a -> SDoc
    messageWithHints a
    dia))
                  | msg :: MsgEnvelope a
    msg@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,
                                      errMsgReason :: forall e. MsgEnvelope e -> ResolvedDiagnosticReason
    errMsgReason     = ResolvedDiagnosticReason
    reason,
                                      errMsgContext :: forall e. MsgEnvelope e -> NamePprCtx
    errMsgContext    = NamePprCtx
    name_ppr_ctx }
                      <- 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 => a -> SDoc
        messageWithHints :: Diagnostic a => a -> SDoc
    messageWithHints a
    e =
          let main_msg :: SDoc
    main_msg = DecoratedSDoc -> SDoc
    formatBulleted (DecoratedSDoc -> SDoc) -> DecoratedSDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ DiagnosticOpts a -> a -> DecoratedSDoc
    forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
    diagnosticMessage DiagnosticOpts a
    msg_opts 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
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    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
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Suggested fixes:") Int
    2
                                           (DecoratedSDoc -> SDoc
    formatBulleted  (DecoratedSDoc -> SDoc) -> DecoratedSDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [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] -> DecoratedSDoc) -> [GhcHint] -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [GhcHint]
    hs)
        log_diags_as_json :: Bool
    log_diags_as_json = LogFlags -> Bool
    log_diagnostics_as_json (Logger -> LogFlags
    logFlags Logger
    logger)

    -- | Given a bag of diagnostics, turn them into an exception if
    -- any has 'SevError', or print them out otherwise.
    printOrThrowDiagnostics :: Logger -> GhcMessageOpts -> DiagOpts -> Messages GhcMessage -> IO ()
    printOrThrowDiagnostics :: Logger
    -> GhcMessageOpts -> DiagOpts -> Messages GhcMessage -> IO ()
    printOrThrowDiagnostics Logger
    logger GhcMessageOpts
    print_config 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
    -> DiagnosticOpts GhcMessage
    -> DiagOpts
    -> Messages GhcMessage
    -> IO ()
    forall a.
    Diagnostic a =>
    Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO ()
    printMessages Logger
    logger DiagnosticOpts GhcMessage
    GhcMessageOpts
    print_config 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