content: {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE DataKinds #-}
  
  module GHC.Parser.Errors.Types where
  
  import GHC.Prelude
  
  import GHC.Core.TyCon (Role)
  import GHC.Data.FastString
  import GHC.Hs
  import GHC.Parser.Types
  import GHC.Parser.Errors.Basic
  import GHC.Types.Error
  import GHC.Types.Hint
  import GHC.Types.Name.Occurrence (OccName)
  import GHC.Types.Name.Reader
  import Data.List.NonEmpty (NonEmpty)
  import GHC.Types.SrcLoc (PsLoc)
  
  import GHC.Generics ( Generic )
  
  -- The type aliases below are useful to make some type signatures a bit more
  -- descriptive, like 'handleWarningsThrowErrors' in 'GHC.Driver.Main'.
  
  type PsWarning = PsMessage   -- /INVARIANT/: The diagnosticReason is a Warning reason
  type PsError   = PsMessage   -- /INVARIANT/: The diagnosticReason is ErrorWithoutFlag
  
  {-
  Note [Messages from GHC.Parser.Header
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  We group the messages from 'GHC.Parser.Header' because we need to
  be able to pattern match on them in the driver code. This is because
  in functions like 'GHC.Driver.Pipeline.preprocess' we want to handle
  only a specific subset of parser messages, during dependency analysis,
  and having a single constructor to handle them all is handy.
  
  -}
  
  data PsHeaderMessage
    = PsErrParseLanguagePragma
    | PsErrUnsupportedExt !String ![String]
    | PsErrParseOptionsPragma !String
  
    {-| PsErrUnsupportedOptionsPragma is an error that occurs when an unknown
        OPTIONS_GHC pragma is supplied is found.
  
        Example(s):
          {-# OPTIONS_GHC foo #-}
  
        Test case(s):
  
          tests/safeHaskell/flags/SafeFlags28
          tests/safeHaskell/flags/SafeFlags19
          tests/safeHaskell/flags/SafeFlags29
          tests/parser/should_fail/T19923c
          tests/parser/should_fail/T19923b
          tests/parser/should_fail/readFail044
          tests/driver/T2499
    -}
    | PsErrUnknownOptionsPragma !String
    deriving Generic
  
  
  data PsMessage
    =
      {-| An \"unknown\" message from the parser. This type constructor allows
          arbitrary messages to be embedded. The typical use case would be GHC plugins
          willing to emit custom diagnostics.
      -}
      PsUnknownMessage (UnknownDiagnosticFor PsMessage)
  
      {-| A group of parser messages emitted in 'GHC.Parser.Header'.
          See Note [Messages from GHC.Parser.Header].
      -}
     | PsHeaderMessage !PsHeaderMessage
  
     {-| PsWarnBidirectionalFormatChars is a warning (controlled by the -Wwarn-bidirectional-format-characters flag)
     that occurs when unicode bi-directional format characters are found within in a file
  
     The 'PsLoc' contains the exact position in the buffer the character occurred, and the
     string contains a description of the character.
     -}
     | PsWarnBidirectionalFormatChars (NonEmpty (PsLoc, Char, String))
  
     {-| PsWarnTab is a warning (controlled by the -Wwarn-tabs flag) that occurs
         when tabulations (tabs) are found within a file.
  
         Test case(s): parser/should_fail/T12610
                       parser/should_compile/T9723b
                       parser/should_compile/T9723a
                       parser/should_compile/read043
                       parser/should_fail/T16270
                       warnings/should_compile/T9230
  
     -}
     | PsWarnTab !Word -- ^ Number of other occurrences other than the first one
  
     {-| PsWarnTransitionalLayout is a warning (controlled by the
         -Walternative-layout-rule-transitional flag) that occurs when pipes ('|')
         or 'where' are at the same depth of an implicit layout block.
  
         Example(s):
  
            f :: IO ()
            f
             | True = do
             let x = ()
                 y = ()
             return ()
             | True = return ()
  
         Test case(s): layout/layout006
                       layout/layout003
                       layout/layout001
  
     -}
     | PsWarnTransitionalLayout !TransLayoutReason
  
     -- | Unrecognised pragma. First field is the actual pragma name which
     -- might be empty. Second field is the set of valid candidate pragmas.
     | PsWarnUnrecognisedPragma !String ![String]
     | PsWarnMisplacedPragma !FileHeaderPragmaType
  
     -- | Invalid Haddock comment position
     | PsWarnHaddockInvalidPos
  
     -- | Multiple Haddock comment for the same entity
     | PsWarnHaddockIgnoreMulti
  
     -- | Found binding occurrence of "*" while StarIsType is enabled
     | PsWarnStarBinder
  
     -- | Using "*" for "Type" without StarIsType enabled
     | PsWarnStarIsType
  
     -- | Pre qualified import with 'WarnPrepositiveQualifiedModule' enabled
     | PsWarnImportPreQualified
  
     | PsWarnOperatorWhitespaceExtConflict !OperatorWhitespaceSymbol
  
     | PsWarnOperatorWhitespace !FastString !OperatorWhitespaceOccurrence
  
     {- | PsWarnViewPatternSignatures is a warning triggered by view patterns whose
          RHS is an unparenthesised pattern signature. It warns on code that is
          highly likely to break when the precedence of view patterns relative to
          pattern signatures is changed per GHC Proposal #281. The suggested fix
          is to add parentheses.
  
          Example:
            f1 (isJust -> True :: Bool) = ()
  
          Suggested fix:
            f1 (isJust -> (True :: Bool)) = ()
  
          Test cases:
            T24159_viewpat
     -}
     | PsWarnViewPatternSignatures !(LPat GhcPs) !(LPat GhcPs)
  
     -- | LambdaCase syntax used without the extension enabled
     | PsErrLambdaCase
  
     -- | A lambda requires at least one parameter
     | PsErrEmptyLambda
  
     -- | Underscores in literals without the extension enabled
     | PsErrNumUnderscores !NumUnderscoreReason
  
     -- | Invalid character in primitive string
     | PsErrPrimStringInvalidChar
  
     -- | Missing block
     | PsErrMissingBlock
  
     -- | Lexer error
     | PsErrLexer !LexErr !LexErrKind
  
     -- | Suffix occurrence of `@`
     | PsErrSuffixAT
  
     -- | Parse errors
     | PsErrParse !String !PsErrParseDetails
  
     -- | Cmm lexer error
     | PsErrCmmLexer
  
     -- | Unsupported boxed sum in expression
     | PsErrUnsupportedBoxedSumExpr !(SumOrTuple (HsExpr GhcPs))
  
     -- | Unsupported boxed sum in pattern
     | PsErrUnsupportedBoxedSumPat !(SumOrTuple (PatBuilder GhcPs))
  
     -- | Unexpected qualified constructor
     | PsErrUnexpectedQualifiedConstructor !RdrName
  
     -- | Tuple section in pattern context
     | PsErrTupleSectionInPat
  
     -- | Bang-pattern without BangPattterns enabled
     | PsErrIllegalBangPattern !(Pat GhcPs)
  
     -- | Operator applied to too few arguments
     | PsErrOpFewArgs !StarIsType !RdrName
  
     -- | Import: multiple occurrences of 'qualified'
     | PsErrImportQualifiedTwice
  
     -- | Multiple occurrences of a splice or quote keyword
     | PsErrSpliceOrQuoteTwice
  
     -- | Post qualified import without 'ImportQualifiedPost'
     | PsErrImportPostQualified
  
     -- | Explicit namespace keyword without 'ExplicitNamespaces'
     | PsErrIllegalExplicitNamespace !ExplicitNamespaceKeyword
  
     -- | Expecting a type constructor but found a variable
     | PsErrVarForTyCon !RdrName
  
     -- | Illegal export form allowed by PatternSynonyms
     | PsErrIllegalPatSynExport
  
     -- | Malformed entity string
     | PsErrMalformedEntityString
  
     -- | Dots used in record update
     | PsErrDotsInRecordUpdate
  
     -- | Precedence out of range
     | PsErrPrecedenceOutOfRange !Int
  
     -- | Invalid use of record dot syntax `.'
     | PsErrOverloadedRecordDotInvalid
  
     -- | `OverloadedRecordUpdate` is not enabled.
     | PsErrOverloadedRecordUpdateNotEnabled
  
     -- | Can't use qualified fields when OverloadedRecordUpdate is enabled.
     | PsErrOverloadedRecordUpdateNoQualifiedFields
  
     -- | Cannot parse data constructor in a data/newtype declaration
     | PsErrInvalidDataCon !(HsType GhcPs)
  
     -- | Cannot parse data constructor in a data/newtype declaration
     | PsErrInvalidInfixDataCon !(HsType GhcPs) !RdrName !(HsType GhcPs)
  
     -- | Illegal DataKinds quote mark in data/newtype constructor declaration
     | PsErrIllegalPromotionQuoteDataCon !RdrName
  
     -- | UNPACK applied to a data constructor
     | PsErrUnpackDataCon
  
     -- | Unexpected kind application in data/newtype declaration
     | PsErrUnexpectedKindAppInDataCon !DataConBuilder !(HsType GhcPs)
  
     -- | Not a record constructor
     | PsErrInvalidRecordCon !(PatBuilder GhcPs)
  
     -- | Illegal unboxed string literal in pattern
     | PsErrIllegalUnboxedStringInPat !(HsLit GhcPs)
  
     -- | Illegal primitive floating point literal in pattern
     | PsErrIllegalUnboxedFloatingLitInPat !(HsLit GhcPs)
  
     -- | Do-notation in pattern
     | PsErrDoNotationInPat
  
     -- | If-then-else syntax in pattern
     | PsErrIfThenElseInPat
  
     -- | Lambda or Lambda-case in pattern
     | PsErrLambdaInPat HsLamVariant
  
     -- | case..of in pattern
     | PsErrCaseInPat
  
     -- | let-syntax in pattern
     | PsErrLetInPat
  
     -- | Arrow expression-syntax in pattern
     | PsErrArrowExprInPat !(HsExpr GhcPs)
  
     -- | Arrow command-syntax in pattern
     | PsErrArrowCmdInPat !(HsCmd GhcPs)
  
     -- | Arrow command-syntax in expression
     | PsErrArrowCmdInExpr !(HsCmd GhcPs)
  
     -- | Or-pattern in expression
     | PsErrOrPatInExpr !(LPat GhcPs)
  
     -- | Type-application without space before '@'
     | PsErrTypeAppWithoutSpace !RdrName !(LHsExpr GhcPs)
  
     -- | Lazy-pattern ('~') without space after it
     | PsErrLazyPatWithoutSpace !(LHsExpr GhcPs)
  
     -- | Bang-pattern ('!') without space after it
     | PsErrBangPatWithoutSpace !(LHsExpr GhcPs)
  
     -- | Pragma not allowed in this position
     | PsErrUnallowedPragma !(HsPragE GhcPs)
  
     -- | Qualified do block in command
     | PsErrQualifiedDoInCmd !ModuleName
  
     -- | Invalid infix hole, expected an infix operator
     | PsErrInvalidInfixHole
  
     -- | Unexpected semi-colons in conditional expression
     | PsErrSemiColonsInCondExpr
         !(HsExpr GhcPs) -- ^ conditional expr
         !Bool           -- ^ "then" semi-colon?
         !(HsExpr GhcPs) -- ^ "then" expr
         !Bool           -- ^ "else" semi-colon?
         !(HsExpr GhcPs) -- ^ "else" expr
  
     -- | Unexpected semi-colons in conditional command
     | PsErrSemiColonsInCondCmd
         !(HsExpr GhcPs) -- ^ conditional expr
         !Bool           -- ^ "then" semi-colon?
         !(HsCmd GhcPs)  -- ^ "then" expr
         !Bool           -- ^ "else" semi-colon?
         !(HsCmd GhcPs)  -- ^ "else" expr
  
     -- | @-operator in a pattern position
     | PsErrAtInPatPos
  
     -- | Unexpected case command in function application
     | PsErrCaseCmdInFunAppCmd !(LHsCmd GhcPs)
  
     -- | Unexpected lambda or \case(s) command in function application
     | PsErrLambdaCmdInFunAppCmd !HsLamVariant !(LHsCmd GhcPs)
  
     -- | Unexpected if command in function application
     | PsErrIfCmdInFunAppCmd !(LHsCmd GhcPs)
  
     -- | Unexpected let command in function application
     | PsErrLetCmdInFunAppCmd !(LHsCmd GhcPs)
  
     -- | Unexpected do command in function application
     | PsErrDoCmdInFunAppCmd !(LHsCmd GhcPs)
  
     -- | Unexpected do block in function application
     | PsErrDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs)
  
     -- | Unexpected mdo block in function application
     | PsErrMDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs)
  
     -- | Unexpected case expression in function application
     | PsErrCaseInFunAppExpr !(LHsExpr GhcPs)
  
     -- | Unexpected lambda or \case(s) expression in function application
     | PsErrLambdaInFunAppExpr !HsLamVariant !(LHsExpr GhcPs)
  
     -- | Unexpected let expression in function application
     | PsErrLetInFunAppExpr !(LHsExpr GhcPs)
  
     -- | Unexpected if expression in function application
     | PsErrIfInFunAppExpr !(LHsExpr GhcPs)
  
     -- | Unexpected proc expression in function application
     | PsErrProcInFunAppExpr !(LHsExpr GhcPs)
  
     -- | Malformed head of type or class declaration
     | PsErrMalformedTyOrClDecl !(LHsType GhcPs)
  
     -- | Illegal 'where' keyword in data declaration
     | PsErrIllegalWhereInDataDecl
  
     -- | Illegal datatype context
     | PsErrIllegalDataTypeContext !(LHsContext GhcPs)
  
     -- | Parse error on input
     | PsErrParseErrorOnInput !OccName
  
     -- | Malformed ... declaration for ...
     | PsErrMalformedDecl !SDoc !RdrName
  
     -- | Not a data constructor
     | PsErrNotADataCon !RdrName
  
     -- | Record syntax used in pattern synonym declaration
     | PsErrRecordSyntaxInPatSynDecl !(LPat GhcPs)
  
     -- | Empty 'where' clause in pattern-synonym declaration
     | PsErrEmptyWhereInPatSynDecl !RdrName
  
     -- | Invalid binding name in 'where' clause of pattern-synonym declaration
     | PsErrInvalidWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs)
  
     -- | Multiple bindings in 'where' clause of pattern-synonym declaration
     | PsErrNoSingleWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs)
  
     -- | Declaration splice not a top-level
     | PsErrDeclSpliceNotAtTopLevel !(SpliceDecl GhcPs)
  
     -- | Inferred type variables not allowed here
     | PsErrInferredTypeVarNotAllowed
  
     -- | Multiple names in standalone kind signatures
     | PsErrMultipleNamesInStandaloneKindSignature [LIdP GhcPs]
  
     -- | Illegal import bundle form
     | PsErrIllegalImportBundleForm
  
     -- | Illegal role name
     | PsErrIllegalRoleName !FastString [Role]
  
     -- | Invalid type signature
     | PsErrInvalidTypeSignature !PsInvalidTypeSignature !(LHsExpr GhcPs)
  
     -- | Unexpected type in declaration
     | PsErrUnexpectedTypeInDecl !(LHsType GhcPs)
                                 !SDoc
                                 !RdrName
                                 [LHsTypeArg GhcPs]
                                 !SDoc
  
     -- | Expected a hyphen
     | PsErrExpectedHyphen
  
     -- | Found a space in a SCC
     | PsErrSpaceInSCC
  
     -- | Found two single quotes
     | PsErrEmptyDoubleQuotes !Bool
                              -- ^ Is TH on?
  
     -- | Invalid package name
     | PsErrInvalidPackageName !FastString
  
     -- | Invalid rule activation marker
     | PsErrInvalidRuleActivationMarker
  
     -- | Linear function found but LinearTypes not enabled
     | PsErrLinearFunction
  
     -- | Multi-way if-expression found but MultiWayIf not enabled
     | PsErrMultiWayIf
  
     -- | Explicit forall found but no extension allowing it is enabled
     | PsErrExplicitForall !Bool
                           -- ^ is Unicode forall?
  
     -- | Found qualified-do without QualifiedDo enabled
     | PsErrIllegalQualifiedDo !SDoc
  
     -- | Cmm parser error
     | PsErrCmmParser !CmmParserError
  
     -- | Illegal traditional record syntax
     --
     -- TODO: distinguish errors without using SDoc
     | PsErrIllegalTraditionalRecordSyntax !SDoc
  
     -- | Parse error in command
     --
     -- TODO: distinguish errors without using SDoc
     | PsErrParseErrorInCmd !SDoc
  
     -- | Parse error in pattern
     | PsErrInPat !(PatBuilder GhcPs) !PsErrInPatDetails
  
     -- | Parse error in right operator section pattern
     -- TODO: embed the proper operator, if possible
     | PsErrParseRightOpSectionInPat !RdrName !(PatBuilder GhcPs)
  
     -- | Illegal linear arrow or multiplicity annotation in GADT record syntax
     | PsErrIllegalGadtRecordMultiplicity !(HsMultAnn GhcPs)
  
     | PsErrInvalidCApiImport
  
     | PsErrMultipleConForNewtype !RdrName !Int
  
     | PsErrUnicodeCharLooksLike
        Char -- ^ the problematic character
        Char -- ^ the character it looks like
        String -- ^ the name of the character that it looks like
  
     | PsErrInvalidPun !PsErrPunDetails
  
     -- | Or pattern used without -XOrPatterns
     | PsErrIllegalOrPat (LPat GhcPs)
  
     -- | Temporary error until GHC gains support for type syntax in patterns.
     --   Test cases: T24159_pat_parse_error_1
     --               T24159_pat_parse_error_2
     --               T24159_pat_parse_error_3
     --               T24159_pat_parse_error_4
     --               T24159_pat_parse_error_5
     --               T24159_pat_parse_error_6
     | PsErrTypeSyntaxInPat !PsErrTypeSyntaxDetails
  
     -- | 'PsErrSpecExprMultipleTypeAscription' is an error that occurs when
     -- a user attempts to use the new form SPECIALISE pragma syntax with
     -- multiple type signatures, e.g.
     --
     -- @{-# SPECIALISE foo 3 :: Float -> Float; Double -> Double #-}
     | PsErrSpecExprMultipleTypeAscription
  
     -- | 'PsWarnSpecMultipleTypeAscription' is a warning that occurs when
     -- a user uses the old-form SPECIALISE pragma syntax with
     -- multiple type signatures, e.g.
     --
     -- @{-# SPECIALISE bar :: Float -> Float; Double -> Double #-}
     --
     -- This constructor is deprecated and will be removed in GHC 9.18.
     | PsWarnSpecMultipleTypeAscription
  
     -- | The deprecated ``pattern`` namespace specifier was used in an import or
     -- export list. Suggested fix: use the ``data`` keyword instead.
     | PsWarnPatternNamespaceSpecifier
        !Bool -- ^ Is ExplicitNamespaces on?
  
     deriving Generic
  
  -- | Extra details about a parse error, which helps
  -- us in determining which should be the hints to
  -- suggest.
  data PsErrParseDetails
    = PsErrParseDetails
    { ped_th_enabled :: !Bool
      -- Is 'TemplateHaskell' enabled?
    , ped_do_in_last_100 :: !Bool
      -- ^ Is there a 'do' in the last 100 characters?
    , ped_mdo_in_last_100 :: !Bool
      -- ^ Is there an 'mdo' in the last 100 characters?
    , ped_pat_syn_enabled :: !Bool
      -- ^ Is 'PatternSynonyms' enabled?
    , ped_pattern_parsed :: !Bool
      -- ^ Did we parse a \"pattern\" keyword?
    }
  
  data PsInvalidTypeSignature
    = PsErrInvalidTypeSig_Qualified
    | PsErrInvalidTypeSig_DataCon
    | PsErrInvalidTypeSig_Other
  
  -- | Is the parsed pattern recursive?
  data PatIsRecursive
    = YesPatIsRecursive
    | NoPatIsRecursive
  
  data PatIncompleteDoBlock
    = YesIncompleteDoBlock
    | NoIncompleteDoBlock
    deriving Eq
  
  -- | Extra information for the expression GHC is currently inspecting/parsing.
  -- It can be used to generate more informative parser diagnostics and hints.
  data ParseContext
    = ParseContext
    { is_infix :: !(Maybe RdrName)
      -- ^ If 'Just', this is an infix
      -- pattern with the bound operator name
    , incomplete_do_block :: !PatIncompleteDoBlock
      -- ^ Did the parser likely fail due to an incomplete do block?
    } deriving Eq
  
  data PsErrInPatDetails
    = PEIP_NegApp
      -- ^ Negative application pattern?
    | PEIP_RecPattern [LPat GhcPs]    -- ^ The pattern arguments
                      !PatIsRecursive -- ^ Is the parsed pattern recursive?
                      !ParseContext
    | PEIP_OtherPatDetails !ParseContext
  
  data PsErrPunDetails
    = PEP_QuoteDisambiguation
    | PEP_TupleSyntaxType
    | PEP_SumSyntaxType
  
  data PsErrTypeSyntaxDetails
    = PETS_FunctionArrow
        !(LocatedA (PatBuilder GhcPs))
        !(HsMultAnnOf (LocatedA (PatBuilder GhcPs)) GhcPs)
        !(LocatedA (PatBuilder GhcPs))
    | PETS_Multiplicity
        !(EpToken "%")
        !(LocatedA (PatBuilder GhcPs))
    | PETS_ForallTelescope
        !(HsForAllTelescope GhcPs)
        !(LocatedA (PatBuilder GhcPs))
    | PETS_ConstraintContext !(LocatedA (PatBuilder GhcPs))
  
  noParseContext :: ParseContext
  noParseContext = ParseContext Nothing NoIncompleteDoBlock
  
  incompleteDoBlock :: ParseContext
  incompleteDoBlock = ParseContext Nothing YesIncompleteDoBlock
  
  -- | Builds a 'PsErrInPatDetails' with the information provided by the 'ParseContext'.
  fromParseContext :: ParseContext -> PsErrInPatDetails
  fromParseContext = PEIP_OtherPatDetails
  
  data NumUnderscoreReason
     = NumUnderscore_Integral
     | NumUnderscore_Float
     deriving (Show,Eq,Ord)
  
  
  data LexErrKind
     = LexErrKind_EOF        -- ^ End of input
     | LexErrKind_UTF8       -- ^ UTF-8 decoding error
     | LexErrKind_Char !Char -- ^ Error at given character
     deriving (Show,Eq,Ord)
  
  data LexErr
     = LexError               -- ^ Lexical error
     | LexUnknownPragma       -- ^ Unknown pragma
     | LexErrorInPragma       -- ^ Lexical error in pragma
     | LexNumEscapeRange      -- ^ Numeric escape sequence out of range
     | LexUnterminatedComment -- ^ Unterminated `{-'
     | LexUnterminatedOptions -- ^ Unterminated OPTIONS pragma
     | LexUnterminatedQQ      -- ^ Unterminated quasiquotation
     deriving (Show,Eq,Ord)
  
  -- | Errors from the Cmm parser
  data CmmParserError
     = CmmUnknownPrimitive    !FastString -- ^ Unknown Cmm primitive
     | CmmUnknownMacro        !FastString -- ^ Unknown macro
     | CmmUnknownCConv        !String     -- ^ Unknown calling convention
     | CmmUnrecognisedSafety  !String     -- ^ Unrecognised safety
     | CmmUnrecognisedHint    !String     -- ^ Unrecognised hint
  
  data TransLayoutReason
     = TransLayout_Where -- ^ "`where' clause at the same depth as implicit layout block"
     | TransLayout_Pipe  -- ^ "`|' at the same depth as implicit layout block")
  
  
  data FileHeaderPragmaType
    = OptionsPrag
    | IncludePrag
    | LanguagePrag
    | DocOptionsPrag
  