content: {-# LANGUAGE DeriveAnyClass #-}
  module Language.PureScript.CST.Errors
    ( ParserErrorInfo(..)
    , ParserErrorType(..)
    , ParserWarningType(..)
    , ParserError
    , ParserWarning
    , prettyPrintError
    , prettyPrintErrorMessage
    , prettyPrintWarningMessage
    ) where
  
  import Prelude
  
  import Control.DeepSeq (NFData)
  import Data.Text qualified as Text
  import Data.Char (isSpace, toUpper)
  import GHC.Generics (Generic)
  import Language.PureScript.CST.Layout (LayoutStack)
  import Language.PureScript.CST.Print (printToken)
  import Language.PureScript.CST.Types (SourcePos(..), SourceRange(..), SourceToken(..), Token(..))
  import Text.Printf (printf)
  
  data ParserErrorType
    = ErrWildcardInType
    | ErrConstraintInKind
    | ErrHoleInType
    | ErrExprInBinder
    | ErrExprInDeclOrBinder
    | ErrExprInDecl
    | ErrBinderInDecl
    | ErrRecordUpdateInCtr
    | ErrRecordPunInUpdate
    | ErrRecordCtrInUpdate
    | ErrTypeInConstraint
    | ErrElseInDecl
    | ErrInstanceNameMismatch
    | ErrUnknownFundep
    | ErrImportInDecl
    | ErrGuardInLetBinder
    | ErrKeywordVar
    | ErrKeywordSymbol
    | ErrQuotedPun
    | ErrToken
    | ErrLineFeedInString
    | ErrAstralCodePointInChar
    | ErrCharEscape
    | ErrNumberOutOfRange
    | ErrLeadingZero
    | ErrExpectedFraction
    | ErrExpectedExponent
    | ErrExpectedHex
    | ErrReservedSymbol
    | ErrCharInGap Char
    | ErrModuleName
    | ErrQualifiedName
    | ErrEmptyDo
    | ErrLexeme (Maybe String) [String]
    | ErrConstraintInForeignImportSyntax
    | ErrEof
    | ErrCustom String
    deriving (Show, Eq, Ord, Generic, NFData)
  
  data ParserWarningType
    = WarnDeprecatedRowSyntax
    | WarnDeprecatedForeignKindSyntax
    | WarnDeprecatedKindImportSyntax
    | WarnDeprecatedKindExportSyntax
    | WarnDeprecatedCaseOfOffsideSyntax
    deriving (Show, Eq, Ord, Generic, NFData)
  
  data ParserErrorInfo a = ParserErrorInfo
    { errRange :: SourceRange
    , errToks :: [SourceToken]
    , errStack :: LayoutStack
    , errType :: a
    } deriving (Show, Eq, Generic, NFData)
  
  type ParserError = ParserErrorInfo ParserErrorType
  type ParserWarning = ParserErrorInfo ParserWarningType
  
  prettyPrintError :: ParserError -> String
  prettyPrintError pe@ParserErrorInfo { errRange } =
    prettyPrintErrorMessage pe <> " at " <> errPos
    where
    errPos = case errRange of
      SourceRange (SourcePos line col) _ ->
        "line " <> show line <> ", column " <> show col
  
  prettyPrintErrorMessage :: ParserError -> String
  prettyPrintErrorMessage ParserErrorInfo {..} = case errType of
    ErrWildcardInType ->
      "Unexpected wildcard in type; type wildcards are only allowed in value annotations"
    ErrConstraintInKind ->
      "Unsupported constraint in kind; constraints are only allowed in value annotations"
    ErrHoleInType ->
      "Unexpected hole in type; type holes are only allowed in value annotations"
    ErrExprInBinder ->
      "Expected pattern, saw expression"
    ErrExprInDeclOrBinder ->
      "Expected declaration or pattern, saw expression"
    ErrExprInDecl ->
      "Expected declaration, saw expression"
    ErrBinderInDecl ->
      "Expected declaration, saw pattern"
    ErrRecordUpdateInCtr ->
      "Expected ':', saw '='"
    ErrRecordPunInUpdate ->
      "Expected record update, saw pun"
    ErrRecordCtrInUpdate ->
      "Expected '=', saw ':'"
    ErrTypeInConstraint ->
      "Expected constraint, saw type"
    ErrElseInDecl ->
      "Expected declaration, saw 'else'"
    ErrInstanceNameMismatch ->
      "All instances in a chain must implement the same type class"
    ErrUnknownFundep ->
      "Unknown type variable in functional dependency"
    ErrImportInDecl ->
      "Expected declaration, saw 'import'"
    ErrGuardInLetBinder ->
      "Unexpected guard in let pattern"
    ErrKeywordVar ->
      "Expected variable, saw keyword"
    ErrKeywordSymbol ->
      "Expected symbol, saw reserved symbol"
    ErrQuotedPun ->
      "Unexpected quoted label in record pun, perhaps due to a missing ':'"
    ErrEof ->
      "Unexpected end of input"
    ErrLexeme (Just (hd : _)) _ | isSpace hd ->
      "Illegal whitespace character " <> displayCodePoint hd
    ErrLexeme (Just a) _ ->
      "Unexpected " <> a
    ErrLineFeedInString ->
      "Unexpected line feed in string literal"
    ErrAstralCodePointInChar ->
      "Illegal astral code point in character literal"
    ErrCharEscape ->
      "Illegal character escape code"
    ErrNumberOutOfRange ->
      "Number literal is out of range"
    ErrLeadingZero ->
      "Unexpected leading zeros"
    ErrExpectedFraction ->
      "Expected fraction"
    ErrExpectedExponent ->
      "Expected exponent"
    ErrExpectedHex ->
      "Expected hex digit"
    ErrReservedSymbol ->
      "Unexpected reserved symbol"
    ErrCharInGap ch ->
      "Unexpected character '" <> [ch] <> "' in gap"
    ErrModuleName ->
      "Invalid module name; underscores and primes are not allowed in module names"
    ErrQualifiedName ->
      "Unexpected qualified name"
    ErrEmptyDo ->
      "Expected do statement"
    ErrLexeme _ _ ->
      basicError
    ErrConstraintInForeignImportSyntax ->
      "Constraints are not allowed in foreign imports. Omit the constraint instead and update the foreign module accordingly."
    ErrToken
      | SourceToken _ (TokLeftArrow _) : _ <- errToks ->
          "Unexpected \"<-\" in expression, perhaps due to a missing 'do' or 'ado' keyword"
    ErrToken ->
      basicError
    ErrCustom err ->
      err
  
    where
    basicError = case errToks of
      tok : _ -> basicTokError (tokValue tok)
      [] -> "Unexpected input"
  
    basicTokError = \case
      TokLayoutStart -> "Unexpected or mismatched indentation"
      TokLayoutSep   -> "Unexpected or mismatched indentation"
      TokLayoutEnd   -> "Unexpected or mismatched indentation"
      TokEof         -> "Unexpected end of input"
      tok            -> "Unexpected token '" <> Text.unpack (printToken tok) <> "'"
  
    displayCodePoint :: Char -> String
    displayCodePoint x =
      "U+" <> map toUpper (printf "%0.4x" (fromEnum x))
  
  prettyPrintWarningMessage :: ParserWarning -> String
  prettyPrintWarningMessage ParserErrorInfo {..} = case errType of
    WarnDeprecatedRowSyntax ->
      "Unary '#' syntax for row kinds is deprecated and will be removed in a future release. Use the 'Row' kind instead."
    WarnDeprecatedForeignKindSyntax ->
      "Foreign kind imports are deprecated and will be removed in a future release. Use empty 'data' instead."
    WarnDeprecatedKindImportSyntax ->
      "Kind imports are deprecated and will be removed in a future release. Omit the 'kind' keyword instead."
    WarnDeprecatedKindExportSyntax ->
      "Kind exports are deprecated and will be removed in a future release. Omit the 'kind' keyword instead."
    WarnDeprecatedCaseOfOffsideSyntax ->
      "Dedented expressions in case branches are deprecated and will be removed in a future release. Indent the branch's expression past it's binder instead."
  