{-# 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
import GHC.Types.Name.Reader ( opIsAt, rdrNameOcc, mkUnqual )
import GHC.Types.Name.Occurrence (isSymOcc, occNameFS, varName)
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Data.FastString
import GHC.Data.Maybe (catMaybes)
import GHC.Hs.Expr (prependQualified, HsExpr(..), HsLamVariant(..), lamCaseKeyword)
import GHC.Hs.Type (pprLHsContext)
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
  diagnosticMessage :: DiagnosticOpts PsMessage -> PsMessage -> DecoratedSDoc
diagnosticMessage DiagnosticOpts PsMessage
opts = \case
    PsUnknownMessage (UnknownDiagnostic DiagnosticOpts PsMessage -> DiagnosticOpts a
f a
m)
      -> DiagnosticOpts a -> a -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (DiagnosticOpts PsMessage -> DiagnosticOpts a
f DiagnosticOpts PsMessage
opts) a
m

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  diagnosticHints :: PsMessage -> [GhcHint]
diagnosticHints = \case
    PsUnknownMessage UnknownDiagnostic (DiagnosticOpts PsMessage)
m                            -> UnknownDiagnostic NoDiagnosticOpts -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints UnknownDiagnostic NoDiagnosticOpts
UnknownDiagnostic (DiagnosticOpts PsMessage)
m
    PsHeaderMessage  PsHeaderMessage
m                            -> PsHeaderMessage -> [GhcHint]
psHeaderMessageHints PsHeaderMessage
m
    PsWarnBidirectionalFormatChars{}              -> [GhcHint]
noHints
    PsWarnTab{}                                   -> [GhcHint
SuggestUseSpaces]
    PsWarnTransitionalLayout{}                    -> [GhcHint]
noHints
    PsWarnOperatorWhitespaceExtConflict OperatorWhitespaceSymbol
sym       -> [OperatorWhitespaceSymbol -> GhcHint
SuggestUseWhitespaceAfter OperatorWhitespaceSymbol
sym]
    PsWarnOperatorWhitespace FastString
sym OperatorWhitespaceOccurrence
occ              -> [String -> OperatorWhitespaceOccurrence -> GhcHint
SuggestUseWhitespaceAround (FastString -> String
unpackFS FastString
sym) OperatorWhitespaceOccurrence
occ]
    PsMessage
PsWarnHaddockInvalidPos                       -> [GhcHint]
noHints
    PsMessage
PsWarnHaddockIgnoreMulti                      -> [GhcHint]
noHints
    PsMessage
PsWarnStarBinder                              -> [GhcHint
SuggestQualifyStarOperator]
    PsMessage
PsWarnStarIsType                              -> [Maybe RdrName -> GhcHint
SuggestUseTypeFromDataKind Maybe RdrName
forall a. Maybe a
Nothing]
    PsWarnUnrecognisedPragma String
""  [String]
_                -> [GhcHint]
noHints
    PsWarnUnrecognisedPragma String
p   [String]
avail            ->
      let suggestions :: [String]
suggestions = String -> [String] -> [String]
fuzzyMatch String
p [String]
avail
       in if [String] -> Bool
forall a. [a] -> Bool
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_th_enabled :: Bool
ped_do_in_last_100 :: Bool
ped_mdo_in_last_100 :: Bool
ped_pat_syn_enabled :: Bool
ped_pattern_parsed :: Bool
ped_pattern_parsed :: PsErrParseDetails -> Bool
ped_pat_syn_enabled :: PsErrParseDetails -> Bool
ped_mdo_in_last_100 :: PsErrParseDetails -> Bool
ped_do_in_last_100 :: PsErrParseDetails -> Bool
ped_th_enabled :: PsErrParseDetails -> Bool
..}        -> case String
token of
      String
""                         -> []
      String
"$"  | Bool -> Bool
not Bool
ped_th_enabled  -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TemplateHaskell]   -- #7396
      String
"$$" | Bool -> Bool
not Bool
ped_th_enabled  -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TemplateHaskell]   -- #20157
      String
"<-" | Bool
ped_mdo_in_last_100 -> [Extension -> GhcHint
suggestExtension Extension
LangExt.RecursiveDo]
           | Bool
otherwise           -> [GhcHint
SuggestMissingDo]
      String
"="  | Bool
ped_do_in_last_100  -> [GhcHint
SuggestLetInDo]                             -- #15849
      String
_    | Bool -> Bool
not Bool
ped_pat_syn_enabled
           , Bool
ped_pattern_parsed  -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PatternSynonyms]   -- #12429
           | Bool
otherwise           -> []
    PsErrTypeAppWithoutSpace{}                    -> [GhcHint]
noHints
    PsErrLazyPatWithoutSpace{}                    -> [GhcHint]
noHints
    PsErrBangPatWithoutSpace{}                    -> [GhcHint]
noHints
    PsMessage
PsErrInvalidInfixHole                         -> [GhcHint]
noHints
    PsMessage
PsErrExpectedHyphen                           -> [GhcHint]
noHints
    PsMessage
PsErrSpaceInSCC                               -> [GhcHint]
noHints
    PsErrEmptyDoubleQuotes Bool
th_on | Bool
th_on          -> [GhcHint
SuggestThQuotationSyntax]
                                 | Bool
otherwise      -> [GhcHint]
noHints
    PsErrLambdaCase{}                             -> [Extension -> GhcHint
suggestExtension Extension
LangExt.LambdaCase]
    PsErrEmptyLambda{}                            -> [GhcHint]
noHints
    PsErrLinearFunction{}                         -> [Extension -> GhcHint
suggestExtension Extension
LangExt.LinearTypes]
    PsErrMultiWayIf{}                             -> [Extension -> GhcHint
suggestExtension Extension
LangExt.MultiWayIf]
    PsErrOverloadedRecordUpdateNotEnabled{}       -> [Extension -> GhcHint
suggestExtension Extension
LangExt.OverloadedRecordUpdate]
    PsErrNumUnderscores{}                         -> [Extension -> GhcHint
suggestExtension Extension
LangExt.NumericUnderscores]
    PsErrIllegalBangPattern{}                     -> [Extension -> GhcHint
suggestExtension Extension
LangExt.BangPatterns]
    PsErrOverloadedRecordDotInvalid{}             -> [GhcHint]
noHints
    PsMessage
PsErrIllegalPatSynExport                      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PatternSynonyms]
    PsMessage
PsErrOverloadedRecordUpdateNoQualifiedFields  -> [GhcHint]
noHints
    PsErrExplicitForall Bool
is_unicode                ->
      let info :: SDoc
info = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or a similar language extension to enable explicit-forall syntax:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                 Bool -> SDoc
forallSym Bool
is_unicode SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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
    PsMessage
PsErrCaseInPat                                -> [GhcHint]
noHints
    PsMessage
PsErrLetInPat                                 -> [GhcHint]
noHints
    PsErrLambdaInPat{}                            -> [GhcHint]
noHints
    PsErrArrowExprInPat{}                         -> [GhcHint]
noHints
    PsErrArrowCmdInPat{}                          -> [GhcHint]
noHints
    PsErrArrowCmdInExpr{}                         -> [GhcHint]
noHints
    PsErrViewPatInExpr{}                          -> [GhcHint]
noHints
    PsErrLambdaCmdInFunAppCmd{}                   -> [GhcHint]
suggestParensAndBlockArgs
    PsErrCaseCmdInFunAppCmd{}                     -> [GhcHint]
suggestParensAndBlockArgs
    PsErrIfCmdInFunAppCmd{}                       -> [GhcHint]
suggestParensAndBlockArgs
    PsErrLetCmdInFunAppCmd{}                      -> [GhcHint]
suggestParensAndBlockArgs
    PsErrDoCmdInFunAppCmd{}                       -> [GhcHint]
suggestParensAndBlockArgs
    PsErrDoInFunAppExpr{}                         -> [GhcHint]
suggestParensAndBlockArgs
    PsErrMDoInFunAppExpr{}                        -> [GhcHint]
suggestParensAndBlockArgs
    PsErrLambdaInFunAppExpr{}                     -> [GhcHint]
suggestParensAndBlockArgs
    PsErrCaseInFunAppExpr{}                       -> [GhcHint]
suggestParensAndBlockArgs
    PsErrLetInFunAppExpr{}                        -> [GhcHint]
suggestParensAndBlockArgs
    PsErrIfInFunAppExpr{}                         -> [GhcHint]
suggestParensAndBlockArgs
    PsErrProcInFunAppExpr{}                       -> [GhcHint]
suggestParensAndBlockArgs
    PsErrMalformedTyOrClDecl{}                    -> [GhcHint]
noHints
    PsMessage
PsErrIllegalWhereInDataDecl                   ->
      [ SDoc -> Extension -> GhcHint
suggestExtensionWithInfo (String -> SDoc
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
    PsErrNotADataCon{}                            -> [GhcHint]
noHints
    PsMessage
PsErrInferredTypeVarNotAllowed                -> [GhcHint]
noHints
    PsErrIllegalTraditionalRecordSyntax{}         -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TraditionalRecordSyntax]
    PsErrParseErrorInCmd{}                        -> [GhcHint]
noHints
    PsErrInPat PatBuilder GhcPs
_ PsErrInPatDetails
details                          -> case PsErrInPatDetails
details of
      PEIP_RecPattern [LPat GhcPs]
args PatIsRecursive
YesPatIsRecursive ParseContext
ctx
       | [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 -> [Maybe GhcHint] -> [GhcHint]
forall a. [Maybe a] -> [a]
catMaybes [Maybe GhcHint
sug_recdo, ParseContext -> Maybe GhcHint
sug_missingdo ParseContext
ctx]
       | Bool
otherwise        -> [Maybe GhcHint] -> [GhcHint]
forall a. [Maybe a] -> [a]
catMaybes [ParseContext -> Maybe GhcHint
sug_missingdo ParseContext
ctx]
      PEIP_OtherPatDetails ParseContext
ctx -> [Maybe GhcHint] -> [GhcHint]
forall a. [Maybe a] -> [a]
catMaybes [ParseContext -> Maybe GhcHint
sug_missingdo ParseContext
ctx]
      PsErrInPatDetails
_                        -> []
      where
        sug_recdo :: Maybe GhcHint
sug_recdo                                           = GhcHint -> Maybe GhcHint
forall a. a -> Maybe a
Just (Extension -> GhcHint
suggestExtension Extension
LangExt.RecursiveDo)
        sug_missingdo :: ParseContext -> Maybe GhcHint
sug_missingdo (ParseContext Maybe RdrName
_ PatIncompleteDoBlock
YesIncompleteDoBlock) = GhcHint -> Maybe GhcHint
forall a. a -> Maybe a
Just GhcHint
SuggestMissingDo
        sug_missingdo ParseContext
_                                     = Maybe GhcHint
forall a. Maybe a
Nothing
    PsErrParseRightOpSectionInPat{}               -> [GhcHint]
noHints
    PsErrIllegalRoleName FastString
_ [Role]
nearby                 -> [[Role] -> GhcHint
SuggestRoles [Role]
nearby]
    PsErrInvalidTypeSignature PsInvalidTypeSignature
reason LHsExpr GhcPs
lhs          ->
        if | IdP GhcPs
RdrName
foreign_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall {p} {l} {l}.
(XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p), Eq (IdP p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs
           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ForeignFunctionInterface]
           | IdP GhcPs
RdrName
default_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall {p} {l} {l}.
(XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p), Eq (IdP p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs
           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DefaultSignatures]
           | IdP GhcPs
RdrName
pattern_RDR IdP GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall {p} {l} {l}.
(XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (HsExpr p) ~ GenLocated l (HsExpr p), Eq (IdP p)) =>
IdP p -> GenLocated l (HsExpr p) -> Bool
`looks_like` LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs
           -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PatternSynonyms]
           | PsInvalidTypeSignature
PsErrInvalidTypeSig_Qualified <- PsInvalidTypeSignature
reason
           -> [GhcHint
SuggestTypeSignatureRemoveQualifier]
           | Bool
otherwise
           -> []
      where
        -- A common error is to forget the ForeignFunctionInterface flag
        -- so check for that, and suggest.  cf #3805
        -- Sadly 'foreign import' still barfs 'parse error' because
        --  'import' is a keyword
        -- looks_like :: RdrName -> LHsExpr GhcPsErr -> Bool -- AZ
        looks_like :: IdP p -> GenLocated l (HsExpr p) -> Bool
looks_like IdP p
s (L l
_ (HsVar XVar p
_ (L l
_ IdP p
v))) = IdP p
v IdP p -> IdP p -> Bool
forall a. Eq a => a -> a -> Bool
== IdP p
s
        looks_like IdP p
s (L l
_ (HsApp XApp p
_ XRec p (HsExpr p)
lhs XRec p (HsExpr p)
_))   = IdP p -> GenLocated l (HsExpr p) -> Bool
looks_like IdP p
s XRec p (HsExpr p)
GenLocated l (HsExpr p)
lhs
        looks_like IdP p
_ GenLocated l (HsExpr p)
_                       = Bool
False

        foreign_RDR :: RdrName
foreign_RDR = NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (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
    PsErrInvalidPun {}                            -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ListTuplePuns]

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

psHeaderMessageDiagnostic :: PsHeaderMessage -> DecoratedSDoc
psHeaderMessageDiagnostic :: PsHeaderMessage -> DecoratedSDoc
psHeaderMessageDiagnostic = \case
  PsHeaderMessage
PsErrParseLanguagePragma
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot parse LANGUAGE pragma"
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expecting comma-separated list of language options,"
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"each starting with a capital letter"
              , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"E.g. {-# LANGUAGE TemplateHaskell, GADTs #-}") ]
  PsErrUnsupportedExt String
unsup [String]
_
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unsupported extension: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
unsup
  PsErrParseOptionsPragma String
str
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Error while parsing OPTIONS_GHC pragma."
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expecting whitespace-separated list of GHC options."
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  E.g. {-# OPTIONS_GHC -Wall -O2 #-}"
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text (String
"Input was: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
str) ]
  PsErrUnknownOptionsPragma String
flag
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unknown flag in  {-# OPTIONS_GHC #-} pragma:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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 [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
suggestions
          then [GhcHint]
noHints
          -- FIXME(adn) To fix the compiler crash in #19923 we just rewrap this into an
          -- UnknownHint, but we should have here a proper hint, but that would require
          -- changing 'supportedExtensions' to emit a list of 'Extension'.
          else [SDoc -> GhcHint
forall a. (Outputable a, Typeable a) => a -> GhcHint
UnknownHint (SDoc -> GhcHint) -> SDoc -> GhcHint
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Perhaps you meant" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
quotedListWithOr ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
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 =
   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
e SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" in function application:"
    SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
4 (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a)

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

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

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