{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
module Language.Cimple.Parser.Error.Pretty
    ( describeContext
    , describeExpected
    , formatParseError
    ) where

import           Data.List                   (intercalate, isPrefixOf, nub,
                                              (\\))
import           Data.Maybe                  (fromMaybe, listToMaybe, mapMaybe)
import           Data.Text                   (Text)
import           Language.Cimple.DescribeAst (describeLexeme, describeNode,
                                              getLoc)
import           Language.Cimple.Lexer       (AlexPosn (..), Context (..),
                                              Lexeme (..), ParseError (..),
                                              lexemePosn)
import           Language.Cimple.Tokens      (LexemeClass (..))

formatParseError :: ParseError -> String
formatParseError :: ParseError -> String
formatParseError (ParseError p :: AlexPosn
p@(AlexPn Int
_ Int
line Int
col) [Context]
ctx [String]
expected Lexeme Text
l) =
    let (AlexPn Int
_ Int
bestLine Int
bestCol) = if Int
line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then AlexPosn -> Maybe AlexPosn -> AlexPosn
forall a. a -> Maybe a -> a
fromMaybe AlexPosn
p (Maybe AlexPosn -> AlexPosn) -> Maybe AlexPosn -> AlexPosn
forall a b. (a -> b) -> a -> b
$ [AlexPosn] -> Maybe AlexPosn
forall a. [a] -> Maybe a
listToMaybe ([AlexPosn] -> Maybe AlexPosn) -> [AlexPosn] -> Maybe AlexPosn
forall a b. (a -> b) -> a -> b
$ (Context -> Maybe AlexPosn) -> [Context] -> [AlexPosn]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Context -> Maybe AlexPosn
getContextPosn [Context]
ctx
            else AlexPosn
p
        getContextPosn :: Context -> Maybe AlexPosn
getContextPosn (ContextLexeme String
_ (L AlexPosn
p' LexemeClass
_ Text
_)) = AlexPosn -> Maybe AlexPosn
forall a. a -> Maybe a
Just AlexPosn
p'
        getContextPosn (ContextNode String
_ Node (Lexeme Text)
n)           = AlexPosn -> Maybe AlexPosn
forall a. a -> Maybe a
Just (Lexeme Text -> AlexPosn
forall text. Lexeme text -> AlexPosn
lexemePosn (Node (Lexeme Text) -> Lexeme Text
forall l. Node (Lexeme l) -> Lexeme l
getLoc Node (Lexeme Text)
n))
        getContextPosn Context
_                            = Maybe AlexPosn
forall a. Maybe a
Nothing
        ctxNames :: [String]
ctxNames = [String] -> [String]
forall a. Eq a => [a] -> [a]
dedupe ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Context -> String) -> [Context] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Context -> String
describeContext [Context]
ctx
        contextStr :: String
contextStr = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ctxNames then String
"" else String
" while parsing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" > " ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
ctxNames)
        lexemeStr :: String
lexemeStr = String
" near " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Lexeme Text -> String
forall a. Show a => Lexeme a -> String
describeLexeme Lexeme Text
l
        expectedStr :: String
expectedStr = String
"; expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
describeExpected [String]
expected
        hint :: String
hint = [Context] -> [String] -> Lexeme Text -> String
getHint [Context]
ctx [String]
expected Lexeme Text
l
    in String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
bestLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
bestCol String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Parse error" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
contextStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lexemeStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expectedStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hint

dedupe :: Eq a => [a] -> [a]
dedupe :: [a] -> [a]
dedupe []     = []
dedupe (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. Eq a => [a] -> [a]
dedupe ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) [a]
xs)

getHint :: [Context] -> [String] -> Lexeme Text -> String
getHint :: [Context] -> [String] -> Lexeme Text -> String
getHint [Context]
ctx [String]
expected Lexeme Text
l
    | Lexeme Text -> Bool
isTerminator Lexeme Text
l =
        let closers :: [String]
closers = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isCloser [String]
expected [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Context -> Maybe String) -> [Context] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe String
closerForCtx (String -> Maybe String)
-> (Context -> String) -> Context -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> String
getContextName) [Context]
ctx
        in if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
closers
           then String
cimpleHint
           else String
"\nHint: Reached a terminator before finding the expected closing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" or " [String]
closers String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
    | Lexeme Text -> Bool
isKeyword Lexeme Text
l Bool -> Bool -> Bool
&& (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
isIdentifierToken [String]
expected =
        String
"\nHint: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Lexeme Text -> String
forall a. Show a => Lexeme a -> String
describeLexeme Lexeme Text
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is a reserved keyword and cannot be used as an identifier."
    | Lexeme Text -> Bool
isIdentifier Lexeme Text
l Bool -> Bool -> Bool
&& (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
isIdentifierToken [String]
expected =
        let expectedDesc :: String
expectedDesc = [String] -> String
describeExpected ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isIdentifierToken [String]
expected)
            foundDesc :: String
foundDesc = Lexeme Text -> String
forall a. Show a => Lexeme a -> String
describeLexeme Lexeme Text
l
        in String
"\nHint: Found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
foundDesc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but here we expected a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expectedDesc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
    | Bool
otherwise = String
cimpleHint
  where
    cimpleHint :: String
cimpleHint = if (Context -> Bool) -> [Context] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Endif") (String -> Bool) -> (Context -> String) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> String
getContextName) [Context]
ctx Bool -> Bool -> Bool
&& (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"'/*'" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
expected
                 then String
"\nHint: In Cimple, every #endif must be followed by a comment indicating what it closes (e.g. '#endif /* FLAG */')."
                 else String
""

getContextName :: Context -> String
getContextName :: Context -> String
getContextName (Context String
name)         = String
name
getContextName (ContextLexeme String
name Lexeme Text
_) = String
name
getContextName (ContextNode String
name Node (Lexeme Text)
_)   = String
name

isIdentifier :: Lexeme Text -> Bool
isIdentifier :: Lexeme Text -> Bool
isIdentifier (L AlexPosn
_ LexemeClass
c Text
_) = LexemeClass
c LexemeClass -> [LexemeClass] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [LexemeClass
IdVar, LexemeClass
IdSueType, LexemeClass
IdConst, LexemeClass
IdFuncType, LexemeClass
IdStdType]

isIdentifierToken :: String -> Bool
isIdentifierToken :: String -> Bool
isIdentifierToken String
s = String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"ID_VAR", String
"ID_SUE_TYPE", String
"ID_CONST", String
"ID_FUNC_TYPE", String
"ID_STD_TYPE"]

isKeyword :: Lexeme Text -> Bool
isKeyword :: Lexeme Text -> Bool
isKeyword (L AlexPosn
_ LexemeClass
c Text
_) = LexemeClass
c LexemeClass -> LexemeClass -> Bool
forall a. Ord a => a -> a -> Bool
>= LexemeClass
KwBitwise Bool -> Bool -> Bool
&& LexemeClass
c LexemeClass -> LexemeClass -> Bool
forall a. Ord a => a -> a -> Bool
<= LexemeClass
KwWhile

closerForCtx :: String -> Maybe String
closerForCtx :: String -> Maybe String
closerForCtx String
name = case String
name of
    String
"FunctionCall"                    -> String -> Maybe String
forall a. a -> Maybe a
Just String
"')'"
    String
"ArgList"                         -> String -> Maybe String
forall a. a -> Maybe a
Just String
"')'"
    String
"CompoundStmt"                    -> String -> Maybe String
forall a. a -> Maybe a
Just String
"'}'"
    String
"AggregateDecl"                   -> String -> Maybe String
forall a. a -> Maybe a
Just String
"'}'"
    String
"MemberDecls"                     -> String -> Maybe String
forall a. a -> Maybe a
Just String
"'}'"
    String
"EnumDecl"                        -> String -> Maybe String
forall a. a -> Maybe a
Just String
"'}'"
    String
"PostfixExpr"                     -> String -> Maybe String
forall a. a -> Maybe a
Just String
"']'" -- Often array access
    String
"PrimaryExpr"                     -> String -> Maybe String
forall a. a -> Maybe a
Just String
"')'" -- Parenthesized expr
    String
"ParenthesizedExpr"               -> String -> Maybe String
forall a. a -> Maybe a
Just String
"')'"
    String
"FunctionPrototype(ID_VAR)"       -> String -> Maybe String
forall a. a -> Maybe a
Just String
"')'"
    String
"FunctionPrototype(ID_FUNC_TYPE)" -> String -> Maybe String
forall a. a -> Maybe a
Just String
"')'"
    String
_                                 -> Maybe String
forall a. Maybe a
Nothing

isTerminator :: Lexeme Text -> Bool
isTerminator :: Lexeme Text -> Bool
isTerminator (L AlexPosn
_ LexemeClass
c Text
_) = LexemeClass
c LexemeClass -> [LexemeClass] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [LexemeClass
PctSemicolon, LexemeClass
Eof, LexemeClass
PpNewline]

isCloser :: String -> Bool
isCloser :: String -> Bool
isCloser String
s = String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"')'", String
"'}'", String
"']'", String
"'*/'", String
"'@}'"]

describeContext :: Context -> String
describeContext :: Context -> String
describeContext (Context String
name) = String -> String
describeContextName String
name
describeContext (ContextLexeme String
name Lexeme Text
l) =
    let name' :: String
name' = String -> String
describeContextName String
name
        lex' :: String
lex' = Lexeme Text -> String
forall a. Show a => Lexeme a -> String
describeLexeme Lexeme Text
l
    in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name' then String
lex'
       else if Lexeme Text -> Bool
isIdentifier Lexeme Text
l then String
name' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lex'
       else String
name'
describeContext (ContextNode String
name Node (Lexeme Text)
n) =
    let name' :: String
name' = String -> String
describeContextName String
name
        node' :: String
node' = Node (Lexeme Text) -> String
forall a. Show a => Node a -> String
describeNode Node (Lexeme Text)
n
    in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name' then String
node' else String
name' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
node'

describeContextName :: String -> String
describeContextName :: String -> String
describeContextName String
name = case String
name of
    String
"TranslationUnit"                         -> String
""
    String
"ToplevelDecl"                            -> String
"top-level declaration"
    String
"Endif"                                   -> String
"#endif"
    String
"FunctionDecl"                            -> String
"function"
    String
"FunctionDefn"                            -> String
"function"
    String
"FunctionDeclarator"                      -> String
"function"
    String
"CompoundStmt"                            -> String
"block"
    String
"Stmt"                                    -> String
"statement"
    String
"VarDeclStmt"                             -> String
"variable declaration"
    String
"VarDecl"                                 -> String
"variable declaration"
    String
"MemberDecls"                             -> String
"struct/union members"
    String
"MemberDecl"                              -> String
"struct/union member"
    String
"IfStmt(CompoundStmt)"                    -> String
"if statement"
    String
"IfStmt(ReturnStmt)"                      -> String
"if statement"
    String
"ForStmt"                                 -> String
"for loop"
    String
"WhileStmt"                               -> String
"while loop"
    String
"DoWhileStmt"                             -> String
"do-while loop"
    String
"SwitchStmt"                              -> String
"switch statement"
    String
"AggregateDecl"                           -> String
"struct/union definition"
    String
"AggregateType"                           -> String
"struct/union definition"
    String
"EnumDecl"                                -> String
"enum definition"
    String
"ConstExpr"                               -> String
"constant expression"
    String
"Expr"                                    -> String
"expression"
    String
"PrimaryExpr"                             -> String
"expression"
    String
"FunctionCall"                            -> String
"function call"
    String
"MacroBody"                               -> String
"macro body"
    String
"FunctionPrototype(ID_VAR)"               -> String
"function"
    String
"FunctionPrototype(ID_FUNC_TYPE)"         -> String
"function"
    String
"PreprocIf(Stmts)"                        -> String
"#if block"
    String
"PreprocIfdef(Stmts)"                     -> String
"#ifdef block"
    String
"PreprocIf(ToplevelDecls)"                -> String
"#if block"
    String
"PreprocIfdef(ToplevelDecls)"             -> String
"#ifdef block"
    String
"Enumerator"                              -> String
"enumerator"
    String
"EnumeratorName"                          -> String
"enumerator"
    String
"InitialiserList"                         -> String
"initializer list"
    String
"QualType(LocalLeafType)"                 -> String
"type"
    String
"QualType(GlobalLeafType)"                -> String
"type"
    String
"LocalLeafType"                           -> String
"type"
    String
"GlobalLeafType"                          -> String
"type"
    String
_ | String
"FunctionPrototype" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name -> String
"function"
    String
_ | String
"PreprocIfdef" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name      -> String
"#ifdef block"
    String
_ | String
"PreprocIf" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name         -> String
"#if block"
    String
_ | String
"IfStmt" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name            -> String
"if statement"
    String
_ | String
"push_" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name             -> String
""
    String
_                                         -> String
name

describeExpected :: [String] -> String
describeExpected :: [String] -> String
describeExpected [] = String
"end of file"
describeExpected [String
option] = String -> String
describeTokenName String
option
describeExpected [String]
options
    | [String] -> Bool
forall (t :: * -> *) a.
(Foldable t, Eq a, IsString a) =>
t a -> Bool
allComment [String]
options = String
"a comment"
    | [String] -> Bool
wants [String
"break", String
"const", String
"continue", String
"ID_CONST", String
"VLA"] = String
"statement or declaration"
    | [String] -> Bool
wants [String
"ID_FUNC_TYPE", String
"non_null", String
"static", String
"'#include'"] = String
"top-level declaration or definition"
    | [String]
options [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"ID_FUNC_TYPE", String
"ID_STD_TYPE", String
"ID_SUE_TYPE", String
"struct", String
"union", String
"void"] = String
"top-level type specifier"
    | [String]
options [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"ID_STD_TYPE", String
"ID_SUE_TYPE", String
"struct", String
"union", String
"void"] = String
"type specifier"
    | [String]
options [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"ID_STD_TYPE", String
"ID_SUE_TYPE", String
"bitwise", String
"const", String
"force", String
"struct", String
"union", String
"void"] = String
"type specifier"
    | [String]
options [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"ID_CONST", String
"ID_VAR", String
"LIT_CHAR", String
"LIT_FLOAT", String
"LIT_FALSE", String
"LIT_INTEGER", String
"'{'"] = String
"constant or literal"
    | [String
"ID_FUNC_TYPE", String
"ID_STD_TYPE", String
"ID_SUE_TYPE", String
"ID_VAR"] [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String]
options = String
"type specifier or variable name"
    | [String
"ID_FUNC_TYPE", String
"ID_STD_TYPE", String
"ID_SUE_TYPE", String
"bitwise", String
"const"] [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String]
options = String
"type specifier"
    | [String
"ID_CONST", String
"sizeof", String
"LIT_CHAR", String
"LIT_FALSE", String
"LIT_INTEGER"] [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String]
options = String
"constant expression"
    | [String
"ID_CONST", String
"ID_SUE_TYPE", String
"'/*'" ] [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String]
options = String
"enumerator, type name, or comment"
    | [String] -> Bool
wants [String
"'defined'"] = String
"preprocessor constant expression"
    | [String] -> Bool
wants [String
"'&'", String
"'&&'", String
"'*'", String
"'=='", String
"';'"] = String
"operator or end of statement"
    | [String] -> Bool
wants [String
"'&'", String
"'&&'", String
"'*'", String
"'^'", String
"'!='"] = String
"operator"
    | [String] -> Bool
wants [String
"ID_CONST", String
"ID_VAR", String
"LIT_CHAR", String
"'*'", String
"'('"] = String
"expression"
    | [String
"ID_CONST", String
"ID_STD_TYPE", String
"ID_SUE_TYPE", String
"ID_VAR", String
"const", String
"sizeof"] [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String]
options = String
"expression or type specifier"
    | [String
"ID_CONST", String
"ID_STD_TYPE", String
"ID_SUE_TYPE", String
"const", String
"sizeof"] [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String]
options = String
"constant expression or type specifier"
    | [String
"'&='", String
"'->'", String
"'*='"] [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String]
options = String
"assignment or member/array access"
    | [String] -> Bool
wants [String
"'='", String
"'*='", String
"'/='", String
"'+='", String
"'-='"] = String
"assignment operator"
    | [String] -> Bool
wants [String
"CMT_WORD"] = String
"comment contents"

    | [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
options Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = [String] -> String
commaOr [String]
options
    | Bool
otherwise           = String
"one of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
commaOr [String]
options
  where
    allComment :: t a -> Bool
allComment t a
opts = Bool -> Bool
not (t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
opts) Bool -> Bool -> Bool
&& (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
"'/*'", a
"'/**'", a
"'/***'", a
"'/** @{'", a
"'/** @} */'", a
"IGN_START"]) t a
opts
    wants :: [String] -> Bool
wants [String]
xs = [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String]
xs [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
options)

describeTokenName :: String -> String
describeTokenName :: String -> String
describeTokenName String
name = case String
name of
    String
"ID_VAR"       -> String
"variable name"
    String
"ID_SUE_TYPE"  -> String
"type name"
    String
"ID_CONST"     -> String
"constant name"
    String
"ID_FUNC_TYPE" -> String
"function type name"
    String
"ID_STD_TYPE"  -> String
"standard type name"
    String
_              -> String
name

commaOr :: [String] -> String
commaOr :: [String] -> String
commaOr = [String] -> String
go ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse
  where
    go :: [String] -> String
go []     = String
""
    go (String
x:[String]
xs) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
xs) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" or " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
x