    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE DeriveTraversable #-}
    {-# LANGUAGE DerivingStrategies #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE AllowAmbiguousTypes #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE PatternSynonyms #-}

    module GHC.Types.Error
       ( -- * Messages
         Messages
       , mkMessages
       , getMessages
       , emptyMessages
       , isEmptyMessages
       , singleMessage
       , addMessage
       , unionMessages
       , unionManyMessages
       , filterMessages
       , MsgEnvelope (..)

       -- * Classifying Messages

       , MessageClass (..)
       , Severity (..)
       , Diagnostic (..)
       , UnknownDiagnostic (..)
       , mkSimpleUnknownDiagnostic
       , mkUnknownDiagnostic
       , embedUnknownDiagnostic
       , DiagnosticMessage (..)
       , DiagnosticReason (WarningWithFlag, ..)
       , ResolvedDiagnosticReason(..)
       , DiagnosticHint (..)
       , mkPlainDiagnostic
       , mkPlainError
       , mkDecoratedDiagnostic
       , mkDecoratedError

       , pprDiagnostic

       , HasDefaultDiagnosticOpts(..)
       , defaultDiagnosticOpts
       , NoDiagnosticOpts(..)

       -- * Hints and refactoring actions
       , GhcHint (..)
       , AvailableBindings(..)
       , LanguageExtensionHint(..)
       , suggestExtension
       , suggestExtensionWithInfo
       , suggestExtensions
       , suggestExtensionsWithInfo
       , suggestAnyExtension
       , suggestAnyExtensionWithInfo
       , useExtensionInOrderTo
       , noHints

        -- * Rendering Messages

       , SDoc
       , DecoratedSDoc (unDecorated)
       , mkDecorated, mkSimpleDecorated
       , unionDecoratedSDoc
       , mapDecoratedSDoc

       , pprMessageBag
       , mkLocMessage
       , mkLocMessageWarningGroups
       , getCaretDiagnostic
       -- * Queries
       , isIntrinsicErrorMessage
       , isExtrinsicErrorMessage
       , isWarningMessage
       , getErrorMessages
       , getWarningMessages
       , partitionMessages
       , errorsFound
       , errorsOrFatalWarningsFound

       -- * Diagnostic codes
       , DiagnosticCode(..)
       )
    where

    import GHC.Prelude

    import GHC.Driver.Flags

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

    import GHC.Types.Hint.Ppr () -- Outputable instance
    import GHC.Unit.Module.Warnings (WarningCategory(..))

    import GHC.Utils.Json
    import GHC.Utils.Panic

    import GHC.Version (cProjectVersion)
    import Data.Bifunctor
    import Data.Foldable    ( fold, toList )
    import Data.List.NonEmpty ( NonEmpty (..) )
    import qualified Data.List.NonEmpty as NE
    import Data.List ( intercalate )
    import Data.Maybe ( maybeToList )
    import Data.Typeable ( Typeable )
    import Numeric.Natural ( Natural )
    import Text.Printf ( printf )

    {- 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). More specifically, every diagnostic has a
    'DiagnosticReason', but a warning 'DiagnosticReason' might be associated with
    'SevError', in the case of -Werror.

    We rely on the 'Severity' to distinguish between a warning and an error.

    '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].
    --
    -- /INVARIANT/: All the messages in this collection must be relevant, i.e.
    -- their 'Severity' should /not/ be 'SevIgnore'. The smart constructor
    -- 'mkMessages' will filter out any message which 'Severity' is 'SevIgnore'.
    newtype Messages e = Messages { forall e. Messages e -> Bag (MsgEnvelope e)
    getMessages :: Bag (MsgEnvelope e) }
      deriving newtype (NonEmpty (Messages e) -> Messages e
    Messages e -> Messages e -> Messages e
    (Messages e -> Messages e -> Messages e)
    -> (NonEmpty (Messages e) -> Messages e)
    -> (forall b. Integral b => b -> Messages e -> Messages e)
    -> Semigroup (Messages e)
    forall b. Integral b => b -> Messages e -> Messages e
    forall e. NonEmpty (Messages e) -> Messages e
    forall e. Messages e -> Messages e -> Messages e
    forall a.
    (a -> a -> a)
    -> (NonEmpty a -> a)
    -> (forall b. Integral b => b -> a -> a)
    -> Semigroup a
    forall e b. Integral b => b -> Messages e -> Messages e
    $c<> :: forall e. Messages e -> Messages e -> Messages e
    <> :: Messages e -> Messages e -> Messages e
    $csconcat :: forall e. NonEmpty (Messages e) -> Messages e
    sconcat :: NonEmpty (Messages e) -> Messages e
    $cstimes :: forall e b. Integral b => b -> Messages e -> Messages e
    stimes :: forall b. Integral b => b -> Messages e -> Messages e
    Semigroup, Semigroup (Messages e)
    Messages e
    Semigroup (Messages e) =>
    Messages e
    -> (Messages e -> Messages e -> Messages e)
    -> ([Messages e] -> Messages e)
    -> Monoid (Messages e)
    [Messages e] -> Messages e
    Messages e -> Messages e -> Messages e
    forall e. Semigroup (Messages e)
    forall e. Messages e
    forall a.
    Semigroup a =>
    a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
    forall e. [Messages e] -> Messages e
    forall e. Messages e -> Messages e -> Messages e
    $cmempty :: forall e. Messages e
    mempty :: Messages e
    $cmappend :: forall e. Messages e -> Messages e -> Messages e
    mappend :: Messages e -> Messages e -> Messages e
    $cmconcat :: forall e. [Messages e] -> Messages e
    mconcat :: [Messages e] -> Messages e
    Monoid)
      deriving stock ((forall a b. (a -> b) -> Messages a -> Messages b)
    -> (forall a b. a -> Messages b -> Messages a) -> Functor Messages
    forall a b. a -> Messages b -> Messages a
    forall a b. (a -> b) -> Messages a -> Messages b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Messages a -> Messages b
    fmap :: forall a b. (a -> b) -> Messages a -> Messages b
    $c<$ :: forall a b. a -> Messages b -> Messages a
    <$ :: forall a b. a -> Messages b -> Messages a
    Functor, (forall m. Monoid m => Messages m -> m)
    -> (forall m a. Monoid m => (a -> m) -> Messages a -> m)
    -> (forall m a. Monoid m => (a -> m) -> Messages a -> m)
    -> (forall a b. (a -> b -> b) -> b -> Messages a -> b)
    -> (forall a b. (a -> b -> b) -> b -> Messages a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Messages a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Messages a -> b)
    -> (forall a. (a -> a -> a) -> Messages a -> a)
    -> (forall a. (a -> a -> a) -> Messages a -> a)
    -> (forall a. Messages a -> [a])
    -> (forall a. Messages a -> Bool)
    -> (forall a. Messages a -> Int)
    -> (forall a. Eq a => a -> Messages a -> Bool)
    -> (forall a. Ord a => Messages a -> a)
    -> (forall a. Ord a => Messages a -> a)
    -> (forall a. Num a => Messages a -> a)
    -> (forall a. Num a => Messages a -> a)
    -> Foldable Messages
    forall a. Eq a => a -> Messages a -> Bool
    forall a. Num a => Messages a -> a
    forall a. Ord a => Messages a -> a
    forall m. Monoid m => Messages m -> m
    forall a. Messages a -> Bool
    forall a. Messages a -> Int
    forall a. Messages a -> [a]
    forall a. (a -> a -> a) -> Messages a -> a
    forall m a. Monoid m => (a -> m) -> Messages a -> m
    forall b a. (b -> a -> b) -> b -> Messages a -> b
    forall a b. (a -> b -> b) -> b -> Messages a -> b
    forall (t :: * -> *).
    (forall m. Monoid m => t m -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. t a -> [a])
    -> (forall a. t a -> Bool)
    -> (forall a. t a -> Int)
    -> (forall a. Eq a => a -> t a -> Bool)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> Foldable t
    $cfold :: forall m. Monoid m => Messages m -> m
    fold :: forall m. Monoid m => Messages m -> m
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> Messages a -> m
    foldMap :: forall m a. Monoid m => (a -> m) -> Messages a -> m
    $cfoldMap' :: forall m a. Monoid m => (a -> m) -> Messages a -> m
    foldMap' :: forall m a. Monoid m => (a -> m) -> Messages a -> m
    $cfoldr :: forall a b. (a -> b -> b) -> b -> Messages a -> b
    foldr :: forall a b. (a -> b -> b) -> b -> Messages a -> b
    $cfoldr' :: forall a b. (a -> b -> b) -> b -> Messages a -> b
    foldr' :: forall a b. (a -> b -> b) -> b -> Messages a -> b
    $cfoldl :: forall b a. (b -> a -> b) -> b -> Messages a -> b
    foldl :: forall b a. (b -> a -> b) -> b -> Messages a -> b
    $cfoldl' :: forall b a. (b -> a -> b) -> b -> Messages a -> b
    foldl' :: forall b a. (b -> a -> b) -> b -> Messages a -> b
    $cfoldr1 :: forall a. (a -> a -> a) -> Messages a -> a
    foldr1 :: forall a. (a -> a -> a) -> Messages a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> Messages a -> a
    foldl1 :: forall a. (a -> a -> a) -> Messages a -> a
    $ctoList :: forall a. Messages a -> [a]
    toList :: forall a. Messages a -> [a]
    $cnull :: forall a. Messages a -> Bool
    null :: forall a. Messages a -> Bool
    $clength :: forall a. Messages a -> Int
    length :: forall a. Messages a -> Int
    $celem :: forall a. Eq a => a -> Messages a -> Bool
    elem :: forall a. Eq a => a -> Messages a -> Bool
    $cmaximum :: forall a. Ord a => Messages a -> a
    maximum :: forall a. Ord a => Messages a -> a
    $cminimum :: forall a. Ord a => Messages a -> a
    minimum :: forall a. Ord a => Messages a -> a
    $csum :: forall a. Num a => Messages a -> a
    sum :: forall a. Num a => Messages a -> a
    $cproduct :: forall a. Num a => Messages a -> a
    product :: forall a. Num a => Messages a -> a
    Foldable, Functor Messages
    Foldable Messages
    (Functor Messages, Foldable Messages) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> Messages a -> f (Messages b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        Messages (f a) -> f (Messages a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> Messages a -> m (Messages b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        Messages (m a) -> m (Messages a))
    -> Traversable Messages
    forall (t :: * -> *).
    (Functor t, Foldable t) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> t a -> f (t b))
    -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> t a -> m (t b))
    -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
    -> Traversable t
    forall (m :: * -> *) a. Monad m => Messages (m a) -> m (Messages a)
    forall (f :: * -> *) a.
    Applicative f =>
    Messages (f a) -> f (Messages a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Messages a -> m (Messages b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Messages a -> f (Messages b)
    $ctraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Messages a -> f (Messages b)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Messages a -> f (Messages b)
    $csequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    Messages (f a) -> f (Messages a)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    Messages (f a) -> f (Messages a)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Messages a -> m (Messages b)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Messages a -> m (Messages b)
    $csequence :: forall (m :: * -> *) a. Monad m => Messages (m a) -> m (Messages a)
    sequence :: forall (m :: * -> *) a. Monad m => Messages (m a) -> m (Messages a)
    Traversable)

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

    mkMessages :: Bag (MsgEnvelope e) -> Messages e
    mkMessages :: forall e. Bag (MsgEnvelope e) -> Messages e
    mkMessages = Bag (MsgEnvelope e) -> Messages e
    forall e. Bag (MsgEnvelope e) -> Messages e
    Messages (Bag (MsgEnvelope e) -> Messages e)
    -> (Bag (MsgEnvelope e) -> Bag (MsgEnvelope e))
    -> Bag (MsgEnvelope e)
    -> Messages e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (MsgEnvelope e -> Bool)
    -> Bag (MsgEnvelope e) -> Bag (MsgEnvelope e)
    forall a. (a -> Bool) -> Bag a -> Bag a
    filterBag MsgEnvelope e -> Bool
    forall e. MsgEnvelope e -> Bool
    interesting
      where
        interesting :: MsgEnvelope e -> Bool
        interesting :: forall e. MsgEnvelope e -> Bool
    interesting = Severity -> Severity -> Bool
    forall a. Eq a => a -> a -> Bool
    (/=) Severity
    SevIgnore (Severity -> Bool)
    -> (MsgEnvelope e -> Severity) -> MsgEnvelope e -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MsgEnvelope e -> Severity
    forall e. MsgEnvelope e -> Severity
    errMsgSeverity

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

    singleMessage :: MsgEnvelope e -> Messages e
    singleMessage :: forall e. MsgEnvelope e -> Messages e
    singleMessage MsgEnvelope e
    e = MsgEnvelope e -> Messages e -> Messages e
    forall e. MsgEnvelope e -> Messages e -> Messages e
    addMessage MsgEnvelope e
    e Messages e
    forall e. Messages e
    emptyMessages

    instance Diagnostic e => Outputable (Messages e) where
      ppr :: Messages e -> SDoc
    ppr Messages e
    msgs = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    braces ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((MsgEnvelope e -> SDoc) -> [MsgEnvelope e] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map MsgEnvelope e -> SDoc
    ppr_one (Bag (MsgEnvelope e) -> [MsgEnvelope e]
    forall a. Bag a -> [a]
    bagToList (Messages e -> Bag (MsgEnvelope e)
    forall e. Messages e -> Bag (MsgEnvelope e)
    getMessages Messages e
    msgs))))
         where
           ppr_one :: MsgEnvelope e -> SDoc
           ppr_one :: MsgEnvelope e -> SDoc
    ppr_one MsgEnvelope e
    envelope =
            [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Resolved:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ResolvedDiagnosticReason -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (MsgEnvelope e -> ResolvedDiagnosticReason
    forall e. MsgEnvelope e -> ResolvedDiagnosticReason
    errMsgReason MsgEnvelope e
    envelope),
                   e -> SDoc
    forall e. Diagnostic e => e -> SDoc
    pprDiagnostic (MsgEnvelope e -> e
    forall e. MsgEnvelope e -> e
    errMsgDiagnostic MsgEnvelope e
    envelope)
                 ]

    instance Diagnostic e => ToJson (Messages e) where
      json :: Messages e -> JsonDoc
    json Messages e
    msgs =  [JsonDoc] -> JsonDoc
    JSArray ([JsonDoc] -> JsonDoc)
    -> (Bag JsonDoc -> [JsonDoc]) -> Bag JsonDoc -> JsonDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bag JsonDoc -> [JsonDoc]
    forall a. Bag a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList (Bag JsonDoc -> JsonDoc) -> Bag JsonDoc -> JsonDoc
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope e -> JsonDoc
    forall a. ToJson a => a -> JsonDoc
    json (MsgEnvelope e -> JsonDoc) -> Bag (MsgEnvelope e) -> Bag JsonDoc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Messages e -> Bag (MsgEnvelope e)
    forall e. Messages e -> Bag (MsgEnvelope e)
    getMessages Messages e
    msgs

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

    Discarding a 'SevIgnore' message from 'addMessage' and 'unionMessages' is just
    an optimisation, as GHC would /also/ suppress any diagnostic which severity is
    'SevIgnore' before printing the message: See for example 'putLogMsg' and
    'defaultLogAction'.

    -}

    -- | Adds a 'Message' to the input collection of messages.
    -- See Note [Discarding Messages].
    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)
      | Severity
    SevIgnore <- MsgEnvelope e -> Severity
    forall e. MsgEnvelope e -> Severity
    errMsgSeverity MsgEnvelope e
    x = Bag (MsgEnvelope e) -> Messages e
    forall e. Bag (MsgEnvelope e) -> Messages e
    Messages Bag (MsgEnvelope e)
    xs
      | Bool
    otherwise                     = Bag (MsgEnvelope e) -> Messages e
    forall e. Bag (MsgEnvelope e) -> Messages e
    Messages (MsgEnvelope e
    x MsgEnvelope e -> Bag (MsgEnvelope e) -> Bag (MsgEnvelope e)
    forall a. a -> Bag a -> Bag a
    `consBag` Bag (MsgEnvelope e)
    xs)

    -- | Joins two collections of messages together.
    -- See Note [Discarding Messages].
    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) =
      Bag (MsgEnvelope e) -> Messages e
    forall e. Bag (MsgEnvelope e) -> Messages e
    Messages (Bag (MsgEnvelope e)
    msgs1 Bag (MsgEnvelope e) -> Bag (MsgEnvelope e) -> Bag (MsgEnvelope e)
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag (MsgEnvelope e)
    msgs2)

    -- | Joins many 'Messages's together
    unionManyMessages :: Foldable f => f (Messages e) -> Messages e
    unionManyMessages :: forall (f :: * -> *) e. Foldable f => f (Messages e) -> Messages e
    unionManyMessages = f (Messages e) -> Messages e
    forall m. Monoid m => f m -> m
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold

    filterMessages :: (MsgEnvelope e -> Bool) -> Messages e -> Messages e
    filterMessages :: forall e. (MsgEnvelope e -> Bool) -> Messages e -> Messages e
    filterMessages MsgEnvelope e -> Bool
    f (Messages Bag (MsgEnvelope e)
    msgs) =
      Bag (MsgEnvelope e) -> Messages e
    forall e. Bag (MsgEnvelope e) -> Messages e
    Messages ((MsgEnvelope e -> Bool)
    -> Bag (MsgEnvelope e) -> Bag (MsgEnvelope e)
    forall a. (a -> Bool) -> Bag a -> Bag a
    filterBag MsgEnvelope e -> Bool
    f Bag (MsgEnvelope e)
    msgs)

    -- | 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

    -- | Creates a new 'DecoratedSDoc' out of a single 'SDoc'
    mkSimpleDecorated :: SDoc -> DecoratedSDoc
    mkSimpleDecorated :: SDoc -> DecoratedSDoc
    mkSimpleDecorated SDoc
    doc = [SDoc] -> DecoratedSDoc
    Decorated [SDoc
    doc]

    -- | Joins two 'DecoratedSDoc' together. The resulting 'DecoratedSDoc'
    -- will have a number of entries which is the sum of the lengths of
    -- the input.
    unionDecoratedSDoc :: DecoratedSDoc -> DecoratedSDoc -> DecoratedSDoc
    unionDecoratedSDoc :: DecoratedSDoc -> DecoratedSDoc -> DecoratedSDoc
    unionDecoratedSDoc (Decorated [SDoc]
    s1) (Decorated [SDoc]
    s2) =
      [SDoc] -> DecoratedSDoc
    Decorated ([SDoc]
    s1 [SDoc] -> [SDoc] -> [SDoc]
    forall a. Monoid a => a -> a -> a
    `mappend` [SDoc]
    s2)

    -- | Apply a transformation function to all elements of a 'DecoratedSDoc'.
    mapDecoratedSDoc :: (SDoc -> SDoc) -> DecoratedSDoc -> DecoratedSDoc
    mapDecoratedSDoc :: (SDoc -> SDoc) -> DecoratedSDoc -> DecoratedSDoc
    mapDecoratedSDoc SDoc -> SDoc
    f (Decorated [SDoc]
    s1) =
      [SDoc] -> DecoratedSDoc
    Decorated ((SDoc -> SDoc) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map SDoc -> SDoc
    f [SDoc]
    s1)

    class HasDefaultDiagnosticOpts opts where
      defaultOpts :: opts

    defaultDiagnosticOpts :: forall opts . HasDefaultDiagnosticOpts (DiagnosticOpts opts) => DiagnosticOpts opts
    defaultDiagnosticOpts :: forall opts.
    HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
    DiagnosticOpts opts
    defaultDiagnosticOpts = forall opts. HasDefaultDiagnosticOpts opts => opts
    defaultOpts @(DiagnosticOpts opts)

    -- | A class identifying a diagnostic.
    -- Dictionary.com defines a diagnostic as:
    --
    -- \"a message output by a computer diagnosing an error in a computer program,
    -- computer system, or component device\".
    --
    -- A 'Diagnostic' carries the /actual/ description of the message (which, in
    -- GHC's case, it can be an error or a warning) and the /reason/ why such
    -- message was generated in the first place.
    class (HasDefaultDiagnosticOpts (DiagnosticOpts a)) => Diagnostic a where

      -- | Type of configuration options for the diagnostic.
      type DiagnosticOpts a

      -- | Extract the error message text from a 'Diagnostic'.
      diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc

      -- | Extract the reason for this diagnostic. For warnings,
      -- a 'DiagnosticReason' includes the warning flag.
      diagnosticReason  :: a -> DiagnosticReason

      -- | Extract any hints a user might use to repair their
      -- code to avoid this diagnostic.
      diagnosticHints   :: a -> [GhcHint]

      -- | Get the 'DiagnosticCode' associated with this 'Diagnostic'.
      -- This can return 'Nothing' for at least two reasons:
      --
      -- 1. The message might be from a plugin that does not supply codes.
      -- 2. The message might not yet have been assigned a code. See the
      --    'Diagnostic' instance for 'DiagnosticMessage'.
      --
      -- Ideally, case (2) would not happen, but because
      -- some errors in GHC still use the old system of just writing the
      -- error message in-place (instead of using a dedicated error type
      -- and constructor), we do not have error codes for all errors.
      -- #18516 tracks our progress toward this goal.
      diagnosticCode    :: a -> Maybe DiagnosticCode

    -- | An existential wrapper around an unknown diagnostic.
    data UnknownDiagnostic opts where
      UnknownDiagnostic :: (Diagnostic a, Typeable a)
                        => (opts -> DiagnosticOpts a) -- Inject the options of the outer context
                                                      -- into the options for the wrapped diagnostic.
                        -> a
                        -> UnknownDiagnostic opts

    instance HasDefaultDiagnosticOpts opts => Diagnostic (UnknownDiagnostic opts) where
      type DiagnosticOpts (UnknownDiagnostic opts) = opts
      diagnosticMessage :: DiagnosticOpts (UnknownDiagnostic opts)
    -> UnknownDiagnostic opts -> DecoratedSDoc
    diagnosticMessage DiagnosticOpts (UnknownDiagnostic opts)
    opts (UnknownDiagnostic opts -> DiagnosticOpts a
    f a
    diag) = DiagnosticOpts a -> a -> DecoratedSDoc
    forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
    diagnosticMessage (opts -> DiagnosticOpts a
    f opts
    DiagnosticOpts (UnknownDiagnostic opts)
    opts) a
    diag
      diagnosticReason :: UnknownDiagnostic opts -> DiagnosticReason
    diagnosticReason    (UnknownDiagnostic opts -> DiagnosticOpts a
    _ a
    diag) = a -> DiagnosticReason
    forall a. Diagnostic a => a -> DiagnosticReason
    diagnosticReason  a
    diag
      diagnosticHints :: UnknownDiagnostic opts -> [GhcHint]
    diagnosticHints     (UnknownDiagnostic opts -> DiagnosticOpts a
    _ a
    diag) = a -> [GhcHint]
    forall a. Diagnostic a => a -> [GhcHint]
    diagnosticHints   a
    diag
      diagnosticCode :: UnknownDiagnostic opts -> Maybe DiagnosticCode
    diagnosticCode      (UnknownDiagnostic opts -> DiagnosticOpts a
    _ a
    diag) = a -> Maybe DiagnosticCode
    forall a. Diagnostic a => a -> Maybe DiagnosticCode
    diagnosticCode    a
    diag

    -- A fallback 'DiagnosticOpts' which can be used when there are no options
    -- for a particular diagnostic.
    data NoDiagnosticOpts = NoDiagnosticOpts
    instance HasDefaultDiagnosticOpts NoDiagnosticOpts where
      defaultOpts :: NoDiagnosticOpts
    defaultOpts = NoDiagnosticOpts
    NoDiagnosticOpts

    -- | Make a "simple" unknown diagnostic which doesn't have any configuration options.
    mkSimpleUnknownDiagnostic :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) => a -> UnknownDiagnostic b
    mkSimpleUnknownDiagnostic :: forall a b.
    (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
    a -> UnknownDiagnostic b
    mkSimpleUnknownDiagnostic = (b -> DiagnosticOpts a) -> a -> UnknownDiagnostic b
    forall a opts.
    (Diagnostic a, Typeable a) =>
    (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts
    UnknownDiagnostic (NoDiagnosticOpts -> b -> NoDiagnosticOpts
    forall a b. a -> b -> a
    const NoDiagnosticOpts
    NoDiagnosticOpts)

    -- | Make an unknown diagnostic which uses the same options as the context it will be embedded into.
    mkUnknownDiagnostic :: (Typeable a, Diagnostic a) => a -> UnknownDiagnostic (DiagnosticOpts a)
    mkUnknownDiagnostic :: forall a.
    (Typeable a, Diagnostic a) =>
    a -> UnknownDiagnostic (DiagnosticOpts a)
    mkUnknownDiagnostic = (DiagnosticOpts a -> DiagnosticOpts a)
    -> a -> UnknownDiagnostic (DiagnosticOpts a)
    forall a opts.
    (Diagnostic a, Typeable a) =>
    (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts
    UnknownDiagnostic DiagnosticOpts a -> DiagnosticOpts a
    forall a. a -> a
    id

    -- | Embed a more complicated diagnostic which requires a potentially different options type.
    embedUnknownDiagnostic :: (Diagnostic a, Typeable a) => (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts
    embedUnknownDiagnostic :: forall a opts.
    (Diagnostic a, Typeable a) =>
    (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts
    embedUnknownDiagnostic = (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts
    forall a opts.
    (Diagnostic a, Typeable a) =>
    (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts
    UnknownDiagnostic

    --------------------------------------------------------------------------------

    pprDiagnostic :: forall e . Diagnostic e => e -> SDoc
    pprDiagnostic :: forall e. Diagnostic e => e -> SDoc
    pprDiagnostic e
    e = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ DiagnosticReason -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (e -> DiagnosticReason
    forall a. Diagnostic a => a -> DiagnosticReason
    diagnosticReason e
    e)
                           , Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat (DecoratedSDoc -> [SDoc]
    unDecorated (DiagnosticOpts e -> e -> DecoratedSDoc
    forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
    diagnosticMessage DiagnosticOpts e
    opts e
    e))) ]
      where opts :: DiagnosticOpts e
    opts = forall opts.
    HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
    DiagnosticOpts opts
    defaultDiagnosticOpts @e

    -- | A generic 'Hint' message, to be used with 'DiagnosticMessage'.
    data DiagnosticHint = DiagnosticHint !SDoc

    instance Outputable DiagnosticHint where
      ppr :: DiagnosticHint -> SDoc
    ppr (DiagnosticHint SDoc
    msg) = SDoc
    msg

    -- | A generic 'Diagnostic' message, without any further classification or
    -- provenance: By looking at a 'DiagnosticMessage' we don't know neither
    -- /where/ it was generated nor how to interpret its payload (as it's just a
    -- structured document). All we can do is to print it out and look at its
    -- 'DiagnosticReason'.
    data DiagnosticMessage = DiagnosticMessage
      { DiagnosticMessage -> DecoratedSDoc
    diagMessage :: !DecoratedSDoc
      , DiagnosticMessage -> DiagnosticReason
    diagReason  :: !DiagnosticReason
      , DiagnosticMessage -> [GhcHint]
    diagHints   :: [GhcHint]
      }

    instance Diagnostic DiagnosticMessage where
      type DiagnosticOpts DiagnosticMessage = NoDiagnosticOpts
      diagnosticMessage :: DiagnosticOpts DiagnosticMessage
    -> DiagnosticMessage -> DecoratedSDoc
    diagnosticMessage DiagnosticOpts DiagnosticMessage
    _ = DiagnosticMessage -> DecoratedSDoc
    diagMessage
      diagnosticReason :: DiagnosticMessage -> DiagnosticReason
    diagnosticReason  = DiagnosticMessage -> DiagnosticReason
    diagReason
      diagnosticHints :: DiagnosticMessage -> [GhcHint]
    diagnosticHints   = DiagnosticMessage -> [GhcHint]
    diagHints
      diagnosticCode :: DiagnosticMessage -> Maybe DiagnosticCode
    diagnosticCode DiagnosticMessage
    _  = Maybe DiagnosticCode
    forall a. Maybe a
    Nothing

    -- | Helper function to use when no hints can be provided. Currently this function
    -- can be used to construct plain 'DiagnosticMessage' and add hints to them, but
    -- once #18516 will be fully executed, the main usage of this function would be in
    -- the implementation of the 'diagnosticHints' typeclass method, to report the fact
    -- that a particular 'Diagnostic' has no hints.
    noHints :: [GhcHint]
    noHints :: [GhcHint]
    noHints = [GhcHint]
    forall a. Monoid a => a
    mempty

    mkPlainDiagnostic :: DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
    mkPlainDiagnostic :: DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
    mkPlainDiagnostic DiagnosticReason
    rea [GhcHint]
    hints SDoc
    doc = DecoratedSDoc -> DiagnosticReason -> [GhcHint] -> DiagnosticMessage
    DiagnosticMessage (SDoc -> DecoratedSDoc
    mkSimpleDecorated SDoc
    doc) DiagnosticReason
    rea [GhcHint]
    hints

    -- | Create an error 'DiagnosticMessage' holding just a single 'SDoc'
    mkPlainError :: [GhcHint] -> SDoc -> DiagnosticMessage
    mkPlainError :: [GhcHint] -> SDoc -> DiagnosticMessage
    mkPlainError [GhcHint]
    hints SDoc
    doc = DecoratedSDoc -> DiagnosticReason -> [GhcHint] -> DiagnosticMessage
    DiagnosticMessage (SDoc -> DecoratedSDoc
    mkSimpleDecorated SDoc
    doc) DiagnosticReason
    ErrorWithoutFlag [GhcHint]
    hints

    -- | Create a 'DiagnosticMessage' from a list of bulleted SDocs and a 'DiagnosticReason'
    mkDecoratedDiagnostic :: DiagnosticReason -> [GhcHint] -> [SDoc] -> DiagnosticMessage
    mkDecoratedDiagnostic :: DiagnosticReason -> [GhcHint] -> [SDoc] -> DiagnosticMessage
    mkDecoratedDiagnostic DiagnosticReason
    rea [GhcHint]
    hints [SDoc]
    docs = DecoratedSDoc -> DiagnosticReason -> [GhcHint] -> DiagnosticMessage
    DiagnosticMessage ([SDoc] -> DecoratedSDoc
    mkDecorated [SDoc]
    docs) DiagnosticReason
    rea [GhcHint]
    hints

    -- | Create an error 'DiagnosticMessage' from a list of bulleted SDocs
    mkDecoratedError :: [GhcHint] -> [SDoc] -> DiagnosticMessage
    mkDecoratedError :: [GhcHint] -> [SDoc] -> DiagnosticMessage
    mkDecoratedError [GhcHint]
    hints [SDoc]
    docs = DecoratedSDoc -> DiagnosticReason -> [GhcHint] -> DiagnosticMessage
    DiagnosticMessage ([SDoc] -> DecoratedSDoc
    mkDecorated [SDoc]
    docs) DiagnosticReason
    ErrorWithoutFlag [GhcHint]
    hints

    -- | The reason /why/ a 'Diagnostic' was emitted in the first place.
    -- Diagnostic messages are born within GHC with a very precise reason, which
    -- can be completely statically-computed (i.e. this is an error or a warning
    -- no matter what), or influenced by the specific state of the 'DynFlags' at
    -- the moment of the creation of a new 'Diagnostic'. For example, a parsing
    -- error is /always/ going to be an error, whereas a 'WarningWithoutFlag
    -- Opt_WarnUnusedImports' might turn into an error due to '-Werror' or
    -- '-Werror=warn-unused-imports'. Interpreting a 'DiagnosticReason' together
    -- with its associated 'Severity' gives us the full picture.
    data DiagnosticReason
      = WarningWithoutFlag
      -- ^ Born as a warning.
      | WarningWithFlags !(NE.NonEmpty WarningFlag)
      -- ^ Warning was enabled with the flag.
      | WarningWithCategory !WarningCategory
      -- ^ Warning was enabled with a custom category.
      | ErrorWithoutFlag
      -- ^ Born as an error.
      deriving (DiagnosticReason -> DiagnosticReason -> Bool
    (DiagnosticReason -> DiagnosticReason -> Bool)
    -> (DiagnosticReason -> DiagnosticReason -> Bool)
    -> Eq DiagnosticReason
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DiagnosticReason -> DiagnosticReason -> Bool
    == :: DiagnosticReason -> DiagnosticReason -> Bool
    $c/= :: DiagnosticReason -> DiagnosticReason -> Bool
    /= :: DiagnosticReason -> DiagnosticReason -> Bool
    Eq, Int -> DiagnosticReason -> ShowS
    [DiagnosticReason] -> ShowS
    DiagnosticReason -> String
    (Int -> DiagnosticReason -> ShowS)
    -> (DiagnosticReason -> String)
    -> ([DiagnosticReason] -> ShowS)
    -> Show DiagnosticReason
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DiagnosticReason -> ShowS
    showsPrec :: Int -> DiagnosticReason -> ShowS
    $cshow :: DiagnosticReason -> String
    show :: DiagnosticReason -> String
    $cshowList :: [DiagnosticReason] -> ShowS
    showList :: [DiagnosticReason] -> ShowS
    Show)

    -- | Like a 'DiagnosticReason', but resolved against a specific set of `DynFlags` to
    -- work out which warning flag actually enabled this warning.
    newtype ResolvedDiagnosticReason
              = ResolvedDiagnosticReason { ResolvedDiagnosticReason -> DiagnosticReason
    resolvedDiagnosticReason :: DiagnosticReason }

    -- | The single warning case 'DiagnosticReason' is very common.
    pattern WarningWithFlag :: WarningFlag -> DiagnosticReason
    pattern $mWarningWithFlag :: forall {r}.
    DiagnosticReason -> (WarningFlag -> r) -> ((# #) -> r) -> r
    $bWarningWithFlag :: WarningFlag -> DiagnosticReason
    WarningWithFlag w = WarningWithFlags (w :| [])

    {- Note [Warnings controlled by multiple flags]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Diagnostics that started life as flag-controlled warnings have a
    'diagnosticReason' of 'WarningWithFlags', giving the flags that control the
    warning. Usually there is only one flag, but in a few cases multiple flags
    apply. Where there are more than one, they are listed highest-priority first.

    For example, the same exported binding may give rise to a warning if either
    `-Wmissing-signatures` or `-Wmissing-exported-signatures` is enabled. Here
    `-Wmissing-signatures` has higher priority, because we want to mention it if
    before are enabled.  See `missingSignatureWarningFlags` for the specific logic
    in this case.

    When reporting such a warning to the user, it is important to mention the
    correct flag (e.g. `-Wmissing-signatures` if it is enabled, or
    `-Wmissing-exported-signatures` if only the latter is enabled).  Thus
    `diag_reason_severity` filters the `DiagnosticReason` based on the currently
    active `DiagOpts`. For a `WarningWithFlags` it returns only the flags that are
    enabled; it leaves other `DiagnosticReason`s unchanged. This is then wrapped
    in a `ResolvedDiagnosticReason` newtype which records that this filtering has
    taken place.

    If we have `-Wmissing-signatures -Werror=missing-exported-signatures` we want
    the error to mention `-Werror=missing-exported-signatures` (even though
    `-Wmissing-signatures` would normally take precedence). Thus if there are any
    fatal warnings, `diag_reason_severity` returns those alone.

    The `MsgEnvelope` stores the filtered `ResolvedDiagnosticReason` listing only the
    relevant flags for subsequent display.

    Side note: we do not treat `-Wmissing-signatures` as a warning group that
    includes `-Wmissing-exported-signatures`, because

      (a) this would require us to provide a flag for the complement, and

      (b) currently, in `-Wmissing-exported-signatures -Wno-missing-signatures`, the
          latter option does not switch off the former.
    -}

    instance Outputable DiagnosticReason where
      ppr :: DiagnosticReason -> SDoc
    ppr = \case
        DiagnosticReason
    WarningWithoutFlag  -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "WarningWithoutFlag"
        WarningWithFlags NonEmpty WarningFlag
    wf -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String
    "WarningWithFlags " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ NonEmpty WarningFlag -> String
    forall a. Show a => a -> String
    show NonEmpty WarningFlag
    wf)
        WarningWithCategory WarningCategory
    cat -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "WarningWithCategory" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> WarningCategory -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WarningCategory
    cat
        DiagnosticReason
    ErrorWithoutFlag    -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ErrorWithoutFlag"

    instance Outputable ResolvedDiagnosticReason where
      ppr :: ResolvedDiagnosticReason -> SDoc
    ppr = DiagnosticReason -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (DiagnosticReason -> SDoc)
    -> (ResolvedDiagnosticReason -> DiagnosticReason)
    -> ResolvedDiagnosticReason
    -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ResolvedDiagnosticReason -> DiagnosticReason
    resolvedDiagnosticReason

    -- | 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, 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 -> NamePprCtx
    errMsgContext     :: NamePprCtx
       , forall e. MsgEnvelope e -> e
    errMsgDiagnostic  :: e
       , forall e. MsgEnvelope e -> Severity
    errMsgSeverity    :: Severity
       , forall e. MsgEnvelope e -> ResolvedDiagnosticReason
    errMsgReason      :: ResolvedDiagnosticReason
          -- ^ The actual reason caused this message
          --
          -- See Note [Warnings controlled by multiple flags]
       } deriving ((forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b)
    -> (forall a b. a -> MsgEnvelope b -> MsgEnvelope a)
    -> Functor MsgEnvelope
    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
    $cfmap :: forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
    fmap :: forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
    $c<$ :: forall a b. a -> MsgEnvelope b -> MsgEnvelope a
    <$ :: forall a b. a -> MsgEnvelope b -> MsgEnvelope a
    Functor, (forall m. Monoid m => MsgEnvelope m -> m)
    -> (forall m a. Monoid m => (a -> m) -> MsgEnvelope a -> m)
    -> (forall m a. Monoid m => (a -> m) -> MsgEnvelope a -> m)
    -> (forall a b. (a -> b -> b) -> b -> MsgEnvelope a -> b)
    -> (forall a b. (a -> b -> b) -> b -> MsgEnvelope a -> b)
    -> (forall b a. (b -> a -> b) -> b -> MsgEnvelope a -> b)
    -> (forall b a. (b -> a -> b) -> b -> MsgEnvelope a -> b)
    -> (forall a. (a -> a -> a) -> MsgEnvelope a -> a)
    -> (forall a. (a -> a -> a) -> MsgEnvelope a -> a)
    -> (forall a. MsgEnvelope a -> [a])
    -> (forall e. MsgEnvelope e -> Bool)
    -> (forall a. MsgEnvelope a -> Int)
    -> (forall a. Eq a => a -> MsgEnvelope a -> Bool)
    -> (forall a. Ord a => MsgEnvelope a -> a)
    -> (forall a. Ord a => MsgEnvelope a -> a)
    -> (forall a. Num a => MsgEnvelope a -> a)
    -> (forall a. Num a => MsgEnvelope a -> a)
    -> Foldable MsgEnvelope
    forall a. Eq a => a -> MsgEnvelope a -> Bool
    forall a. Num a => MsgEnvelope a -> a
    forall a. Ord a => MsgEnvelope a -> a
    forall m. Monoid m => MsgEnvelope m -> m
    forall e. MsgEnvelope e -> Bool
    forall a. MsgEnvelope a -> Int
    forall a. MsgEnvelope a -> [a]
    forall a. (a -> a -> a) -> MsgEnvelope a -> a
    forall m a. Monoid m => (a -> m) -> MsgEnvelope a -> m
    forall b a. (b -> a -> b) -> b -> MsgEnvelope a -> b
    forall a b. (a -> b -> b) -> b -> MsgEnvelope a -> b
    forall (t :: * -> *).
    (forall m. Monoid m => t m -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. t a -> [a])
    -> (forall a. t a -> Bool)
    -> (forall a. t a -> Int)
    -> (forall a. Eq a => a -> t a -> Bool)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> Foldable t
    $cfold :: forall m. Monoid m => MsgEnvelope m -> m
    fold :: forall m. Monoid m => MsgEnvelope m -> m
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> MsgEnvelope a -> m
    foldMap :: forall m a. Monoid m => (a -> m) -> MsgEnvelope a -> m
    $cfoldMap' :: forall m a. Monoid m => (a -> m) -> MsgEnvelope a -> m
    foldMap' :: forall m a. Monoid m => (a -> m) -> MsgEnvelope a -> m
    $cfoldr :: forall a b. (a -> b -> b) -> b -> MsgEnvelope a -> b
    foldr :: forall a b. (a -> b -> b) -> b -> MsgEnvelope a -> b
    $cfoldr' :: forall a b. (a -> b -> b) -> b -> MsgEnvelope a -> b
    foldr' :: forall a b. (a -> b -> b) -> b -> MsgEnvelope a -> b
    $cfoldl :: forall b a. (b -> a -> b) -> b -> MsgEnvelope a -> b
    foldl :: forall b a. (b -> a -> b) -> b -> MsgEnvelope a -> b
    $cfoldl' :: forall b a. (b -> a -> b) -> b -> MsgEnvelope a -> b
    foldl' :: forall b a. (b -> a -> b) -> b -> MsgEnvelope a -> b
    $cfoldr1 :: forall a. (a -> a -> a) -> MsgEnvelope a -> a
    foldr1 :: forall a. (a -> a -> a) -> MsgEnvelope a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> MsgEnvelope a -> a
    foldl1 :: forall a. (a -> a -> a) -> MsgEnvelope a -> a
    $ctoList :: forall a. MsgEnvelope a -> [a]
    toList :: forall a. MsgEnvelope a -> [a]
    $cnull :: forall e. MsgEnvelope e -> Bool
    null :: forall e. MsgEnvelope e -> Bool
    $clength :: forall a. MsgEnvelope a -> Int
    length :: forall a. MsgEnvelope a -> Int
    $celem :: forall a. Eq a => a -> MsgEnvelope a -> Bool
    elem :: forall a. Eq a => a -> MsgEnvelope a -> Bool
    $cmaximum :: forall a. Ord a => MsgEnvelope a -> a
    maximum :: forall a. Ord a => MsgEnvelope a -> a
    $cminimum :: forall a. Ord a => MsgEnvelope a -> a
    minimum :: forall a. Ord a => MsgEnvelope a -> a
    $csum :: forall a. Num a => MsgEnvelope a -> a
    sum :: forall a. Num a => MsgEnvelope a -> a
    $cproduct :: forall a. Num a => MsgEnvelope a -> a
    product :: forall a. Num a => MsgEnvelope a -> a
    Foldable, Functor MsgEnvelope
    Foldable MsgEnvelope
    (Functor MsgEnvelope, Foldable MsgEnvelope) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> MsgEnvelope a -> f (MsgEnvelope b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        MsgEnvelope (f a) -> f (MsgEnvelope a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> MsgEnvelope a -> m (MsgEnvelope b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        MsgEnvelope (m a) -> m (MsgEnvelope a))
    -> Traversable MsgEnvelope
    forall (t :: * -> *).
    (Functor t, Foldable t) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> t a -> f (t b))
    -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> t a -> m (t b))
    -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
    -> Traversable t
    forall (m :: * -> *) a.
    Monad m =>
    MsgEnvelope (m a) -> m (MsgEnvelope a)
    forall (f :: * -> *) a.
    Applicative f =>
    MsgEnvelope (f a) -> f (MsgEnvelope a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MsgEnvelope a -> m (MsgEnvelope b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> MsgEnvelope a -> f (MsgEnvelope b)
    $ctraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> MsgEnvelope a -> f (MsgEnvelope b)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> MsgEnvelope a -> f (MsgEnvelope b)
    $csequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    MsgEnvelope (f a) -> f (MsgEnvelope a)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    MsgEnvelope (f a) -> f (MsgEnvelope a)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MsgEnvelope a -> m (MsgEnvelope b)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MsgEnvelope a -> m (MsgEnvelope b)
    $csequence :: forall (m :: * -> *) a.
    Monad m =>
    MsgEnvelope (m a) -> m (MsgEnvelope a)
    sequence :: forall (m :: * -> *) a.
    Monad m =>
    MsgEnvelope (m a) -> m (MsgEnvelope a)
    Traversable)

    -- | The class for a diagnostic message. The main purpose is to classify a
    -- message within GHC, to distinguish it from a debug/dump message vs a proper
    -- diagnostic, for which we include a 'DiagnosticReason'.
    data MessageClass
      = MCOutput
      | MCFatal
      | MCInteractive

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

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

      | MCDiagnostic Severity ResolvedDiagnosticReason (Maybe DiagnosticCode)
        -- ^ Diagnostics from the compiler. This constructor is very powerful as
        -- it allows the construction of a 'MessageClass' with a completely
        -- arbitrary permutation of 'Severity' and 'DiagnosticReason'. As such,
        -- users are encouraged to use the 'mkMCDiagnostic' smart constructor
        -- instead. Use this constructor directly only if you need to construct
        -- and manipulate diagnostic messages directly, for example inside
        -- 'GHC.Utils.Error'. In all the other circumstances, /especially/ when
        -- emitting compiler diagnostics, use the smart constructor.
        --
        -- The @Maybe 'DiagnosticCode'@ field carries a code (if available) for
        -- this diagnostic. If you are creating a message not tied to any
        -- error-message type, then use Nothing. In the long run, this really
        -- should always have a 'DiagnosticCode'. See Note [Diagnostic codes].

    {-
    Note [Suppressing Messages]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The 'SevIgnore' constructor is used to generate messages for diagnostics which
    are meant to be suppressed and not reported to the user: the classic example
    are warnings for which the user didn't enable the corresponding 'WarningFlag',
    so GHC shouldn't print them.

    A different approach would be to extend the zoo of 'mkMsgEnvelope' functions
    to return a 'Maybe (MsgEnvelope e)', so that we won't need to even create the
    message to begin with. Both approaches have been evaluated, but we settled on
    the "SevIgnore one" for a number of reasons:

    * It's less invasive to deal with;
    * It plays slightly better with deferred diagnostics (see 'GHC.Tc.Errors') as
      for those we need to be able to /always/ produce a message (so that is
      reported at runtime);
    * It gives us more freedom: we can still decide to drop a 'SevIgnore' message
      at leisure, or we can decide to keep it around until the last moment. Maybe
      in the future we would need to turn a 'SevIgnore' into something else, for
      example to "unsuppress" diagnostics if a flag is set: with this approach, we
      have more leeway to accommodate new features.

    -}

    -- | Used to describe warnings and errors
    --   o The message has a file\/line\/column heading,
    --     plus "warning:" or "error:",
    --     added by mkLocMessage
    --   o With 'SevIgnore' the message is suppressed
    --   o Output is intended for end users
    data Severity
      = SevIgnore
      -- ^ Ignore this message, for example in
      -- case of suppression of warnings users
      -- don't want to see. See Note [Suppressing Messages]
      | SevWarning
      | SevError
      deriving (Severity -> Severity -> Bool
    (Severity -> Severity -> Bool)
    -> (Severity -> Severity -> Bool) -> Eq Severity
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Severity -> Severity -> Bool
    == :: Severity -> Severity -> Bool
    $c/= :: Severity -> Severity -> Bool
    /= :: Severity -> Severity -> Bool
    Eq, Eq Severity
    Eq Severity =>
    (Severity -> Severity -> Ordering)
    -> (Severity -> Severity -> Bool)
    -> (Severity -> Severity -> Bool)
    -> (Severity -> Severity -> Bool)
    -> (Severity -> Severity -> Bool)
    -> (Severity -> Severity -> Severity)
    -> (Severity -> Severity -> Severity)
    -> Ord Severity
    Severity -> Severity -> Bool
    Severity -> Severity -> Ordering
    Severity -> Severity -> Severity
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Severity -> Severity -> Ordering
    compare :: Severity -> Severity -> Ordering
    $c< :: Severity -> Severity -> Bool
    < :: Severity -> Severity -> Bool
    $c<= :: Severity -> Severity -> Bool
    <= :: Severity -> Severity -> Bool
    $c> :: Severity -> Severity -> Bool
    > :: Severity -> Severity -> Bool
    $c>= :: Severity -> Severity -> Bool
    >= :: Severity -> Severity -> Bool
    $cmax :: Severity -> Severity -> Severity
    max :: Severity -> Severity -> Severity
    $cmin :: Severity -> Severity -> Severity
    min :: Severity -> Severity -> Severity
    Ord, Int -> Severity -> ShowS
    [Severity] -> ShowS
    Severity -> String
    (Int -> Severity -> ShowS)
    -> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Severity -> ShowS
    showsPrec :: Int -> Severity -> ShowS
    $cshow :: Severity -> String
    show :: Severity -> String
    $cshowList :: [Severity] -> ShowS
    showList :: [Severity] -> ShowS
    Show)

    instance Outputable Severity where
      ppr :: Severity -> SDoc
    ppr = \case
        Severity
    SevIgnore  -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "SevIgnore"
        Severity
    SevWarning -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "SevWarning"
        Severity
    SevError   -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "SevError"

    instance ToJson Severity where
      json :: Severity -> JsonDoc
    json Severity
    SevIgnore = String -> JsonDoc
    JSString String
    "Ignore"
      json Severity
    SevWarning = String -> JsonDoc
    JSString String
    "Warning"
      json Severity
    SevError = String -> JsonDoc
    JSString String
    "Error"

    instance ToJson MessageClass where
      json :: MessageClass -> JsonDoc
    json MessageClass
    MCOutput = String -> JsonDoc
    JSString String
    "MCOutput"
      json MessageClass
    MCFatal  = String -> JsonDoc
    JSString String
    "MCFatal"
      json MessageClass
    MCInteractive = String -> JsonDoc
    JSString String
    "MCInteractive"
      json MessageClass
    MCDump = String -> JsonDoc
    JSString String
    "MCDump"
      json MessageClass
    MCInfo = String -> JsonDoc
    JSString String
    "MCInfo"
      json (MCDiagnostic Severity
    sev ResolvedDiagnosticReason
    reason Maybe DiagnosticCode
    code) =
        String -> JsonDoc
    JSString (String -> JsonDoc) -> String -> JsonDoc
    forall a b. (a -> b) -> a -> b
    $ SDocContext -> SDoc -> String
    renderWithContext SDocContext
    defaultSDocContext (SDoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "MCDiagnostic" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Severity -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Severity
    sev SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ResolvedDiagnosticReason -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ResolvedDiagnosticReason
    reason SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Maybe DiagnosticCode -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe DiagnosticCode
    code)

    instance ToJson DiagnosticCode where
      json :: DiagnosticCode -> JsonDoc
    json DiagnosticCode
    c = Int -> JsonDoc
    JSInt (Natural -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (DiagnosticCode -> Natural
    diagnosticCodeNumber DiagnosticCode
    c))

    {- Note [Diagnostic Message JSON Schema]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The below instance of ToJson must conform to the JSON schema
    specified in docs/users_guide/diagnostics-as-json-schema-1_1.json.
    When the schema is altered, please bump the version.
    If the content is altered in a backwards compatible way,
    update the minor version (e.g. 1.3 ~> 1.4).
    If the content is breaking, update the major version (e.g. 1.3 ~> 2.0).
    When updating the schema, replace the above file and name it appropriately with
    the version appended, and change the documentation of the -fdiagnostics-as-json
    flag to reflect the new schema.
    To learn more about JSON schemas, check out the below link:
    https://json-schema.org
    -}

    schemaVersion :: String
    schemaVersion :: String
    schemaVersion = String
    "1.1"
    -- See Note [Diagnostic Message JSON Schema] before editing!
    instance Diagnostic e => ToJson (MsgEnvelope e) where
      json :: MsgEnvelope e -> JsonDoc
    json MsgEnvelope e
    m = [(String, JsonDoc)] -> JsonDoc
    JSObject ([(String, JsonDoc)] -> JsonDoc) -> [(String, JsonDoc)] -> JsonDoc
    forall a b. (a -> b) -> a -> b
    $ [
        (String
    "version", String -> JsonDoc
    JSString String
    schemaVersion),
        (String
    "ghcVersion", String -> JsonDoc
    JSString (String -> JsonDoc) -> String -> JsonDoc
    forall a b. (a -> b) -> a -> b
    $ String
    "ghc-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    cProjectVersion),
        (String
    "span", SrcSpan -> JsonDoc
    forall a. ToJson a => a -> JsonDoc
    json (SrcSpan -> JsonDoc) -> SrcSpan -> JsonDoc
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope e -> SrcSpan
    forall e. MsgEnvelope e -> SrcSpan
    errMsgSpan MsgEnvelope e
    m),
        (String
    "severity", Severity -> JsonDoc
    forall a. ToJson a => a -> JsonDoc
    json (Severity -> JsonDoc) -> Severity -> JsonDoc
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope e -> Severity
    forall e. MsgEnvelope e -> Severity
    errMsgSeverity MsgEnvelope e
    m),
        (String
    "code", JsonDoc
    -> (DiagnosticCode -> JsonDoc) -> Maybe DiagnosticCode -> JsonDoc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe JsonDoc
    JSNull DiagnosticCode -> JsonDoc
    forall a. ToJson a => a -> JsonDoc
    json (e -> Maybe DiagnosticCode
    forall a. Diagnostic a => a -> Maybe DiagnosticCode
    diagnosticCode e
    diag)),
        (String
    "message", [JsonDoc] -> JsonDoc
    JSArray ([JsonDoc] -> JsonDoc) -> [JsonDoc] -> JsonDoc
    forall a b. (a -> b) -> a -> b
    $ (SDoc -> JsonDoc) -> [SDoc] -> [JsonDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map SDoc -> JsonDoc
    renderToJSString [SDoc]
    diagMsg),
        (String
    "hints", [JsonDoc] -> JsonDoc
    JSArray ([JsonDoc] -> JsonDoc) -> [JsonDoc] -> JsonDoc
    forall a b. (a -> b) -> a -> b
    $ (GhcHint -> JsonDoc) -> [GhcHint] -> [JsonDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SDoc -> JsonDoc
    renderToJSString (SDoc -> JsonDoc) -> (GhcHint -> SDoc) -> GhcHint -> JsonDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GhcHint -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr) (e -> [GhcHint]
    forall a. Diagnostic a => a -> [GhcHint]
    diagnosticHints e
    diag) ) ]
        [(String, JsonDoc)] -> [(String, JsonDoc)] -> [(String, JsonDoc)]
    forall a. [a] -> [a] -> [a]
    ++ [ (String
    "reason", JsonDoc
    reasonJson)
           | JsonDoc
    reasonJson <- Maybe JsonDoc -> [JsonDoc]
    forall a. Maybe a -> [a]
    maybeToList (Maybe JsonDoc -> [JsonDoc]) -> Maybe JsonDoc -> [JsonDoc]
    forall a b. (a -> b) -> a -> b
    $ ResolvedDiagnosticReason -> Maybe JsonDoc
    usefulReasonJson_maybe (MsgEnvelope e -> ResolvedDiagnosticReason
    forall e. MsgEnvelope e -> ResolvedDiagnosticReason
    errMsgReason MsgEnvelope e
    m) ]
        where
          diag :: e
    diag = MsgEnvelope e -> e
    forall e. MsgEnvelope e -> e
    errMsgDiagnostic MsgEnvelope e
    m
          opts :: DiagnosticOpts e
    opts = forall opts.
    HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
    DiagnosticOpts opts
    defaultDiagnosticOpts @e
          style :: PprStyle
    style = NamePprCtx -> PprStyle
    mkErrStyle (MsgEnvelope e -> NamePprCtx
    forall e. MsgEnvelope e -> NamePprCtx
    errMsgContext MsgEnvelope e
    m)
          ctx :: SDocContext
    ctx = SDocContext
    defaultSDocContext {sdocStyle = style }
          diagMsg :: [SDoc]
    diagMsg = (SDoc -> Bool) -> [SDoc] -> [SDoc]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (SDoc -> Bool) -> SDoc -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDocContext -> SDoc -> Bool
    isEmpty SDocContext
    ctx) (DecoratedSDoc -> [SDoc]
    unDecorated (DiagnosticOpts e -> e -> DecoratedSDoc
    forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
    diagnosticMessage (DiagnosticOpts e
    opts) e
    diag))
          renderToJSString :: SDoc -> JsonDoc
          renderToJSString :: SDoc -> JsonDoc
    renderToJSString = String -> JsonDoc
    JSString (String -> JsonDoc) -> (SDoc -> String) -> SDoc -> JsonDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SDocContext -> SDoc -> String
    renderWithContext SDocContext
    ctx)

          usefulReasonJson_maybe :: ResolvedDiagnosticReason -> Maybe JsonDoc
          usefulReasonJson_maybe :: ResolvedDiagnosticReason -> Maybe JsonDoc
    usefulReasonJson_maybe (ResolvedDiagnosticReason DiagnosticReason
    rea) =
            case DiagnosticReason
    rea of
              DiagnosticReason
    WarningWithoutFlag -> Maybe JsonDoc
    forall a. Maybe a
    Nothing
              DiagnosticReason
    ErrorWithoutFlag   -> Maybe JsonDoc
    forall a. Maybe a
    Nothing
              WarningWithFlags NonEmpty WarningFlag
    flags ->
                JsonDoc -> Maybe JsonDoc
    forall a. a -> Maybe a
    Just (JsonDoc -> Maybe JsonDoc) -> JsonDoc -> Maybe JsonDoc
    forall a b. (a -> b) -> a -> b
    $ [(String, JsonDoc)] -> JsonDoc
    JSObject
                  [ (String
    "flags", [JsonDoc] -> JsonDoc
    JSArray ([JsonDoc] -> JsonDoc) -> [JsonDoc] -> JsonDoc
    forall a b. (a -> b) -> a -> b
    $ (WarningFlag -> JsonDoc) -> [WarningFlag] -> [JsonDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> JsonDoc
    JSString (String -> JsonDoc)
    -> (WarningFlag -> String) -> WarningFlag -> JsonDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty String -> String
    forall a. NonEmpty a -> a
    NE.head (NonEmpty String -> String)
    -> (WarningFlag -> NonEmpty String) -> WarningFlag -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WarningFlag -> NonEmpty String
    warnFlagNames) (NonEmpty WarningFlag -> [WarningFlag]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty WarningFlag
    flags))
                  ]
              WarningWithCategory (WarningCategory FastString
    cat) ->
                JsonDoc -> Maybe JsonDoc
    forall a. a -> Maybe a
    Just (JsonDoc -> Maybe JsonDoc) -> JsonDoc -> Maybe JsonDoc
    forall a b. (a -> b) -> a -> b
    $ [(String, JsonDoc)] -> JsonDoc
    JSObject
                  [ (String
    "category", String -> JsonDoc
    JSString (String -> JsonDoc) -> String -> JsonDoc
    forall a b. (a -> b) -> a -> b
    $ FastString -> String
    unpackFS FastString
    cat)
                  ]

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

    -- | Shows an 'MsgEnvelope'. Only use this for debugging.
    showMsgEnvelope :: forall a . Diagnostic a => MsgEnvelope a -> String
    showMsgEnvelope :: forall a. Diagnostic a => MsgEnvelope a -> String
    showMsgEnvelope MsgEnvelope a
    err =
      SDocContext -> SDoc -> String
    renderWithContext SDocContext
    defaultSDocContext ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat (DecoratedSDoc -> [SDoc]
    unDecorated (DecoratedSDoc -> [SDoc]) -> (a -> DecoratedSDoc) -> a -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DiagnosticOpts a -> a -> DecoratedSDoc
    forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
    diagnosticMessage (forall opts.
    HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
    DiagnosticOpts opts
    defaultDiagnosticOpts @a)) (a -> [SDoc]) -> a -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope a -> a
    forall e. MsgEnvelope e -> e
    errMsgDiagnostic MsgEnvelope a
    err))

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

    mkLocMessage
      :: MessageClass                       -- ^ What kind of message?
      -> SrcSpan                            -- ^ location
      -> SDoc                               -- ^ message
      -> SDoc
    mkLocMessage :: MessageClass -> SrcSpan -> SDoc -> SDoc
    mkLocMessage = Bool -> MessageClass -> SrcSpan -> SDoc -> SDoc
    mkLocMessageWarningGroups Bool
    True

    -- | Make an error message with location info, specifying whether to show
    -- warning groups (if applicable).
    mkLocMessageWarningGroups
      :: Bool                               -- ^ Print warning groups (if applicable)?
      -> MessageClass                       -- ^ What kind of message?
      -> 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>".
    mkLocMessageWarningGroups :: Bool -> MessageClass -> SrcSpan -> SDoc -> SDoc
    mkLocMessageWarningGroups Bool
    show_warn_groups MessageClass
    msg_class SrcSpan
    locn SDoc
    msg
        = (SDocContext -> Scheme) -> (Scheme -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Scheme
    sdocColScheme ((Scheme -> SDoc) -> SDoc) -> (Scheme -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \Scheme
    col_scheme ->
          let locn' :: SDoc
    locn' = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocErrorSpans ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \case
                         Bool
    True  -> SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    locn
                         Bool
    False -> SrcLoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (SrcSpan -> SrcLoc
    srcSpanStart SrcSpan
    locn)

              msg_colour :: PprColour
    msg_colour = MessageClass -> Scheme -> PprColour
    getMessageClassColour MessageClass
    msg_class Scheme
    col_scheme
              col :: String -> SDoc
    col = PprColour -> SDoc -> SDoc
    coloured PprColour
    msg_colour (SDoc -> SDoc) -> (String -> SDoc) -> String -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> SDoc
    forall doc. IsLine doc => String -> doc
    text

              msg_title :: SDoc
    msg_title = PprColour -> SDoc -> SDoc
    coloured PprColour
    msg_colour (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                case MessageClass
    msg_class of
                  MCDiagnostic Severity
    SevError   ResolvedDiagnosticReason
    _ Maybe DiagnosticCode
    _ -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "error"
                  MCDiagnostic Severity
    SevWarning ResolvedDiagnosticReason
    _ Maybe DiagnosticCode
    _ -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "warning"
                  MessageClass
    MCFatal                     -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "fatal"
                  MessageClass
    _                           -> SDoc
    forall doc. IsOutput doc => doc
    empty

              warning_flag_doc :: SDoc
    warning_flag_doc =
                case MessageClass
    msg_class of
                  MCDiagnostic Severity
    sev ResolvedDiagnosticReason
    reason Maybe DiagnosticCode
    _code
                    | Just SDoc
    msg <- Severity -> DiagnosticReason -> Maybe SDoc
    flag_msg Severity
    sev (ResolvedDiagnosticReason -> DiagnosticReason
    resolvedDiagnosticReason ResolvedDiagnosticReason
    reason)
                      -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    brackets SDoc
    msg
                  MessageClass
    _   -> SDoc
    forall doc. IsOutput doc => doc
    empty

              ppr_with_hyperlink :: DiagnosticCode -> SDoc
    ppr_with_hyperlink DiagnosticCode
    code =
                -- this is a bit hacky, but we assume that if the terminal supports colors
                -- then it should also support links
                (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption (\ SDocContext
    ctx -> SDocContext -> Bool
    sdocPrintErrIndexLinks SDocContext
    ctx) ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                  \ Bool
    use_hyperlinks ->
                     if Bool
    use_hyperlinks
                     then LinkedDiagCode -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (LinkedDiagCode -> SDoc) -> LinkedDiagCode -> SDoc
    forall a b. (a -> b) -> a -> b
    $ DiagnosticCode -> LinkedDiagCode
    LinkedDiagCode DiagnosticCode
    code
                     else DiagnosticCode -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DiagnosticCode
    code

              code_doc :: SDoc
    code_doc =
                case MessageClass
    msg_class of
                  MCDiagnostic Severity
    _ ResolvedDiagnosticReason
    _ (Just DiagnosticCode
    code) -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    brackets (DiagnosticCode -> SDoc
    ppr_with_hyperlink DiagnosticCode
    code)
                  MessageClass
    _                            -> SDoc
    forall doc. IsOutput doc => doc
    empty

              flag_msg :: Severity -> DiagnosticReason -> Maybe SDoc
              flag_msg :: Severity -> DiagnosticReason -> Maybe SDoc
    flag_msg Severity
    SevIgnore DiagnosticReason
    _                 = Maybe SDoc
    forall a. Maybe a
    Nothing
                -- The above can happen when displaying an error message
                -- in a log file, e.g. with -ddump-tc-trace. It should not
                -- happen otherwise, though.
              flag_msg Severity
    SevError DiagnosticReason
    WarningWithoutFlag = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (String -> SDoc
    col String
    "-Werror")
              flag_msg Severity
    SevError (WarningWithFlags (WarningFlag
    wflag :| [WarningFlag]
    _)) =
                let name :: String
    name = NonEmpty String -> String
    forall a. NonEmpty a -> a
    NE.head (WarningFlag -> NonEmpty String
    warnFlagNames WarningFlag
    wflag) in
                SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    col (String
    "-W" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    name) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [WarningGroup] -> SDoc
    warn_flag_grp (WarningFlag -> [WarningGroup]
    smallestWarningGroups WarningFlag
    wflag)
                                          SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    comma
                                          SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    col (String
    "Werror=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    name)
              flag_msg Severity
    SevError   (WarningWithCategory WarningCategory
    cat) =
                SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ PprColour -> SDoc -> SDoc
    coloured PprColour
    msg_colour (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "-W" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> WarningCategory -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WarningCategory
    cat)
                           SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [WarningGroup] -> SDoc
    warn_flag_grp [WarningGroup]
    smallestWarningGroupsForCategory
                           SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    comma
                           SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> PprColour -> SDoc -> SDoc
    coloured PprColour
    msg_colour (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "-Werror=" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> WarningCategory -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WarningCategory
    cat)
              flag_msg Severity
    SevError   DiagnosticReason
    ErrorWithoutFlag   = Maybe SDoc
    forall a. Maybe a
    Nothing
              flag_msg Severity
    SevWarning DiagnosticReason
    WarningWithoutFlag = Maybe SDoc
    forall a. Maybe a
    Nothing
              flag_msg Severity
    SevWarning (WarningWithFlags (WarningFlag
    wflag :| [WarningFlag]
    _)) =
                let name :: String
    name = NonEmpty String -> String
    forall a. NonEmpty a -> a
    NE.head (WarningFlag -> NonEmpty String
    warnFlagNames WarningFlag
    wflag) in
                SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (String -> SDoc
    col (String
    "-W" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    name) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [WarningGroup] -> SDoc
    warn_flag_grp (WarningFlag -> [WarningGroup]
    smallestWarningGroups WarningFlag
    wflag))
              flag_msg Severity
    SevWarning (WarningWithCategory WarningCategory
    cat) =
                SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (PprColour -> SDoc -> SDoc
    coloured PprColour
    msg_colour (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "-W" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> WarningCategory -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WarningCategory
    cat)
                          SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [WarningGroup] -> SDoc
    warn_flag_grp [WarningGroup]
    smallestWarningGroupsForCategory)
              flag_msg Severity
    SevWarning DiagnosticReason
    ErrorWithoutFlag =
                String -> SDoc -> Maybe SDoc
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "SevWarning with ErrorWithoutFlag" (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $
                  [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "locn:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    locn
                       , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "msg:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SDoc
    msg ]

              warn_flag_grp :: [WarningGroup] -> SDoc
    warn_flag_grp [WarningGroup]
    groups
                  | Bool
    show_warn_groups, Bool -> Bool
    not ([WarningGroup] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [WarningGroup]
    groups)
                              = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String
    "(in " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " ((WarningGroup -> String) -> [WarningGroup] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String
    "-W"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> (WarningGroup -> String) -> WarningGroup -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WarningGroup -> String
    warningGroupName) [WarningGroup]
    groups) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
                  | Bool
    otherwise = SDoc
    forall doc. IsOutput doc => doc
    empty

              -- Add prefixes, like    Foo.hs:34: warning:
              --                           <the warning message>
              header :: SDoc
    header = SDoc
    locn' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    colon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
                       SDoc
    msg_title SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    colon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
                       SDoc
    code_doc SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    warning_flag_doc

          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)

    getMessageClassColour :: MessageClass -> Col.Scheme -> Col.PprColour
    getMessageClassColour :: MessageClass -> Scheme -> PprColour
    getMessageClassColour (MCDiagnostic Severity
    SevError ResolvedDiagnosticReason
    _reason Maybe DiagnosticCode
    _code)   = Scheme -> PprColour
    Col.sError
    getMessageClassColour (MCDiagnostic Severity
    SevWarning ResolvedDiagnosticReason
    _reason Maybe DiagnosticCode
    _code) = Scheme -> PprColour
    Col.sWarning
    getMessageClassColour MessageClass
    MCFatal                                 = Scheme -> PprColour
    Col.sFatal
    getMessageClassColour MessageClass
    _                                       = PprColour -> Scheme -> PprColour
    forall a b. a -> b -> a
    const PprColour
    forall a. Monoid a => a
    mempty

    getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc
    getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc
    getCaretDiagnostic MessageClass
    _ (UnhelpfulSpan UnhelpfulSpanReason
    _) = SDoc -> IO SDoc
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SDoc
    forall doc. IsOutput doc => doc
    empty
    getCaretDiagnostic MessageClass
    msg_class (RealSrcSpan RealSrcSpan
    span Maybe BufSpan
    _) =
      Maybe String -> SDoc
    caretDiagnostic (Maybe String -> SDoc) -> IO (Maybe String) -> IO SDoc
    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)
            IO (Maybe String)
    -> (IOError -> IO (Maybe String)) -> IO (Maybe String)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catchException` \(IOError
    _ :: IOError) ->
              Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe String
    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)
          content <- String -> IO StringBuffer
    hGetStringBuffer String
    fn
          case atLine i content of
            Just StringBuffer
    at_line -> Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe String -> IO (Maybe String))
    -> Maybe String -> IO (Maybe String)
    forall a b. (a -> b) -> a -> b
    $
              case String -> [String]
    lines (Char -> Char
    fix (Char -> Char) -> ShowS
    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]
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    srcLine
                [String]
    _           -> Maybe String
    forall a. Maybe a
    Nothing
            Maybe StringBuffer
    _ -> Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe String
    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 = Int -> String
    forall a. Show a => a -> String
    show Int
    row
        multiline :: Bool
    multiline = Int
    row Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= RealSrcSpan -> Int
    srcSpanEndLine RealSrcSpan
    span

        caretDiagnostic :: Maybe String -> SDoc
    caretDiagnostic Maybe String
    Nothing = SDoc
    forall doc. IsOutput doc => doc
    empty
        caretDiagnostic (Just String
    srcLineWithNewline) =
          (SDocContext -> Scheme) -> (Scheme -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Scheme
    sdocColScheme((Scheme -> SDoc) -> SDoc) -> (Scheme -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \Scheme
    col_scheme ->
          let sevColour :: PprColour
    sevColour = MessageClass -> Scheme -> PprColour
    getMessageClassColour MessageClass
    msg_class Scheme
    col_scheme
              marginColour :: PprColour
    marginColour = Scheme -> PprColour
    Col.sMargin Scheme
    col_scheme
          in
          PprColour -> SDoc -> SDoc
    coloured PprColour
    marginColour (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    marginSpace) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <>
          String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String
    "\n") SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <>
          PprColour -> SDoc -> SDoc
    coloured PprColour
    marginColour (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    marginRow) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <>
          String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String
    " " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    srcLinePre) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <>
          PprColour -> SDoc -> SDoc
    coloured PprColour
    sevColour (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    srcLineSpan) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <>
          String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String
    srcLinePost String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n") SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <>
          PprColour -> SDoc -> SDoc
    coloured PprColour
    marginColour (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    marginSpace) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <>
          PprColour -> SDoc -> SDoc
    coloured PprColour
    sevColour (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String
    " " String -> ShowS
    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 -> Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    effectiveWidth Char
    ' ' String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                             Int -> Int -> ShowS
    expandTabs Int
    tabWidth (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    effectiveWidth) String
    cs
                Char
    c    : String
    cs -> Char
    c Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> Int -> ShowS
    expandTabs Int
    tabWidth (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) String
    cs
              where effectiveWidth :: Int
    effectiveWidth = Int
    tabWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    tabWidth

            srcLine :: String
    srcLine = (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
            end :: Int
    end | Bool
    multiline = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    srcLine
                | Bool
    otherwise = RealSrcSpan -> Int
    srcSpanEndCol RealSrcSpan
    span Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
            width :: Int
    width = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    1 (Int
    end Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    start)

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

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

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

    --
    -- Queries
    --

    {- Note [Intrinsic And Extrinsic Failures]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We distinguish between /intrinsic/ and /extrinsic/ failures. We classify in
    the former category those diagnostics which are /essentially/ failures, and
    their nature can't be changed. This is the case for 'ErrorWithoutFlag'. We
    classify as /extrinsic/ all those diagnostics (like fatal warnings) which are
    born as warnings but which are still failures under particular 'DynFlags'
    settings. It's important to be aware of such logic distinction, because when
    we are inside the typechecker or the desugarer, we are interested about
    intrinsic errors, and to bail out as soon as we find one of them. Conversely,
    if we find an /extrinsic/ one, for example because a particular 'WarningFlag'
    makes a warning into an error, we /don't/ want to bail out, that's still not the
    right time to do so: Rather, we want to first collect all the diagnostics, and
    later classify and report them appropriately (in the driver).
    -}

    -- | Returns 'True' if this is, intrinsically, a failure. See
    -- Note [Intrinsic And Extrinsic Failures].
    isIntrinsicErrorMessage :: Diagnostic e => MsgEnvelope e -> Bool
    isIntrinsicErrorMessage :: forall e. Diagnostic e => MsgEnvelope e -> Bool
    isIntrinsicErrorMessage = DiagnosticReason -> DiagnosticReason -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) DiagnosticReason
    ErrorWithoutFlag (DiagnosticReason -> Bool)
    -> (MsgEnvelope e -> DiagnosticReason) -> MsgEnvelope e -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ResolvedDiagnosticReason -> DiagnosticReason
    resolvedDiagnosticReason (ResolvedDiagnosticReason -> DiagnosticReason)
    -> (MsgEnvelope e -> ResolvedDiagnosticReason)
    -> MsgEnvelope e
    -> DiagnosticReason
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MsgEnvelope e -> ResolvedDiagnosticReason
    forall e. MsgEnvelope e -> ResolvedDiagnosticReason
    errMsgReason

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

    -- | Are there any hard errors here? -Werror warnings are /not/ detected. If
    -- you want to check for -Werror warnings, use 'errorsOrFatalWarningsFound'.
    errorsFound :: Diagnostic e => Messages e -> Bool
    errorsFound :: forall e. Diagnostic e => Messages e -> Bool
    errorsFound (Messages Bag (MsgEnvelope e)
    msgs) = (MsgEnvelope e -> Bool) -> Bag (MsgEnvelope e) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any MsgEnvelope e -> Bool
    forall e. Diagnostic e => MsgEnvelope e -> Bool
    isIntrinsicErrorMessage Bag (MsgEnvelope e)
    msgs

    -- | Returns 'True' if the envelope contains a message that will stop
    -- compilation: either an intrinsic error or a fatal (-Werror) warning
    isExtrinsicErrorMessage :: MsgEnvelope e -> Bool
    isExtrinsicErrorMessage :: forall e. MsgEnvelope e -> Bool
    isExtrinsicErrorMessage = Severity -> Severity -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Severity
    SevError (Severity -> Bool)
    -> (MsgEnvelope e -> Severity) -> MsgEnvelope e -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MsgEnvelope e -> Severity
    forall e. MsgEnvelope e -> Severity
    errMsgSeverity

    -- | Are there any errors or -Werror warnings here?
    errorsOrFatalWarningsFound :: Messages e -> Bool
    errorsOrFatalWarningsFound :: forall a. Messages a -> Bool
    errorsOrFatalWarningsFound (Messages Bag (MsgEnvelope e)
    msgs) = (MsgEnvelope e -> Bool) -> Bag (MsgEnvelope e) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any MsgEnvelope e -> Bool
    forall e. MsgEnvelope e -> Bool
    isExtrinsicErrorMessage Bag (MsgEnvelope e)
    msgs

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

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

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

    ----------------------------------------------------------------
    --                                                            --
    -- Definition of diagnostic codes                             --
    --                                                            --
    ----------------------------------------------------------------

    -- | A diagnostic code is a namespaced numeric identifier
    -- unique to the given diagnostic (error or warning).
    --
    -- All diagnostic codes defined within GHC are given the
    -- GHC namespace.
    --
    -- See Note [Diagnostic codes] in GHC.Types.Error.Codes.
    data DiagnosticCode =
      DiagnosticCode
        { DiagnosticCode -> String
    diagnosticCodeNameSpace :: String
            -- ^ diagnostic code prefix (e.g. "GHC")
        , DiagnosticCode -> Natural
    diagnosticCodeNumber    :: Natural
            -- ^ the actual diagnostic code
        }
      deriving ( DiagnosticCode -> DiagnosticCode -> Bool
    (DiagnosticCode -> DiagnosticCode -> Bool)
    -> (DiagnosticCode -> DiagnosticCode -> Bool) -> Eq DiagnosticCode
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DiagnosticCode -> DiagnosticCode -> Bool
    == :: DiagnosticCode -> DiagnosticCode -> Bool
    $c/= :: DiagnosticCode -> DiagnosticCode -> Bool
    /= :: DiagnosticCode -> DiagnosticCode -> Bool
    Eq, Eq DiagnosticCode
    Eq DiagnosticCode =>
    (DiagnosticCode -> DiagnosticCode -> Ordering)
    -> (DiagnosticCode -> DiagnosticCode -> Bool)
    -> (DiagnosticCode -> DiagnosticCode -> Bool)
    -> (DiagnosticCode -> DiagnosticCode -> Bool)
    -> (DiagnosticCode -> DiagnosticCode -> Bool)
    -> (DiagnosticCode -> DiagnosticCode -> DiagnosticCode)
    -> (DiagnosticCode -> DiagnosticCode -> DiagnosticCode)
    -> Ord DiagnosticCode
    DiagnosticCode -> DiagnosticCode -> Bool
    DiagnosticCode -> DiagnosticCode -> Ordering
    DiagnosticCode -> DiagnosticCode -> DiagnosticCode
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: DiagnosticCode -> DiagnosticCode -> Ordering
    compare :: DiagnosticCode -> DiagnosticCode -> Ordering
    $c< :: DiagnosticCode -> DiagnosticCode -> Bool
    < :: DiagnosticCode -> DiagnosticCode -> Bool
    $c<= :: DiagnosticCode -> DiagnosticCode -> Bool
    <= :: DiagnosticCode -> DiagnosticCode -> Bool
    $c> :: DiagnosticCode -> DiagnosticCode -> Bool
    > :: DiagnosticCode -> DiagnosticCode -> Bool
    $c>= :: DiagnosticCode -> DiagnosticCode -> Bool
    >= :: DiagnosticCode -> DiagnosticCode -> Bool
    $cmax :: DiagnosticCode -> DiagnosticCode -> DiagnosticCode
    max :: DiagnosticCode -> DiagnosticCode -> DiagnosticCode
    $cmin :: DiagnosticCode -> DiagnosticCode -> DiagnosticCode
    min :: DiagnosticCode -> DiagnosticCode -> DiagnosticCode
    Ord )

    instance Show DiagnosticCode where
      show :: DiagnosticCode -> String
    show (DiagnosticCode String
    prefix Natural
    c) =
        String
    prefix String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> Natural -> String
    forall r. PrintfType r => String -> r
    printf String
    "%05d" Natural
    c
          -- pad the numeric code to have at least 5 digits

    instance Outputable DiagnosticCode where
      ppr :: DiagnosticCode -> SDoc
    ppr DiagnosticCode
    code = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (DiagnosticCode -> String
    forall a. Show a => a -> String
    show DiagnosticCode
    code)

    -- | A newtype that is a witness to the `-fprint-error-index-links` flag. It
    -- alters the @Outputable@ instance to emit @DiagnosticCode@ as ANSI hyperlinks
    -- to the HF error index
    newtype LinkedDiagCode = LinkedDiagCode DiagnosticCode

    instance Outputable LinkedDiagCode where
      ppr :: LinkedDiagCode -> SDoc
    ppr (LinkedDiagCode d :: DiagnosticCode
    d@DiagnosticCode{}) = DiagnosticCode -> SDoc
    linkEscapeCode DiagnosticCode
    d

    -- | Wrap the link in terminal escape codes specified by OSC 8.
    linkEscapeCode :: DiagnosticCode -> SDoc
    linkEscapeCode :: DiagnosticCode -> SDoc
    linkEscapeCode DiagnosticCode
    d = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "\ESC]8;;" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> DiagnosticCode -> SDoc
    hfErrorLink DiagnosticCode
    d -- make the actual link
                       SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "\ESC\\" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> DiagnosticCode -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DiagnosticCode
    d SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "\ESC]8;;\ESC\\" -- the rest is the visible text

    -- | create a link to the HF error index given an error code.
    hfErrorLink :: DiagnosticCode -> SDoc
    hfErrorLink :: DiagnosticCode -> SDoc
    hfErrorLink DiagnosticCode
    errorCode = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "https://errors.haskell.org/messages/" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> DiagnosticCode -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DiagnosticCode
    errorCode