implementation module lex

import Control.Monad, Control.Applicative
import Data.Either, Data.Maybe, Data.Map, Data.Func
import StdString
import StdTuple
from StdFunc import const, o
import StdBool
import StdList
import StdChar

import yard

lexer :: [Char] -> LexerOutput
lexer r = case runParser lexProgram r of
	(Right p, _) = Right p
	(Left e, _) = Left $ toString e

trans1 :: Char a -> Parser Char a
trans1 t r = item t >>| pure r

lexProgram :: Parser Char [Token]
lexProgram = lexToken >>= \t->pure [(0, 0, t)]

lexToken :: Parser Char TokenValue
lexToken = 
	(lexKw "var" VarToken) <|>
	(lexKw "Void" VoidToken) <|>
	(lexKw "return" ReturnToken) <|>
	(lexKw "if" IfToken) <|>
	(lexKw "else" ElseToken) <|>
	(lexKw "while" WhileToken) <|>
	(lexKw "True" TrueToken) <|>
	(lexKw "False" FalseToken) <|>
	(lexKw "Int" IntTypeToken) <|>
	(lexKw "Bool" BoolTypeToken) <|>
	(lexKw "Char" CharTypeToken) <|>
	//Escape chars
	(liftM CharToken $ item '\'' *> item '\\' *> lexEscape <* item '\'') <|>
	//Normal chars
	(liftM CharToken $ item '\'' *> satisfy ((<>) '\'') <* item '\'') <|>
	(lexOp "::" DoubleColonToken) <|>
	(lexOp "!=" NotEqualToken) <|>
	(lexOp "<=" LesserEqToken) <|>
	(lexOp ">=" GreaterEqToken) <|>
	(lexOp "==" EqualsToken) <|>
	(lexOp "&&" AmpersandsToken) <|>
	(lexOp "||" PipesToken) <|>
	(lexOp "[]" EmptyListToken) <|>
	(lexOp "->" ArrowToken) <|>
	(lexOp "(" BraceOpenToken) <|>
	(lexOp ")" BraceCloseToken) <|>
	(lexOp "{" CBraceOpenToken) <|>
	(lexOp "}" CBraceCloseToken) <|>
	(lexOp "[" SquareOpenToken) <|>
	(lexOp "]" SquareCloseToken) <|>
	(lexOp "," CommaToken) <|>
	(lexOp ":" ColonToken) <|>
	(lexOp ";" SColonToken) <|>
	(lexOp "." DotToken) <|>
	(lexOp "+" PlusToken) <|>
	(lexOp "*" StarToken) <|>
	(lexOp "/" SlashToken) <|>
	(lexOp "%" PercentToken) <|>
	(lexOp "=" AssignmentToken) <|>
	(lexOp "<" LesserToken) <|>
	(lexOp ">" BiggerToken) <|>
	(lexOp "!" ExclamationToken) <|>
	(lexOp "-" DashToken) <|>
	//Numbers
	(liftM (NumberToken o toInt o toString) $ some $ satisfy isDigit) <|>
	//Identifiersr
	(liftM IdentToken $ some $ satisfy isIdentChar) <|>
	(satisfy isSpace >>| lexToken)

lexEscape = (
	lexOp "a" (toChar 7) <|>
	lexOp "b" '\b' <|>
	lexOp "f" '\f' <|>
	lexOp "n" '\n' <|>
	lexOp "r" '\t' <|>
	lexOp "v" '\v' <|>
	lexOp "'" '\''
	) <?> ("Unknown escape", 0)

lexKw :: String a -> Parser Char a
lexKw kw tv = list (fromString kw) <* check (not o isIdentChar) >>| pure tv

lexOp :: String a -> Parser Char a
lexOp s tv = list (fromString s) >>| pure tv

isIdentChar :: Char -> Bool
isIdentChar c = isAlphanum c || c == '_'