    module GHC.Driver.Errors (
        warningsToMessages
      , printOrThrowWarnings
      , printBagOfErrors
      , isWarnMsgFatal
      , handleFlagWarnings
      ) where

    import GHC.Driver.Session
    import GHC.Data.Bag
    import GHC.Utils.Exception
    import GHC.Utils.Error ( formatBulleted, sortMsgBag )
    import GHC.Types.SourceError ( mkSrcErr )
    import GHC.Prelude
    import GHC.Types.SrcLoc
    import GHC.Types.Error
    import GHC.Utils.Outputable ( text, withPprStyle, mkErrStyle )
    import GHC.Utils.Logger
    import qualified GHC.Driver.CmdLine as CmdLine

    -- | Converts a list of 'WarningMessages' into a tuple where the second element contains only
    -- error, i.e. warnings that are considered fatal by GHC based on the input 'DynFlags'.
    warningsToMessages :: DynFlags -> WarningMessages -> (WarningMessages, ErrorMessages)
    warningsToMessages :: DynFlags -> WarningMessages -> (WarningMessages, WarningMessages)
    warningsToMessages DynFlags
    dflags =
      (MsgEnvelope DecoratedSDoc
     -> Either (MsgEnvelope DecoratedSDoc) (MsgEnvelope DecoratedSDoc))
    -> WarningMessages -> (WarningMessages, WarningMessages)
    forall a b c. (a -> Either b c) -> Bag a -> (Bag b, Bag c)
    partitionBagWith ((MsgEnvelope DecoratedSDoc
      -> Either (MsgEnvelope DecoratedSDoc) (MsgEnvelope DecoratedSDoc))
     -> WarningMessages -> (WarningMessages, WarningMessages))
    -> (MsgEnvelope DecoratedSDoc
        -> Either (MsgEnvelope DecoratedSDoc) (MsgEnvelope DecoratedSDoc))
    -> WarningMessages
    -> (WarningMessages, WarningMessages)
    forall a b. (a -> b) -> a -> b
    $ \MsgEnvelope DecoratedSDoc
    warn ->
        case DynFlags -> MsgEnvelope DecoratedSDoc -> Maybe (Maybe WarningFlag)
    isWarnMsgFatal DynFlags
    dflags MsgEnvelope DecoratedSDoc
    warn of
          Maybe (Maybe WarningFlag)
    Nothing -> MsgEnvelope DecoratedSDoc
    -> Either (MsgEnvelope DecoratedSDoc) (MsgEnvelope DecoratedSDoc)
    forall a b. a -> Either a b
    Left MsgEnvelope DecoratedSDoc
    warn
          Just Maybe WarningFlag
    err_reason ->
            MsgEnvelope DecoratedSDoc
    -> Either (MsgEnvelope DecoratedSDoc) (MsgEnvelope DecoratedSDoc)
    forall a b. b -> Either a b
    Right MsgEnvelope DecoratedSDoc
    warn{ errMsgSeverity :: Severity
    errMsgSeverity = Severity
    SevError
                      , errMsgReason :: WarnReason
    errMsgReason = Maybe WarningFlag -> WarnReason
    ErrReason Maybe WarningFlag
    err_reason }

    printBagOfErrors :: RenderableDiagnostic a => Logger -> DynFlags -> Bag (MsgEnvelope a) -> IO ()
    printBagOfErrors :: forall a.
    RenderableDiagnostic a =>
    Logger -> DynFlags -> Bag (MsgEnvelope a) -> IO ()
    printBagOfErrors Logger
    logger DynFlags
    dflags Bag (MsgEnvelope a)
    bag_of_errors
      = [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   = DynFlags -> PprStyle -> SDocContext
    initSDocContext DynFlags
    dflags PprStyle
    style
                    in Logger -> LogAction
    putLogMsg Logger
    logger DynFlags
    dflags WarnReason
    reason Severity
    sev SrcSpan
    s (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                       PprStyle -> SDoc -> SDoc
    withPprStyle PprStyle
    style (SDocContext -> DecoratedSDoc -> SDoc
    formatBulleted SDocContext
    ctx (a -> DecoratedSDoc
    forall a. RenderableDiagnostic a => a -> DecoratedSDoc
    renderDiagnostic a
    doc))
                  | MsgEnvelope { errMsgSpan :: forall e. MsgEnvelope e -> SrcSpan
    errMsgSpan      = SrcSpan
    s,
                                  errMsgDiagnostic :: forall e. MsgEnvelope e -> e
    errMsgDiagnostic = a
    doc,
                                  errMsgSeverity :: forall e. MsgEnvelope e -> Severity
    errMsgSeverity  = Severity
    sev,
                                  errMsgReason :: forall e. MsgEnvelope e -> WarnReason
    errMsgReason    = WarnReason
    reason,
                                  errMsgContext :: forall e. MsgEnvelope e -> PrintUnqualified
    errMsgContext   = PrintUnqualified
    unqual } <- Maybe DynFlags -> Bag (MsgEnvelope a) -> [MsgEnvelope a]
    forall e. Maybe DynFlags -> Bag (MsgEnvelope e) -> [MsgEnvelope e]
    sortMsgBag (DynFlags -> Maybe DynFlags
    forall a. a -> Maybe a
    Just DynFlags
    dflags)
                                                                           Bag (MsgEnvelope a)
    bag_of_errors ]

    handleFlagWarnings :: Logger -> DynFlags -> [CmdLine.Warn] -> IO ()
    handleFlagWarnings :: Logger -> DynFlags -> [Warn] -> IO ()
    handleFlagWarnings Logger
    logger DynFlags
    dflags [Warn]
    warns = do
      let warns' :: [Warn]
    warns' = (Warn -> Bool) -> [Warn] -> [Warn]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (DynFlags -> WarnReason -> Bool
    shouldPrintWarning DynFlags
    dflags (WarnReason -> Bool) -> (Warn -> WarnReason) -> Warn -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Warn -> WarnReason
    CmdLine.warnReason)  [Warn]
    warns

          -- It would be nicer if warns :: [Located SDoc], but that
          -- has circular import problems.
          bag :: WarningMessages
    bag = [MsgEnvelope DecoratedSDoc] -> WarningMessages
    forall a. [a] -> Bag a
    listToBag [ SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainWarnMsg SrcSpan
    loc (String -> SDoc
    text String
    warn)
                          | CmdLine.Warn WarnReason
    _ (L SrcSpan
    loc String
    warn) <- [Warn]
    warns' ]

      Logger -> DynFlags -> WarningMessages -> IO ()
    printOrThrowWarnings Logger
    logger DynFlags
    dflags WarningMessages
    bag

    -- | Checks if given 'WarnMsg' is a fatal warning.
    isWarnMsgFatal :: DynFlags -> WarnMsg -> Maybe (Maybe WarningFlag)
    isWarnMsgFatal :: DynFlags -> MsgEnvelope DecoratedSDoc -> Maybe (Maybe WarningFlag)
    isWarnMsgFatal DynFlags
    dflags MsgEnvelope{errMsgReason :: forall e. MsgEnvelope e -> WarnReason
    errMsgReason = Reason WarningFlag
    wflag}
      = if WarningFlag -> DynFlags -> Bool
    wopt_fatal WarningFlag
    wflag DynFlags
    dflags
          then Maybe WarningFlag -> Maybe (Maybe WarningFlag)
    forall a. a -> Maybe a
    Just (WarningFlag -> Maybe WarningFlag
    forall a. a -> Maybe a
    Just WarningFlag
    wflag)
          else Maybe (Maybe WarningFlag)
    forall a. Maybe a
    Nothing
    isWarnMsgFatal DynFlags
    dflags MsgEnvelope DecoratedSDoc
    _
      = if GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_WarnIsError DynFlags
    dflags
          then Maybe WarningFlag -> Maybe (Maybe WarningFlag)
    forall a. a -> Maybe a
    Just Maybe WarningFlag
    forall a. Maybe a
    Nothing
          else Maybe (Maybe WarningFlag)
    forall a. Maybe a
    Nothing

    -- Given a warn reason, check to see if it's associated -W opt is enabled
    shouldPrintWarning :: DynFlags -> CmdLine.WarnReason -> Bool
    shouldPrintWarning :: DynFlags -> WarnReason -> Bool
    shouldPrintWarning DynFlags
    dflags WarnReason
    CmdLine.ReasonDeprecatedFlag
      = WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnDeprecatedFlags DynFlags
    dflags
    shouldPrintWarning DynFlags
    dflags WarnReason
    CmdLine.ReasonUnrecognisedFlag
      = WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnUnrecognisedWarningFlags DynFlags
    dflags
    shouldPrintWarning DynFlags
    _ WarnReason
    _
      = Bool
    True

    -- | Given a bag of warnings, turn them into an exception if
    -- -Werror is enabled, or print them out otherwise.
    printOrThrowWarnings :: Logger -> DynFlags -> Bag WarnMsg -> IO ()
    printOrThrowWarnings :: Logger -> DynFlags -> WarningMessages -> IO ()
    printOrThrowWarnings Logger
    logger DynFlags
    dflags WarningMessages
    warns = do
      let (Bool
    make_error, WarningMessages
    warns') =
            (Bool
     -> MsgEnvelope DecoratedSDoc -> (Bool, MsgEnvelope DecoratedSDoc))
    -> Bool -> WarningMessages -> (Bool, WarningMessages)
    forall acc x y.
    (acc -> x -> (acc, y)) -> acc -> Bag x -> (acc, Bag y)
    mapAccumBagL
              (\Bool
    make_err MsgEnvelope DecoratedSDoc
    warn ->
                case DynFlags -> MsgEnvelope DecoratedSDoc -> Maybe (Maybe WarningFlag)
    isWarnMsgFatal DynFlags
    dflags MsgEnvelope DecoratedSDoc
    warn of
                  Maybe (Maybe WarningFlag)
    Nothing ->
                    (Bool
    make_err, MsgEnvelope DecoratedSDoc
    warn)
                  Just Maybe WarningFlag
    err_reason ->
                    (Bool
    True, MsgEnvelope DecoratedSDoc
    warn{ errMsgSeverity :: Severity
    errMsgSeverity = Severity
    SevError
                               , errMsgReason :: WarnReason
    errMsgReason = Maybe WarningFlag -> WarnReason
    ErrReason Maybe WarningFlag
    err_reason
                               }))
              Bool
    False WarningMessages
    warns
      if Bool
    make_error
        then SourceError -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO (WarningMessages -> SourceError
    mkSrcErr WarningMessages
    warns')
        else Logger -> DynFlags -> WarningMessages -> IO ()
    forall a.
    RenderableDiagnostic a =>
    Logger -> DynFlags -> Bag (MsgEnvelope a) -> IO ()
    printBagOfErrors Logger
    logger DynFlags
    dflags WarningMessages
    warns