{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}

{-# 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.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(..))
import GHC.Hs.Type (pprLHsContext)
import GHC.Builtin.Names (allNameStrings)
import GHC.Builtin.Types (filterCTuple)
import qualified GHC.LanguageExtensions as LangExt
import Data.List.NonEmpty (NonEmpty((:|)))


instance Diagnostic PsMessage where
  diagnosticMessage :: PsMessage -> DecoratedSDoc
diagnosticMessage = \case
    PsUnknownMessage a
m
      -> a -> DecoratedSDoc
forall a. Diagnostic a => a -> DecoratedSDoc
diagnosticMessage 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
$ String -> SDoc
text String
"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
$
            String -> SDoc
text String
"Multiple Haddock comments for a single entity are not allowed." SDoc -> SDoc -> SDoc
$$
            String -> SDoc
text String
"The extraneous comment will be ignored."
    PsWarnBidirectionalFormatChars ((PsLoc
loc,Char
_,String
desc) :| [(PsLoc, Char, String)]
xs)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"A unicode bidirectional formatting character" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (String -> SDoc
text String
desc)
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"was found at offset" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (BufPos -> Int
bufPos (PsLoc -> BufPos
psBufPos PsLoc
loc)) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in the file"
         SDoc -> SDoc -> SDoc
$$ (case [(PsLoc, Char, String)]
xs of
           [] -> SDoc
empty
           [(PsLoc, Char, String)]
xs -> String -> SDoc
text String
"along with further bidirectional formatting characters at" SDoc -> SDoc -> SDoc
<+> [(PsLoc, Char, String)] -> SDoc
forall b. [(PsLoc, b, String)] -> SDoc
pprChars [(PsLoc, Char, String)]
xs
            where
              pprChars :: [(PsLoc, b, String)] -> SDoc
pprChars [] = SDoc
empty
              pprChars ((PsLoc
loc,b
_,String
desc):[(PsLoc, b, String)]
xs) = String -> SDoc
text String
"offset" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (BufPos -> Int
bufPos (PsLoc -> BufPos
psBufPos PsLoc
loc)) SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
":" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
desc
                                       SDoc -> SDoc -> SDoc
$$ [(PsLoc, b, String)] -> SDoc
pprChars [(PsLoc, b, String)]
xs
              )
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"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
$
           String -> SDoc
text String
"Tab character found here"
             SDoc -> SDoc -> SDoc
<> (if Word
tc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
1
                 then String -> SDoc
text String
""
                 else String -> SDoc
text String
", and in" SDoc -> SDoc -> SDoc
<+> 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)) (String -> SDoc
text String
"further location"))
             SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"."
    PsWarnTransitionalLayout TransLayoutReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"transitional layout will not be accepted in the future:"
            SDoc -> SDoc -> SDoc
$$ String -> SDoc
text (case TransLayoutReason
reason of
               TransLayoutReason
TransLayout_Where -> String
"`where' clause at the same depth as implicit layout block"
               TransLayoutReason
TransLayout_Pipe  -> String
"`|' at the same depth as implicit layout block"
            )
    PsWarnOperatorWhitespaceExtConflict OperatorWhitespaceSymbol
sym
      -> let mk_prefix_msg :: String -> String -> SDoc
mk_prefix_msg String
extension_name String
syntax_meaning =
                  String -> SDoc
text String
"The prefix use of a" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (OperatorWhitespaceSymbol -> SDoc
pprOperatorWhitespaceSymbol OperatorWhitespaceSymbol
sym)
                    SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"would denote" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
syntax_meaning
               SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"were the" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
extension_name SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"extension enabled.")
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         case OperatorWhitespaceSymbol
sym of
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixPercent -> String -> String -> SDoc
mk_prefix_msg String
"LinearTypes" String
"a multiplicity annotation"
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixDollar -> String -> String -> SDoc
mk_prefix_msg String
"TemplateHaskell" String
"an untyped splice"
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixDollarDollar -> String -> String -> SDoc
mk_prefix_msg String
"TemplateHaskell" String
"a typed splice"
    PsWarnOperatorWhitespace FastString
sym OperatorWhitespaceOccurrence
occ_type
      -> let mk_msg :: String -> SDoc
mk_msg String
occ_type_str =
                  String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
occ_type_str SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"use of a" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (FastString -> SDoc
ftext FastString
sym)
                    SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"might be repurposed as special syntax"
               SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"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 -> String -> SDoc
mk_msg String
"prefix"
           OperatorWhitespaceOccurrence
OperatorWhitespaceOccurrence_Suffix -> String -> SDoc
mk_msg String
"suffix"
           OperatorWhitespaceOccurrence
OperatorWhitespaceOccurrence_TightInfix -> String -> SDoc
mk_msg String
"tight infix"
    PsMessage
PsWarnStarBinder
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"Found binding occurrence of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"*")
            SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"yet StarIsType is enabled."
    PsMessage
PsWarnStarIsType
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
             String -> SDoc
text String
"Using" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"*")
             SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"(or its Unicode variant) to mean"
             SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"Data.Kind.Type")
          SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"relies on the StarIsType extension, which will become"
          SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"deprecated in the future."
    PsMessage
PsWarnUnrecognisedPragma
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Unrecognised pragma"
    PsMessage
PsWarnImportPreQualified
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"Found" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"qualified")
             SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in prepositive position"

    PsErrLexer LexErr
err LexErrKind
kind
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hcat
           [ String -> SDoc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ case LexErr
err of
              LexErr
LexError               -> String
"lexical error"
              LexErr
LexUnknownPragma       -> String
"unknown pragma"
              LexErr
LexErrorInPragma       -> String
"lexical error in pragma"
              LexErr
LexNumEscapeRange      -> String
"numeric escape sequence out of range"
              LexErr
LexStringCharLit       -> String
"lexical error in string/character literal"
              LexErr
LexStringCharLitEOF    -> String
"unexpected end-of-file in string/character literal"
              LexErr
LexUnterminatedComment -> String
"unterminated `{-'"
              LexErr
LexUnterminatedOptions -> String
"unterminated OPTIONS pragma"
              LexErr
LexUnterminatedQQ      -> String
"unterminated quasiquotation"

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

    PsErrTypeAppWithoutSpace RdrName
v LHsExpr GhcPs
e
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
sep [ String -> SDoc
text String
"@-pattern in expression context:"
               , Int -> SDoc -> SDoc
nest Int
4 (RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc RdrName
v SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e)
               ]
           SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"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
sep [ String -> SDoc
text String
"Lazy pattern in expression context:"
               , Int -> SDoc -> SDoc
nest Int
4 (String -> SDoc
text String
"~" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e)
               ]
           SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"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
sep [ String -> SDoc
text String
"Bang pattern in expression context:"
               , Int -> SDoc -> SDoc
nest Int
4 (String -> SDoc
text String
"!" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
e)
               ]
           SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"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
$ String -> SDoc
text String
"Invalid infix hole, expected an infix operator"
    PsMessage
PsErrExpectedHyphen
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Expected a hyphen"
    PsMessage
PsErrSpaceInSCC
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"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
vcat [SDoc]
msg
         where
            msg :: [SDoc]
msg    = [ String -> SDoc
text String
"Parser error on `''`"
                     , String -> SDoc
text String
"Character literals may not be empty"
                     ]
    PsMessage
PsErrLambdaCase
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Illegal lambda-case"
    PsMessage
PsErrEmptyLambda
       -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"A lambda requires at least one parameter"
    PsMessage
PsErrLinearFunction
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Illegal use of linear functions"
    PsMessage
PsErrOverloadedRecordUpdateNotEnabled
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Illegal overloaded record update"
    PsMessage
PsErrMultiWayIf
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Illegal multi-way if-expression"
    PsErrNumUnderscores NumUnderscoreReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ case NumUnderscoreReason
reason of
             NumUnderscoreReason
NumUnderscore_Integral -> String
"Illegal underscores in integer literals"
             NumUnderscoreReason
NumUnderscore_Float    -> String
"Illegal underscores in floating literals"
    PsErrIllegalBangPattern Pat GhcPs
e
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Illegal bang-pattern" SDoc -> SDoc -> SDoc
$$ 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
$
           String -> SDoc
text String
"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
$ String -> SDoc
text String
"Illegal export form"
    PsMessage
PsErrOverloadedRecordUpdateNoQualifiedFields
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"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
$ String -> SDoc
text String
"Illegal symbol" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Bool -> SDoc
forallSym Bool
is_unicode) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in type"
    PsErrIllegalQualifiedDo SDoc
qdoDoc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
text String
"Illegal qualified" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
qdoDoc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"block"
    PsErrQualifiedDoInCmd ModuleName
m
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Parse error in command:") Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
             String -> SDoc
text String
"Found a qualified" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
".do block in a command, but"
             SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"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
$
           String -> SDoc
text String
"record syntax not supported for pattern synonym declarations:"
           SDoc -> SDoc -> SDoc
$$ GenLocated SrcSpanAnnA (Pat GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
pat
    PsErrEmptyWhereInPatSynDecl RdrName
patsyn_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
text String
"pattern synonym 'where' clause cannot be empty"
           SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"In the pattern synonym declaration for: "
              SDoc -> SDoc -> SDoc
<+> 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
$
           String -> SDoc
text String
"pattern synonym 'where' clause must bind the pattern synonym's name"
           SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
patsyn_name) SDoc -> SDoc -> SDoc
$$ 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
$
           String -> SDoc
text String
"pattern synonym 'where' clause must contain a single binding:"
           SDoc -> SDoc -> SDoc
$$ 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 (String -> SDoc
text String
"Declaration splices are allowed only"
                 SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"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
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"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 [GenLocated SrcSpanAnnN RdrName]
[LIdP GhcPs]
vs)
                , String -> SDoc
text String
"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
$
           String -> SDoc
text String
"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 (String -> SDoc
text String
"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
$
           String -> SDoc
text String
"Found" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"qualified")
             SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in postpositive position. "
    PsMessage
PsErrImportQualifiedTwice
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Multiple occurrences of 'qualified'"
    PsMessage
PsErrIllegalImportBundleForm
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
text String
"Illegal import form, this syntax can only be used to bundle"
           SDoc -> SDoc -> SDoc
$+$ String -> SDoc
text String
"pattern synonyms with types in module exports."
    PsMessage
PsErrInvalidRuleActivationMarker
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Invalid rule activation marker"

    PsMessage
PsErrMissingBlock
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"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 (String -> SDoc
text String
"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 (String -> SDoc
text String
"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 (String -> SDoc
text String
"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
$ String -> SDoc
text String
"Tuple section in pattern context"
    PsErrOpFewArgs StarIsType
_ RdrName
op
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
text String
"Operator applied to too few arguments:" SDoc -> SDoc -> SDoc
<+> 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
$
           String -> SDoc
text String
"Expecting a type constructor but found a variable,"
             SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name) SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"."
           SDoc -> SDoc -> SDoc
$$ if OccName -> Bool
isSymOcc (OccName -> Bool) -> OccName -> Bool
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
name
              then String -> SDoc
text String
"If" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is a type constructor"
                    SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"then enable ExplicitNamespaces and use the 'type' keyword."
              else SDoc
empty
    PsMessage
PsErrMalformedEntityString
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Malformed entity string"
    PsMessage
PsErrDotsInRecordUpdate
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"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 (String -> SDoc
text String
"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 (String -> SDoc
text String
"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
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
tc SDoc -> SDoc -> SDoc
<+> HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
rhs)
    PsMessage
PsErrUnpackDataCon
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"{-# 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 (String -> SDoc
text String
"Unexpected kind application in a data/newtype declaration:") Int
2
                (DataConBuilder -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataConBuilder
lhs SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"@" SDoc -> SDoc -> SDoc
<> 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
$ String -> SDoc
text String
"Not a record constructor:" SDoc -> SDoc -> SDoc
<+> 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
$ String -> SDoc
text String
"Illegal unboxed string literal in pattern:" SDoc -> SDoc -> SDoc
$$ 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
$ String -> SDoc
text String
"Illegal unboxed floating point literal in pattern:" SDoc -> SDoc -> SDoc
$$ 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
$ String -> SDoc
text String
"do-notation in pattern"
    PsMessage
PsErrIfThenElseInPat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"(if ... then ... else ...)-syntax in pattern"
    PsMessage
PsErrLambdaCaseInPat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"(\\case ...)-syntax in pattern"
    PsMessage
PsErrCaseInPat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"(case ... of ...)-syntax in pattern"
    PsMessage
PsErrLetInPat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"(let ... in ...)-syntax in pattern"
    PsMessage
PsErrLambdaInPat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
text String
"Lambda-syntax in pattern."
           SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Pattern matching on functions is not possible."
    PsErrArrowExprInPat HsExpr GhcPs
e
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Expression syntax in pattern:" SDoc -> SDoc -> SDoc
<+> 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
$ String -> SDoc
text String
"Command syntax in pattern:" SDoc -> SDoc -> SDoc
<+> 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
vcat
           [ String -> SDoc
text String
"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)
           ]
    PsErrViewPatInExpr LHsExpr GhcPs
a LHsExpr GhcPs
b
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
sep [ String -> SDoc
text String
"View pattern in expression context:"
               , Int -> SDoc -> SDoc
nest Int
4 (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
a SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"->" SDoc -> SDoc -> SDoc
<+> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
b)
               ]
    PsErrLambdaCmdInFunAppCmd 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 (String -> SDoc
text String
"lambda command") GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
a
    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 (String -> SDoc
text String
"case command") GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd 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 (String -> SDoc
text String
"if command") GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd 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 (String -> SDoc
text String
"let command") GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd 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 (String -> SDoc
text String
"do command") GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd 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 (String -> SDoc
text String
"do block")) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr 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 (String -> SDoc
text String
"mdo block")) GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
a
    PsErrLambdaInFunAppExpr 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 (String -> SDoc
text String
"lambda expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr 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 (String -> SDoc
text String
"case expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
a
    PsErrLambdaCaseInFunAppExpr 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 (String -> SDoc
text String
"lambda-case expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr 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 (String -> SDoc
text String
"let expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr 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 (String -> SDoc
text String
"if expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr 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 (String -> SDoc
text String
"proc expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
a
    PsErrMalformedTyOrClDecl LHsType GhcPs
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
text String
"Malformed head of type or class declaration:" SDoc -> SDoc -> SDoc
<+> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ty
    PsMessage
PsErrIllegalWhereInDataDecl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Illegal keyword 'where' in data declaration"
    PsErrIllegalDataTypeContext LHsContext GhcPs
c
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
text String
"Illegal datatype context:"
             SDoc -> SDoc -> SDoc
<+> 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 GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
c)
    PsMessage
PsErrPrimStringInvalidChar
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"primitive string literal must contain only characters <= \'\\xFF\'"
    PsMessage
PsErrSuffixAT
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
text String
"Suffix occurrence of @. For an as-pattern, remove the leading whitespace."
    PsErrPrecedenceOutOfRange Int
i
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Precedence out of range: " SDoc -> SDoc -> SDoc
<> Int -> SDoc
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
$
           String -> SDoc
text String
"Unexpected semi-colons in conditional:"
           SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
4 SDoc
expr
         where
            pprOptSemi :: Bool -> SDoc
pprOptSemi Bool
True  = SDoc
semi
            pprOptSemi Bool
False = SDoc
empty
            expr :: SDoc
expr = String -> SDoc
text String
"if"   SDoc -> SDoc -> SDoc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
c SDoc -> SDoc -> SDoc
<> Bool -> SDoc
pprOptSemi Bool
st SDoc -> SDoc -> SDoc
<+>
                   String -> SDoc
text String
"then" SDoc -> SDoc -> SDoc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
t SDoc -> SDoc -> SDoc
<> Bool -> SDoc
pprOptSemi Bool
se SDoc -> SDoc -> SDoc
<+>
                   String -> SDoc
text String
"else" SDoc -> SDoc -> SDoc
<+> 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
$
           String -> SDoc
text String
"Unexpected semi-colons in conditional:"
           SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
4 SDoc
expr
         where
            pprOptSemi :: Bool -> SDoc
pprOptSemi Bool
True  = SDoc
semi
            pprOptSemi Bool
False = SDoc
empty
            expr :: SDoc
expr = String -> SDoc
text String
"if"   SDoc -> SDoc -> SDoc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
c SDoc -> SDoc -> SDoc
<> Bool -> SDoc
pprOptSemi Bool
st SDoc -> SDoc -> SDoc
<+>
                   String -> SDoc
text String
"then" SDoc -> SDoc -> SDoc
<+> HsCmd GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcPs
t SDoc -> SDoc -> SDoc
<> Bool -> SDoc
pprOptSemi Bool
se SDoc -> SDoc -> SDoc
<+>
                   String -> SDoc
text String
"else" SDoc -> SDoc -> SDoc
<+> 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
$
           String -> SDoc
text String
"Found a binding for the"
           SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"@")
           SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"operator in a pattern position."
           SDoc -> SDoc -> SDoc
$$ SDoc
perhapsAsPat
    PsErrParseErrorOnInput OccName
occ
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"parse error on input" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
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
$
           String -> SDoc
text String
"Malformed" SDoc -> SDoc -> SDoc
<+> SDoc
what
           SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
for)
    PsErrUnexpectedTypeAppInDecl LHsType GhcPs
ki SDoc
what RdrName
for
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Unexpected type application"
                  SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"@" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ki
                , String -> SDoc
text String
"In the" SDoc -> SDoc -> SDoc
<+> SDoc
what
                  SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"declaration for"
                  SDoc -> SDoc -> SDoc
<+> 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
$ String -> SDoc
text String
"Not a data constructor:" SDoc -> SDoc -> SDoc
<+> 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
$ String -> SDoc
text String
"Inferred type variables are not allowed here"
    PsErrIllegalTraditionalRecordSyntax SDoc
s
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
text String
"Illegal record syntax:" SDoc -> SDoc -> SDoc
<+> SDoc
s
    PsErrParseErrorInCmd SDoc
s
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"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 -> String -> SDoc
text String
"-" SDoc -> SDoc -> SDoc
<> PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
s
                 PEIP_TypeArgs [HsPatSigType GhcPs]
peipd_tyargs
                   | Bool -> Bool
not ([HsPatSigType GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsPatSigType GhcPs]
peipd_tyargs) -> PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
s SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
vcat [
                               [SDoc] -> SDoc
hsep [String -> SDoc
text String
"@" SDoc -> SDoc -> SDoc
<> HsPatSigType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsPatSigType GhcPs
t | HsPatSigType GhcPs
t <- [HsPatSigType GhcPs]
peipd_tyargs]
                             , String -> SDoc
text String
"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
<+> String -> SDoc
text String
"In a function binding for the"
                                     SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
fun)
                                     SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"operator."
                                  SDoc -> SDoc -> SDoc
$$ if RdrName -> Bool
opIsAt RdrName
fun
                                        then SDoc
perhapsAsPat
                                        else SDoc
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
<+> SDoc
body
    PsErrParseRightOpSectionInPat infixOcc
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
<+> infixOcc -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc infixOcc
infixOcc SDoc -> SDoc -> SDoc
<> 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
$
           String -> SDoc
text String
"Illegal role name" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
role)
    PsErrInvalidTypeSignature LHsExpr GhcPs
lhs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
text String
"Invalid type signature:"
           SDoc -> SDoc -> SDoc
<+> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
lhs
           SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
":: ..."
    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
vcat [ String -> SDoc
text String
"Unexpected type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t)
                 , String -> SDoc
text String
"In the" SDoc -> SDoc -> SDoc
<+> SDoc
what
                   SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
tc'
                 , [SDoc] -> SDoc
vcat[ (String -> SDoc
text String
"A" SDoc -> SDoc -> SDoc
<+> SDoc
what
                          SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"declaration should have form")
                 , Int -> SDoc -> SDoc
nest Int
2
                   (SDoc
what
                    SDoc -> SDoc -> SDoc
<+> SDoc
tc'
                    SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text ([HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [String] -> [String]
forall b a. [b] -> [a] -> [a]
takeList [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
[LHsTypeArg GhcPs]
tparms [String]
allNameStrings))
                    SDoc -> SDoc -> SDoc
<+> 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
vcat
            [ String -> SDoc
text String
"Parse error" SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (FastString -> SDoc
ftext FastString
pkg)
            , String -> SDoc
text String
"Version number or non-alphanumeric" SDoc -> SDoc -> SDoc
<+>
              String -> SDoc
text String
"character in package name"
            ]

    PsErrIllegalGadtRecordMultiplicity HsArrow GhcPs
arr
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat
            [ String -> SDoc
text String
"Parse error" SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (HsArrow GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsArrow GhcPs
arr)
            , String -> SDoc
text String
"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
vcat [ String -> SDoc
text String
"Wrapper stubs can't be used with CApiFFI."]

  diagnosticReason :: PsMessage -> DiagnosticReason
diagnosticReason  = \case
    PsUnknownMessage a
m                            -> a -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason a
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
    PsMessage
PsWarnUnrecognisedPragma                      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnrecognisedPragmas
    PsMessage
PsWarnImportPreQualified                      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnPrepositiveQualifiedModule
    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
    PsMessage
PsErrUnpackDataCon                            -> DiagnosticReason
ErrorWithoutFlag
    PsErrUnexpectedKindAppInDataCon{}             -> DiagnosticReason
ErrorWithoutFlag
    PsErrInvalidRecordCon{}                       -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalUnboxedStringInPat{}              -> DiagnosticReason
ErrorWithoutFlag
    PsErrIllegalUnboxedFloatingLitInPat{}         -> DiagnosticReason
ErrorWithoutFlag
    PsErrDoNotationInPat{}                        -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrIfThenElseInPat                          -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrLambdaCaseInPat                          -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrCaseInPat                                -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrLetInPat                                 -> DiagnosticReason
ErrorWithoutFlag
    PsMessage
PsErrLambdaInPat                              -> DiagnosticReason
ErrorWithoutFlag
    PsErrArrowExprInPat{}                         -> DiagnosticReason
ErrorWithoutFlag
    PsErrArrowCmdInPat{}                          -> DiagnosticReason
ErrorWithoutFlag
    PsErrArrowCmdInExpr{}                         -> DiagnosticReason
ErrorWithoutFlag
    PsErrViewPatInExpr{}                          -> DiagnosticReason
ErrorWithoutFlag
    PsErrLambdaCmdInFunAppCmd{}                   -> DiagnosticReason
ErrorWithoutFlag
    PsErrCaseCmdInFunAppCmd{}                     -> DiagnosticReason
ErrorWithoutFlag
    PsErrIfCmdInFunAppCmd{}                       -> DiagnosticReason
ErrorWithoutFlag
    PsErrLetCmdInFunAppCmd{}                      -> DiagnosticReason
ErrorWithoutFlag
    PsErrDoCmdInFunAppCmd{}                       -> DiagnosticReason
ErrorWithoutFlag
    PsErrDoInFunAppExpr{}                         -> DiagnosticReason
ErrorWithoutFlag
    PsErrMDoInFunAppExpr{}                        -> DiagnosticReason
ErrorWithoutFlag
    PsErrLambdaInFunAppExpr{}                     -> DiagnosticReason
ErrorWithoutFlag
    PsErrCaseInFunAppExpr{}                       -> DiagnosticReason
ErrorWithoutFlag
    PsErrLambdaCaseInFunAppExpr{}                 -> 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
    PsErrUnexpectedTypeAppInDecl{}                -> 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

  diagnosticHints :: PsMessage -> [GhcHint]
diagnosticHints  = \case
    PsUnknownMessage a
m                            -> a -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints a
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              -> [String -> OperatorWhitespaceOccurrence -> GhcHint
SuggestUseWhitespaceAround (FastString -> String
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]
    PsMessage
PsWarnUnrecognisedPragma                      -> [GhcHint]
noHints
    PsMessage
PsWarnImportPreQualified                      -> [ GhcHint
SuggestQualifiedAfterModuleName
                                                     , Extension -> GhcHint
suggestExtension Extension
LangExt.ImportQualifiedPost]
    PsErrLexer{}                                  -> [GhcHint]
noHints
    PsMessage
PsErrCmmLexer                                 -> [GhcHint]
noHints
    PsErrCmmParser{}                              -> [GhcHint]
noHints
    PsErrParse String
token PsErrParseDetails{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
ped_pattern_parsed :: Bool
ped_pat_syn_enabled :: Bool
ped_mdo_in_last_100 :: Bool
ped_do_in_last_100 :: Bool
ped_th_enabled :: Bool
..}        -> case String
token of
      String
""                         -> []
      String
"$"  | Bool -> Bool
not Bool
ped_th_enabled  -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TemplateHaskell]   -- #7396
      String
"$$" | Bool -> Bool
not Bool
ped_th_enabled  -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TemplateHaskell]   -- #20157
      String
"<-" | Bool
ped_mdo_in_last_100 -> [Extension -> GhcHint
suggestExtension Extension
LangExt.RecursiveDo]
           | Bool
otherwise           -> [GhcHint
SuggestMissingDo]
      String
"="  | Bool
ped_do_in_last_100  -> [GhcHint
SuggestLetInDo]                             -- #15849
      String
_    | 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                ->
      let info :: SDoc
info = String -> SDoc
text String
"or a similar language extension to enable explicit-forall syntax:" SDoc -> SDoc -> SDoc
<+>
                 Bool -> SDoc
forallSym Bool
is_unicode SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"<tvs>. <type>"
      in [ SDoc -> Extension -> GhcHint
suggestExtensionWithInfo SDoc
info Extension
LangExt.RankNTypes ]
    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
    PsMessage
PsErrUnpackDataCon                            -> [GhcHint]
noHints
    PsErrUnexpectedKindAppInDataCon{}             -> [GhcHint]
noHints
    PsErrInvalidRecordCon{}                       -> [GhcHint]
noHints
    PsErrIllegalUnboxedStringInPat{}              -> [GhcHint]
noHints
    PsErrIllegalUnboxedFloatingLitInPat{}         -> [GhcHint]
noHints
    PsErrDoNotationInPat{}                        -> [GhcHint]
noHints
    PsMessage
PsErrIfThenElseInPat                          -> [GhcHint]
noHints
    PsMessage
PsErrLambdaCaseInPat                          -> [GhcHint]
noHints
    PsMessage
PsErrCaseInPat                                -> [GhcHint]
noHints
    PsMessage
PsErrLetInPat                                 -> [GhcHint]
noHints
    PsMessage
PsErrLambdaInPat                              -> [GhcHint]
noHints
    PsErrArrowExprInPat{}                         -> [GhcHint]
noHints
    PsErrArrowCmdInPat{}                          -> [GhcHint]
noHints
    PsErrArrowCmdInExpr{}                         -> [GhcHint]
noHints
    PsErrViewPatInExpr{}                          -> [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
    PsErrLambdaCaseInFunAppExpr{}                 -> [GhcHint]
suggestParensAndBlockArgs
    PsErrLetInFunAppExpr{}                        -> [GhcHint]
suggestParensAndBlockArgs
    PsErrIfInFunAppExpr{}                         -> [GhcHint]
suggestParensAndBlockArgs
    PsErrProcInFunAppExpr{}                       -> [GhcHint]
suggestParensAndBlockArgs
    PsErrMalformedTyOrClDecl{}                    -> [GhcHint]
noHints
    PsMessage
PsErrIllegalWhereInDataDecl                   ->
      [ SDoc -> Extension -> GhcHint
suggestExtensionWithInfo (String -> SDoc
text String
"or a similar language extension to enable syntax: data T where")
                                 Extension
LangExt.GADTs ]
    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
    PsErrUnexpectedTypeAppInDecl{}                -> [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 (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat 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 LHsExpr GhcPs
lhs                 ->
        if | RdrName
IdP GhcPs
foreign_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall p l l.
(Eq (IdP p), XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
lhs
           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ForeignFunctionInterface]
           | RdrName
IdP GhcPs
default_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall p l l.
(Eq (IdP p), XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
lhs
           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DefaultSignatures]
           | RdrName
IdP GhcPs
pattern_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall p l l.
(Eq (IdP p), XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` GenLocated SrcSpanAnnA (HsExpr GhcPs)
LHsExpr GhcPs
lhs
           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PatternSynonyms]
           | Bool
otherwise
           -> [GhcHint
SuggestTypeSignatureForm]
      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 _ 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 GenLocated l (HsExpr p)
XRec p (HsExpr p)
lhs
        looks_like IdP p
_ GenLocated l (HsExpr p)
_                       = Bool
False

        foreign_RDR :: RdrName
foreign_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"foreign")
        default_RDR :: RdrName
default_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"default")
        pattern_RDR :: RdrName
pattern_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"pattern")
    PsErrUnexpectedTypeInDecl{}                   -> [GhcHint]
noHints
    PsErrInvalidPackageName{}                     -> [GhcHint]
noHints
    PsErrIllegalGadtRecordMultiplicity{}          -> [GhcHint]
noHints
    PsErrInvalidCApiImport {}                     -> [GhcHint]
noHints

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
vcat [ String -> SDoc
text String
"Cannot parse LANGUAGE pragma"
              , String -> SDoc
text String
"Expecting comma-separated list of language options,"
              , String -> SDoc
text String
"each starting with a capital letter"
              , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"E.g. {-# LANGUAGE TemplateHaskell, GADTs #-}") ]
  PsErrUnsupportedExt String
unsup [String]
_
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Unsupported extension: " SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
unsup
  PsErrParseOptionsPragma String
str
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Error while parsing OPTIONS_GHC pragma."
              , String -> SDoc
text String
"Expecting whitespace-separated list of GHC options."
              , String -> SDoc
text String
"  E.g. {-# OPTIONS_GHC -Wall -O2 #-}"
              , String -> SDoc
text (String
"Input was: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
str) ]
  PsErrUnknownOptionsPragma String
flag
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Unknown flag in  {-# OPTIONS_GHC #-} pragma:" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
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 String
unsup [String]
supported
    -> if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
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
$ String -> SDoc
text String
"Perhaps you meant" SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
quotedListWithOr ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
suggestions)]
       where
         suggestions :: [String]
         suggestions :: [String]
suggestions = String -> [String] -> [String]
fuzzyMatch String
unsup [String]
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 :: SDoc -> a -> SDoc
pp_unexpected_fun_app SDoc
e a
a =
   String -> SDoc
text String
"Unexpected " SDoc -> SDoc -> SDoc
<> SDoc
e SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" in function application:"
    SDoc -> SDoc -> SDoc
$$ 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 = String -> SDoc
text String
"Parse error in pattern:"

forallSym :: Bool -> SDoc
forallSym :: Bool -> SDoc
forallSym Bool
True  = String -> SDoc
text String
"∀"
forallSym Bool
False = String -> SDoc
text String
"forall"