never executed always true always false
    1 {-# LANGUAGE ExistentialQuantification #-}
    2 
    3 module GHC.Parser.Errors.Types where
    4 
    5 import GHC.Prelude
    6 
    7 import Data.Typeable
    8 
    9 import GHC.Core.TyCon (Role)
   10 import GHC.Data.FastString
   11 import GHC.Hs
   12 import GHC.Parser.Types
   13 import GHC.Parser.Errors.Basic
   14 import GHC.Types.Error
   15 import GHC.Types.Name.Occurrence (OccName)
   16 import GHC.Types.Name.Reader
   17 import GHC.Unit.Module.Name
   18 import GHC.Utils.Outputable
   19 import Data.List.NonEmpty (NonEmpty)
   20 import GHC.Types.SrcLoc (PsLoc)
   21 
   22 -- The type aliases below are useful to make some type signatures a bit more
   23 -- descriptive, like 'handleWarningsThrowErrors' in 'GHC.Driver.Main'.
   24 
   25 type PsWarning = PsMessage   -- /INVARIANT/: The diagnosticReason is a Warning reason
   26 type PsError   = PsMessage   -- /INVARIANT/: The diagnosticReason is ErrorWithoutFlag
   27 
   28 {-
   29 Note [Messages from GHC.Parser.Header
   30 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   31 
   32 We group the messages from 'GHC.Parser.Header' because we need to
   33 be able to pattern match on them in the driver code. This is because
   34 in functions like 'GHC.Driver.Pipeline.preprocess' we want to handle
   35 only a specific subset of parser messages, during dependency analysis,
   36 and having a single constructor to handle them all is handy.
   37 
   38 -}
   39 
   40 data PsHeaderMessage
   41   = PsErrParseLanguagePragma
   42   | PsErrUnsupportedExt !String ![String]
   43   | PsErrParseOptionsPragma !String
   44 
   45   {-| PsErrUnsupportedOptionsPragma is an error that occurs when an unknown
   46       OPTIONS_GHC pragma is supplied is found.
   47 
   48       Example(s):
   49         {-# OPTIONS_GHC foo #-}
   50 
   51       Test case(s):
   52 
   53         tests/safeHaskell/flags/SafeFlags28
   54         tests/safeHaskell/flags/SafeFlags19
   55         tests/safeHaskell/flags/SafeFlags29
   56         tests/parser/should_fail/T19923c
   57         tests/parser/should_fail/T19923b
   58         tests/parser/should_fail/readFail044
   59         tests/driver/T2499
   60   -}
   61   | PsErrUnknownOptionsPragma !String
   62 
   63 
   64 data PsMessage
   65   =
   66     {-| An \"unknown\" message from the parser. This type constructor allows
   67         arbitrary messages to be embedded. The typical use case would be GHC plugins
   68         willing to emit custom diagnostics.
   69     -}
   70    forall a. (Diagnostic a, Typeable a) => PsUnknownMessage a
   71 
   72     {-| A group of parser messages emitted in 'GHC.Parser.Header'.
   73         See Note [Messages from GHC.Parser.Header].
   74     -}
   75    | PsHeaderMessage !PsHeaderMessage
   76 
   77    {-| PsWarnBidirectionalFormatChars is a warning (controlled by the -Wwarn-bidirectional-format-characters flag)
   78    that occurs when unicode bi-directional format characters are found within in a file
   79 
   80    The 'PsLoc' contains the exact position in the buffer the character occured, and the
   81    string contains a description of the character.
   82    -}
   83    | PsWarnBidirectionalFormatChars (NonEmpty (PsLoc, Char, String))
   84 
   85    {-| PsWarnTab is a warning (controlled by the -Wwarn-tabs flag) that occurs
   86        when tabulations (tabs) are found within a file.
   87 
   88        Test case(s): parser/should_fail/T12610
   89                      parser/should_compile/T9723b
   90                      parser/should_compile/T9723a
   91                      parser/should_compile/read043
   92                      parser/should_fail/T16270
   93                      warnings/should_compile/T9230
   94 
   95    -}
   96    | PsWarnTab !Word -- ^ Number of other occurrences other than the first one
   97 
   98    {-| PsWarnTransitionalLayout is a warning (controlled by the
   99        -Walternative-layout-rule-transitional flag) that occurs when pipes ('|')
  100        or 'where' are at the same depth of an implicit layout block.
  101 
  102        Example(s):
  103 
  104           f :: IO ()
  105           f
  106            | True = do
  107            let x = ()
  108                y = ()
  109            return ()
  110            | True = return ()
  111 
  112        Test case(s): layout/layout006
  113                      layout/layout003
  114                      layout/layout001
  115 
  116    -}
  117    | PsWarnTransitionalLayout !TransLayoutReason
  118 
  119    -- | Unrecognised pragma
  120    | PsWarnUnrecognisedPragma
  121 
  122    -- | Invalid Haddock comment position
  123    | PsWarnHaddockInvalidPos
  124 
  125    -- | Multiple Haddock comment for the same entity
  126    | PsWarnHaddockIgnoreMulti
  127 
  128    -- | Found binding occurrence of "*" while StarIsType is enabled
  129    | PsWarnStarBinder
  130 
  131    -- | Using "*" for "Type" without StarIsType enabled
  132    | PsWarnStarIsType
  133 
  134    -- | Pre qualified import with 'WarnPrepositiveQualifiedModule' enabled
  135    | PsWarnImportPreQualified
  136 
  137    | PsWarnOperatorWhitespaceExtConflict !OperatorWhitespaceSymbol
  138 
  139    | PsWarnOperatorWhitespace !FastString !OperatorWhitespaceOccurrence
  140 
  141    -- | LambdaCase syntax used without the extension enabled
  142    | PsErrLambdaCase
  143 
  144    -- | A lambda requires at least one parameter
  145    | PsErrEmptyLambda
  146 
  147    -- | Underscores in literals without the extension enabled
  148    | PsErrNumUnderscores !NumUnderscoreReason
  149 
  150    -- | Invalid character in primitive string
  151    | PsErrPrimStringInvalidChar
  152 
  153    -- | Missing block
  154    | PsErrMissingBlock
  155 
  156    -- | Lexer error
  157    | PsErrLexer !LexErr !LexErrKind
  158 
  159    -- | Suffix occurrence of `@`
  160    | PsErrSuffixAT
  161 
  162    -- | Parse errors
  163    | PsErrParse !String !PsErrParseDetails
  164 
  165    -- | Cmm lexer error
  166    | PsErrCmmLexer
  167 
  168    -- | Unsupported boxed sum in expression
  169    | PsErrUnsupportedBoxedSumExpr !(SumOrTuple (HsExpr GhcPs))
  170 
  171    -- | Unsupported boxed sum in pattern
  172    | PsErrUnsupportedBoxedSumPat !(SumOrTuple (PatBuilder GhcPs))
  173 
  174    -- | Unexpected qualified constructor
  175    | PsErrUnexpectedQualifiedConstructor !RdrName
  176 
  177    -- | Tuple section in pattern context
  178    | PsErrTupleSectionInPat
  179 
  180    -- | Bang-pattern without BangPattterns enabled
  181    | PsErrIllegalBangPattern !(Pat GhcPs)
  182 
  183    -- | Operator applied to too few arguments
  184    | PsErrOpFewArgs !StarIsType !RdrName
  185 
  186    -- | Import: multiple occurrences of 'qualified'
  187    | PsErrImportQualifiedTwice
  188 
  189    -- | Post qualified import without 'ImportQualifiedPost'
  190    | PsErrImportPostQualified
  191 
  192    -- | Explicit namespace keyword without 'ExplicitNamespaces'
  193    | PsErrIllegalExplicitNamespace
  194 
  195    -- | Expecting a type constructor but found a variable
  196    | PsErrVarForTyCon !RdrName
  197 
  198    -- | Illegal export form allowed by PatternSynonyms
  199    | PsErrIllegalPatSynExport
  200 
  201    -- | Malformed entity string
  202    | PsErrMalformedEntityString
  203 
  204    -- | Dots used in record update
  205    | PsErrDotsInRecordUpdate
  206 
  207    -- | Precedence out of range
  208    | PsErrPrecedenceOutOfRange !Int
  209 
  210    -- | Invalid use of record dot syntax `.'
  211    | PsErrOverloadedRecordDotInvalid
  212 
  213    -- | `OverloadedRecordUpdate` is not enabled.
  214    | PsErrOverloadedRecordUpdateNotEnabled
  215 
  216    -- | Can't use qualified fields when OverloadedRecordUpdate is enabled.
  217    | PsErrOverloadedRecordUpdateNoQualifiedFields
  218 
  219    -- | Cannot parse data constructor in a data/newtype declaration
  220    | PsErrInvalidDataCon !(HsType GhcPs)
  221 
  222    -- | Cannot parse data constructor in a data/newtype declaration
  223    | PsErrInvalidInfixDataCon !(HsType GhcPs) !RdrName !(HsType GhcPs)
  224 
  225    -- | UNPACK applied to a data constructor
  226    | PsErrUnpackDataCon
  227 
  228    -- | Unexpected kind application in data/newtype declaration
  229    | PsErrUnexpectedKindAppInDataCon !DataConBuilder !(HsType GhcPs)
  230 
  231    -- | Not a record constructor
  232    | PsErrInvalidRecordCon !(PatBuilder GhcPs)
  233 
  234    -- | Illegal unboxed string literal in pattern
  235    | PsErrIllegalUnboxedStringInPat !(HsLit GhcPs)
  236 
  237    -- | Do-notation in pattern
  238    | PsErrDoNotationInPat
  239 
  240    -- | If-then-else syntax in pattern
  241    | PsErrIfThenElseInPat
  242 
  243    -- | Lambda-case in pattern
  244    | PsErrLambdaCaseInPat
  245 
  246    -- | case..of in pattern
  247    | PsErrCaseInPat
  248 
  249    -- | let-syntax in pattern
  250    | PsErrLetInPat
  251 
  252    -- | Lambda-syntax in pattern
  253    | PsErrLambdaInPat
  254 
  255    -- | Arrow expression-syntax in pattern
  256    | PsErrArrowExprInPat !(HsExpr GhcPs)
  257 
  258    -- | Arrow command-syntax in pattern
  259    | PsErrArrowCmdInPat !(HsCmd GhcPs)
  260 
  261    -- | Arrow command-syntax in expression
  262    | PsErrArrowCmdInExpr !(HsCmd GhcPs)
  263 
  264    -- | View-pattern in expression
  265    | PsErrViewPatInExpr !(LHsExpr GhcPs) !(LHsExpr GhcPs)
  266 
  267    -- | Type-application without space before '@'
  268    | PsErrTypeAppWithoutSpace !RdrName !(LHsExpr GhcPs)
  269 
  270    -- | Lazy-pattern ('~') without space after it
  271    | PsErrLazyPatWithoutSpace !(LHsExpr GhcPs)
  272 
  273    -- | Bang-pattern ('!') without space after it
  274    | PsErrBangPatWithoutSpace !(LHsExpr GhcPs)
  275 
  276    -- | Pragma not allowed in this position
  277    | PsErrUnallowedPragma !(HsPragE GhcPs)
  278 
  279    -- | Qualified do block in command
  280    | PsErrQualifiedDoInCmd !ModuleName
  281 
  282    -- | Invalid infix hole, expected an infix operator
  283    | PsErrInvalidInfixHole
  284 
  285    -- | Unexpected semi-colons in conditional expression
  286    | PsErrSemiColonsInCondExpr
  287        !(HsExpr GhcPs) -- ^ conditional expr
  288        !Bool           -- ^ "then" semi-colon?
  289        !(HsExpr GhcPs) -- ^ "then" expr
  290        !Bool           -- ^ "else" semi-colon?
  291        !(HsExpr GhcPs) -- ^ "else" expr
  292 
  293    -- | Unexpected semi-colons in conditional command
  294    | PsErrSemiColonsInCondCmd
  295        !(HsExpr GhcPs) -- ^ conditional expr
  296        !Bool           -- ^ "then" semi-colon?
  297        !(HsCmd GhcPs)  -- ^ "then" expr
  298        !Bool           -- ^ "else" semi-colon?
  299        !(HsCmd GhcPs)  -- ^ "else" expr
  300 
  301    -- | @-operator in a pattern position
  302    | PsErrAtInPatPos
  303 
  304    -- | Unexpected lambda command in function application
  305    | PsErrLambdaCmdInFunAppCmd !(LHsCmd GhcPs)
  306 
  307    -- | Unexpected case command in function application
  308    | PsErrCaseCmdInFunAppCmd !(LHsCmd GhcPs)
  309 
  310    -- | Unexpected if command in function application
  311    | PsErrIfCmdInFunAppCmd !(LHsCmd GhcPs)
  312 
  313    -- | Unexpected let command in function application
  314    | PsErrLetCmdInFunAppCmd !(LHsCmd GhcPs)
  315 
  316    -- | Unexpected do command in function application
  317    | PsErrDoCmdInFunAppCmd !(LHsCmd GhcPs)
  318 
  319    -- | Unexpected do block in function application
  320    | PsErrDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs)
  321 
  322    -- | Unexpected mdo block in function application
  323    | PsErrMDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs)
  324 
  325    -- | Unexpected lambda expression in function application
  326    | PsErrLambdaInFunAppExpr !(LHsExpr GhcPs)
  327 
  328    -- | Unexpected case expression in function application
  329    | PsErrCaseInFunAppExpr !(LHsExpr GhcPs)
  330 
  331    -- | Unexpected lambda-case expression in function application
  332    | PsErrLambdaCaseInFunAppExpr !(LHsExpr GhcPs)
  333 
  334    -- | Unexpected let expression in function application
  335    | PsErrLetInFunAppExpr !(LHsExpr GhcPs)
  336 
  337    -- | Unexpected if expression in function application
  338    | PsErrIfInFunAppExpr !(LHsExpr GhcPs)
  339 
  340    -- | Unexpected proc expression in function application
  341    | PsErrProcInFunAppExpr !(LHsExpr GhcPs)
  342 
  343    -- | Malformed head of type or class declaration
  344    | PsErrMalformedTyOrClDecl !(LHsType GhcPs)
  345 
  346    -- | Illegal 'where' keyword in data declaration
  347    | PsErrIllegalWhereInDataDecl
  348 
  349    -- | Illegal datatype context
  350    | PsErrIllegalDataTypeContext !(LHsContext GhcPs)
  351 
  352    -- | Parse error on input
  353    | PsErrParseErrorOnInput !OccName
  354 
  355    -- | Malformed ... declaration for ...
  356    | PsErrMalformedDecl !SDoc !RdrName
  357 
  358    -- | Unexpected type application in a declaration
  359    | PsErrUnexpectedTypeAppInDecl !(LHsType GhcPs) !SDoc !RdrName
  360 
  361    -- | Not a data constructor
  362    | PsErrNotADataCon !RdrName
  363 
  364    -- | Record syntax used in pattern synonym declaration
  365    | PsErrRecordSyntaxInPatSynDecl !(LPat GhcPs)
  366 
  367    -- | Empty 'where' clause in pattern-synonym declaration
  368    | PsErrEmptyWhereInPatSynDecl !RdrName
  369 
  370    -- | Invalid binding name in 'where' clause of pattern-synonym declaration
  371    | PsErrInvalidWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs)
  372 
  373    -- | Multiple bindings in 'where' clause of pattern-synonym declaration
  374    | PsErrNoSingleWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs)
  375 
  376    -- | Declaration splice not a top-level
  377    | PsErrDeclSpliceNotAtTopLevel !(SpliceDecl GhcPs)
  378 
  379    -- | Inferred type variables not allowed here
  380    | PsErrInferredTypeVarNotAllowed
  381 
  382    -- | Multiple names in standalone kind signatures
  383    | PsErrMultipleNamesInStandaloneKindSignature [LIdP GhcPs]
  384 
  385    -- | Illegal import bundle form
  386    | PsErrIllegalImportBundleForm
  387 
  388    -- | Illegal role name
  389    | PsErrIllegalRoleName !FastString [Role]
  390 
  391    -- | Invalid type signature
  392    | PsErrInvalidTypeSignature !(LHsExpr GhcPs)
  393 
  394    -- | Unexpected type in declaration
  395    | PsErrUnexpectedTypeInDecl !(LHsType GhcPs)
  396                                !SDoc
  397                                !RdrName
  398                                [LHsTypeArg GhcPs]
  399                                !SDoc
  400 
  401    -- | Expected a hyphen
  402    | PsErrExpectedHyphen
  403 
  404    -- | Found a space in a SCC
  405    | PsErrSpaceInSCC
  406 
  407    -- | Found two single quotes
  408    | PsErrEmptyDoubleQuotes !Bool
  409                             -- ^ Is TH on?
  410 
  411    -- | Invalid package name
  412    | PsErrInvalidPackageName !FastString
  413 
  414    -- | Invalid rule activation marker
  415    | PsErrInvalidRuleActivationMarker
  416 
  417    -- | Linear function found but LinearTypes not enabled
  418    | PsErrLinearFunction
  419 
  420    -- | Multi-way if-expression found but MultiWayIf not enabled
  421    | PsErrMultiWayIf
  422 
  423    -- | Explicit forall found but no extension allowing it is enabled
  424    | PsErrExplicitForall !Bool
  425                          -- ^ is Unicode forall?
  426 
  427    -- | Found qualified-do without QualifiedDo enabled
  428    | PsErrIllegalQualifiedDo !SDoc
  429 
  430    -- | Cmm parser error
  431    | PsErrCmmParser !CmmParserError
  432 
  433    -- | Illegal traditional record syntax
  434    --
  435    -- TODO: distinguish errors without using SDoc
  436    | PsErrIllegalTraditionalRecordSyntax !SDoc
  437 
  438    -- | Parse error in command
  439    --
  440    -- TODO: distinguish errors without using SDoc
  441    | PsErrParseErrorInCmd !SDoc
  442 
  443    -- | Parse error in pattern
  444    | PsErrInPat !(PatBuilder GhcPs) !PsErrInPatDetails
  445 
  446    -- | Parse error in right operator section pattern
  447    -- TODO: embed the proper operator, if possible
  448    | forall infixOcc. (OutputableBndr infixOcc) => PsErrParseRightOpSectionInPat !infixOcc !(PatBuilder GhcPs)
  449 
  450    -- | Illegal linear arrow or multiplicity annotation in GADT record syntax
  451    | PsErrIllegalGadtRecordMultiplicity !(HsArrow GhcPs)
  452 
  453    | PsErrInvalidCApiImport
  454 
  455 newtype StarIsType = StarIsType Bool
  456 
  457 -- | Extra details about a parse error, which helps
  458 -- us in determining which should be the hints to
  459 -- suggest.
  460 data PsErrParseDetails
  461   = PsErrParseDetails
  462   { ped_th_enabled :: !Bool
  463     -- Is 'TemplateHaskell' enabled?
  464   , ped_do_in_last_100 :: !Bool
  465     -- ^ Is there a 'do' in the last 100 characters?
  466   , ped_mdo_in_last_100 :: !Bool
  467     -- ^ Is there an 'mdo' in the last 100 characters?
  468   , ped_pat_syn_enabled :: !Bool
  469     -- ^ Is 'PatternSynonyms' enabled?
  470   , ped_pattern_parsed :: !Bool
  471     -- ^ Did we parse a \"pattern\" keyword?
  472   }
  473 
  474 -- | Is the parsed pattern recursive?
  475 data PatIsRecursive
  476   = YesPatIsRecursive
  477   | NoPatIsRecursive
  478 
  479 data PatIncompleteDoBlock
  480   = YesIncompleteDoBlock
  481   | NoIncompleteDoBlock
  482   deriving Eq
  483 
  484 -- | Extra information for the expression GHC is currently inspecting/parsing.
  485 -- It can be used to generate more informative parser diagnostics and hints.
  486 data ParseContext
  487   = ParseContext
  488   { is_infix :: !(Maybe RdrName)
  489     -- ^ If 'Just', this is an infix
  490     -- pattern with the binded operator name
  491   , incomplete_do_block :: !PatIncompleteDoBlock
  492     -- ^ Did the parser likely fail due to an incomplete do block?
  493   } deriving Eq
  494 
  495 data PsErrInPatDetails
  496   = PEIP_NegApp
  497     -- ^ Negative application pattern?
  498   | PEIP_TypeArgs [HsPatSigType GhcPs]
  499     -- ^ The list of type arguments for the pattern
  500   | PEIP_RecPattern [LPat GhcPs]    -- ^ The pattern arguments
  501                     !PatIsRecursive -- ^ Is the parsed pattern recursive?
  502                     !ParseContext
  503   | PEIP_OtherPatDetails !ParseContext
  504 
  505 noParseContext :: ParseContext
  506 noParseContext = ParseContext Nothing NoIncompleteDoBlock
  507 
  508 incompleteDoBlock :: ParseContext
  509 incompleteDoBlock = ParseContext Nothing YesIncompleteDoBlock
  510 
  511 -- | Builds a 'PsErrInPatDetails' with the information provided by the 'ParseContext'.
  512 fromParseContext :: ParseContext -> PsErrInPatDetails
  513 fromParseContext = PEIP_OtherPatDetails
  514 
  515 data NumUnderscoreReason
  516    = NumUnderscore_Integral
  517    | NumUnderscore_Float
  518    deriving (Show,Eq,Ord)
  519 
  520 data LexErrKind
  521    = LexErrKind_EOF        -- ^ End of input
  522    | LexErrKind_UTF8       -- ^ UTF-8 decoding error
  523    | LexErrKind_Char !Char -- ^ Error at given character
  524    deriving (Show,Eq,Ord)
  525 
  526 data LexErr
  527    = LexError               -- ^ Lexical error
  528    | LexUnknownPragma       -- ^ Unknown pragma
  529    | LexErrorInPragma       -- ^ Lexical error in pragma
  530    | LexNumEscapeRange      -- ^ Numeric escape sequence out of range
  531    | LexStringCharLit       -- ^ Lexical error in string/character literal
  532    | LexStringCharLitEOF    -- ^ Unexpected end-of-file in string/character literal
  533    | LexUnterminatedComment -- ^ Unterminated `{-'
  534    | LexUnterminatedOptions -- ^ Unterminated OPTIONS pragma
  535    | LexUnterminatedQQ      -- ^ Unterminated quasiquotation
  536 
  537 -- | Errors from the Cmm parser
  538 data CmmParserError
  539    = CmmUnknownPrimitive    !FastString -- ^ Unknown Cmm primitive
  540    | CmmUnknownMacro        !FastString -- ^ Unknown macro
  541    | CmmUnknownCConv        !String     -- ^ Unknown calling convention
  542    | CmmUnrecognisedSafety  !String     -- ^ Unrecognised safety
  543    | CmmUnrecognisedHint    !String     -- ^ Unrecognised hint
  544 
  545 data TransLayoutReason
  546    = TransLayout_Where -- ^ "`where' clause at the same depth as implicit layout block"
  547    | TransLayout_Pipe  -- ^ "`|' at the same depth as implicit layout block")