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

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


instance Diagnostic PsMessage where
  type DiagnosticOpts PsMessage = NoDiagnosticOpts
  defaultDiagnosticOpts :: DiagnosticOpts PsMessage
defaultDiagnosticOpts = NoDiagnosticOpts
NoDiagnosticOpts
  diagnosticMessage :: DiagnosticOpts PsMessage -> PsMessage -> DecoratedSDoc
diagnosticMessage DiagnosticOpts PsMessage
_ = \case
    PsUnknownMessage (UnknownDiagnostic @e a
m)
      -> forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (forall a. Diagnostic a => DiagnosticOpts a
defaultDiagnosticOpts @e) a
m

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

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

    PsWarnTab Word
tc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Tab character found here"
             forall doc. IsLine doc => doc -> doc -> doc
<> (if Word
tc forall a. Eq a => a -> a -> Bool
== Word
1
                 then forall doc. IsLine doc => String -> doc
text String
""
                 else forall doc. IsLine doc => String -> doc
text String
", and in" forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc -> SDoc
speakNOf (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
tc forall a. Num a => a -> a -> a
- Word
1)) (forall doc. IsLine doc => String -> doc
text String
"further location"))
             forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"."
    PsWarnTransitionalLayout TransLayoutReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
            forall doc. IsLine doc => String -> doc
text String
"transitional layout will not be accepted in the future:"
            forall doc. IsDoc doc => doc -> doc -> doc
$$ (case TransLayoutReason
reason of
               TransLayoutReason
TransLayout_Where -> forall doc. IsLine doc => String -> doc
text String
"`where' clause at the same depth as implicit layout block"
               TransLayoutReason
TransLayout_Pipe  -> forall doc. IsLine doc => String -> doc
text String
"`|' 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 =
                  forall doc. IsLine doc => String -> doc
text String
"The prefix use of a" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OperatorWhitespaceSymbol -> SDoc
pprOperatorWhitespaceSymbol OperatorWhitespaceSymbol
sym)
                    forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"would denote" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
syntax_meaning
               forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsLine doc => String -> doc
text String
"were the" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
extension_name forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"extension enabled.")
         in SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         case OperatorWhitespaceSymbol
sym of
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixPercent -> SDoc -> SDoc -> SDoc
mk_prefix_msg (forall doc. IsLine doc => String -> doc
text String
"LinearTypes") (forall doc. IsLine doc => String -> doc
text String
"a multiplicity annotation")
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixDollar -> SDoc -> SDoc -> SDoc
mk_prefix_msg (forall doc. IsLine doc => String -> doc
text String
"TemplateHaskell") (forall doc. IsLine doc => String -> doc
text String
"an untyped splice")
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixDollarDollar -> SDoc -> SDoc -> SDoc
mk_prefix_msg (forall doc. IsLine doc => String -> doc
text String
"TemplateHaskell") (forall doc. IsLine doc => String -> doc
text String
"a typed splice")
    PsWarnOperatorWhitespace FastString
sym OperatorWhitespaceOccurrence
occ_type
      -> let mk_msg :: String -> SDoc
mk_msg String
occ_type_str =
                  forall doc. IsLine doc => String -> doc
text String
"The" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
occ_type_str forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"use of a" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => FastString -> doc
ftext FastString
sym)
                    forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"might be repurposed as special syntax"
               forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsLine doc => String -> doc
text String
"by a future language extension.")
         in SDoc -> DecoratedSDoc
mkSimpleDecorated 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 forall a b. (a -> b) -> a -> b
$
            forall doc. IsLine doc => String -> doc
text String
"Found binding occurrence of" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"*")
            forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"yet StarIsType is enabled."
    PsMessage
PsWarnStarIsType
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
             forall doc. IsLine doc => String -> doc
text String
"Using" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"*")
             forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"(or its Unicode variant) to mean"
             forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"Data.Kind.Type")
          forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"relies on the StarIsType extension, which will become"
          forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"deprecated in the future."
    PsWarnUnrecognisedPragma String
prag [String]
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"Unrecognised pragma"
                          forall doc. IsLine doc => doc -> doc -> doc
<> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
prag then forall doc. IsOutput doc => doc
empty else forall doc. IsLine doc => String -> doc
text String
":" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
prag
    PsWarnMisplacedPragma FileHeaderPragmaType
prag
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"Misplaced" forall doc. IsLine doc => doc -> doc -> doc
<+> FileHeaderPragmaType -> SDoc
pprFileHeaderPragmaType FileHeaderPragmaType
prag forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"pragma"
    PsMessage
PsWarnImportPreQualified
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
            forall doc. IsLine doc => String -> doc
text String
"Found" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"qualified")
             forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"in prepositive position"

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

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

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

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

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

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

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

    PsErrUnicodeCharLooksLike Char
bad_char Char
looks_like_char String
looks_like_char_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => [doc] -> doc
hsep [ forall doc. IsLine doc => String -> doc
text String
"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
                , forall doc. IsLine doc => String -> doc
text String
"'" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text [Char
bad_char] forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"' (" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text (forall a. Show a => a -> String
show Char
bad_char) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
")"
                , forall doc. IsLine doc => String -> doc
text String
"looks like"
                , forall doc. IsLine doc => String -> doc
text String
"'" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text [Char
looks_like_char] forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"' (" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
looks_like_char_name forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
")" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
                , forall doc. IsLine doc => String -> doc
text String
"but it is not" ]

  diagnosticReason :: PsMessage -> DiagnosticReason
diagnosticReason = \case
    PsUnknownMessage UnknownDiagnostic
m                            -> forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason UnknownDiagnostic
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
    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
    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
    PsErrLambdaCaseCmdInFunAppCmd{}               -> 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
    PsErrMultipleConForNewtype {}                 -> DiagnosticReason
ErrorWithoutFlag
    PsErrUnicodeCharLooksLike{}                   -> DiagnosticReason
ErrorWithoutFlag

  diagnosticHints :: PsMessage -> [GhcHint]
diagnosticHints = \case
    PsUnknownMessage UnknownDiagnostic
m                            -> forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints UnknownDiagnostic
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 forall a. Maybe a
Nothing]
    PsWarnUnrecognisedPragma String
""  [String]
_                -> [GhcHint]
noHints
    PsWarnUnrecognisedPragma String
p   [String]
avail            ->
      let suggestions :: [String]
suggestions = String -> [String] -> [String]
fuzzyMatch String
p [String]
avail
       in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
suggestions
          then [GhcHint]
noHints
          else [[String] -> GhcHint
SuggestCorrectPragmaName [String]
suggestions]
    PsWarnMisplacedPragma{}                       -> [GhcHint
SuggestPlacePragmaInHeader]
    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 = forall doc. IsLine doc => String -> doc
text String
"or a similar language extension to enable explicit-forall syntax:" forall doc. IsLine doc => doc -> doc -> doc
<+>
                 Bool -> SDoc
forallSym Bool
is_unicode forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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
    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
    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
    PsErrLambdaCaseCmdInFunAppCmd{}               -> [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 (forall doc. IsLine doc => String -> doc
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
       | forall (t :: * -> *) a. Foldable t => t a -> Int
length [LPat GhcPs]
args forall a. Eq a => a -> a -> Bool
/= Int
0 -> forall a. [Maybe a] -> [a]
catMaybes [Maybe GhcHint
sug_recdo, ParseContext -> Maybe GhcHint
sug_missingdo ParseContext
ctx]
       | Bool
otherwise        -> forall a. [Maybe a] -> [a]
catMaybes [ParseContext -> Maybe GhcHint
sug_missingdo ParseContext
ctx]
      PEIP_OtherPatDetails ParseContext
ctx -> forall a. [Maybe a] -> [a]
catMaybes [ParseContext -> Maybe GhcHint
sug_missingdo ParseContext
ctx]
      PsErrInPatDetails
_                        -> []
      where
        sug_recdo :: Maybe GhcHint
sug_recdo                                           = forall a. a -> Maybe a
Just (Extension -> GhcHint
suggestExtension Extension
LangExt.RecursiveDo)
        sug_missingdo :: ParseContext -> Maybe GhcHint
sug_missingdo (ParseContext Maybe RdrName
_ PatIncompleteDoBlock
YesIncompleteDoBlock) = forall a. a -> Maybe a
Just GhcHint
SuggestMissingDo
        sug_missingdo ParseContext
_                                     = forall a. Maybe a
Nothing
    PsErrParseRightOpSectionInPat{}               -> [GhcHint]
noHints
    PsErrIllegalRoleName FastString
_ [Role]
nearby                 -> [[Role] -> GhcHint
SuggestRoles [Role]
nearby]
    PsErrInvalidTypeSignature LHsExpr GhcPs
lhs                 ->
        if | RdrName
foreign_RDR 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
lhs
           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ForeignFunctionInterface]
           | RdrName
default_RDR 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
lhs
           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DefaultSignatures]
           | RdrName
pattern_RDR 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
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 l
_ IdP p
v))) = IdP p
v 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)
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
    PsErrMultipleConForNewtype {}                 -> [GhcHint]
noHints
    PsErrUnicodeCharLooksLike{}                   -> [GhcHint]
noHints

  diagnosticCode :: PsMessage -> Maybe DiagnosticCode
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 forall a b. (a -> b) -> a -> b
$
         forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Cannot parse LANGUAGE pragma"
              , forall doc. IsLine doc => String -> doc
text String
"Expecting comma-separated list of language options,"
              , forall doc. IsLine doc => String -> doc
text String
"each starting with a capital letter"
              , Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsLine doc => String -> doc
text String
"E.g. {-# LANGUAGE TemplateHaskell, GADTs #-}") ]
  PsErrUnsupportedExt String
unsup [String]
_
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"Unsupported extension: " forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
unsup
  PsErrParseOptionsPragma String
str
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Error while parsing OPTIONS_GHC pragma."
              , forall doc. IsLine doc => String -> doc
text String
"Expecting whitespace-separated list of GHC options."
              , forall doc. IsLine doc => String -> doc
text String
"  E.g. {-# OPTIONS_GHC -Wall -O2 #-}"
              , forall doc. IsLine doc => String -> doc
text (String
"Input was: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
str) ]
  PsErrUnknownOptionsPragma String
flag
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"Unknown flag in  {-# OPTIONS_GHC #-} pragma:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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 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 [forall a. (Outputable a, Typeable a) => a -> GhcHint
UnknownHint forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"Perhaps you meant" forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
quotedListWithOr (forall a b. (a -> b) -> [a] -> [b]
map forall doc. IsLine doc => String -> doc
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 :: forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app SDoc
e a
a =
   forall doc. IsLine doc => String -> doc
text String
"Unexpected " forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
e forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" in function application:"
    forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
4 (forall a. Outputable a => a -> SDoc
ppr a
a)

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

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

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