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

module GHC.Parser.Errors.Ppr
   ( pprWarning
   , pprError
   )
where

import GHC.Prelude
import GHC.Driver.Flags
import GHC.Parser.Errors
import GHC.Parser.Types
import GHC.Types.Basic
import GHC.Types.SrcLoc
import GHC.Types.Name.Reader (starInfo, rdrNameOcc, opIsAt, mkUnqual)
import GHC.Types.Name.Occurrence (isSymOcc, occNameFS, varName)
import GHC.Utils.Error
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Data.FastString
import GHC.Hs.Expr (prependQualified,HsExpr(..))
import GHC.Hs.Type (pprLHsContext)
import GHC.Builtin.Names (allNameStrings)
import GHC.Builtin.Types (filterCTuple)

mkParserErr :: SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserErr :: SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserErr SrcSpan
span SDoc
doc = MsgEnvelope
   { errMsgSpan :: SrcSpan
errMsgSpan        = SrcSpan
span
   , errMsgContext :: PrintUnqualified
errMsgContext     = PrintUnqualified
alwaysQualify
   , errMsgDiagnostic :: DecoratedSDoc
errMsgDiagnostic  = [SDoc] -> DecoratedSDoc
mkDecorated [SDoc
doc]
   , errMsgSeverity :: Severity
errMsgSeverity    = Severity
SevError
   , errMsgReason :: WarnReason
errMsgReason      = WarnReason
NoReason
   }

mkParserWarn :: WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn :: WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn WarningFlag
flag SrcSpan
span SDoc
doc = MsgEnvelope
   { errMsgSpan :: SrcSpan
errMsgSpan        = SrcSpan
span
   , errMsgContext :: PrintUnqualified
errMsgContext     = PrintUnqualified
alwaysQualify
   , errMsgDiagnostic :: DecoratedSDoc
errMsgDiagnostic  = [SDoc] -> DecoratedSDoc
mkDecorated [SDoc
doc]
   , errMsgSeverity :: Severity
errMsgSeverity    = Severity
SevWarning
   , errMsgReason :: WarnReason
errMsgReason      = WarningFlag -> WarnReason
Reason WarningFlag
flag
   }

pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc
pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc
pprWarning = \case
   PsWarnTab SrcSpan
loc Word
tc
      -> WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn WarningFlag
Opt_WarnTabs SrcSpan
loc (SDoc -> MsgEnvelope DecoratedSDoc)
-> SDoc -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
          String -> SDoc
text String
"Tab character found here"
            SDoc -> SDoc -> SDoc
<> (if Word
tc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
1
                then String -> SDoc
text String
""
                else String -> SDoc
text String
", and in" SDoc -> SDoc -> SDoc
<+> Int -> SDoc -> SDoc
speakNOf (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
tc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)) (String -> SDoc
text String
"further location"))
            SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"."
            SDoc -> SDoc -> SDoc
$+$ String -> SDoc
text String
"Please use spaces instead."

   PsWarnTransitionalLayout SrcSpan
loc TransLayoutReason
reason
      -> WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn WarningFlag
Opt_WarnAlternativeLayoutRuleTransitional SrcSpan
loc (SDoc -> MsgEnvelope DecoratedSDoc)
-> SDoc -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"transitional layout will not be accepted in the future:"
            SDoc -> SDoc -> SDoc
$$ String -> SDoc
text (case TransLayoutReason
reason of
               TransLayoutReason
TransLayout_Where -> String
"`where' clause at the same depth as implicit layout block"
               TransLayoutReason
TransLayout_Pipe  -> String
"`|' at the same depth as implicit layout block"
            )

   PsWarnUnrecognisedPragma SrcSpan
loc
      -> WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn WarningFlag
Opt_WarnUnrecognisedPragmas SrcSpan
loc (SDoc -> MsgEnvelope DecoratedSDoc)
-> SDoc -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"Unrecognised pragma"

   PsWarnHaddockInvalidPos SrcSpan
loc
      -> WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn WarningFlag
Opt_WarnInvalidHaddock SrcSpan
loc (SDoc -> MsgEnvelope DecoratedSDoc)
-> SDoc -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"A Haddock comment cannot appear in this position and will be ignored."

   PsWarnHaddockIgnoreMulti SrcSpan
loc
      -> WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn WarningFlag
Opt_WarnInvalidHaddock SrcSpan
loc (SDoc -> MsgEnvelope DecoratedSDoc)
-> SDoc -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"Multiple Haddock comments for a single entity are not allowed." SDoc -> SDoc -> SDoc
$$
            String -> SDoc
text String
"The extraneous comment will be ignored."

   PsWarnStarBinder SrcSpan
loc
      -> WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn WarningFlag
Opt_WarnStarBinder SrcSpan
loc (SDoc -> MsgEnvelope DecoratedSDoc)
-> SDoc -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"Found binding occurrence of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"*")
            SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"yet StarIsType is enabled."
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"NB. To use (or export) this operator in"
            SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"modules with StarIsType,"
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"    including the definition module, you must qualify it."

   PsWarnStarIsType SrcSpan
loc
      -> WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn WarningFlag
Opt_WarnStarIsType SrcSpan
loc (SDoc -> MsgEnvelope DecoratedSDoc)
-> SDoc -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
             String -> SDoc
text String
"Using" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"*")
             SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"(or its Unicode variant) to mean"
             SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"Data.Kind.Type")
          SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"relies on the StarIsType extension, which will become"
          SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"deprecated in the future."
          SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Suggested fix: use" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"Type")
           SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"from" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"Data.Kind") SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"instead."

   PsWarnImportPreQualified SrcSpan
loc
      -> WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn WarningFlag
Opt_WarnPrepositiveQualifiedModule SrcSpan
loc (SDoc -> MsgEnvelope DecoratedSDoc)
-> SDoc -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"Found" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"qualified")
             SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in prepositive position"
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Suggested fix: place " SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"qualified")
             SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"after the module name instead."
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"To allow this, enable language extension 'ImportQualifiedPost'"

   PsWarnOperatorWhitespaceExtConflict SrcSpan
loc OperatorWhitespaceSymbol
sym
      -> WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn WarningFlag
Opt_WarnOperatorWhitespaceExtConflict SrcSpan
loc (SDoc -> MsgEnvelope DecoratedSDoc)
-> SDoc -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         let mk_prefix_msg :: String -> String -> String -> SDoc
mk_prefix_msg String
operator_symbol String
extension_name String
syntax_meaning =
                  String -> SDoc
text String
"The prefix use of a" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
operator_symbol)
                    SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"would denote" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
syntax_meaning
               SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"were the" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
extension_name SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"extension enabled.")
               SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Suggested fix: add whitespace after the"
                    SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
operator_symbol) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'.'
         in
         case OperatorWhitespaceSymbol
sym of
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixPercent -> String -> String -> String -> SDoc
mk_prefix_msg String
"%" String
"LinearTypes" String
"a multiplicity annotation"
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixDollar -> String -> String -> String -> SDoc
mk_prefix_msg String
"$" String
"TemplateHaskell" String
"an untyped splice"
           OperatorWhitespaceSymbol
OperatorWhitespaceSymbol_PrefixDollarDollar -> String -> String -> String -> SDoc
mk_prefix_msg String
"$$" String
"TemplateHaskell" String
"a typed splice"


   PsWarnOperatorWhitespace SrcSpan
loc FastString
sym OperatorWhitespaceOccurrence
occ_type
      -> WarningFlag -> SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserWarn WarningFlag
Opt_WarnOperatorWhitespace SrcSpan
loc (SDoc -> MsgEnvelope DecoratedSDoc)
-> SDoc -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         let mk_msg :: String -> SDoc
mk_msg String
occ_type_str =
                  String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
occ_type_str SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"use of a" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (FastString -> SDoc
ftext FastString
sym)
                    SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"might be repurposed as special syntax"
               SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"by a future language extension.")
               SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Suggested fix: add whitespace around it."
         in
         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"

pprError :: PsError -> MsgEnvelope DecoratedSDoc
pprError :: PsError -> MsgEnvelope DecoratedSDoc
pprError PsError
err = SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
mkParserErr (PsError -> SrcSpan
errLoc PsError
err) (SDoc -> MsgEnvelope DecoratedSDoc)
-> SDoc -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat
   (PsErrorDesc -> SDoc
pp_err (PsError -> PsErrorDesc
errDesc PsError
err) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (Hint -> SDoc) -> [Hint] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Hint -> SDoc
pp_hint (PsError -> [Hint]
errHints PsError
err))

pp_err :: PsErrorDesc -> SDoc
pp_err :: PsErrorDesc -> SDoc
pp_err = \case
   PsErrorDesc
PsErrLambdaCase
      -> String -> SDoc
text String
"Illegal lambda-case (use LambdaCase)"

   PsErrNumUnderscores NumUnderscoreReason
reason
      -> String -> SDoc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ case NumUnderscoreReason
reason of
            NumUnderscoreReason
NumUnderscore_Integral -> String
"Use NumericUnderscores to allow underscores in integer literals"
            NumUnderscoreReason
NumUnderscore_Float    -> String
"Use NumericUnderscores to allow underscores in floating literals"

   PsErrorDesc
PsErrPrimStringInvalidChar
      -> String -> SDoc
text String
"primitive string literal must contain only characters <= \'\\xFF\'"

   PsErrorDesc
PsErrMissingBlock
      -> String -> SDoc
text String
"Missing block"

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


         , String -> SDoc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ case LexErrKind
kind of
            LexErrKind
LexErrKind_EOF    -> String
" at end of input"
            LexErrKind
LexErrKind_UTF8   -> String
" (UTF-8 decoding error)"
            LexErrKind_Char Char
c -> String
" at character " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c
         ]

   PsErrorDesc
PsErrSuffixAT
      -> String -> SDoc
text String
"Suffix occurrence of @. For an as-pattern, remove the leading whitespace."

   PsErrParse String
token
      | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
token
      -> String -> SDoc
text String
"parse error (possibly incorrect indentation or mismatched brackets)"

      | Bool
otherwise
      -> String -> SDoc
text String
"parse error on input" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
token)

   PsErrorDesc
PsErrCmmLexer
      -> String -> SDoc
text String
"Cmm lexical error"

   PsErrUnsupportedBoxedSumExpr SumOrTuple (HsExpr GhcPs)
s
      -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Boxed sums not supported:") Int
2
              (Boxity -> SumOrTuple (HsExpr GhcPs) -> SDoc
forall b. Outputable b => Boxity -> SumOrTuple b -> SDoc
pprSumOrTuple Boxity
Boxed SumOrTuple (HsExpr GhcPs)
s)

   PsErrUnsupportedBoxedSumPat SumOrTuple (PatBuilder GhcPs)
s
      -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Boxed sums not supported:") Int
2
              (Boxity -> SumOrTuple (PatBuilder GhcPs) -> SDoc
forall b. Outputable b => Boxity -> SumOrTuple b -> SDoc
pprSumOrTuple Boxity
Boxed SumOrTuple (PatBuilder GhcPs)
s)

   PsErrUnexpectedQualifiedConstructor RdrName
v
      -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Expected an unqualified type constructor:") Int
2
              (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
v)

   PsErrorDesc
PsErrTupleSectionInPat
      -> String -> SDoc
text String
"Tuple section in pattern context"

   PsErrIllegalBangPattern Pat GhcPs
e
      -> String -> SDoc
text String
"Illegal bang-pattern (use BangPatterns):" SDoc -> SDoc -> SDoc
$$ Pat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcPs
e

   PsErrOpFewArgs (StarIsType Bool
star_is_type) RdrName
op
      -> String -> SDoc
text String
"Operator applied to too few arguments:" SDoc -> SDoc -> SDoc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
op
         SDoc -> SDoc -> SDoc
$$ Bool -> RdrName -> SDoc
starInfo Bool
star_is_type RdrName
op

   PsErrorDesc
PsErrImportQualifiedTwice
      -> String -> SDoc
text String
"Multiple occurrences of 'qualified'"

   PsErrorDesc
PsErrImportPostQualified
      -> String -> SDoc
text String
"Found" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"qualified")
          SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in postpositive position. "
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"To allow this, enable language extension 'ImportQualifiedPost'"

   PsErrorDesc
PsErrIllegalExplicitNamespace
      -> String -> SDoc
text String
"Illegal keyword 'type' (use ExplicitNamespaces to enable)"

   PsErrVarForTyCon RdrName
name
      -> String -> SDoc
text String
"Expecting a type constructor but found a variable,"
           SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name) SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"."
         SDoc -> SDoc -> SDoc
$$ if OccName -> Bool
isSymOcc (OccName -> Bool) -> OccName -> Bool
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
name
            then String -> SDoc
text String
"If" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is a type constructor"
                  SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"then enable ExplicitNamespaces and use the 'type' keyword."
            else SDoc
empty

   PsErrorDesc
PsErrIllegalPatSynExport
      -> String -> SDoc
text String
"Illegal export form (use PatternSynonyms to enable)"

   PsErrorDesc
PsErrMalformedEntityString
      -> String -> SDoc
text String
"Malformed entity string"

   PsErrorDesc
PsErrDotsInRecordUpdate
      -> String -> SDoc
text String
"You cannot use `..' in a record update"

   PsErrPrecedenceOutOfRange Int
i
      -> String -> SDoc
text String
"Precedence out of range: " SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i

   PsErrorDesc
PsErrOverloadedRecordDotInvalid
      -> String -> SDoc
text String
"Use of OverloadedRecordDot '.' not valid ('.' isn't allowed when constructing records or in record patterns)"

   PsErrorDesc
PsErrOverloadedRecordUpdateNoQualifiedFields
      -> String -> SDoc
text String
"Fields cannot be qualified when OverloadedRecordUpdate is enabled"

   PsErrorDesc
PsErrOverloadedRecordUpdateNotEnabled
      -> String -> SDoc
text String
"OverloadedRecordUpdate needs to be enabled"

   PsErrInvalidDataCon HsType GhcPs
t
      -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Cannot parse data constructor in a data/newtype declaration:") Int
2
              (HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
t)

   PsErrInvalidInfixDataCon HsType GhcPs
lhs RdrName
tc HsType GhcPs
rhs
      -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Cannot parse an infix data constructor in a data/newtype declaration:")
            Int
2 (HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
lhs SDoc -> SDoc -> SDoc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
tc SDoc -> SDoc -> SDoc
<+> HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
rhs)

   PsErrorDesc
PsErrUnpackDataCon
      -> String -> SDoc
text String
"{-# UNPACK #-} cannot be applied to a data constructor."

   PsErrUnexpectedKindAppInDataCon DataConBuilder
lhs HsType GhcPs
ki
      -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Unexpected kind application in a data/newtype declaration:") Int
2
              (DataConBuilder -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataConBuilder
lhs SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"@" SDoc -> SDoc -> SDoc
<> HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
ki)

   PsErrInvalidRecordCon PatBuilder GhcPs
p
      -> String -> SDoc
text String
"Not a record constructor:" SDoc -> SDoc -> SDoc
<+> PatBuilder GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatBuilder GhcPs
p

   PsErrIllegalUnboxedStringInPat HsLit GhcPs
lit
      -> String -> SDoc
text String
"Illegal unboxed string literal in pattern:" SDoc -> SDoc -> SDoc
$$ HsLit GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsLit GhcPs
lit

   PsErrorDesc
PsErrDoNotationInPat
      -> String -> SDoc
text String
"do-notation in pattern"

   PsErrorDesc
PsErrIfTheElseInPat
      -> String -> SDoc
text String
"(if ... then ... else ...)-syntax in pattern"

   PsErrorDesc
PsErrLambdaCaseInPat
      -> String -> SDoc
text String
"(\\case ...)-syntax in pattern"

   PsErrorDesc
PsErrCaseInPat
      -> String -> SDoc
text String
"(case ... of ...)-syntax in pattern"

   PsErrorDesc
PsErrLetInPat
      -> String -> SDoc
text String
"(let ... in ...)-syntax in pattern"

   PsErrorDesc
PsErrLambdaInPat
      -> String -> SDoc
text String
"Lambda-syntax in pattern."
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Pattern matching on functions is not possible."

   PsErrArrowExprInPat HsExpr GhcPs
e
      -> String -> SDoc
text String
"Expression syntax in pattern:" SDoc -> SDoc -> SDoc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e

   PsErrArrowCmdInPat HsCmd GhcPs
c
      -> String -> SDoc
text String
"Command syntax in pattern:" SDoc -> SDoc -> SDoc
<+> HsCmd GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcPs
c

   PsErrArrowCmdInExpr HsCmd GhcPs
c
      -> [SDoc] -> SDoc
vcat
         [ String -> SDoc
text String
"Arrow command found where an expression was expected:"
         , Int -> SDoc -> SDoc
nest Int
2 (HsCmd GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcPs
c)
         ]

   PsErrViewPatInExpr XRec GhcPs (HsExpr GhcPs)
a XRec GhcPs (HsExpr GhcPs)
b
      -> [SDoc] -> SDoc
sep [ String -> SDoc
text String
"View pattern in expression context:"
             , Int -> SDoc -> SDoc
nest Int
4 (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
a SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"->" SDoc -> SDoc -> SDoc
<+> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
b)
             ]

   PsErrTypeAppWithoutSpace RdrName
v XRec GhcPs (HsExpr GhcPs)
e
      -> [SDoc] -> SDoc
sep [ String -> SDoc
text String
"@-pattern in expression context:"
             , Int -> SDoc -> SDoc
nest Int
4 (RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc RdrName
v SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
e)
             ]
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Type application syntax requires a space before '@'"


   PsErrLazyPatWithoutSpace XRec GhcPs (HsExpr GhcPs)
e
      -> [SDoc] -> SDoc
sep [ String -> SDoc
text String
"Lazy pattern in expression context:"
             , Int -> SDoc -> SDoc
nest Int
4 (String -> SDoc
text String
"~" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
e)
             ]
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Did you mean to add a space after the '~'?"

   PsErrBangPatWithoutSpace XRec GhcPs (HsExpr GhcPs)
e
      -> [SDoc] -> SDoc
sep [ String -> SDoc
text String
"Bang pattern in expression context:"
             , Int -> SDoc -> SDoc
nest Int
4 (String -> SDoc
text String
"!" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
e)
             ]
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Did you mean to add a space after the '!'?"

   PsErrUnallowedPragma HsPragE GhcPs
prag
      -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"A pragma is not allowed in this position:") Int
2
              (HsPragE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsPragE GhcPs
prag)

   PsErrQualifiedDoInCmd ModuleName
m
      -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Parse error in command:") Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"Found a qualified" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
".do block in a command, but"
            SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"qualified 'do' is not supported in commands."

   PsErrParseErrorInCmd SDoc
s
      -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Parse error in command:") Int
2 SDoc
s

   PsErrParseErrorInPat SDoc
s
      -> String -> SDoc
text String
"Parse error in pattern:" SDoc -> SDoc -> SDoc
<+> SDoc
s


   PsErrorDesc
PsErrInvalidInfixHole
      -> String -> SDoc
text String
"Invalid infix hole, expected an infix operator"

   PsErrSemiColonsInCondExpr HsExpr GhcPs
c Bool
st HsExpr GhcPs
t Bool
se HsExpr GhcPs
e
      -> String -> SDoc
text String
"Unexpected semi-colons in conditional:"
         SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
4 SDoc
expr
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Perhaps you meant to use DoAndIfThenElse?"
         where
            pprOptSemi :: Bool -> SDoc
pprOptSemi Bool
True  = SDoc
semi
            pprOptSemi Bool
False = SDoc
empty
            expr :: SDoc
expr = String -> SDoc
text String
"if"   SDoc -> SDoc -> SDoc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
c SDoc -> SDoc -> SDoc
<> Bool -> SDoc
pprOptSemi Bool
st SDoc -> SDoc -> SDoc
<+>
                   String -> SDoc
text String
"then" SDoc -> SDoc -> SDoc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
t SDoc -> SDoc -> SDoc
<> Bool -> SDoc
pprOptSemi Bool
se SDoc -> SDoc -> SDoc
<+>
                   String -> SDoc
text String
"else" SDoc -> SDoc -> SDoc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e

   PsErrSemiColonsInCondCmd HsExpr GhcPs
c Bool
st HsCmd GhcPs
t Bool
se HsCmd GhcPs
e
      -> String -> SDoc
text String
"Unexpected semi-colons in conditional:"
         SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
4 SDoc
expr
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Perhaps you meant to use DoAndIfThenElse?"
         where
            pprOptSemi :: Bool -> SDoc
pprOptSemi Bool
True  = SDoc
semi
            pprOptSemi Bool
False = SDoc
empty
            expr :: SDoc
expr = String -> SDoc
text String
"if"   SDoc -> SDoc -> SDoc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
c SDoc -> SDoc -> SDoc
<> Bool -> SDoc
pprOptSemi Bool
st SDoc -> SDoc -> SDoc
<+>
                   String -> SDoc
text String
"then" SDoc -> SDoc -> SDoc
<+> HsCmd GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcPs
t SDoc -> SDoc -> SDoc
<> Bool -> SDoc
pprOptSemi Bool
se SDoc -> SDoc -> SDoc
<+>
                   String -> SDoc
text String
"else" SDoc -> SDoc -> SDoc
<+> HsCmd GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcPs
e


   PsErrorDesc
PsErrAtInPatPos
      -> String -> SDoc
text String
"Found a binding for the"
         SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"@")
         SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"operator in a pattern position."
         SDoc -> SDoc -> SDoc
$$ SDoc
perhaps_as_pat

   PsErrLambdaCmdInFunAppCmd LHsCmd GhcPs
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (String -> SDoc
text String
"lambda command") GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
a

   PsErrCaseCmdInFunAppCmd LHsCmd GhcPs
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (String -> SDoc
text String
"case command") GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
a

   PsErrIfCmdInFunAppCmd LHsCmd GhcPs
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (String -> SDoc
text String
"if command") GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
a

   PsErrLetCmdInFunAppCmd LHsCmd GhcPs
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (String -> SDoc
text String
"let command") GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
a

   PsErrDoCmdInFunAppCmd LHsCmd GhcPs
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsCmd GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (String -> SDoc
text String
"do command") GenLocated SrcSpanAnnA (HsCmd GhcPs)
LHsCmd GhcPs
a

   PsErrDoInFunAppExpr Maybe ModuleName
m XRec GhcPs (HsExpr GhcPs)
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (Maybe ModuleName -> SDoc -> SDoc
prependQualified Maybe ModuleName
m (String -> SDoc
text String
"do block")) GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
a

   PsErrMDoInFunAppExpr Maybe ModuleName
m XRec GhcPs (HsExpr GhcPs)
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (Maybe ModuleName -> SDoc -> SDoc
prependQualified Maybe ModuleName
m (String -> SDoc
text String
"mdo block")) GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
a

   PsErrLambdaInFunAppExpr XRec GhcPs (HsExpr GhcPs)
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (String -> SDoc
text String
"lambda expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
a

   PsErrCaseInFunAppExpr XRec GhcPs (HsExpr GhcPs)
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (String -> SDoc
text String
"case expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
a

   PsErrLambdaCaseInFunAppExpr XRec GhcPs (HsExpr GhcPs)
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (String -> SDoc
text String
"lambda-case expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
a

   PsErrLetInFunAppExpr XRec GhcPs (HsExpr GhcPs)
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (String -> SDoc
text String
"let expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
a

   PsErrIfInFunAppExpr XRec GhcPs (HsExpr GhcPs)
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (String -> SDoc
text String
"if expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
a

   PsErrProcInFunAppExpr XRec GhcPs (HsExpr GhcPs)
a
      -> SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => SDoc -> a -> SDoc
pp_unexpected_fun_app (String -> SDoc
text String
"proc expression") GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
a

   PsErrMalformedTyOrClDecl LHsType GhcPs
ty
      -> String -> SDoc
text String
"Malformed head of type or class declaration:"
         SDoc -> SDoc -> SDoc
<+> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ty

   PsErrorDesc
PsErrIllegalWhereInDataDecl
      -> [SDoc] -> SDoc
vcat
            [ String -> SDoc
text String
"Illegal keyword 'where' in data declaration"
            , String -> SDoc
text String
"Perhaps you intended to use GADTs or a similar language"
            , String -> SDoc
text String
"extension to enable syntax: data T where"
            ]

   PsErrIllegalTraditionalRecordSyntax SDoc
s
      -> String -> SDoc
text String
"Illegal record syntax (use TraditionalRecordSyntax):"
         SDoc -> SDoc -> SDoc
<+> SDoc
s

   PsErrParseErrorOnInput OccName
occ
      -> String -> SDoc
text String
"parse error on input" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
ftext (OccName -> FastString
occNameFS OccName
occ)

   PsErrIllegalDataTypeContext LHsContext GhcPs
c
      -> String -> SDoc
text String
"Illegal datatype context (use DatatypeContexts):"
         SDoc -> SDoc -> SDoc
<+> Maybe (LHsContext GhcPs) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
Maybe (LHsContext (GhcPass p)) -> SDoc
pprLHsContext (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
LHsContext GhcPs
c)

   PsErrMalformedDecl SDoc
what RdrName
for
      -> String -> SDoc
text String
"Malformed" SDoc -> SDoc -> SDoc
<+> SDoc
what
         SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
for)

   PsErrUnexpectedTypeAppInDecl LHsType GhcPs
ki SDoc
what RdrName
for
      -> [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Unexpected type application"
                SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"@" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
ki
              , String -> SDoc
text String
"In the" SDoc -> SDoc -> SDoc
<+> SDoc
what
                SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"declaration for"
                SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
for)
              ]

   PsErrNotADataCon RdrName
name
      -> String -> SDoc
text String
"Not a data constructor:" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name)

   PsErrRecordSyntaxInPatSynDecl LPat GhcPs
pat
      -> String -> SDoc
text String
"record syntax not supported for pattern synonym declarations:"
         SDoc -> SDoc -> SDoc
$$ GenLocated SrcSpanAnnA (Pat GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (Pat GhcPs)
LPat GhcPs
pat

   PsErrEmptyWhereInPatSynDecl RdrName
patsyn_name
      -> String -> SDoc
text String
"pattern synonym 'where' clause cannot be empty"
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"In the pattern synonym declaration for: "
            SDoc -> SDoc -> SDoc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RdrName
patsyn_name)

   PsErrInvalidWhereBindInPatSynDecl RdrName
patsyn_name HsDecl GhcPs
decl
      -> String -> SDoc
text String
"pattern synonym 'where' clause must bind the pattern synonym's name"
         SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
patsyn_name) SDoc -> SDoc -> SDoc
$$ HsDecl GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsDecl GhcPs
decl

   PsErrNoSingleWhereBindInPatSynDecl RdrName
_patsyn_name HsDecl GhcPs
decl
      -> String -> SDoc
text String
"pattern synonym 'where' clause must contain a single binding:"
         SDoc -> SDoc -> SDoc
$$ HsDecl GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsDecl GhcPs
decl

   PsErrDeclSpliceNotAtTopLevel SpliceDecl GhcPs
d
      -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Declaration splices are allowed only"
               SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"at the top level:")
           Int
2 (SpliceDecl GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr SpliceDecl GhcPs
d)

   PsErrorDesc
PsErrInferredTypeVarNotAllowed
      -> String -> SDoc
text String
"Inferred type variables are not allowed here"

   PsErrIllegalRoleName FastString
role [Role]
nearby
      -> String -> SDoc
text String
"Illegal role name" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
role)
         SDoc -> SDoc -> SDoc
$$ case [Role]
nearby of
             []  -> SDoc
empty
             [Role
r] -> String -> SDoc
text String
"Perhaps you meant" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
r)
             -- will this last case ever happen??
             [Role]
_   -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Perhaps you meant one of these:")
                         Int
2 ((Role -> SDoc) -> [Role] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas (SDoc -> SDoc
quotes (SDoc -> SDoc) -> (Role -> SDoc) -> Role -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [Role]
nearby)

   PsErrMultipleNamesInStandaloneKindSignature [XRec GhcPs (IdP GhcPs)]
vs
      -> [SDoc] -> SDoc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Standalone kind signatures do not support multiple names at the moment:")
                Int
2 ((GenLocated SrcSpanAnnN RdrName -> SDoc)
-> [GenLocated SrcSpanAnnN RdrName] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas GenLocated SrcSpanAnnN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnN RdrName]
[XRec GhcPs (IdP GhcPs)]
vs)
              , String -> SDoc
text String
"See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details."
              ]

   PsErrorDesc
PsErrIllegalImportBundleForm
      -> String -> SDoc
text String
"Illegal import form, this syntax can only be used to bundle"
         SDoc -> SDoc -> SDoc
$+$ String -> SDoc
text String
"pattern synonyms with types in module exports."

   PsErrInvalidTypeSignature XRec GhcPs (HsExpr GhcPs)
lhs
      -> String -> SDoc
text String
"Invalid type signature:"
         SDoc -> SDoc -> SDoc
<+> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
lhs
         SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
":: ..."
         SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
hint
         where
         hint :: String
hint | RdrName
IdP GhcPs
foreign_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall {p} {l} {l}.
(XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p), Eq (IdP p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
lhs
              = String
"Perhaps you meant to use ForeignFunctionInterface?"
              | RdrName
IdP GhcPs
default_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall {p} {l} {l}.
(XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p), Eq (IdP p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
lhs
              = String
"Perhaps you meant to use DefaultSignatures?"
              | RdrName
IdP GhcPs
pattern_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall {p} {l} {l}.
(XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p), Eq (IdP p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` GenLocated SrcSpanAnnA (HsExpr GhcPs)
XRec GhcPs (HsExpr GhcPs)
lhs
              = String
"Perhaps you meant to use PatternSynonyms?"
              | Bool
otherwise
              = String
"Should be of form <variable> :: <type>"

         -- 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 GhcPs -> Bool -- AZ
         looks_like :: IdP p -> GenLocated l (HsExpr p) -> Bool
looks_like IdP p
s (L l
_ (HsVar XVar p
_ (L l
_ IdP p
v))) = IdP p
v IdP p -> IdP p -> Bool
forall a. Eq a => a -> a -> Bool
== IdP p
s
         looks_like IdP p
s (L l
_ (HsApp XApp p
_ XRec p (HsExpr p)
lhs XRec p (HsExpr p)
_))   = IdP p -> GenLocated l (HsExpr p) -> Bool
looks_like IdP p
s GenLocated l (HsExpr p)
XRec p (HsExpr p)
lhs
         looks_like IdP p
_ GenLocated l (HsExpr p)
_                       = Bool
False

         foreign_RDR :: RdrName
foreign_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"foreign")
         default_RDR :: RdrName
default_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"default")
         pattern_RDR :: RdrName
pattern_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"pattern")

   PsErrUnexpectedTypeInDecl LHsType GhcPs
t SDoc
what RdrName
tc [LHsTypeArg GhcPs]
tparms SDoc
equals_or_where
      -> [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Unexpected type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsType GhcPs)
LHsType GhcPs
t)
              , String -> SDoc
text String
"In the" SDoc -> SDoc -> SDoc
<+> SDoc
what
                SDoc -> SDoc -> SDoc
<+> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"declaration for") SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
tc'
              , [SDoc] -> SDoc
vcat[ (String -> SDoc
text String
"A" SDoc -> SDoc -> SDoc
<+> SDoc
what
                       SDoc -> SDoc -> SDoc
<+> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"declaration should have form"))
              , Int -> SDoc -> SDoc
nest Int
2
                (SDoc
what
                 SDoc -> SDoc -> SDoc
<+> SDoc
tc'
                 SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text ([HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [String] -> [String]
forall b a. [b] -> [a] -> [a]
takeList [HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
[LHsTypeArg GhcPs]
tparms [String]
allNameStrings))
                 SDoc -> SDoc -> SDoc
<+> SDoc
equals_or_where) ] ]
          where
            -- Avoid printing a constraint tuple in the error message. Print
            -- a plain old tuple instead (since that's what the user probably
            -- wrote). See #14907
            tc' :: SDoc
tc' = RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RdrName -> SDoc) -> RdrName -> SDoc
forall a b. (a -> b) -> a -> b
$ RdrName -> RdrName
filterCTuple RdrName
tc

   PsErrCmmParser CmmParserError
cmm_err -> case CmmParserError
cmm_err of
      CmmUnknownPrimitive FastString
name     -> String -> SDoc
text String
"unknown primitive" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
ftext FastString
name
      CmmUnknownMacro FastString
fun          -> String -> SDoc
text String
"unknown macro" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
ftext FastString
fun
      CmmUnknownCConv String
cconv        -> String -> SDoc
text String
"unknown calling convention:" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
cconv
      CmmUnrecognisedSafety String
safety -> String -> SDoc
text String
"unrecognised safety" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
safety
      CmmUnrecognisedHint String
hint     -> String -> SDoc
text String
"unrecognised hint:" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
hint

   PsErrorDesc
PsErrExpectedHyphen
      -> String -> SDoc
text String
"Expected a hyphen"

   PsErrorDesc
PsErrSpaceInSCC
      -> String -> SDoc
text String
"Spaces are not allowed in SCCs"

   PsErrEmptyDoubleQuotes Bool
th_on
      -> if Bool
th_on then [SDoc] -> SDoc
vcat ([SDoc]
msg [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
th_msg) else [SDoc] -> SDoc
vcat [SDoc]
msg
         where
            msg :: [SDoc]
msg    = [ String -> SDoc
text String
"Parser error on `''`"
                     , String -> SDoc
text String
"Character literals may not be empty"
                     ]
            th_msg :: [SDoc]
th_msg = [ String -> SDoc
text String
"Or perhaps you intended to use quotation syntax of TemplateHaskell,"
                     , String -> SDoc
text String
"but the type variable or constructor is missing"
                     ]

   PsErrInvalidPackageName FastString
pkg
      -> [SDoc] -> SDoc
vcat
            [ String -> SDoc
text String
"Parse error" SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (FastString -> SDoc
ftext FastString
pkg)
            , String -> SDoc
text String
"Version number or non-alphanumeric" SDoc -> SDoc -> SDoc
<+>
              String -> SDoc
text String
"character in package name"
            ]

   PsErrorDesc
PsErrInvalidRuleActivationMarker
      -> String -> SDoc
text String
"Invalid rule activation marker"

   PsErrorDesc
PsErrLinearFunction
      -> String -> SDoc
text String
"Enable LinearTypes to allow linear functions"

   PsErrorDesc
PsErrMultiWayIf
      -> String -> SDoc
text String
"Multi-way if-expressions need MultiWayIf turned on"

   PsErrExplicitForall Bool
is_unicode
      -> [SDoc] -> SDoc
vcat
         [ String -> SDoc
text String
"Illegal symbol" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Bool -> SDoc
forallSym Bool
is_unicode) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in type"
         , String -> SDoc
text String
"Perhaps you intended to use RankNTypes or a similar language"
         , String -> SDoc
text String
"extension to enable explicit-forall syntax:" SDoc -> SDoc -> SDoc
<+>
           Bool -> SDoc
forallSym Bool
is_unicode SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"<tvs>. <type>"
         ]
         where
          forallSym :: Bool -> SDoc
forallSym Bool
True  = String -> SDoc
text String
"∀"
          forallSym Bool
False = String -> SDoc
text String
"forall"

   PsErrIllegalQualifiedDo SDoc
qdoDoc
      -> [SDoc] -> SDoc
vcat
         [ String -> SDoc
text String
"Illegal qualified" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
qdoDoc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"block"
         , String -> SDoc
text String
"Perhaps you intended to use QualifiedDo"
         ]

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 =
   String -> SDoc
text String
"Unexpected " SDoc -> SDoc -> SDoc
<> SDoc
e SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" in function application:"
    SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
4 (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a)
    SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"You could write it with parentheses"
    SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Or perhaps you meant to enable BlockArguments?"

pp_hint :: Hint -> SDoc
pp_hint :: Hint -> SDoc
pp_hint = \case
   Hint
SuggestTH              -> String -> SDoc
text String
"Perhaps you intended to use TemplateHaskell"
   Hint
SuggestDo              -> String -> SDoc
text String
"Perhaps this statement should be within a 'do' block?"
   Hint
SuggestMissingDo       -> String -> SDoc
text String
"Possibly caused by a missing 'do'?"
   Hint
SuggestRecursiveDo     -> String -> SDoc
text String
"Perhaps you intended to use RecursiveDo"
   Hint
SuggestLetInDo         -> String -> SDoc
text String
"Perhaps you need a 'let' in a 'do' block?"
                             SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"e.g. 'let x = 5' instead of 'x = 5'"
   Hint
SuggestPatternSynonyms -> String -> SDoc
text String
"Perhaps you intended to use PatternSynonyms"

   SuggestInfixBindMaybeAtPat RdrName
fun
      -> String -> SDoc
text String
"In a function binding for the"
            SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
fun)
            SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"operator."
         SDoc -> SDoc -> SDoc
$$ if RdrName -> Bool
opIsAt RdrName
fun
               then SDoc
perhaps_as_pat
               else SDoc
empty
   Hint
TypeApplicationsInPatternsOnlyDataCons ->
     String -> SDoc
text String
"Type applications in patterns are only allowed on data constructors."

perhaps_as_pat :: SDoc
perhaps_as_pat :: SDoc
perhaps_as_pat = String -> SDoc
text String
"Perhaps you meant an as-pattern, which must not be surrounded by whitespace"