implementation module parse

import Control.Applicative
import Control.Monad
import Data.Either
import Data.Functor
import Data.Func
import StdEnv
import Text.Parsers.Simple.ParserCombinators => qualified parse

import ast

(<:>) infixl 0 :: a (m [a]) -> m [a] | Functor m
(<:>) l r = (\xs->[l:xs]) <$> r

:: Token = TEq | TSemiColon | TLambda | TDot | TBrackOpen | TBrackClose | TBool Bool | TChar Char | TInt Int | TIdent [Char]

lex :: [Char] -> Either [String] [Token]
lex [] = pure []
lex ['=':ts] = TEq <:> lex ts
lex [';':ts] = TSemiColon <:> lex ts
lex ['\\':ts] = TLambda <:> lex ts
lex ['.':ts] = TDot <:> lex ts
lex [')':ts] = TBrackClose <:> lex ts
lex ['(':ts] = TBrackOpen <:> lex ts
lex ['True':ts] = TBool True <:> lex ts
lex ['False':ts] = TBool False <:> lex ts
lex ['\'',c,'\'':ts] = TChar c <:> lex ts
lex ['-',t:ts]
	| isDigit t = lex [t:ts] >>= \v->case v of
		[TInt i:rest] = Right [TInt (~i):rest]
		x = pure x
lex [t:ts]
	| isSpace t = lex ts
	| isDigit t
		# (i, ts) = span isDigit [t:ts]
		= TInt (toInt (toString i)) <:> lex ts
	| isAlpha t
		# (i, ts) = span isAlpha [t:ts]
		= TIdent i <:> lex ts
	= Left ["Unexpected: " +++ toString t +++ " ord: " +++ toString (toInt t)]

parse :: ([Token] -> Either [String] AST)
parse = 'Text.Parsers.Simple.ParserCombinators'.parse (AST <$> many pFunction)
where
	pId = (\(TIdent i)->i) <$> pSatisfy (\t->t=:(TIdent _))

	pFunction :: Parser Token Function
	pFunction
		=   Function
		<$> pId
		<*> many pId
		<*  pSatisfy (\t->t=:TEq)
		<*> pExpression
		<*  pSatisfy (\t->t=:TSemiColon)

	pExpression :: Parser Token Expression
	pExpression = flip pChainl1 (pure App) $
		     (Lambda <$ pSatisfy (\t->t=:TLambda) <*> pId <* pSatisfy (\t->t=:TDot) <*> pExpression)
		<<|> (pSatisfy (\t->t=:TBrackOpen) *> pExpression <* pSatisfy (\t->t=:TBrackClose))
		<<|> ((\(TInt i)->Lit (Int i)) <$> pSatisfy (\t->t=:(TInt _)))
		<<|> ((\(TChar i)->Lit (Char i)) <$> pSatisfy (\t->t=:(TChar _)))
		<<|> ((\(TBool i)->Lit (Bool i)) <$> pSatisfy (\t->t=:(TBool _)))
		<<|> (Var <$> pId)