module skeleton3b
/* 
	Mart Lubbers s4109503
	Charlie Gerhardus s3050009
*/

/*
	Advanced Programming.
	Skeleton for exercise 3.3 and 3.4.
	To be used in a project with the environment Everything, 
	or StdEnv with an import of StdMaybe from StdLib

	Pieter Koopman, pieter@cs.ru.nl
*/

import StdEnv, StdGeneric, StdMaybe, GenEq

//------------------ show --------------
generic show_ a :: a [String] -> [String]

show_{|Int|}  i c = [toString i:c]
show_{|Bool|} b c = [toString b:c]
show_{|UNIT|} _ c = c

show a = show_{|*|} a []

//------------------ parse --------------

:: Result a :== Maybe (a, [String])

generic parse a :: [String] -> Result a

parse{|Bool|} ["True" :r] = Just (True ,r)
parse{|Bool|} ["False":r] = Just (False,r)
parse{|Bool|} _ = Nothing

//------------------ some data types --------------

:: T		= C
:: Color	= Red | Yellow | Blue
:: Tree a	= Tip | Bin a (Tree a) (Tree a)

//------------------ general useful --------------

instance + String where (+) s t = s+++t
derive bimap Maybe, []

//------------------ to test if parse and show work properly --------------

test :: t -> Bool | gEq{|*|}, show_{|*|}, parse{|*|} t
test x
	= case parse{|*|} (show x) of
		Just (y,[])	= x === y
		_			= False

/***** End Prelude, add all new code below this line *************************/
//Show stuff
show_{|OBJECT|} f (OBJECT x) c = f x c
show_{|CONS of {gcd_name, gcd_arity}|} f (CONS x) c
| gcd_arity == 0 = [gcd_name:f x c]
| otherwise = ["(":gcd_name:f x [")":c]]
show_{|PAIR|} f1 f2 (PAIR x1 x2) c = f1 x1 (f2 x2 c)
show_{|EITHER|} f _ (LEFT x) c = f x c
show_{|EITHER|} _ f (RIGHT x) c = f x c
show_{|(,)|} f1 f2 (x1, x2) c = ["("] ++ f1 x1 [",":f2 x2 c]++[")"]

derive show_ T, [], Color, Tree

//Parse stuff (monads would make this more neat)
parse{|Int|} [i:r] = Just (toInt i, r)
parse{|Int|} _ = Nothing
parse{|UNIT|} r = Just (UNIT, r)
parse{|OBJECT|} f r = case f r of
	Just (x, r) = Just (OBJECT x, r)
	_ = Nothing
parse{|CONS of {gcd_name, gcd_arity}|} f r
| gcd_arity == 0 = case r of
	[gcd_name:r] = case f r of
		Just (x, r) = Just (CONS x, r)
		_ = Nothing
	_ = Nothing
| otherwise = case r of
	["(",gcd_name:r] = case f r of
		Just (x, r) = Just (CONS x, r % (0, (length r) - 2))
		_ = Nothing
	_ = Nothing
parse{|PAIR|} f1 f2 r = case f1 r of
	Just (x1, r) = case f2 r of
		Just (x2, r) = Just (PAIR x1 x2, r)
		_ = Nothing
	_ = Nothing
parse{|EITHER|} f1 f2 r = case f2 r of
	Just (x, r) = Just (RIGHT x, r)
	_ = case f1 r of
		Just (x, r) = Just (LEFT x, r)
		_ = Nothing
parse{|(,)|} f1 f2 ["(":r] = case f1 r of
	Just (x1, r) = case r of
		[",":r] = case f2 r of
			Just (x2, r) = Just ((x1, x2), r % (0, (length r) - 2))
			_ = Nothing
		_ = Nothing
	_ = Nothing

derive parse T, [], Color, Tree
Start = show 42