{-# 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 (Int -> ParserErrorType -> ShowS
[ParserErrorType] -> ShowS
ParserErrorType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserErrorType] -> ShowS
$cshowList :: [ParserErrorType] -> ShowS
show :: ParserErrorType -> String
$cshow :: ParserErrorType -> String
showsPrec :: Int -> ParserErrorType -> ShowS
$cshowsPrec :: Int -> ParserErrorType -> ShowS
Show, ParserErrorType -> ParserErrorType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserErrorType -> ParserErrorType -> Bool
$c/= :: ParserErrorType -> ParserErrorType -> Bool
== :: ParserErrorType -> ParserErrorType -> Bool
$c== :: ParserErrorType -> ParserErrorType -> Bool
Eq, Eq ParserErrorType
ParserErrorType -> ParserErrorType -> Bool
ParserErrorType -> ParserErrorType -> Ordering
ParserErrorType -> ParserErrorType -> ParserErrorType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParserErrorType -> ParserErrorType -> ParserErrorType
$cmin :: ParserErrorType -> ParserErrorType -> ParserErrorType
max :: ParserErrorType -> ParserErrorType -> ParserErrorType
$cmax :: ParserErrorType -> ParserErrorType -> ParserErrorType
>= :: ParserErrorType -> ParserErrorType -> Bool
$c>= :: ParserErrorType -> ParserErrorType -> Bool
> :: ParserErrorType -> ParserErrorType -> Bool
$c> :: ParserErrorType -> ParserErrorType -> Bool
<= :: ParserErrorType -> ParserErrorType -> Bool
$c<= :: ParserErrorType -> ParserErrorType -> Bool
< :: ParserErrorType -> ParserErrorType -> Bool
$c< :: ParserErrorType -> ParserErrorType -> Bool
compare :: ParserErrorType -> ParserErrorType -> Ordering
$ccompare :: ParserErrorType -> ParserErrorType -> Ordering
Ord, forall x. Rep ParserErrorType x -> ParserErrorType
forall x. ParserErrorType -> Rep ParserErrorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParserErrorType x -> ParserErrorType
$cfrom :: forall x. ParserErrorType -> Rep ParserErrorType x
Generic, ParserErrorType -> ()
forall a. (a -> ()) -> NFData a
rnf :: ParserErrorType -> ()
$crnf :: ParserErrorType -> ()
NFData)

data ParserWarningType
  = WarnDeprecatedRowSyntax
  | WarnDeprecatedForeignKindSyntax
  | WarnDeprecatedKindImportSyntax
  | WarnDeprecatedKindExportSyntax
  | WarnDeprecatedCaseOfOffsideSyntax
  deriving (Int -> ParserWarningType -> ShowS
[ParserWarningType] -> ShowS
ParserWarningType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserWarningType] -> ShowS
$cshowList :: [ParserWarningType] -> ShowS
show :: ParserWarningType -> String
$cshow :: ParserWarningType -> String
showsPrec :: Int -> ParserWarningType -> ShowS
$cshowsPrec :: Int -> ParserWarningType -> ShowS
Show, ParserWarningType -> ParserWarningType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserWarningType -> ParserWarningType -> Bool
$c/= :: ParserWarningType -> ParserWarningType -> Bool
== :: ParserWarningType -> ParserWarningType -> Bool
$c== :: ParserWarningType -> ParserWarningType -> Bool
Eq, Eq ParserWarningType
ParserWarningType -> ParserWarningType -> Bool
ParserWarningType -> ParserWarningType -> Ordering
ParserWarningType -> ParserWarningType -> ParserWarningType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParserWarningType -> ParserWarningType -> ParserWarningType
$cmin :: ParserWarningType -> ParserWarningType -> ParserWarningType
max :: ParserWarningType -> ParserWarningType -> ParserWarningType
$cmax :: ParserWarningType -> ParserWarningType -> ParserWarningType
>= :: ParserWarningType -> ParserWarningType -> Bool
$c>= :: ParserWarningType -> ParserWarningType -> Bool
> :: ParserWarningType -> ParserWarningType -> Bool
$c> :: ParserWarningType -> ParserWarningType -> Bool
<= :: ParserWarningType -> ParserWarningType -> Bool
$c<= :: ParserWarningType -> ParserWarningType -> Bool
< :: ParserWarningType -> ParserWarningType -> Bool
$c< :: ParserWarningType -> ParserWarningType -> Bool
compare :: ParserWarningType -> ParserWarningType -> Ordering
$ccompare :: ParserWarningType -> ParserWarningType -> Ordering
Ord, forall x. Rep ParserWarningType x -> ParserWarningType
forall x. ParserWarningType -> Rep ParserWarningType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParserWarningType x -> ParserWarningType
$cfrom :: forall x. ParserWarningType -> Rep ParserWarningType x
Generic, ParserWarningType -> ()
forall a. (a -> ()) -> NFData a
rnf :: ParserWarningType -> ()
$crnf :: ParserWarningType -> ()
NFData)

data ParserErrorInfo a = ParserErrorInfo
  { forall a. ParserErrorInfo a -> SourceRange
errRange :: SourceRange
  , forall a. ParserErrorInfo a -> [SourceToken]
errToks :: [SourceToken]
  , forall a. ParserErrorInfo a -> LayoutStack
errStack :: LayoutStack
  , forall a. ParserErrorInfo a -> a
errType :: a
  } deriving (Int -> ParserErrorInfo a -> ShowS
forall a. Show a => Int -> ParserErrorInfo a -> ShowS
forall a. Show a => [ParserErrorInfo a] -> ShowS
forall a. Show a => ParserErrorInfo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserErrorInfo a] -> ShowS
$cshowList :: forall a. Show a => [ParserErrorInfo a] -> ShowS
show :: ParserErrorInfo a -> String
$cshow :: forall a. Show a => ParserErrorInfo a -> String
showsPrec :: Int -> ParserErrorInfo a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ParserErrorInfo a -> ShowS
Show, ParserErrorInfo a -> ParserErrorInfo a -> Bool
forall a. Eq a => ParserErrorInfo a -> ParserErrorInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserErrorInfo a -> ParserErrorInfo a -> Bool
$c/= :: forall a. Eq a => ParserErrorInfo a -> ParserErrorInfo a -> Bool
== :: ParserErrorInfo a -> ParserErrorInfo a -> Bool
$c== :: forall a. Eq a => ParserErrorInfo a -> ParserErrorInfo a -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ParserErrorInfo a) x -> ParserErrorInfo a
forall a x. ParserErrorInfo a -> Rep (ParserErrorInfo a) x
$cto :: forall a x. Rep (ParserErrorInfo a) x -> ParserErrorInfo a
$cfrom :: forall a x. ParserErrorInfo a -> Rep (ParserErrorInfo a) x
Generic, forall a. NFData a => ParserErrorInfo a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ParserErrorInfo a -> ()
$crnf :: forall a. NFData a => ParserErrorInfo a -> ()
NFData)

type ParserError = ParserErrorInfo ParserErrorType
type ParserWarning = ParserErrorInfo ParserWarningType

prettyPrintError :: ParserError -> String
prettyPrintError :: ParserError -> String
prettyPrintError pe :: ParserError
pe@ParserErrorInfo { SourceRange
errRange :: SourceRange
errRange :: forall a. ParserErrorInfo a -> SourceRange
errRange } =
  ParserError -> String
prettyPrintErrorMessage ParserError
pe forall a. Semigroup a => a -> a -> a
<> String
" at " forall a. Semigroup a => a -> a -> a
<> String
errPos
  where
  errPos :: String
errPos = case SourceRange
errRange of
    SourceRange (SourcePos Int
line Int
col) SourcePos
_ ->
      String
"line " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
line forall a. Semigroup a => a -> a -> a
<> String
", column " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
col

prettyPrintErrorMessage :: ParserError -> String
prettyPrintErrorMessage :: ParserError -> String
prettyPrintErrorMessage ParserErrorInfo {LayoutStack
[SourceToken]
SourceRange
ParserErrorType
errType :: ParserErrorType
errStack :: LayoutStack
errToks :: [SourceToken]
errRange :: SourceRange
errType :: forall a. ParserErrorInfo a -> a
errStack :: forall a. ParserErrorInfo a -> LayoutStack
errToks :: forall a. ParserErrorInfo a -> [SourceToken]
errRange :: forall a. ParserErrorInfo a -> SourceRange
..} = case ParserErrorType
errType of
  ParserErrorType
ErrWildcardInType ->
    String
"Unexpected wildcard in type; type wildcards are only allowed in value annotations"
  ParserErrorType
ErrConstraintInKind ->
    String
"Unsupported constraint in kind; constraints are only allowed in value annotations"
  ParserErrorType
ErrHoleInType ->
    String
"Unexpected hole in type; type holes are only allowed in value annotations"
  ParserErrorType
ErrExprInBinder ->
    String
"Expected pattern, saw expression"
  ParserErrorType
ErrExprInDeclOrBinder ->
    String
"Expected declaration or pattern, saw expression"
  ParserErrorType
ErrExprInDecl ->
    String
"Expected declaration, saw expression"
  ParserErrorType
ErrBinderInDecl ->
    String
"Expected declaration, saw pattern"
  ParserErrorType
ErrRecordUpdateInCtr ->
    String
"Expected ':', saw '='"
  ParserErrorType
ErrRecordPunInUpdate ->
    String
"Expected record update, saw pun"
  ParserErrorType
ErrRecordCtrInUpdate ->
    String
"Expected '=', saw ':'"
  ParserErrorType
ErrTypeInConstraint ->
    String
"Expected constraint, saw type"
  ParserErrorType
ErrElseInDecl ->
    String
"Expected declaration, saw 'else'"
  ParserErrorType
ErrInstanceNameMismatch ->
    String
"All instances in a chain must implement the same type class"
  ParserErrorType
ErrUnknownFundep ->
    String
"Unknown type variable in functional dependency"
  ParserErrorType
ErrImportInDecl ->
    String
"Expected declaration, saw 'import'"
  ParserErrorType
ErrGuardInLetBinder ->
    String
"Unexpected guard in let pattern"
  ParserErrorType
ErrKeywordVar ->
    String
"Expected variable, saw keyword"
  ParserErrorType
ErrKeywordSymbol ->
    String
"Expected symbol, saw reserved symbol"
  ParserErrorType
ErrQuotedPun ->
    String
"Unexpected quoted label in record pun, perhaps due to a missing ':'"
  ParserErrorType
ErrEof ->
    String
"Unexpected end of input"
  ErrLexeme (Just (Char
hd : String
_)) [String]
_ | Char -> Bool
isSpace Char
hd ->
    String
"Illegal whitespace character " forall a. Semigroup a => a -> a -> a
<> Char -> String
displayCodePoint Char
hd
  ErrLexeme (Just String
a) [String]
_ ->
    String
"Unexpected " forall a. Semigroup a => a -> a -> a
<> String
a
  ParserErrorType
ErrLineFeedInString ->
    String
"Unexpected line feed in string literal"
  ParserErrorType
ErrAstralCodePointInChar ->
    String
"Illegal astral code point in character literal"
  ParserErrorType
ErrCharEscape ->
    String
"Illegal character escape code"
  ParserErrorType
ErrNumberOutOfRange ->
    String
"Number literal is out of range"
  ParserErrorType
ErrLeadingZero ->
    String
"Unexpected leading zeros"
  ParserErrorType
ErrExpectedFraction ->
    String
"Expected fraction"
  ParserErrorType
ErrExpectedExponent ->
    String
"Expected exponent"
  ParserErrorType
ErrExpectedHex ->
    String
"Expected hex digit"
  ParserErrorType
ErrReservedSymbol ->
    String
"Unexpected reserved symbol"
  ErrCharInGap Char
ch ->
    String
"Unexpected character '" forall a. Semigroup a => a -> a -> a
<> [Char
ch] forall a. Semigroup a => a -> a -> a
<> String
"' in gap"
  ParserErrorType
ErrModuleName ->
    String
"Invalid module name; underscores and primes are not allowed in module names"
  ParserErrorType
ErrQualifiedName ->
    String
"Unexpected qualified name"
  ParserErrorType
ErrEmptyDo ->
    String
"Expected do statement"
  ErrLexeme Maybe String
_ [String]
_ ->
    String
basicError
  ParserErrorType
ErrConstraintInForeignImportSyntax ->
    String
"Constraints are not allowed in foreign imports. Omit the constraint instead and update the foreign module accordingly."
  ParserErrorType
ErrToken
    | SourceToken TokenAnn
_ (TokLeftArrow SourceStyle
_) : [SourceToken]
_ <- [SourceToken]
errToks ->
        String
"Unexpected \"<-\" in expression, perhaps due to a missing 'do' or 'ado' keyword"
  ParserErrorType
ErrToken ->
    String
basicError
  ErrCustom String
err ->
    String
err

  where
  basicError :: String
basicError = case [SourceToken]
errToks of
    SourceToken
tok : [SourceToken]
_ -> Token -> String
basicTokError (SourceToken -> Token
tokValue SourceToken
tok)
    [] -> String
"Unexpected input"

  basicTokError :: Token -> String
basicTokError = \case
    Token
TokLayoutStart -> String
"Unexpected or mismatched indentation"
    Token
TokLayoutSep   -> String
"Unexpected or mismatched indentation"
    Token
TokLayoutEnd   -> String
"Unexpected or mismatched indentation"
    Token
TokEof         -> String
"Unexpected end of input"
    Token
tok            -> String
"Unexpected token '" forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Token -> Text
printToken Token
tok) forall a. Semigroup a => a -> a -> a
<> String
"'"

  displayCodePoint :: Char -> String
  displayCodePoint :: Char -> String
displayCodePoint Char
x =
    String
"U+" forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (forall r. PrintfType r => String -> r
printf String
"%0.4x" (forall a. Enum a => a -> Int
fromEnum Char
x))

prettyPrintWarningMessage :: ParserWarning -> String
prettyPrintWarningMessage :: ParserWarning -> String
prettyPrintWarningMessage ParserErrorInfo {LayoutStack
[SourceToken]
SourceRange
ParserWarningType
errType :: ParserWarningType
errStack :: LayoutStack
errToks :: [SourceToken]
errRange :: SourceRange
errType :: forall a. ParserErrorInfo a -> a
errStack :: forall a. ParserErrorInfo a -> LayoutStack
errToks :: forall a. ParserErrorInfo a -> [SourceToken]
errRange :: forall a. ParserErrorInfo a -> SourceRange
..} = case ParserWarningType
errType of
  ParserWarningType
WarnDeprecatedRowSyntax ->
    String
"Unary '#' syntax for row kinds is deprecated and will be removed in a future release. Use the 'Row' kind instead."
  ParserWarningType
WarnDeprecatedForeignKindSyntax ->
    String
"Foreign kind imports are deprecated and will be removed in a future release. Use empty 'data' instead."
  ParserWarningType
WarnDeprecatedKindImportSyntax ->
    String
"Kind imports are deprecated and will be removed in a future release. Omit the 'kind' keyword instead."
  ParserWarningType
WarnDeprecatedKindExportSyntax ->
    String
"Kind exports are deprecated and will be removed in a future release. Omit the 'kind' keyword instead."
  ParserWarningType
WarnDeprecatedCaseOfOffsideSyntax ->
    String
"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."