    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE LambdaCase #-}

    module GHC.Types.Error
       ( -- * Messages
         Messages
       , WarningMessages
       , ErrorMessages
       , mkMessages
       , emptyMessages
       , isEmptyMessages
       , addMessage
       , unionMessages
       , MsgEnvelope (..)
       , WarnMsg
       , SDoc
       , DecoratedSDoc (unDecorated)
       , Severity (..)
       , RenderableDiagnostic (..)
       , pprMessageBag
       , mkDecorated
       , mkLocMessage
       , mkLocMessageAnn
       , getSeverityColour
       , getCaretDiagnostic
       , makeIntoWarning
       -- * Constructing individual errors
       , mkMsgEnvelope
       , mkPlainMsgEnvelope
       , mkErr
       , mkLongMsgEnvelope
       , mkWarnMsg
       , mkPlainWarnMsg
       , mkLongWarnMsg
       -- * Queries
       , isErrorMessage
       , isWarningMessage
       , getErrorMessages
       , getWarningMessages
       , partitionMessages
       , errorsFound
       )
    where

    import GHC.Prelude

    import GHC.Driver.Flags

    import GHC.Data.Bag
    import GHC.Utils.Outputable as Outputable
    import qualified GHC.Utils.Ppr.Colour as Col
    import GHC.Types.SrcLoc as SrcLoc
    import GHC.Data.FastString (unpackFS)
    import GHC.Data.StringBuffer (atLine, hGetStringBuffer, len, lexemeToString)
    import GHC.Utils.Json

    import System.IO.Error  ( catchIOError )

    {-
    Note [Messages]
    ~~~~~~~~~~~~~~~

    We represent the 'Messages' as a single bag of warnings and errors.

    The reason behind that is that there is a fluid relationship between errors and warnings and we want to
    be able to promote or demote errors and warnings based on certain flags (e.g. -Werror, -fdefer-type-errors
    or -XPartialTypeSignatures). For now we rely on the 'Severity' to distinguish between a warning and an
    error, although the 'Severity' can be /more/ than just 'SevWarn' and 'SevError', and as such it probably
    shouldn't belong to an 'MsgEnvelope' to begin with, as it might potentially lead to the construction of
    "impossible states" (e.g. a waning with 'SevInfo', for example).

    'WarningMessages' and 'ErrorMessages' are for now simple type aliases to retain backward compatibility, but
    in future iterations these can be either parameterised over an 'e' message type (to make type signatures
    a bit more declarative) or removed altogether.
    -}

    -- | A collection of messages emitted by GHC during error reporting. A diagnostic message is typically
    -- a warning or an error. See Note [Messages].
    newtype Messages e = Messages (Bag (MsgEnvelope e))

    instance Functor Messages where
      fmap :: forall a b. (a -> b) -> Messages a -> Messages b
    fmap a -> b
    f (Messages Bag (MsgEnvelope a)
    xs) = forall e. Bag (MsgEnvelope e) -> Messages e
    Messages (forall a b. (a -> b) -> Bag a -> Bag b
    mapBag (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f) Bag (MsgEnvelope a)
    xs)

    emptyMessages :: Messages e
    emptyMessages :: forall e. Messages e
    emptyMessages = forall e. Bag (MsgEnvelope e) -> Messages e
    Messages forall a. Bag a
    emptyBag

    mkMessages :: Bag (MsgEnvelope e) -> Messages e
    mkMessages :: forall e. Bag (MsgEnvelope e) -> Messages e
    mkMessages = forall e. Bag (MsgEnvelope e) -> Messages e
    Messages

    isEmptyMessages :: Messages e -> Bool
    isEmptyMessages :: forall e. Messages e -> Bool
    isEmptyMessages (Messages Bag (MsgEnvelope e)
    msgs) = forall a. Bag a -> Bool
    isEmptyBag Bag (MsgEnvelope e)
    msgs

    addMessage :: MsgEnvelope e -> Messages e -> Messages e
    addMessage :: forall e. MsgEnvelope e -> Messages e -> Messages e
    addMessage MsgEnvelope e
    x (Messages Bag (MsgEnvelope e)
    xs) = forall e. Bag (MsgEnvelope e) -> Messages e
    Messages (MsgEnvelope e
    x forall a. a -> Bag a -> Bag a
    `consBag` Bag (MsgEnvelope e)
    xs)

    -- | Joins two collections of messages together.
    unionMessages :: Messages e -> Messages e -> Messages e
    unionMessages :: forall e. Messages e -> Messages e -> Messages e
    unionMessages (Messages Bag (MsgEnvelope e)
    msgs1) (Messages Bag (MsgEnvelope e)
    msgs2) = forall e. Bag (MsgEnvelope e) -> Messages e
    Messages (Bag (MsgEnvelope e)
    msgs1 forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag (MsgEnvelope e)
    msgs2)

    type WarningMessages = Bag (MsgEnvelope DecoratedSDoc)
    type ErrorMessages   = Bag (MsgEnvelope DecoratedSDoc)

    type WarnMsg         = MsgEnvelope DecoratedSDoc

    -- | A 'DecoratedSDoc' is isomorphic to a '[SDoc]' but it carries the invariant that the input '[SDoc]'
    -- needs to be rendered /decorated/ into its final form, where the typical case would be adding bullets
    -- between each elements of the list.
    -- The type of decoration depends on the formatting function used, but in practice GHC uses the
    -- 'formatBulleted'.
    newtype DecoratedSDoc = Decorated { DecoratedSDoc -> [SDoc]
    unDecorated :: [SDoc] }

    -- | Creates a new 'DecoratedSDoc' out of a list of 'SDoc'.
    mkDecorated :: [SDoc] -> DecoratedSDoc
    mkDecorated :: [SDoc] -> DecoratedSDoc
    mkDecorated = [SDoc] -> DecoratedSDoc
    Decorated

    {-
    Note [Rendering Messages]
    ~~~~~~~~~~~~~~~~~~~~~~~~~

    Turning 'Messages' into something that renders nicely for the user is one of the last steps, and it
    happens typically at the application boundaries (i.e. from the 'Driver' upwards).

    For now (see #18516) this class is very boring as it has only one instance, but the idea is that as
    the more domain-specific types are defined, the more instances we would get. For example, given something like:

    data TcRnMessage
      = TcRnOutOfScope ..
      | ..

    We could then define how a 'TcRnMessage' is displayed to the user. Rather than scattering pieces of
    'SDoc' around the codebase, we would write once for all:

    instance RenderableDiagnostic TcRnMessage where
      renderDiagnostic = \case
        TcRnOutOfScope .. -> Decorated [text "Out of scope error ..."]
        ...

    This way, we can easily write generic rendering functions for errors that all they care about is the
    knowledge that a given type 'e' has a 'RenderableDiagnostic' constraint.

    -}

    -- | A class for types (typically errors and warnings) which can be \"rendered\" into an opaque 'DecoratedSDoc'.
    -- For more information, see Note [Rendering Messages].
    class RenderableDiagnostic a where
      renderDiagnostic :: a -> DecoratedSDoc

    -- | An envelope for GHC's facts about a running program, parameterised over the
    -- /domain-specific/ (i.e. parsing, typecheck-renaming, etc) diagnostics.
    --
    -- To say things differently, GHC emits /diagnostics/ about the running program, each of which is wrapped
    -- into a 'MsgEnvelope' that carries specific information like where the error happened, its severity, etc.
    -- Finally, multiple 'MsgEnvelope's are aggregated into 'Messages' that are returned to the user.
    data MsgEnvelope e = MsgEnvelope
       { forall e. MsgEnvelope e -> SrcSpan
    errMsgSpan        :: SrcSpan
          -- ^ The SrcSpan is used for sorting errors into line-number order
       , forall e. MsgEnvelope e -> PrintUnqualified
    errMsgContext     :: PrintUnqualified
       , forall e. MsgEnvelope e -> e
    errMsgDiagnostic  :: e
       , forall e. MsgEnvelope e -> Severity
    errMsgSeverity    :: Severity
       , forall e. MsgEnvelope e -> WarnReason
    errMsgReason      :: WarnReason
       } deriving forall a b. a -> MsgEnvelope b -> MsgEnvelope a
    forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: forall a b. a -> MsgEnvelope b -> MsgEnvelope a
    $c<$ :: forall a b. a -> MsgEnvelope b -> MsgEnvelope a
    fmap :: forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
    $cfmap :: forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
    Functor

    instance RenderableDiagnostic DecoratedSDoc where
      renderDiagnostic :: DecoratedSDoc -> DecoratedSDoc
    renderDiagnostic = forall a. a -> a
    id

    data Severity
      = SevOutput
      | SevFatal
      | SevInteractive

      | SevDump
        -- ^ Log message intended for compiler developers
        -- No file\/line\/column stuff

      | SevInfo
        -- ^ Log messages intended for end users.
        -- No file\/line\/column stuff.

      | SevWarning
      | SevError
        -- ^ SevWarning and SevError are used for warnings and errors
        --   o The message has a file\/line\/column heading,
        --     plus "warning:" or "error:",
        --     added by mkLocMessags
        --   o Output is intended for end users
      deriving (Severity -> Severity -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Severity -> Severity -> Bool
    $c/= :: Severity -> Severity -> Bool
    == :: Severity -> Severity -> Bool
    $c== :: Severity -> Severity -> Bool
    Eq, Int -> Severity -> ShowS
    [Severity] -> ShowS
    Severity -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Severity] -> ShowS
    $cshowList :: [Severity] -> ShowS
    show :: Severity -> String
    $cshow :: Severity -> String
    showsPrec :: Int -> Severity -> ShowS
    $cshowsPrec :: Int -> Severity -> ShowS
    Show)

    instance ToJson Severity where
      json :: Severity -> JsonDoc
    json Severity
    s = String -> JsonDoc
    JSString (forall a. Show a => a -> String
    show Severity
    s)

    instance Show (MsgEnvelope DecoratedSDoc) where
        show :: MsgEnvelope DecoratedSDoc -> String
    show = forall a. RenderableDiagnostic a => MsgEnvelope a -> String
    showMsgEnvelope

    -- | Shows an 'MsgEnvelope'.
    showMsgEnvelope :: RenderableDiagnostic a => MsgEnvelope a -> String
    showMsgEnvelope :: forall a. RenderableDiagnostic a => MsgEnvelope a -> String
    showMsgEnvelope MsgEnvelope a
    err =
      SDocContext -> SDoc -> String
    renderWithContext SDocContext
    defaultSDocContext ([SDoc] -> SDoc
    vcat (DecoratedSDoc -> [SDoc]
    unDecorated forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. RenderableDiagnostic a => a -> DecoratedSDoc
    renderDiagnostic forall a b. (a -> b) -> a -> b
    $ forall e. MsgEnvelope e -> e
    errMsgDiagnostic MsgEnvelope a
    err))

    pprMessageBag :: Bag SDoc -> SDoc
    pprMessageBag :: Bag SDoc -> SDoc
    pprMessageBag Bag SDoc
    msgs = [SDoc] -> SDoc
    vcat (SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    blankLine (forall a. Bag a -> [a]
    bagToList Bag SDoc
    msgs))

    -- | Make an unannotated error message with location info.
    mkLocMessage :: Severity -> SrcSpan -> SDoc -> SDoc
    mkLocMessage :: Severity -> SrcSpan -> SDoc -> SDoc
    mkLocMessage = Maybe String -> Severity -> SrcSpan -> SDoc -> SDoc
    mkLocMessageAnn forall a. Maybe a
    Nothing

    -- | Make a possibly annotated error message with location info.
    mkLocMessageAnn
      :: Maybe String                       -- ^ optional annotation
      -> Severity                           -- ^ severity
      -> SrcSpan                            -- ^ location
      -> SDoc                             -- ^ message
      -> SDoc
      -- Always print the location, even if it is unhelpful.  Error messages
      -- are supposed to be in a standard format, and one without a location
      -- would look strange.  Better to say explicitly "<no location info>".
    mkLocMessageAnn :: Maybe String -> Severity -> SrcSpan -> SDoc -> SDoc
    mkLocMessageAnn Maybe String
    ann Severity
    severity SrcSpan
    locn SDoc
    msg
        = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Scheme
    sdocColScheme forall a b. (a -> b) -> a -> b
    $ \Scheme
    col_scheme ->
          let locn' :: SDoc
    locn' = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocErrorSpans forall a b. (a -> b) -> a -> b
    $ \case
                         Bool
    True  -> forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    locn
                         Bool
    False -> forall a. Outputable a => a -> SDoc
    ppr (SrcSpan -> SrcLoc
    srcSpanStart SrcSpan
    locn)

              sevColour :: PprColour
    sevColour = Severity -> Scheme -> PprColour
    getSeverityColour Severity
    severity Scheme
    col_scheme

              -- Add optional information
              optAnn :: SDoc
    optAnn = case Maybe String
    ann of
                Maybe String
    Nothing -> String -> SDoc
    text String
    ""
                Just String
    i  -> String -> SDoc
    text String
    " [" SDoc -> SDoc -> SDoc
    <> PprColour -> SDoc -> SDoc
    coloured PprColour
    sevColour (String -> SDoc
    text String
    i) SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "]"

              -- Add prefixes, like    Foo.hs:34: warning:
              --                           <the warning message>
              header :: SDoc
    header = SDoc
    locn' SDoc -> SDoc -> SDoc
    <> SDoc
    colon SDoc -> SDoc -> SDoc
    <+>
                       PprColour -> SDoc -> SDoc
    coloured PprColour
    sevColour SDoc
    sevText SDoc -> SDoc -> SDoc
    <> SDoc
    optAnn

          in PprColour -> SDoc -> SDoc
    coloured (Scheme -> PprColour
    Col.sMessage Scheme
    col_scheme)
                      (SDoc -> Int -> SDoc -> SDoc
    hang (PprColour -> SDoc -> SDoc
    coloured (Scheme -> PprColour
    Col.sHeader Scheme
    col_scheme) SDoc
    header) Int
    4
                            SDoc
    msg)

      where
        sevText :: SDoc
    sevText =
          case Severity
    severity of
            Severity
    SevWarning -> String -> SDoc
    text String
    "warning:"
            Severity
    SevError   -> String -> SDoc
    text String
    "error:"
            Severity
    SevFatal   -> String -> SDoc
    text String
    "fatal:"
            Severity
    _          -> SDoc
    empty

    getSeverityColour :: Severity -> Col.Scheme -> Col.PprColour
    getSeverityColour :: Severity -> Scheme -> PprColour
    getSeverityColour Severity
    SevWarning = Scheme -> PprColour
    Col.sWarning
    getSeverityColour Severity
    SevError   = Scheme -> PprColour
    Col.sError
    getSeverityColour Severity
    SevFatal   = Scheme -> PprColour
    Col.sFatal
    getSeverityColour Severity
    _          = forall a b. a -> b -> a
    const forall a. Monoid a => a
    mempty

    getCaretDiagnostic :: Severity -> SrcSpan -> IO SDoc
    getCaretDiagnostic :: Severity -> SrcSpan -> IO SDoc
    getCaretDiagnostic Severity
    _ (UnhelpfulSpan UnhelpfulSpanReason
    _) = forall (f :: * -> *) a. Applicative f => a -> f a
    pure SDoc
    empty
    getCaretDiagnostic Severity
    severity (RealSrcSpan RealSrcSpan
    span Maybe BufSpan
    _) =
      Maybe String -> SDoc
    caretDiagnostic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FastString -> Int -> IO (Maybe String)
    getSrcLine (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    span) Int
    row
      where
        getSrcLine :: FastString -> Int -> IO (Maybe String)
    getSrcLine FastString
    fn Int
    i =
          Int -> String -> IO (Maybe String)
    getLine Int
    i (FastString -> String
    unpackFS FastString
    fn)
            forall a. IO a -> (IOError -> IO a) -> IO a
    `catchIOError` \IOError
    _ ->
              forall (f :: * -> *) a. Applicative f => a -> f a
    pure forall a. Maybe a
    Nothing

        getLine :: Int -> String -> IO (Maybe String)
    getLine Int
    i String
    fn = do
          -- StringBuffer has advantages over readFile:
          -- (a) no lazy IO, otherwise IO exceptions may occur in pure code
          -- (b) always UTF-8, rather than some system-dependent encoding
          --     (Haskell source code must be UTF-8 anyway)
          StringBuffer
    content <- String -> IO StringBuffer
    hGetStringBuffer String
    fn
          case Int -> StringBuffer -> Maybe StringBuffer
    atLine Int
    i StringBuffer
    content of
            Just StringBuffer
    at_line -> forall (f :: * -> *) a. Applicative f => a -> f a
    pure forall a b. (a -> b) -> a -> b
    $
              case String -> [String]
    lines (Char -> Char
    fix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StringBuffer -> Int -> String
    lexemeToString StringBuffer
    at_line (StringBuffer -> Int
    len StringBuffer
    at_line)) of
                String
    srcLine : [String]
    _ -> forall a. a -> Maybe a
    Just String
    srcLine
                [String]
    _           -> forall a. Maybe a
    Nothing
            Maybe StringBuffer
    _ -> forall (f :: * -> *) a. Applicative f => a -> f a
    pure forall a. Maybe a
    Nothing

        -- allow user to visibly see that their code is incorrectly encoded
        -- (StringBuffer.nextChar uses \0 to represent undecodable characters)
        fix :: Char -> Char
    fix Char
    '\0' = Char
    '\xfffd'
        fix Char
    c    = Char
    c

        row :: Int
    row = RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    span
        rowStr :: String
    rowStr = forall a. Show a => a -> String
    show Int
    row
        multiline :: Bool
    multiline = Int
    row forall a. Eq a => a -> a -> Bool
    /= RealSrcSpan -> Int
    srcSpanEndLine RealSrcSpan
    span

        caretDiagnostic :: Maybe String -> SDoc
    caretDiagnostic Maybe String
    Nothing = SDoc
    empty
        caretDiagnostic (Just String
    srcLineWithNewline) =
          forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Scheme
    sdocColSchemeforall a b. (a -> b) -> a -> b
    $ \Scheme
    col_scheme ->
          let sevColour :: PprColour
    sevColour = Severity -> Scheme -> PprColour
    getSeverityColour Severity
    severity Scheme
    col_scheme
              marginColour :: PprColour
    marginColour = Scheme -> PprColour
    Col.sMargin Scheme
    col_scheme
          in
          PprColour -> SDoc -> SDoc
    coloured PprColour
    marginColour (String -> SDoc
    text String
    marginSpace) SDoc -> SDoc -> SDoc
    <>
          String -> SDoc
    text (String
    "\n") SDoc -> SDoc -> SDoc
    <>
          PprColour -> SDoc -> SDoc
    coloured PprColour
    marginColour (String -> SDoc
    text String
    marginRow) SDoc -> SDoc -> SDoc
    <>
          String -> SDoc
    text (String
    " " forall a. [a] -> [a] -> [a]
    ++ String
    srcLinePre) SDoc -> SDoc -> SDoc
    <>
          PprColour -> SDoc -> SDoc
    coloured PprColour
    sevColour (String -> SDoc
    text String
    srcLineSpan) SDoc -> SDoc -> SDoc
    <>
          String -> SDoc
    text (String
    srcLinePost forall a. [a] -> [a] -> [a]
    ++ String
    "\n") SDoc -> SDoc -> SDoc
    <>
          PprColour -> SDoc -> SDoc
    coloured PprColour
    marginColour (String -> SDoc
    text String
    marginSpace) SDoc -> SDoc -> SDoc
    <>
          PprColour -> SDoc -> SDoc
    coloured PprColour
    sevColour (String -> SDoc
    text (String
    " " forall a. [a] -> [a] -> [a]
    ++ String
    caretLine))

          where

            -- expand tabs in a device-independent manner #13664
            expandTabs :: Int -> Int -> ShowS
    expandTabs Int
    tabWidth Int
    i String
    s =
              case String
    s of
                String
    ""        -> String
    ""
                Char
    '\t' : String
    cs -> forall a. Int -> a -> [a]
    replicate Int
    effectiveWidth Char
    ' ' forall a. [a] -> [a] -> [a]
    ++
                             Int -> Int -> ShowS
    expandTabs Int
    tabWidth (Int
    i forall a. Num a => a -> a -> a
    + Int
    effectiveWidth) String
    cs
                Char
    c    : String
    cs -> Char
    c forall a. a -> [a] -> [a]
    : Int -> Int -> ShowS
    expandTabs Int
    tabWidth (Int
    i forall a. Num a => a -> a -> a
    + Int
    1) String
    cs
              where effectiveWidth :: Int
    effectiveWidth = Int
    tabWidth forall a. Num a => a -> a -> a
    - Int
    i forall a. Integral a => a -> a -> a
    `mod` Int
    tabWidth

            srcLine :: String
    srcLine = forall a. (a -> Bool) -> [a] -> [a]
    filter (forall a. Eq a => a -> a -> Bool
    /= Char
    '\n') (Int -> Int -> ShowS
    expandTabs Int
    8 Int
    0 String
    srcLineWithNewline)

            start :: Int
    start = RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    span forall a. Num a => a -> a -> a
    - Int
    1
            end :: Int
    end | Bool
    multiline = forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    srcLine
                | Bool
    otherwise = RealSrcSpan -> Int
    srcSpanEndCol RealSrcSpan
    span forall a. Num a => a -> a -> a
    - Int
    1
            width :: Int
    width = forall a. Ord a => a -> a -> a
    max Int
    1 (Int
    end forall a. Num a => a -> a -> a
    - Int
    start)

            marginWidth :: Int
    marginWidth = forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    rowStr
            marginSpace :: String
    marginSpace = forall a. Int -> a -> [a]
    replicate Int
    marginWidth Char
    ' ' forall a. [a] -> [a] -> [a]
    ++ String
    " |"
            marginRow :: String
    marginRow   = String
    rowStr forall a. [a] -> [a] -> [a]
    ++ String
    " |"

            (String
    srcLinePre,  String
    srcLineRest) = forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    start String
    srcLine
            (String
    srcLineSpan, String
    srcLinePost) = forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    width String
    srcLineRest

            caretEllipsis :: String
    caretEllipsis | Bool
    multiline = String
    "..."
                          | Bool
    otherwise = String
    ""
            caretLine :: String
    caretLine = forall a. Int -> a -> [a]
    replicate Int
    start Char
    ' ' forall a. [a] -> [a] -> [a]
    ++ forall a. Int -> a -> [a]
    replicate Int
    width Char
    '^' forall a. [a] -> [a] -> [a]
    ++ String
    caretEllipsis

    makeIntoWarning :: WarnReason -> MsgEnvelope e -> MsgEnvelope e
    makeIntoWarning :: forall e. WarnReason -> MsgEnvelope e -> MsgEnvelope e
    makeIntoWarning WarnReason
    reason MsgEnvelope e
    err = MsgEnvelope e
    err
        { errMsgSeverity :: Severity
    errMsgSeverity = Severity
    SevWarning
        , errMsgReason :: WarnReason
    errMsgReason = WarnReason
    reason }

    --
    -- Creating MsgEnvelope(s)
    --

    mk_err_msg
      :: Severity -> SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mk_err_msg :: forall e.
    Severity -> SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mk_err_msg Severity
    sev SrcSpan
    locn PrintUnqualified
    print_unqual e
    err
     = MsgEnvelope { errMsgSpan :: SrcSpan
    errMsgSpan = SrcSpan
    locn
                   , errMsgContext :: PrintUnqualified
    errMsgContext = PrintUnqualified
    print_unqual
                   , errMsgDiagnostic :: e
    errMsgDiagnostic = e
    err
                   , errMsgSeverity :: Severity
    errMsgSeverity = Severity
    sev
                   , errMsgReason :: WarnReason
    errMsgReason = WarnReason
    NoReason }

    mkErr :: SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mkErr :: forall e. SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mkErr = forall e.
    Severity -> SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mk_err_msg Severity
    SevError

    mkLongMsgEnvelope, mkLongWarnMsg   :: SrcSpan -> PrintUnqualified -> SDoc -> SDoc -> MsgEnvelope DecoratedSDoc
    -- ^ A long (multi-line) error message
    mkMsgEnvelope, mkWarnMsg           :: SrcSpan -> PrintUnqualified -> SDoc         -> MsgEnvelope DecoratedSDoc
    -- ^ A short (one-line) error message
    mkPlainMsgEnvelope, mkPlainWarnMsg :: SrcSpan ->                     SDoc         -> MsgEnvelope DecoratedSDoc
    -- ^ Variant that doesn't care about qualified/unqualified names

    mkLongMsgEnvelope :: SrcSpan
    -> PrintUnqualified -> SDoc -> SDoc -> MsgEnvelope DecoratedSDoc
    mkLongMsgEnvelope   SrcSpan
    locn PrintUnqualified
    unqual SDoc
    msg SDoc
    extra = forall e.
    Severity -> SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mk_err_msg Severity
    SevError   SrcSpan
    locn PrintUnqualified
    unqual        ([SDoc] -> DecoratedSDoc
    mkDecorated [SDoc
    msg,SDoc
    extra])
    mkMsgEnvelope :: SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
    mkMsgEnvelope       SrcSpan
    locn PrintUnqualified
    unqual SDoc
    msg       = forall e.
    Severity -> SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mk_err_msg Severity
    SevError   SrcSpan
    locn PrintUnqualified
    unqual        ([SDoc] -> DecoratedSDoc
    mkDecorated [SDoc
    msg])
    mkPlainMsgEnvelope :: SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainMsgEnvelope  SrcSpan
    locn        SDoc
    msg       = forall e.
    Severity -> SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mk_err_msg Severity
    SevError   SrcSpan
    locn PrintUnqualified
    alwaysQualify ([SDoc] -> DecoratedSDoc
    mkDecorated [SDoc
    msg])
    mkLongWarnMsg :: SrcSpan
    -> PrintUnqualified -> SDoc -> SDoc -> MsgEnvelope DecoratedSDoc
    mkLongWarnMsg       SrcSpan
    locn PrintUnqualified
    unqual SDoc
    msg SDoc
    extra = forall e.
    Severity -> SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mk_err_msg Severity
    SevWarning SrcSpan
    locn PrintUnqualified
    unqual        ([SDoc] -> DecoratedSDoc
    mkDecorated [SDoc
    msg,SDoc
    extra])
    mkWarnMsg :: SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
    mkWarnMsg           SrcSpan
    locn PrintUnqualified
    unqual SDoc
    msg       = forall e.
    Severity -> SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mk_err_msg Severity
    SevWarning SrcSpan
    locn PrintUnqualified
    unqual        ([SDoc] -> DecoratedSDoc
    mkDecorated [SDoc
    msg])
    mkPlainWarnMsg :: SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainWarnMsg      SrcSpan
    locn        SDoc
    msg       = forall e.
    Severity -> SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mk_err_msg Severity
    SevWarning SrcSpan
    locn PrintUnqualified
    alwaysQualify ([SDoc] -> DecoratedSDoc
    mkDecorated [SDoc
    msg])

    --
    -- Queries
    --

    isErrorMessage :: MsgEnvelope e -> Bool
    isErrorMessage :: forall e. MsgEnvelope e -> Bool
    isErrorMessage = (forall a. Eq a => a -> a -> Bool
    == Severity
    SevError) forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall e. MsgEnvelope e -> Severity
    errMsgSeverity

    isWarningMessage :: MsgEnvelope e -> Bool
    isWarningMessage :: forall e. MsgEnvelope e -> Bool
    isWarningMessage = Bool -> Bool
    not forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall e. MsgEnvelope e -> Bool
    isErrorMessage

    errorsFound :: Messages e -> Bool
    errorsFound :: forall e. Messages e -> Bool
    errorsFound (Messages Bag (MsgEnvelope e)
    msgs) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any forall e. MsgEnvelope e -> Bool
    isErrorMessage Bag (MsgEnvelope e)
    msgs

    getWarningMessages :: Messages e -> Bag (MsgEnvelope e)
    getWarningMessages :: forall e. Messages e -> Bag (MsgEnvelope e)
    getWarningMessages (Messages Bag (MsgEnvelope e)
    xs) = forall a b. (a, b) -> a
    fst forall a b. (a -> b) -> a -> b
    $ forall a. (a -> Bool) -> Bag a -> (Bag a, Bag a)
    partitionBag forall e. MsgEnvelope e -> Bool
    isWarningMessage Bag (MsgEnvelope e)
    xs

    getErrorMessages :: Messages e -> Bag (MsgEnvelope e)
    getErrorMessages :: forall e. Messages e -> Bag (MsgEnvelope e)
    getErrorMessages (Messages Bag (MsgEnvelope e)
    xs) = forall a b. (a, b) -> a
    fst forall a b. (a -> b) -> a -> b
    $ forall a. (a -> Bool) -> Bag a -> (Bag a, Bag a)
    partitionBag forall e. MsgEnvelope e -> Bool
    isErrorMessage Bag (MsgEnvelope e)
    xs

    -- | Partitions the 'Messages' and returns a tuple which first element are the warnings, and the
    -- second the errors.
    partitionMessages :: Messages e -> (Bag (MsgEnvelope e), Bag (MsgEnvelope e))
    partitionMessages :: forall e. Messages e -> (Bag (MsgEnvelope e), Bag (MsgEnvelope e))
    partitionMessages (Messages Bag (MsgEnvelope e)
    xs) = forall a. (a -> Bool) -> Bag a -> (Bag a, Bag a)
    partitionBag forall e. MsgEnvelope e -> Bool
    isWarningMessage Bag (MsgEnvelope e)
    xs