module pc


import StdEnv => qualified abs

import Data.Either
import Data.Functor
import Data.Func
import Data.Tuple
import Control.Applicative
import Control.Monad
import Text.Parsers.Simple.ParserCombinators

class type a | toString a

class lit v where
	lit :: a -> v a | type a
class lambda v where
	abs :: ((v a) -> v b) -> v (a -> b)
	(@) infixl 9 :: (v (a -> b)) (v a) -> v b
class tupl v where
	tupl :: (v a) (v b) -> v (a, b)
	first :: (v (a, b)) -> v a
	second :: (v (a, b)) -> v b

//Pretty printing
:: Show a = Show (Int [String] -> [String])
show :: (Show a) -> String
show a = foldr (+++) "" (unShow a 0 [])
unShow (Show a) = a
instance lit Show where
	lit a = Show \i c->[toString a:c]
instance lambda Show where
	abs l = Show \i c->let showV = Show \_ c->["\\v",toString i:c]
		in ["(":unShow showV i [".":unShow (l showV) (i+1) [")":c]]]
	(@) f x = Show \i c->["(":unShow f i [" ":unShow x i [")":c]]]
instance tupl Show where
	tupl l r = Show \i c->["(":unShow l i [",":unShow r i c]]
	first t = Show \i c->unShow t i [".fst":c]
	second t = Show \i c->unShow t i [".second":c]

//Evaluation
:: Eval a = Eval a
eval = unEval
unEval (Eval a) = a
instance lit Eval where
	lit a = Eval a
instance lambda Eval where
	abs l = Eval $ unEval o l o Eval
	(@) f x = Eval o unEval f o unEval $ x
instance tupl Eval where
	tupl l r = Eval (unEval l, unEval r)
	first t = Eval o fst o unEval $ t
	second t = Eval o snd o unEval $ t

//Parsing
class parser a :: Parser Char a
instance parser Int where
	parser = foldl (\a b->10*a + digitToInt b) 0 <$> some pDigit <* many pSpace
instance parser (a, b) | parser a & parser b where
	parser = tuple <$ pToken '(' <*> parser <* pToken ',' <*> parser <* pToken ')'

:: T = E.e: T e & type e
instance toString T where toString (T e) = toString e
instance toString (a, b) | toString a & toString b where
	toString (a, b) = "(" +++ toString a +++ "," +++ toString b +++ ")"

pIdent = toString <$> some pAlpha
pBracket p = pToken '(' *> p <* pToken ')'

eparser :: Parser Char (v T) | lit v
eparser
	= lit <$> litparser

litparser :: Parser Char T
litparser
	// parse Int
	=   T o foldl (\a b->10*a+digitToInt b) 0 <$> some pDigit
	// parse tuple
	<|> pBracket ((\(T a) (T b)->T (a, b)) <$> litparser <* pToken ',' <*> litparser)

Start = show <$> parse eparser ['(42,(44,45))']
//Start :: (String, Int, Either [String] AST)
//Start = (show t, eval t, parse parser ['(\\x.\\y.x)42 43'])
//where
//	t :: v Int | tupl, lambda, lit v
//	t = (abs \x->abs \y->x) @ lit 42 @ lit 43