{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic PsMessage

module GHC.Parser.Errors.Ppr where

import GHC.Prelude
import GHC.Driver.Flags
import GHC.Parser.Errors.Basic
import GHC.Parser.Errors.Types
import GHC.Parser.Types
import GHC.Types.Basic
import GHC.Types.Hint
import GHC.Types.Error
import GHC.Types.Hint.Ppr (perhapsAsPat)
import GHC.Types.SrcLoc
import GHC.Types.Error.Codes
import GHC.Types.Name.Reader ( opIsAt, rdrNameOcc, mkUnqual )
import GHC.Types.Name.Occurrence (isSymOcc, occNameFS, varName)
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Data.FastString
import GHC.Data.Maybe (catMaybes)
import GHC.Hs.Expr (prependQualified, HsExpr(..), HsLamVariant(..), lamCaseKeyword)
import GHC.Hs.Type (pprLHsContext, pprHsArrow, pprHsForAll)
import GHC.Builtin.Names (allNameStringList)
import GHC.Builtin.Types (filterCTuple)
import qualified GHC.LanguageExtensions as LangExt
import Data.List.NonEmpty (NonEmpty((:|)))
import GHC.Hs.Pat (Pat(..), LPat)
import GHC.Hs.Extension
import GHC.Parser.Annotation (noAnn)


instance Diagnostic PsMessage where
  type DiagnosticOpts PsMessage = NoDiagnosticOpts
  diagnosticMessage :: DiagnosticOpts PsMessage -> PsMessage -> DecoratedSDoc
diagnosticMessage DiagnosticOpts PsMessage
opts = \case
    PsUnknownMessage (UnknownDiagnostic DiagnosticOpts PsMessage -> DiagnosticOpts a
f a
m)
      -> DiagnosticOpts a -> a -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (DiagnosticOpts PsMessage -> DiagnosticOpts a
f DiagnosticOpts PsMessage
opts) a
m

    PsHeaderMessage PsHeaderMessage
m
      -> PsHeaderMessage -> DecoratedSDoc
psHeaderMessageDiagnostic PsHeaderMessage
m

    PsMessage
PsWarnHaddockInvalidPos
       -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"A Haddock comment cannot appear in this position and will be ignored."
    PsMessage
PsWarnHaddockIgnoreMulti
       -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Multiple Haddock comments for a single entity are not allowed." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The extraneous comment will be ignored."
    PsWarnBidirectionalFormatChars ((PsLoc
loc,Char
_,[Char]
desc) :| [(PsLoc, Char, [Char])]
xs)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"A unicode bidirectional formatting character" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
desc)
         SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"was found at offset" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (BufPos -> Int
bufPos (PsLoc -> BufPos
psBufPos PsLoc
loc)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in the file"
         SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (case [(PsLoc, Char, [Char])]
xs of
           [] -> SDoc
forall doc. IsOutput doc => doc
empty
           [(PsLoc, Char, [Char])]
xs -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"along with further bidirectional formatting characters at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [(PsLoc, Char, [Char])] -> SDoc
forall {b}. [(PsLoc, b, [Char])] -> SDoc
pprChars [(PsLoc, Char, [Char])]
xs
            where
              pprChars :: [(PsLoc, b, [Char])] -> SDoc
pprChars [] = SDoc
forall doc. IsOutput doc => doc
empty
              pprChars ((PsLoc
loc,b
_,[Char]
desc):[(PsLoc, b, [Char])]
xs) = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"offset" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (BufPos -> Int
bufPos (PsLoc -> BufPos
psBufPos PsLoc
loc)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
":" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
desc
                                       SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [(PsLoc, b, [Char])] -> SDoc
pprChars [(PsLoc, b, [Char])]
xs
              )
         SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Bidirectional formatting characters may be rendered misleadingly in certain editors"

    PsWarnTab Word
tc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Tab character found here"
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> (if Word
tc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
1
                 then [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
""
                 else [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
", and in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc -> SDoc
speakNOf (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
tc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)) ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"further location"))
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"."
    PsWarnTransitionalLayout TransLayoutReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"transitional layout will not be accepted in the future:"
            SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (case TransLayoutReason
reason of
               TransLayoutReason
TransLayout_Where -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"`where' clause at the same depth as implicit layout block"
               TransLayoutReason
TransLayout_Pipe  -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"`|' at the same depth as implicit layout block"
            )
    PsWarnOperatorWhitespaceExtConflict OperatorWhitespaceSymbol
sym
      -> let mk_prefix_msg :: SDoc -> SDoc -> SDoc
mk_prefix_msg SDoc
extension_name SDoc
syntax_meaning =
                  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The prefix use of a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OperatorWhitespaceSymbol -> SDoc
pprOperatorWhitespaceSymbol OperatorWhitespaceSymbol
sym)
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"would denote" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
syntax_meaning
               SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"were the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
extension_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"extension enabled.")
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         case OperatorWhitespaceSymbol
sym of
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixPercent -> SDoc -> SDoc -> SDoc
mk_prefix_msg ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"LinearTypes") ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a multiplicity annotation")
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixDollar -> SDoc -> SDoc -> SDoc
mk_prefix_msg ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"TemplateHaskell") ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"an untyped splice")
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixDollarDollar -> SDoc -> SDoc -> SDoc
mk_prefix_msg ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"TemplateHaskell") ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a typed splice")
    PsWarnOperatorWhitespace FastString
sym OperatorWhitespaceOccurrence
occ_type
      -> let mk_msg :: [Char] -> SDoc
mk_msg [Char]
occ_type_str =
                  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
occ_type_str SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"use of a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
sym)
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"might be repurposed as special syntax"
               SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"by a future language extension.")
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         case OperatorWhitespaceOccurrence
occ_type of
           OperatorWhitespaceOccurrence
OperatorWhitespaceOccurrence_Prefix -> [Char] -> SDoc
mk_msg [Char]
"prefix"
           OperatorWhitespaceOccurrence
OperatorWhitespaceOccurrence_Suffix -> [Char] -> SDoc
mk_msg [Char]
"suffix"
           OperatorWhitespaceOccurrence
OperatorWhitespaceOccurrence_TightInfix -> [Char] -> SDoc
mk_msg [Char]
"tight infix"
    PsMessage
PsWarnStarBinder
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Found binding occurrence of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"*")
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"yet StarIsType is enabled."
    PsMessage
PsWarnStarIsType
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
             [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Using" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"*")
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(or its Unicode variant) to mean"
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Data.Kind.Type")
          SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"relies on the StarIsType extension, which will become"
          SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"deprecated in the future."
    PsWarnUnrecognisedPragma [Char]
prag [[Char]]
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unrecognised pragma"
                          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
prag then SDoc
forall doc. IsOutput doc => doc
empty else [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
":" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
prag
    PsWarnMisplacedPragma FileHeaderPragmaType
prag
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Misplaced" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FileHeaderPragmaType -> SDoc
pprFileHeaderPragmaType FileHeaderPragmaType
prag SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"pragma"
    PsMessage
PsWarnImportPreQualified
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Found" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"qualified")
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in prepositive position"
    PsWarnViewPatternSignatures LPat GhcPs
old LPat GhcPs
new
      -> [SDoc] -> DecoratedSDoc
mkDecorated ([SDoc] -> DecoratedSDoc) -> [SDoc] -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
          [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Found an unparenthesized pattern signature on the RHS of a view pattern."
          , [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"This code might stop working in a future GHC release"
                 , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"due to a planned change to the precedence of view patterns,"
                 , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"unless the view function is an endofunction." ]
          , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Current parse:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (Pat GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LPat GhcPs -> LPat GhcPs
add_parens_sig LPat GhcPs
old))
                 , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Future parse:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (Pat GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LPat GhcPs -> LPat GhcPs
add_parens_view LPat GhcPs
new)) ]
          ]
      where
        add_parens_sig :: LPat GhcPs -> LPat GhcPs
        add_parens_sig :: LPat GhcPs -> LPat GhcPs
add_parens_sig = LPat GhcPs -> LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
go
          where go :: GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
go (L SrcSpanAnnA
l (ViewPat XViewPat GhcPs
x LHsExpr GhcPs
e LPat GhcPs
p)) = SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XViewPat GhcPs -> LHsExpr GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XViewPat p -> LHsExpr p -> LPat p -> Pat p
ViewPat XViewPat GhcPs
x LHsExpr GhcPs
e (GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
go LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p))
                go (L SrcSpanAnnA
l (SigPat XSigPat GhcPs
x LPat GhcPs
p HsPatSigType (NoGhcTc GhcPs)
sig)) = LPat GhcPs -> LPat GhcPs
par_pat (SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XSigPat GhcPs
-> LPat GhcPs -> HsPatSigType (NoGhcTc GhcPs) -> Pat GhcPs
forall p. XSigPat p -> LPat p -> HsPatSigType (NoGhcTc p) -> Pat p
SigPat XSigPat GhcPs
x LPat GhcPs
p HsPatSigType (NoGhcTc GhcPs)
sig))
                go GenLocated SrcSpanAnnA (Pat GhcPs)
p = GenLocated SrcSpanAnnA (Pat GhcPs)
p

        add_parens_view :: LPat GhcPs -> LPat GhcPs
        add_parens_view :: LPat GhcPs -> LPat GhcPs
add_parens_view = LPat GhcPs -> LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
go
          where go :: GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
go (L SrcSpanAnnA
l (ViewPat XViewPat GhcPs
x LHsExpr GhcPs
e LPat GhcPs
p)) = LPat GhcPs -> LPat GhcPs
par_pat (SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XViewPat GhcPs -> LHsExpr GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XViewPat p -> LHsExpr p -> LPat p -> Pat p
ViewPat XViewPat GhcPs
x LHsExpr GhcPs
e LPat GhcPs
p))
                go (L SrcSpanAnnA
l (SigPat XSigPat GhcPs
x LPat GhcPs
p HsPatSigType (NoGhcTc GhcPs)
sig)) = SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XSigPat GhcPs
-> LPat GhcPs -> HsPatSigType (NoGhcTc GhcPs) -> Pat GhcPs
forall p. XSigPat p -> LPat p -> HsPatSigType (NoGhcTc p) -> Pat p
SigPat XSigPat GhcPs
x (GenLocated SrcSpanAnnA (Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
go LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p) HsPatSigType (NoGhcTc GhcPs)
sig)
                go GenLocated SrcSpanAnnA (Pat GhcPs)
p = GenLocated SrcSpanAnnA (Pat GhcPs)
p

        par_pat :: LPat GhcPs -> LPat GhcPs
        par_pat :: LPat GhcPs -> LPat GhcPs
par_pat LPat GhcPs
p = SrcSpanAnnA -> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
forall a. NoAnn a => a
noAnn (XParPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XParPat p -> LPat p -> Pat p
ParPat (EpToken "(", EpToken ")")
XParPat GhcPs
forall a. NoAnn a => a
noAnn LPat GhcPs
p)

    PsErrLexer LexErr
err LexErrKind
kind
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat
           [ case LexErr
err of
              LexErr
LexError               -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"lexical error"
              LexErr
LexUnknownPragma       -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"unknown pragma"
              LexErr
LexErrorInPragma       -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"lexical error in pragma"
              LexErr
LexNumEscapeRange      -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"numeric escape sequence out of range"
              LexErr
LexUnterminatedComment -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"unterminated `{-'"
              LexErr
LexUnterminatedOptions -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"unterminated OPTIONS pragma"
              LexErr
LexUnterminatedQQ      -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"unterminated quasiquotation"

           , case LexErrKind
kind of
              LexErrKind
LexErrKind_EOF    -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
" at end of input"
              LexErrKind
LexErrKind_UTF8   -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
" (UTF-8 decoding error)"
              LexErrKind_Char Char
c -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ [Char]
" at character " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c
           ]
    PsErrParse [Char]
token PsErrParseDetails
_details
      | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
token
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"parse error (possibly incorrect indentation or mismatched brackets)"
      | Bool
otherwise
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"parse error on input" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
token)
    PsMessage
PsErrCmmLexer
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Cmm lexical error"
    PsErrCmmParser CmmParserError
cmm_err -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ case CmmParserError
cmm_err of
      CmmUnknownPrimitive FastString
name     -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"unknown primitive" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
name
      CmmUnknownMacro FastString
fun          -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"unknown macro" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fun
      CmmUnknownCConv [Char]
cconv        -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"unknown calling convention:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
cconv
      CmmUnrecognisedSafety [Char]
safety -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"unrecognised safety" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
safety
      CmmUnrecognisedHint [Char]
hint     -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"unrecognised hint:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
hint

    PsErrTypeAppWithoutSpace RdrName
v LHsExpr GhcPs
e
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"@-pattern in expression context:"
               , Int -> SDoc -> SDoc
nest Int
4 (RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc RdrName
v SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
               ]
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Type application syntax requires a space before '@'"
    PsErrLazyPatWithoutSpace LHsExpr GhcPs
e
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Lazy pattern in expression context:"
               , Int -> SDoc -> SDoc
nest Int
4 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"~" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
               ]
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Did you mean to add a space after the '~'?"
    PsErrBangPatWithoutSpace LHsExpr GhcPs
e
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Bang pattern in expression context:"
               , Int -> SDoc -> SDoc
nest Int
4 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"!" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
               ]
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Did you mean to add a space after the '!'?"
    PsMessage
PsErrInvalidInfixHole
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Invalid infix hole, expected an infix operator"
    PsMessage
PsErrExpectedHyphen
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Expected a hyphen"
    PsMessage
PsErrSpaceInSCC
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Spaces are not allowed in SCCs"
    PsErrEmptyDoubleQuotes Bool
_th_on
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
msg
         where
            msg :: [SDoc]
msg    = [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Parser error on `''`"
                     , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Character literals may not be empty"
                     ]
    PsMessage
PsErrLambdaCase
      -- we can't get this error for \cases, since without -XLambdaCase, that's
      -- just a regular lambda expression
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsLamVariant -> SDoc
lamCaseKeyword HsLamVariant
LamCase
    PsMessage
PsErrEmptyLambda
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"A lambda requires at least one parameter"
    PsMessage
PsErrLinearFunction
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal use of linear functions"
    PsMessage
PsErrOverloadedRecordUpdateNotEnabled
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal overloaded record update"
    PsMessage
PsErrMultiWayIf
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal multi-way if-expression"
    PsErrNumUnderscores NumUnderscoreReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ case NumUnderscoreReason
reason of
             NumUnderscoreReason
NumUnderscore_Integral -> [Char]
"Illegal underscores in integer literals"
             NumUnderscoreReason
NumUnderscore_Float    -> [Char]
"Illegal underscores in floating literals"
    PsErrIllegalBangPattern Pat GhcPs
e
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal bang-pattern or strict binding" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Pat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcPs
e
    PsMessage
PsErrOverloadedRecordDotInvalid
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Use of OverloadedRecordDot '.' not valid ('.' isn't allowed when constructing records or in record patterns)"
    PsMessage
PsErrIllegalPatSynExport
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal export form"
    PsMessage
PsErrOverloadedRecordUpdateNoQualifiedFields
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Fields cannot be qualified when OverloadedRecordUpdate is enabled"
    PsErrExplicitForall Bool
is_unicode
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal symbol" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Bool -> SDoc
forallSym Bool
is_unicode) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in type"
    PsErrIllegalQualifiedDo SDoc
qdoDoc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal qualified" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
qdoDoc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"block"
    PsErrQualifiedDoInCmd ModuleName
m
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Parse error in command:") Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
             [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Found a qualified" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
".do block in a command, but"
             SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"qualified 'do' is not supported in commands."
    PsErrRecordSyntaxInPatSynDecl LPat GhcPs
pat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"record syntax not supported for pattern synonym declarations:"
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ GenLocated SrcSpanAnnA (Pat GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat
    PsErrEmptyWhereInPatSynDecl RdrName
patsyn_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"pattern synonym 'where' clause cannot be empty"
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"In the pattern synonym declaration for: "
              SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RdrName
patsyn_name)
    PsErrInvalidWhereBindInPatSynDecl RdrName
patsyn_name HsDecl GhcPs
decl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"pattern synonym 'where' clause must bind the pattern synonym's name"
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
patsyn_name) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ HsDecl GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsDecl GhcPs
decl
    PsErrNoSingleWhereBindInPatSynDecl RdrName
_patsyn_name HsDecl GhcPs
decl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"pattern synonym 'where' clause must contain a single binding:"
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ HsDecl GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsDecl GhcPs
decl
    PsErrDeclSpliceNotAtTopLevel SpliceDecl GhcPs
d
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Declaration splices are allowed only"
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"at the top level:")
             Int
2 (SpliceDecl GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr SpliceDecl GhcPs
d)
    PsErrMultipleNamesInStandaloneKindSignature [LIdP GhcPs]
vs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Standalone kind signatures do not support multiple names at the moment:")
                  Int
2 ((GenLocated SrcSpanAnnN RdrName -> SDoc)
-> [GenLocated SrcSpanAnnN RdrName] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas GenLocated SrcSpanAnnN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
vs)
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details."
                ]
    PsMessage
PsErrIllegalExplicitNamespace
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal keyword 'type'"

    PsErrUnallowedPragma HsPragE GhcPs
prag
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"A pragma is not allowed in this position:") Int
2
                (HsPragE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsPragE GhcPs
prag)
    PsMessage
PsErrImportPostQualified
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Found" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"qualified")
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in postpositive position. "
    PsMessage
PsErrImportQualifiedTwice
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Multiple occurrences of 'qualified'"
    PsMessage
PsErrIllegalImportBundleForm
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal import form, this syntax can only be used to bundle"
           SDoc -> SDoc -> SDoc
$+$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"pattern synonyms with types in module exports."
    PsMessage
PsErrInvalidRuleActivationMarker
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Invalid rule activation marker"

    PsMessage
PsErrMissingBlock
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Missing block"
    PsErrUnsupportedBoxedSumExpr SumOrTuple (HsExpr GhcPs)
s
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Boxed sums not supported:") Int
2
                (Boxity -> SumOrTuple (HsExpr GhcPs) -> SDoc
forall b. Outputable b => Boxity -> SumOrTuple b -> SDoc
pprSumOrTuple Boxity
Boxed SumOrTuple (HsExpr GhcPs)
s)
    PsErrUnsupportedBoxedSumPat SumOrTuple (PatBuilder GhcPs)
s
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Boxed sums not supported:") Int
2
                (Boxity -> SumOrTuple (PatBuilder GhcPs) -> SDoc
forall b. Outputable b => Boxity -> SumOrTuple b -> SDoc
pprSumOrTuple Boxity
Boxed SumOrTuple (PatBuilder GhcPs)
s)
    PsErrUnexpectedQualifiedConstructor RdrName
v
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Expected an unqualified type constructor:") Int
2
                (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
v)
    PsMessage
PsErrTupleSectionInPat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Tuple section in pattern context"
    PsErrOpFewArgs StarIsType
_ RdrName
op
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Operator applied to too few arguments:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
op
    PsErrVarForTyCon RdrName
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Expecting a type constructor but found a variable,"
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"."
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ if OccName -> Bool
isSymOcc (OccName -> Bool) -> OccName -> Bool
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
name
              then [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"If" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is a type constructor"
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"then enable ExplicitNamespaces and use the 'type' keyword."
              else SDoc
forall doc. IsOutput doc => doc
empty
    PsMessage
PsErrMalformedEntityString
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Malformed entity string"
    PsMessage
PsErrDotsInRecordUpdate
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"You cannot use `..' in a record update"
    PsErrInvalidDataCon HsType GhcPs
t
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Cannot parse data constructor in a data/newtype declaration:") Int
2
                (HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
t)
    PsErrInvalidInfixDataCon HsType GhcPs
lhs RdrName
tc HsType GhcPs
rhs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Cannot parse an infix data constructor in a data/newtype declaration:") Int
2
                (HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
lhs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
rhs)
    PsErrIllegalPromotionQuoteDataCon RdrName
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal promotion quote mark in the declaration of" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"data/newtype constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc RdrName
name
    PsMessage
PsErrUnpackDataCon
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"{-# UNPACK #-} cannot be applied to a data constructor."
    PsErrUnexpectedKindAppInDataCon DataConBuilder
lhs HsType GhcPs
ki
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unexpected kind application in a data/newtype declaration:") Int
2
                (DataConBuilder -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataConBuilder
lhs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
ki)
    PsErrInvalidRecordCon PatBuilder GhcPs
p
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Not a record constructor:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
p
    PsErrIllegalUnboxedStringInPat HsLit GhcPs
lit
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal unboxed string literal in pattern:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ HsLit GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsLit GhcPs
lit
    PsErrIllegalUnboxedFloatingLitInPat HsLit GhcPs
lit
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal unboxed floating point literal in pattern:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ HsLit GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsLit GhcPs
lit
    PsMessage
PsErrDoNotationInPat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"do-notation in pattern"
    PsMessage
PsErrIfThenElseInPat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(if ... then ... else ...)-syntax in pattern"
    PsMessage
PsErrCaseInPat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(case ... of ...)-syntax in pattern"
    PsMessage
PsErrLetInPat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(let ... in ...)-syntax in pattern"
    PsErrLambdaInPat HsLamVariant
lam_variant
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsLamVariant -> SDoc
lamCaseKeyword HsLamVariant
lam_variant SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"-syntax in pattern"
    PsErrArrowExprInPat HsExpr GhcPs
e
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Expression syntax in pattern:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e
    PsErrArrowCmdInPat HsCmd GhcPs
c
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Command syntax in pattern:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsCmd GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcPs
c
    PsErrArrowCmdInExpr HsCmd GhcPs
c
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
           [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Arrow command found where an expression was expected:"
           , Int -> SDoc -> SDoc
nest Int
2 (HsCmd GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcPs
c)
           ]
    PsErrOrPatInExpr LPat GhcPs
p
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Or pattern in expression context:"
               , Int -> SDoc -> SDoc
nest Int
4 (GenLocated SrcSpanAnnA (Pat GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p)
               ]
    PsErrCaseCmdInFunAppCmd LHsCmd GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"case command") LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
a
    PsErrLambdaCmdInFunAppCmd HsLamVariant
lam_variant LHsCmd GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (HsLamVariant -> SDoc
lamCaseKeyword HsLamVariant
lam_variant SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"command") LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
a
    PsErrIfCmdInFunAppCmd LHsCmd GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"if command") LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
a
    PsErrLetCmdInFunAppCmd LHsCmd GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"let command") LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
a
    PsErrDoCmdInFunAppCmd LHsCmd GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"do command") LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
a
    PsErrDoInFunAppExpr Maybe ModuleName
m LHsExpr GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (Maybe ModuleName -> SDoc -> SDoc
prependQualified Maybe ModuleName
m ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"do block")) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a
    PsErrMDoInFunAppExpr Maybe ModuleName
m LHsExpr GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (Maybe ModuleName -> SDoc -> SDoc
prependQualified Maybe ModuleName
m ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"mdo block")) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a
    PsErrCaseInFunAppExpr LHsExpr GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"case expression") LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a
    PsErrLambdaInFunAppExpr HsLamVariant
lam_variant LHsExpr GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (HsLamVariant -> SDoc
lamCaseKeyword HsLamVariant
lam_variant SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"expression") LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a
    PsErrLetInFunAppExpr LHsExpr GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"let expression") LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a
    PsErrIfInFunAppExpr LHsExpr GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"if expression") LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a
    PsErrProcInFunAppExpr LHsExpr GhcPs
a
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"proc expression") LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a
    PsErrMalformedTyOrClDecl LHsType GhcPs
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Malformed head of type or class declaration:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    PsMessage
PsErrIllegalWhereInDataDecl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal keyword 'where' in data declaration"
    PsErrIllegalDataTypeContext LHsContext GhcPs
c
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal datatype context:"
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe (LHsContext GhcPs) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
Maybe (LHsContext (GhcPass p)) -> SDoc
pprLHsContext (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. a -> Maybe a
Just LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
c)
    PsMessage
PsErrPrimStringInvalidChar
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"primitive string literal must contain only characters <= \'\\xFF\'"
    PsMessage
PsErrSuffixAT
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The symbol '@' occurs as a suffix." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"For an as-pattern, there must not be any whitespace surrounding '@'."
    PsErrPrecedenceOutOfRange Int
i
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Precedence out of range: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
i
    PsErrSemiColonsInCondExpr HsExpr GhcPs
c Bool
st HsExpr GhcPs
t Bool
se HsExpr GhcPs
e
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unexpected semi-colons in conditional:"
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
4 SDoc
expr
         where
            pprOptSemi :: Bool -> doc
pprOptSemi Bool
True  = doc
forall doc. IsLine doc => doc
semi
            pprOptSemi Bool
False = doc
forall doc. IsOutput doc => doc
empty
            expr :: SDoc
expr = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"if"   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall {doc}. IsLine doc => Bool -> doc
pprOptSemi Bool
st SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"then" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
t SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall {doc}. IsLine doc => Bool -> doc
pprOptSemi Bool
se SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"else" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e
    PsErrSemiColonsInCondCmd HsExpr GhcPs
c Bool
st HsCmd GhcPs
t Bool
se HsCmd GhcPs
e
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unexpected semi-colons in conditional:"
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
4 SDoc
expr
         where
            pprOptSemi :: Bool -> doc
pprOptSemi Bool
True  = doc
forall doc. IsLine doc => doc
semi
            pprOptSemi Bool
False = doc
forall doc. IsOutput doc => doc
empty
            expr :: SDoc
expr = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"if"   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall {doc}. IsLine doc => Bool -> doc
pprOptSemi Bool
st SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"then" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsCmd GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcPs
t SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall {doc}. IsLine doc => Bool -> doc
pprOptSemi Bool
se SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"else" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsCmd GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcPs
e
    PsMessage
PsErrAtInPatPos
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Found a binding for the"
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"@")
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"operator in a pattern position."
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
perhapsAsPat
    PsErrParseErrorOnInput OccName
occ
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"parse error on input" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext (OccName -> FastString
occNameFS OccName
occ)
    PsErrMalformedDecl SDoc
what RdrName
for
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Malformed" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
for)
    PsErrNotADataCon RdrName
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Not a data constructor:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name)
    PsMessage
PsErrInferredTypeVarNotAllowed
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Inferred type variables are not allowed here"
    PsErrIllegalTraditionalRecordSyntax SDoc
s
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal record syntax:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
s
    PsErrParseErrorInCmd SDoc
s
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Parse error in command:") Int
2 SDoc
s
    PsErrInPat PatBuilder GhcPs
s PsErrInPatDetails
details
      -> let msg :: SDoc
msg  = SDoc
parse_error_in_pat
             body :: SDoc
body = case PsErrInPatDetails
details of
                 PsErrInPatDetails
PEIP_NegApp -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"-" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
s
                 PEIP_TypeArgs [HsConPatTyArg GhcPs]
peipd_tyargs
                   | Bool -> Bool
not ([HsConPatTyArg GhcPs] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsConPatTyArg GhcPs]
peipd_tyargs) -> PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
s SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [
                               [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ((HsConPatTyArg GhcPs -> SDoc) -> [HsConPatTyArg GhcPs] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map HsConPatTyArg GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr [HsConPatTyArg GhcPs]
peipd_tyargs)
                             , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Type applications in patterns are only allowed on data constructors."
                             ]
                   | Bool
otherwise -> PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
s
                 PEIP_OtherPatDetails (ParseContext (Just RdrName
fun) PatIncompleteDoBlock
_)
                  -> PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
s SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"In a function binding for the"
                                     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
fun)
                                     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"operator."
                                  SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ if RdrName -> Bool
opIsAt RdrName
fun
                                        then SDoc
perhapsAsPat
                                        else SDoc
forall doc. IsOutput doc => doc
empty
                 PsErrInPatDetails
_  -> PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
s
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc
msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
body
    PsErrParseRightOpSectionInPat RdrName
infixOcc PatBuilder GhcPs
s
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc
parse_error_in_pat SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc RdrName
infixOcc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
s
    PsErrIllegalRoleName FastString
role [Role]
_nearby
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal role name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
role)
    PsErrInvalidTypeSignature PsInvalidTypeSignature
reason LHsExpr GhcPs
lhs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ case PsInvalidTypeSignature
reason of
           PsInvalidTypeSignature
PsErrInvalidTypeSig_DataCon   -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Invalid data constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                                            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in type signature" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                                            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"You can only define data constructors in data type declarations."
           PsInvalidTypeSignature
PsErrInvalidTypeSig_Qualified -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Invalid qualified name in type signature."
           PsInvalidTypeSignature
PsErrInvalidTypeSig_Other     -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Invalid type signature" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                                            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"A type signature should be of form" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                                            [Char] -> SDoc
placeHolder [Char]
"variables" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
placeHolder [Char]
"type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                                            SDoc
forall doc. IsLine doc => doc
dot
            where placeHolder :: [Char] -> SDoc
placeHolder = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
angleBrackets (SDoc -> SDoc) -> ([Char] -> SDoc) -> [Char] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text
    PsErrUnexpectedTypeInDecl LHsType GhcPs
t SDoc
what RdrName
tc [LHsTypeArg GhcPs]
tparms SDoc
equals_or_where
       -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unexpected type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t)
                 , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"In the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
tc'
                 , [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat[ ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"A" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what
                          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"declaration should have form")
                 , Int -> SDoc -> SDoc
nest Int
2
                   (SDoc
what
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
tc'
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep (([Char] -> SDoc) -> [[Char]] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [[Char]] -> [[Char]]
forall b a. [b] -> [a] -> [a]
takeList [LHsTypeArg GhcPs]
[HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
tparms [[Char]]
allNameStringList))
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
equals_or_where) ] ]
           where
             -- Avoid printing a constraint tuple in the error message. Print
             -- a plain old tuple instead (since that's what the user probably
             -- wrote). See #14907
             tc' :: SDoc
tc' = RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RdrName -> SDoc) -> RdrName -> SDoc
forall a b. (a -> b) -> a -> b
$ RdrName -> RdrName
filterCTuple RdrName
tc
    PsErrInvalidPackageName FastString
pkg
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
            [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Parse error" 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 -> SDoc
quotes (FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
pkg)
            , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Version number or non-alphanumeric" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"character in package name"
            ]

    PsErrIllegalGadtRecordMultiplicity HsArrow GhcPs
arr
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
            [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Parse error" 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 -> SDoc
quotes (HsArrowOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsArrow GhcPs
HsArrowOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs
arr)
            , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Record constructors in GADTs must use an ordinary, non-linear arrow."
            ]
    PsErrInvalidCApiImport {} -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Wrapper stubs can't be used with CApiFFI."]

    PsErrMultipleConForNewtype RdrName
tycon Int
n -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
      [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep
          [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"A newtype must have exactly one constructor,"
          , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
tycon) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"has" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
speakN Int
n ]
      , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"In the newtype declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
tycon) ]

    PsErrUnicodeCharLooksLike Char
bad_char Char
looks_like_char [Char]
looks_like_char_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unicode character"
                -- purposefully not using `quotes (text [bad_char])`, because the quotes function adds smart quotes,
                -- and smart quotes may be the topic of this error message
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"'" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char
bad_char] SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"' (" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (Char -> [Char]
forall a. Show a => a -> [Char]
show Char
bad_char) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
")"
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"looks like"
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"'" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char
looks_like_char] SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"' (" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
looks_like_char_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
")" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"but it is not" ]

    PsErrInvalidPun PsErrPunDetails
PEP_QuoteDisambiguation
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
        [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Disambiguating data constructors of tuples and lists is disabled."
        , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Remove the quote to use the data constructor."
        ]

    PsErrInvalidPun PsErrPunDetails
PEP_TupleSyntaxType
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
        [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unboxed tuple data constructors are not supported in types."
        , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Use" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Tuple<n># a b c ...") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"to refer to the type constructor."
        ]

    PsErrInvalidPun PsErrPunDetails
PEP_SumSyntaxType
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
        [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unboxed sum data constructors are not supported in types."
        , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Use" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Sum<n># a b c ...") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"to refer to the type constructor."
        ]
    PsErrTypeSyntaxInPat PsErrTypeSyntaxDetails
ctx
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
        [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"in pattern:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
ctx'
        , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Type syntax in patterns isn't supported at the time"]
        where
          ([Char]
what, SDoc
ctx') = case PsErrTypeSyntaxDetails
ctx of
            PETS_FunctionArrow LocatedA (PatBuilder GhcPs)
arg HsArrowOf (LocatedA (PatBuilder GhcPs)) GhcPs
arr LocatedA (PatBuilder GhcPs)
res -> ([Char]
"function arrow", LocatedA (PatBuilder GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedA (PatBuilder GhcPs)
arg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsArrowOf (LocatedA (PatBuilder GhcPs)) GhcPs -> SDoc
forall mult (pass :: Pass).
(Outputable mult, OutputableBndrId pass) =>
HsArrowOf mult (GhcPass pass) -> SDoc
pprHsArrow HsArrowOf (LocatedA (PatBuilder GhcPs)) GhcPs
arr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> LocatedA (PatBuilder GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedA (PatBuilder GhcPs)
res)
            PETS_Multiplicity EpToken "%"
tok LocatedA (PatBuilder GhcPs)
p        -> ([Char]
"multiplicity annotation", EpToken "%" -> SDoc
forall a. Outputable a => a -> SDoc
ppr EpToken "%"
tok SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocatedA (PatBuilder GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedA (PatBuilder GhcPs)
p)
            PETS_ForallTelescope HsForAllTelescope GhcPs
tele LocatedA (PatBuilder GhcPs)
body -> ([Char]
"forall telescope", HsForAllTelescope GhcPs -> Maybe (LHsContext GhcPs) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsForAllTelescope (GhcPass p)
-> Maybe (LHsContext (GhcPass p)) -> SDoc
pprHsForAll HsForAllTelescope GhcPs
tele Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. Maybe a
Nothing SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> LocatedA (PatBuilder GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedA (PatBuilder GhcPs)
body)
            PETS_ConstraintContext LocatedA (PatBuilder GhcPs)
ctx     -> ([Char]
"constraint context", LocatedA (PatBuilder GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedA (PatBuilder GhcPs)
ctx)

    PsErrIllegalOrPat LPat GhcPs
pat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal or-pattern:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Pat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr (GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat)]

  diagnosticReason :: PsMessage -> DiagnosticReason
diagnosticReason  = \case
    PsUnknownMessage UnknownDiagnostic (DiagnosticOpts PsMessage)
m                            -> UnknownDiagnostic NoDiagnosticOpts -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason UnknownDiagnostic NoDiagnosticOpts
UnknownDiagnostic (DiagnosticOpts PsMessage)
m
    PsHeaderMessage  PsHeaderMessage
m                            -> PsHeaderMessage -> DiagnosticReason
psHeaderMessageReason PsHeaderMessage
m
    PsWarnBidirectionalFormatChars{}              -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnicodeBidirectionalFormatCharacters
    PsWarnTab{}                                   -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnTabs
    PsWarnTransitionalLayout{}                    -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnAlternativeLayoutRuleTransitional
    PsWarnOperatorWhitespaceExtConflict{}         -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnOperatorWhitespaceExtConflict
    PsWarnOperatorWhitespace{}                    -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnOperatorWhitespace
    PsMessage
PsWarnHaddockInvalidPos                       -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnInvalidHaddock
    PsMessage
PsWarnHaddockIgnoreMulti                      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnInvalidHaddock
    PsMessage
PsWarnStarBinder                              -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnStarBinder
    PsMessage
PsWarnStarIsType                              -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnStarIsType
    PsWarnUnrecognisedPragma{}                    -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnrecognisedPragmas
    PsWarnMisplacedPragma{}                       -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMisplacedPragmas
    PsMessage
PsWarnImportPreQualified                      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnPrepositiveQualifiedModule
    PsWarnViewPatternSignatures{}                 -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnViewPatternSignatures
    PsErrLexer{}                                  -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrCmmLexer                                 -> DiagnosticReason
ErrorWithoutFlag
    PsErrCmmParser{}                              -> DiagnosticReason
ErrorWithoutFlag
    PsErrParse{}                                  -> DiagnosticReason
ErrorWithoutFlag
    PsErrTypeAppWithoutSpace{}                    -> DiagnosticReason
ErrorWithoutFlag
    PsErrLazyPatWithoutSpace{}                    -> DiagnosticReason
ErrorWithoutFlag
    PsErrBangPatWithoutSpace{}                    -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrInvalidInfixHole                         -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrExpectedHyphen                           -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrSpaceInSCC                               -> DiagnosticReason
ErrorWithoutFlag
    PsErrEmptyDoubleQuotes{}                      -> DiagnosticReason
ErrorWithoutFlag
    PsErrLambdaCase{}                             -> DiagnosticReason
ErrorWithoutFlag
    PsErrEmptyLambda{}                            -> DiagnosticReason
ErrorWithoutFlag
    PsErrLinearFunction{}                         -> DiagnosticReason
ErrorWithoutFlag
    PsErrMultiWayIf{}                             -> DiagnosticReason
ErrorWithoutFlag
    PsErrOverloadedRecordUpdateNotEnabled{}       -> DiagnosticReason
ErrorWithoutFlag
    PsErrNumUnderscores{}                         -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalBangPattern{}                     -> DiagnosticReason
ErrorWithoutFlag
    PsErrOverloadedRecordDotInvalid{}             -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrIllegalPatSynExport                      -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrOverloadedRecordUpdateNoQualifiedFields  -> DiagnosticReason
ErrorWithoutFlag
    PsErrExplicitForall{}                         -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalQualifiedDo{}                     -> DiagnosticReason
ErrorWithoutFlag
    PsErrQualifiedDoInCmd{}                       -> DiagnosticReason
ErrorWithoutFlag
    PsErrRecordSyntaxInPatSynDecl{}               -> DiagnosticReason
ErrorWithoutFlag
    PsErrEmptyWhereInPatSynDecl{}                 -> DiagnosticReason
ErrorWithoutFlag
    PsErrInvalidWhereBindInPatSynDecl{}           -> DiagnosticReason
ErrorWithoutFlag
    PsErrNoSingleWhereBindInPatSynDecl{}          -> DiagnosticReason
ErrorWithoutFlag
    PsErrDeclSpliceNotAtTopLevel{}                -> DiagnosticReason
ErrorWithoutFlag
    PsErrMultipleNamesInStandaloneKindSignature{} -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrIllegalExplicitNamespace                 -> DiagnosticReason
ErrorWithoutFlag
    PsErrUnallowedPragma{}                        -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrImportPostQualified                      -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrImportQualifiedTwice                     -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrIllegalImportBundleForm                  -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrInvalidRuleActivationMarker              -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrMissingBlock                             -> DiagnosticReason
ErrorWithoutFlag
    PsErrUnsupportedBoxedSumExpr{}                -> DiagnosticReason
ErrorWithoutFlag
    PsErrUnsupportedBoxedSumPat{}                 -> DiagnosticReason
ErrorWithoutFlag
    PsErrUnexpectedQualifiedConstructor{}         -> DiagnosticReason
ErrorWithoutFlag
    PsErrTupleSectionInPat{}                      -> DiagnosticReason
ErrorWithoutFlag
    PsErrOpFewArgs{}                              -> DiagnosticReason
ErrorWithoutFlag
    PsErrVarForTyCon{}                            -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrMalformedEntityString                    -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrDotsInRecordUpdate                       -> DiagnosticReason
ErrorWithoutFlag
    PsErrInvalidDataCon{}                         -> DiagnosticReason
ErrorWithoutFlag
    PsErrInvalidInfixDataCon{}                    -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalPromotionQuoteDataCon{}           -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrUnpackDataCon                            -> DiagnosticReason
ErrorWithoutFlag
    PsErrUnexpectedKindAppInDataCon{}             -> DiagnosticReason
ErrorWithoutFlag
    PsErrInvalidRecordCon{}                       -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalUnboxedStringInPat{}              -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalUnboxedFloatingLitInPat{}         -> DiagnosticReason
ErrorWithoutFlag
    PsErrDoNotationInPat{}                        -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrIfThenElseInPat                          -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrCaseInPat                                -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrLetInPat                                 -> DiagnosticReason
ErrorWithoutFlag
    PsErrLambdaInPat{}                            -> DiagnosticReason
ErrorWithoutFlag
    PsErrArrowExprInPat{}                         -> DiagnosticReason
ErrorWithoutFlag
    PsErrArrowCmdInPat{}                          -> DiagnosticReason
ErrorWithoutFlag
    PsErrArrowCmdInExpr{}                         -> DiagnosticReason
ErrorWithoutFlag
    PsErrOrPatInExpr{}                            -> DiagnosticReason
ErrorWithoutFlag
    PsErrCaseCmdInFunAppCmd{}                     -> DiagnosticReason
ErrorWithoutFlag
    PsErrLambdaCmdInFunAppCmd{}                   -> DiagnosticReason
ErrorWithoutFlag
    PsErrIfCmdInFunAppCmd{}                       -> DiagnosticReason
ErrorWithoutFlag
    PsErrLetCmdInFunAppCmd{}                      -> DiagnosticReason
ErrorWithoutFlag
    PsErrDoCmdInFunAppCmd{}                       -> DiagnosticReason
ErrorWithoutFlag
    PsErrDoInFunAppExpr{}                         -> DiagnosticReason
ErrorWithoutFlag
    PsErrMDoInFunAppExpr{}                        -> DiagnosticReason
ErrorWithoutFlag
    PsErrLambdaInFunAppExpr{}                     -> DiagnosticReason
ErrorWithoutFlag
    PsErrCaseInFunAppExpr{}                       -> DiagnosticReason
ErrorWithoutFlag
    PsErrLetInFunAppExpr{}                        -> DiagnosticReason
ErrorWithoutFlag
    PsErrIfInFunAppExpr{}                         -> DiagnosticReason
ErrorWithoutFlag
    PsErrProcInFunAppExpr{}                       -> DiagnosticReason
ErrorWithoutFlag
    PsErrMalformedTyOrClDecl{}                    -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrIllegalWhereInDataDecl                   -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalDataTypeContext{}                 -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrPrimStringInvalidChar                    -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrSuffixAT                                 -> DiagnosticReason
ErrorWithoutFlag
    PsErrPrecedenceOutOfRange{}                   -> DiagnosticReason
ErrorWithoutFlag
    PsErrSemiColonsInCondExpr{}                   -> DiagnosticReason
ErrorWithoutFlag
    PsErrSemiColonsInCondCmd{}                    -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrAtInPatPos                               -> DiagnosticReason
ErrorWithoutFlag
    PsErrParseErrorOnInput{}                      -> DiagnosticReason
ErrorWithoutFlag
    PsErrMalformedDecl{}                          -> DiagnosticReason
ErrorWithoutFlag
    PsErrNotADataCon{}                            -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrInferredTypeVarNotAllowed                -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalTraditionalRecordSyntax{}         -> DiagnosticReason
ErrorWithoutFlag
    PsErrParseErrorInCmd{}                        -> DiagnosticReason
ErrorWithoutFlag
    PsErrInPat{}                                  -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalRoleName{}                        -> DiagnosticReason
ErrorWithoutFlag
    PsErrInvalidTypeSignature{}                   -> DiagnosticReason
ErrorWithoutFlag
    PsErrUnexpectedTypeInDecl{}                   -> DiagnosticReason
ErrorWithoutFlag
    PsErrInvalidPackageName{}                     -> DiagnosticReason
ErrorWithoutFlag
    PsErrParseRightOpSectionInPat{}               -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalGadtRecordMultiplicity{}          -> DiagnosticReason
ErrorWithoutFlag
    PsErrInvalidCApiImport {}                     -> DiagnosticReason
ErrorWithoutFlag
    PsErrMultipleConForNewtype {}                 -> DiagnosticReason
ErrorWithoutFlag
    PsErrUnicodeCharLooksLike{}                   -> DiagnosticReason
ErrorWithoutFlag
    PsErrInvalidPun {}                            -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalOrPat{}                           -> DiagnosticReason
ErrorWithoutFlag
    PsErrTypeSyntaxInPat{}                        -> DiagnosticReason
ErrorWithoutFlag

  diagnosticHints :: PsMessage -> [GhcHint]
diagnosticHints = \case
    PsUnknownMessage UnknownDiagnostic (DiagnosticOpts PsMessage)
m                            -> UnknownDiagnostic NoDiagnosticOpts -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints UnknownDiagnostic NoDiagnosticOpts
UnknownDiagnostic (DiagnosticOpts PsMessage)
m
    PsHeaderMessage  PsHeaderMessage
m                            -> PsHeaderMessage -> [GhcHint]
psHeaderMessageHints PsHeaderMessage
m
    PsWarnBidirectionalFormatChars{}              -> [GhcHint]
noHints
    PsWarnTab{}                                   -> [GhcHint
SuggestUseSpaces]
    PsWarnTransitionalLayout{}                    -> [GhcHint]
noHints
    PsWarnOperatorWhitespaceExtConflict OperatorWhitespaceSymbol
sym       -> [OperatorWhitespaceSymbol -> GhcHint
SuggestUseWhitespaceAfter OperatorWhitespaceSymbol
sym]
    PsWarnOperatorWhitespace FastString
sym OperatorWhitespaceOccurrence
occ              -> [[Char] -> OperatorWhitespaceOccurrence -> GhcHint
SuggestUseWhitespaceAround (FastString -> [Char]
unpackFS FastString
sym) OperatorWhitespaceOccurrence
occ]
    PsMessage
PsWarnHaddockInvalidPos                       -> [GhcHint]
noHints
    PsMessage
PsWarnHaddockIgnoreMulti                      -> [GhcHint]
noHints
    PsMessage
PsWarnStarBinder                              -> [GhcHint
SuggestQualifyStarOperator]
    PsMessage
PsWarnStarIsType                              -> [Maybe RdrName -> GhcHint
SuggestUseTypeFromDataKind Maybe RdrName
forall a. Maybe a
Nothing]
    PsWarnUnrecognisedPragma [Char]
""  [[Char]]
_                -> [GhcHint]
noHints
    PsWarnUnrecognisedPragma [Char]
p   [[Char]]
avail            ->
      let suggestions :: [[Char]]
suggestions = [Char] -> [[Char]] -> [[Char]]
fuzzyMatch [Char]
p [[Char]]
avail
       in if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
suggestions
          then [GhcHint]
noHints
          else [[[Char]] -> GhcHint
SuggestCorrectPragmaName [[Char]]
suggestions]
    PsWarnMisplacedPragma{}                       -> [GhcHint
SuggestPlacePragmaInHeader]
    PsMessage
PsWarnImportPreQualified                      -> [ GhcHint
SuggestQualifiedAfterModuleName
                                                     , Extension -> GhcHint
suggestExtension Extension
LangExt.ImportQualifiedPost]
    PsWarnViewPatternSignatures{}                 -> [GhcHint
SuggestParenthesizePatternRHS]
    PsErrLexer{}                                  -> [GhcHint]
noHints
    PsMessage
PsErrCmmLexer                                 -> [GhcHint]
noHints
    PsErrCmmParser{}                              -> [GhcHint]
noHints
    PsErrParse [Char]
token PsErrParseDetails{Bool
ped_th_enabled :: Bool
ped_do_in_last_100 :: Bool
ped_mdo_in_last_100 :: Bool
ped_pat_syn_enabled :: Bool
ped_pattern_parsed :: Bool
ped_pattern_parsed :: PsErrParseDetails -> Bool
ped_pat_syn_enabled :: PsErrParseDetails -> Bool
ped_mdo_in_last_100 :: PsErrParseDetails -> Bool
ped_do_in_last_100 :: PsErrParseDetails -> Bool
ped_th_enabled :: PsErrParseDetails -> Bool
..}        -> case [Char]
token of
      [Char]
""                         -> []
      [Char]
"$"  | Bool -> Bool
not Bool
ped_th_enabled  -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TemplateHaskell]   -- #7396
      [Char]
"$$" | Bool -> Bool
not Bool
ped_th_enabled  -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TemplateHaskell]   -- #20157
      [Char]
"<-" | Bool
ped_mdo_in_last_100 -> [Extension -> GhcHint
suggestExtension Extension
LangExt.RecursiveDo]
           | Bool
otherwise           -> [GhcHint
SuggestMissingDo]
      [Char]
"="  | Bool
ped_do_in_last_100  -> [GhcHint
SuggestLetInDo]                             -- #15849
      [Char]
_    | Bool -> Bool
not Bool
ped_pat_syn_enabled
           , Bool
ped_pattern_parsed  -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PatternSynonyms]   -- #12429
           | Bool
otherwise           -> []
    PsErrTypeAppWithoutSpace{}                    -> [GhcHint]
noHints
    PsErrLazyPatWithoutSpace{}                    -> [GhcHint]
noHints
    PsErrBangPatWithoutSpace{}                    -> [GhcHint]
noHints
    PsMessage
PsErrInvalidInfixHole                         -> [GhcHint]
noHints
    PsMessage
PsErrExpectedHyphen                           -> [GhcHint]
noHints
    PsMessage
PsErrSpaceInSCC                               -> [GhcHint]
noHints
    PsErrEmptyDoubleQuotes Bool
th_on | Bool
th_on          -> [GhcHint
SuggestThQuotationSyntax]
                                 | Bool
otherwise      -> [GhcHint]
noHints
    PsErrLambdaCase{}                             -> [Extension -> GhcHint
suggestExtension Extension
LangExt.LambdaCase]
    PsErrEmptyLambda{}                            -> [GhcHint]
noHints
    PsErrLinearFunction{}                         -> [Extension -> GhcHint
suggestExtension Extension
LangExt.LinearTypes]
    PsErrMultiWayIf{}                             -> [Extension -> GhcHint
suggestExtension Extension
LangExt.MultiWayIf]
    PsErrOverloadedRecordUpdateNotEnabled{}       -> [Extension -> GhcHint
suggestExtension Extension
LangExt.OverloadedRecordUpdate]
    PsErrNumUnderscores{}                         -> [Extension -> GhcHint
suggestExtension Extension
LangExt.NumericUnderscores]
    PsErrIllegalBangPattern{}                     -> [Extension -> GhcHint
suggestExtension Extension
LangExt.BangPatterns]
    PsErrOverloadedRecordDotInvalid{}             -> [GhcHint]
noHints
    PsMessage
PsErrIllegalPatSynExport                      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PatternSynonyms]
    PsMessage
PsErrOverloadedRecordUpdateNoQualifiedFields  -> [GhcHint]
noHints
    PsErrExplicitForall Bool
is_unicode                -> [SDoc -> Extension -> GhcHint
useExtensionInOrderTo SDoc
info Extension
LangExt.ExplicitForAll]
      where info :: SDoc
info = SDoc
"to enable syntax:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc
forallSym Bool
is_unicode SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
angleBrackets SDoc
"tvs" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
angleBrackets SDoc
"type"
    PsErrIllegalQualifiedDo{}                     -> [Extension -> GhcHint
suggestExtension Extension
LangExt.QualifiedDo]
    PsErrQualifiedDoInCmd{}                       -> [GhcHint]
noHints
    PsErrRecordSyntaxInPatSynDecl{}               -> [GhcHint]
noHints
    PsErrEmptyWhereInPatSynDecl{}                 -> [GhcHint]
noHints
    PsErrInvalidWhereBindInPatSynDecl{}           -> [GhcHint]
noHints
    PsErrNoSingleWhereBindInPatSynDecl{}          -> [GhcHint]
noHints
    PsErrDeclSpliceNotAtTopLevel{}                -> [GhcHint]
noHints
    PsErrMultipleNamesInStandaloneKindSignature{} -> [GhcHint]
noHints
    PsMessage
PsErrIllegalExplicitNamespace                 -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ExplicitNamespaces]
    PsErrUnallowedPragma{}                        -> [GhcHint]
noHints
    PsMessage
PsErrImportPostQualified                      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ImportQualifiedPost]
    PsMessage
PsErrImportQualifiedTwice                     -> [GhcHint]
noHints
    PsMessage
PsErrIllegalImportBundleForm                  -> [GhcHint]
noHints
    PsMessage
PsErrInvalidRuleActivationMarker              -> [GhcHint]
noHints
    PsMessage
PsErrMissingBlock                             -> [GhcHint]
noHints
    PsErrUnsupportedBoxedSumExpr{}                -> [GhcHint]
noHints
    PsErrUnsupportedBoxedSumPat{}                 -> [GhcHint]
noHints
    PsErrUnexpectedQualifiedConstructor{}         -> [GhcHint]
noHints
    PsErrTupleSectionInPat{}                      -> [GhcHint]
noHints
    PsErrOpFewArgs StarIsType
star_is_type RdrName
op
      -> StarIsType -> RdrName -> [GhcHint]
noStarIsTypeHints StarIsType
star_is_type RdrName
op
    PsErrVarForTyCon{}                            -> [GhcHint]
noHints
    PsMessage
PsErrMalformedEntityString                    -> [GhcHint]
noHints
    PsMessage
PsErrDotsInRecordUpdate                       -> [GhcHint]
noHints
    PsErrInvalidDataCon{}                         -> [GhcHint]
noHints
    PsErrInvalidInfixDataCon{}                    -> [GhcHint]
noHints
    PsErrIllegalPromotionQuoteDataCon{}           -> [GhcHint]
noHints
    PsMessage
PsErrUnpackDataCon                            -> [GhcHint]
noHints
    PsErrUnexpectedKindAppInDataCon{}             -> [GhcHint]
noHints
    PsErrInvalidRecordCon{}                       -> [GhcHint]
noHints
    PsErrIllegalUnboxedStringInPat{}              -> [GhcHint]
noHints
    PsErrIllegalUnboxedFloatingLitInPat{}         -> [GhcHint]
noHints
    PsErrDoNotationInPat{}                        -> [GhcHint]
noHints
    PsMessage
PsErrIfThenElseInPat                          -> [GhcHint]
noHints
    PsMessage
PsErrCaseInPat                                -> [GhcHint]
noHints
    PsMessage
PsErrLetInPat                                 -> [GhcHint]
noHints
    PsErrLambdaInPat{}                            -> [GhcHint]
noHints
    PsErrArrowExprInPat{}                         -> [GhcHint]
noHints
    PsErrArrowCmdInPat{}                          -> [GhcHint]
noHints
    PsErrArrowCmdInExpr{}                         -> [GhcHint]
noHints
    PsErrOrPatInExpr{}                            -> [GhcHint]
noHints
    PsErrLambdaCmdInFunAppCmd{}                   -> [GhcHint]
suggestParensAndBlockArgs
    PsErrCaseCmdInFunAppCmd{}                     -> [GhcHint]
suggestParensAndBlockArgs
    PsErrIfCmdInFunAppCmd{}                       -> [GhcHint]
suggestParensAndBlockArgs
    PsErrLetCmdInFunAppCmd{}                      -> [GhcHint]
suggestParensAndBlockArgs
    PsErrDoCmdInFunAppCmd{}                       -> [GhcHint]
suggestParensAndBlockArgs
    PsErrDoInFunAppExpr{}                         -> [GhcHint]
suggestParensAndBlockArgs
    PsErrMDoInFunAppExpr{}                        -> [GhcHint]
suggestParensAndBlockArgs
    PsErrLambdaInFunAppExpr{}                     -> [GhcHint]
suggestParensAndBlockArgs
    PsErrCaseInFunAppExpr{}                       -> [GhcHint]
suggestParensAndBlockArgs
    PsErrLetInFunAppExpr{}                        -> [GhcHint]
suggestParensAndBlockArgs
    PsErrIfInFunAppExpr{}                         -> [GhcHint]
suggestParensAndBlockArgs
    PsErrProcInFunAppExpr{}                       -> [GhcHint]
suggestParensAndBlockArgs
    PsErrMalformedTyOrClDecl{}                    -> [GhcHint]
noHints
    PsMessage
PsErrIllegalWhereInDataDecl                   -> [SDoc -> Extension -> GhcHint
useExtensionInOrderTo SDoc
"to enable syntax: data T where" Extension
LangExt.GADTSyntax]
    PsErrIllegalDataTypeContext{}                 -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DatatypeContexts]
    PsMessage
PsErrPrimStringInvalidChar                    -> [GhcHint]
noHints
    PsMessage
PsErrSuffixAT                                 -> [GhcHint]
noHints
    PsErrPrecedenceOutOfRange{}                   -> [GhcHint]
noHints
    PsErrSemiColonsInCondExpr{}                   -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DoAndIfThenElse]
    PsErrSemiColonsInCondCmd{}                    -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DoAndIfThenElse]
    PsMessage
PsErrAtInPatPos                               -> [GhcHint]
noHints
    PsErrParseErrorOnInput{}                      -> [GhcHint]
noHints
    PsErrMalformedDecl{}                          -> [GhcHint]
noHints
    PsErrNotADataCon{}                            -> [GhcHint]
noHints
    PsMessage
PsErrInferredTypeVarNotAllowed                -> [GhcHint]
noHints
    PsErrIllegalTraditionalRecordSyntax{}         -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TraditionalRecordSyntax]
    PsErrParseErrorInCmd{}                        -> [GhcHint]
noHints
    PsErrInPat PatBuilder GhcPs
_ PsErrInPatDetails
details                          -> case PsErrInPatDetails
details of
      PEIP_RecPattern [LPat GhcPs]
args PatIsRecursive
YesPatIsRecursive ParseContext
ctx
       | [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 -> [Maybe GhcHint] -> [GhcHint]
forall a. [Maybe a] -> [a]
catMaybes [Maybe GhcHint
sug_recdo, ParseContext -> Maybe GhcHint
sug_missingdo ParseContext
ctx]
       | Bool
otherwise        -> [Maybe GhcHint] -> [GhcHint]
forall a. [Maybe a] -> [a]
catMaybes [ParseContext -> Maybe GhcHint
sug_missingdo ParseContext
ctx]
      PEIP_OtherPatDetails ParseContext
ctx -> [Maybe GhcHint] -> [GhcHint]
forall a. [Maybe a] -> [a]
catMaybes [ParseContext -> Maybe GhcHint
sug_missingdo ParseContext
ctx]
      PsErrInPatDetails
_                        -> []
      where
        sug_recdo :: Maybe GhcHint
sug_recdo                                           = GhcHint -> Maybe GhcHint
forall a. a -> Maybe a
Just (Extension -> GhcHint
suggestExtension Extension
LangExt.RecursiveDo)
        sug_missingdo :: ParseContext -> Maybe GhcHint
sug_missingdo (ParseContext Maybe RdrName
_ PatIncompleteDoBlock
YesIncompleteDoBlock) = GhcHint -> Maybe GhcHint
forall a. a -> Maybe a
Just GhcHint
SuggestMissingDo
        sug_missingdo ParseContext
_                                     = Maybe GhcHint
forall a. Maybe a
Nothing
    PsErrParseRightOpSectionInPat{}               -> [GhcHint]
noHints
    PsErrIllegalRoleName FastString
_ [Role]
nearby                 -> [[Role] -> GhcHint
SuggestRoles [Role]
nearby]
    PsErrInvalidTypeSignature PsInvalidTypeSignature
reason LHsExpr GhcPs
lhs          ->
        if | IdP GhcPs
RdrName
foreign_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall {p} {l} {l}.
(XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p), Eq (IdP p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs
           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ForeignFunctionInterface]
           | IdP GhcPs
RdrName
default_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall {p} {l} {l}.
(XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p), Eq (IdP p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs
           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DefaultSignatures]
           | IdP GhcPs
RdrName
pattern_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall {p} {l} {l}.
(XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p), Eq (IdP p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs
           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PatternSynonyms]
           | PsInvalidTypeSignature
PsErrInvalidTypeSig_Qualified <- PsInvalidTypeSignature
reason
           -> [GhcHint
SuggestTypeSignatureRemoveQualifier]
           | Bool
otherwise
           -> []
      where
        -- A common error is to forget the ForeignFunctionInterface flag
        -- so check for that, and suggest.  cf #3805
        -- Sadly 'foreign import' still barfs 'parse error' because
        --  'import' is a keyword
        -- looks_like :: RdrName -> LHsExpr GhcPsErr -> Bool -- AZ
        looks_like :: IdP p -> GenLocated l (HsExpr p) -> Bool
looks_like IdP p
s (L l
_ (HsVar XVar p
_ (L l
_ IdP p
v))) = IdP p
v IdP p -> IdP p -> Bool
forall a. Eq a => a -> a -> Bool
== IdP p
s
        looks_like IdP p
s (L l
_ (HsApp XApp p
_ XRec p (HsExpr p)
lhs XRec p (HsExpr p)
_))   = IdP p -> GenLocated l (HsExpr p) -> Bool
looks_like IdP p
s XRec p (HsExpr p)
GenLocated l (HsExpr p)
lhs
        looks_like IdP p
_ GenLocated l (HsExpr p)
_                       = Bool
False

        foreign_RDR :: RdrName
foreign_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName ([Char] -> FastString
fsLit [Char]
"foreign")
        default_RDR :: RdrName
default_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName ([Char] -> FastString
fsLit [Char]
"default")
        pattern_RDR :: RdrName
pattern_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName ([Char] -> FastString
fsLit [Char]
"pattern")
    PsErrUnexpectedTypeInDecl{}                   -> [GhcHint]
noHints
    PsErrInvalidPackageName{}                     -> [GhcHint]
noHints
    PsErrIllegalGadtRecordMultiplicity{}          -> [GhcHint]
noHints
    PsErrInvalidCApiImport {}                     -> [GhcHint]
noHints
    PsErrMultipleConForNewtype {}                 -> [GhcHint]
noHints
    PsErrUnicodeCharLooksLike{}                   -> [GhcHint]
noHints
    PsErrInvalidPun {}                            -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ListTuplePuns]
    PsErrIllegalOrPat{}                           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.OrPatterns]
    PsErrTypeSyntaxInPat{}                        -> [GhcHint]
noHints

  diagnosticCode :: PsMessage -> Maybe DiagnosticCode
diagnosticCode = PsMessage -> Maybe DiagnosticCode
forall diag.
(Generic diag, GDiagnosticCode (Rep diag)) =>
diag -> Maybe DiagnosticCode
constructorCode

psHeaderMessageDiagnostic :: PsHeaderMessage -> DecoratedSDoc
psHeaderMessageDiagnostic :: PsHeaderMessage -> DecoratedSDoc
psHeaderMessageDiagnostic = \case
  PsHeaderMessage
PsErrParseLanguagePragma
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Cannot parse LANGUAGE pragma"
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Expecting comma-separated list of language options,"
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"each starting with a capital letter"
              , Int -> SDoc -> SDoc
nest Int
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"E.g. {-# LANGUAGE TemplateHaskell, GADTs #-}") ]
  PsErrUnsupportedExt [Char]
unsup [[Char]]
_
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unsupported extension: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
unsup
  PsErrParseOptionsPragma [Char]
str
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Error while parsing OPTIONS_GHC pragma."
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Expecting whitespace-separated list of GHC options."
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"  E.g. {-# OPTIONS_GHC -Wall -O2 #-}"
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char]
"Input was: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
str) ]
  PsErrUnknownOptionsPragma [Char]
flag
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unknown flag in  {-# OPTIONS_GHC #-} pragma:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
flag

psHeaderMessageReason :: PsHeaderMessage -> DiagnosticReason
psHeaderMessageReason :: PsHeaderMessage -> DiagnosticReason
psHeaderMessageReason = \case
  PsHeaderMessage
PsErrParseLanguagePragma
    -> DiagnosticReason
ErrorWithoutFlag
  PsErrUnsupportedExt{}
    -> DiagnosticReason
ErrorWithoutFlag
  PsErrParseOptionsPragma{}
    -> DiagnosticReason
ErrorWithoutFlag
  PsErrUnknownOptionsPragma{}
    -> DiagnosticReason
ErrorWithoutFlag

psHeaderMessageHints :: PsHeaderMessage -> [GhcHint]
psHeaderMessageHints :: PsHeaderMessage -> [GhcHint]
psHeaderMessageHints = \case
  PsHeaderMessage
PsErrParseLanguagePragma
    -> [GhcHint]
noHints
  PsErrUnsupportedExt [Char]
unsup [[Char]]
supported
    -> if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
suggestions
          then [GhcHint]
noHints
          -- FIXME(adn) To fix the compiler crash in #19923 we just rewrap this into an
          -- UnknownHint, but we should have here a proper hint, but that would require
          -- changing 'supportedExtensions' to emit a list of 'Extension'.
          else [SDoc -> GhcHint
forall a. (Outputable a, Typeable a) => a -> GhcHint
UnknownHint (SDoc -> GhcHint) -> SDoc -> GhcHint
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Perhaps you meant" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
quotedListWithOr (([Char] -> SDoc) -> [[Char]] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [[Char]]
suggestions)]
       where
         suggestions :: [String]
         suggestions :: [[Char]]
suggestions = [Char] -> [[Char]] -> [[Char]]
fuzzyMatch [Char]
unsup [[Char]]
supported
  PsErrParseOptionsPragma{}
    -> [GhcHint]
noHints
  PsErrUnknownOptionsPragma{}
    -> [GhcHint]
noHints


suggestParensAndBlockArgs :: [GhcHint]
suggestParensAndBlockArgs :: [GhcHint]
suggestParensAndBlockArgs =
  [GhcHint
SuggestParentheses, Extension -> GhcHint
suggestExtension Extension
LangExt.BlockArguments]

pp_unexpected_fun_app :: Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app :: forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app SDoc
e a
a =
   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unexpected " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
e SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
" in function application:"
    SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
4 (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a)

parse_error_in_pat :: SDoc
parse_error_in_pat :: SDoc
parse_error_in_pat = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Parse error in pattern:"

forallSym :: Bool -> SDoc
forallSym :: Bool -> SDoc
forallSym Bool
True  = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"∀"
forallSym Bool
False = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"forall"

pprFileHeaderPragmaType :: FileHeaderPragmaType -> SDoc
pprFileHeaderPragmaType :: FileHeaderPragmaType -> SDoc
pprFileHeaderPragmaType FileHeaderPragmaType
OptionsPrag    = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"OPTIONS"
pprFileHeaderPragmaType FileHeaderPragmaType
IncludePrag    = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"INCLUDE"
pprFileHeaderPragmaType FileHeaderPragmaType
LanguagePrag   = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"LANGUAGE"
pprFileHeaderPragmaType FileHeaderPragmaType
DocOptionsPrag = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"OPTIONS_HADDOCK"