
{-# LANGUAGE Safe, NoMonomorphismRestriction #-}


module Text.ParserCombinators.MyParser.Exercises.N0.Lexer where

	import MonadLib
	import Control.Applicative
	import Data.Functor.Identity
	import Data.Char
	import Data.Maybe
	import Data.Either
	import Text.ParserCombinators.MyParser

	data N0 = VAR String | NUM Integer | TRUE | FALSE | EQUALS | LESS | PLUS | MINUS | TIMES | ASSIGN | SEQ | SKIP | IF | THEN | ELSE | WHILE | LEFT | RIGHT | NOT | AND | PRINT | SPACE deriving (Show, Eq)

	word = foldl (<|>) empty
		[
			TRUE <$ ones "true",
			FALSE <$ ones "false",
			SKIP <$ ones "skip",
			IF <$ ones "if",
			THEN <$ ones "then",
			ELSE <$ ones "else",
			WHILE <$ ones "while",
			PRINT <$ ones "print",
			NUM . foldl (\x y -> x * 10 + y) 0 <$> some (toInteger . digitToInt <$> satisfies isDigit),
			VAR <$> some (satisfies isLower)
		]

	symbol = foldl (<|>) empty
		[
			EQUALS <$ ones "=",
			LESS <$ ones "<",
			PLUS <$ ones "+",
			MINUS <$ ones "-",
			TIMES <$ ones "*",
			ASSIGN <$ ones ":=",
			SEQ <$ ones ";",
			LEFT <$ ones "(",
			RIGHT <$ ones ")",
			AND <$ ones "&&",
			NOT <$ ones "!!",
			SPACE <$ space
		]

	parseWord = do
		x <- some symbol
		y <- word
		return $ x ++ [y]

	space = some (satisfies isSpace)


	lexer :: ParserT Char String Identity [N0]
	lexer = do
		x <- optional word
		y <- many parseWord
		z <- many symbol
		return $ filter (SPACE /=) $ maybeToList x ++ join y ++ z

	lexn0 str = take 1 $ run' (lexer <* end) str

	isVar (VAR a) = Just a
	isVar _ = Nothing
	isNum (NUM a) = Just a
	isNum _ = Nothing

	t1 = "while skipy < 100 (skipy := skipy + 10; skip)"
	t2 = "while:=\nif bif skipy="
	t3 = "abc::==def:=:="
	t4 = "if % = $ then 0 else 1"
