module program1

import StdBool
import StdEnum
from StdFunc import flip, o
import StdList
import StdString
import StdTuple

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Functor
import Data.List
import Data.Maybe

:: Bin a = Leaf | Bin (Bin a) a (Bin a)
:: Rose a = Rose a [Rose a]

instance == (Bin a) | == a
where
	== Leaf Leaf = True
	== (Bin la xa ra) (Bin lb xb rb) = xa == xb && la == lb && ra == rb
	== _ _ = False

instance == (Rose a) | == a
where
	== (Rose x xs) (Rose y ys) = x == y && xs == ys

class serialize a
where
	write :: a [String] -> [String]
	read :: [String] -> Maybe (a, [String])

sread :== StateT read

instance serialize Bool
where
	write b c = [toString b:c]
	read ["True": r] = Just (True,  r)
	read ["False":r] = Just (False, r)
	read _           = Nothing

instance serialize String
where
	write s c = [s:c]
	read [s:r] = Just (s,r)
	read _     = Nothing

instance serialize Int
where
	write i c = write (toString i) c
	read ["0":r] = Just (0, r)
	read [i:r] = case toInt i of
		0 -> Nothing
		i -> Just (i, r)
	read _ = Nothing

instance serialize [a] | serialize a
where
	// We don't actually need to start with [, but this gives some type safety.
	// The ] is necessary to recognise the end of the list.
	write xs c = write "[" (foldl (flip write) (write "]" c) xs)
	read ["[":r] = readElements [] r
	where
		readElements :: [a] [String] -> Maybe ([a], [String]) | serialize a
		readElements xs ["]":r] = Just (xs, r)
		readElements xs s = read s >>= \(x,r) -> readElements [x:xs] r
	read _ = Nothing

instance serialize (Bin a) | serialize a
where
	// Here, it is necessary to start with "Bin", to be able to parse
	// ["Leaf":_] unambiguously.
	write Leaf c = write "Leaf" c
	write (Bin l x r) c = write "Bin" (write l (write x (write r c)))
	read ["Leaf":r] = Just (Leaf, r)
	read ["Bin":r] = runStateT (liftM3 Bin sread sread sread) r
	read _ = Nothing

instance serialize (Rose a) | serialize a
where
	// Other than for [], we don't include the constructor here (it is not
	// necessary because there is only one constructor).
	write (Rose x xs) c = write xs (write x c)
	read s = runStateT (liftM2 (flip Rose) sread sread) s

test :: a -> (Bool, [String]) | serialize, == a
test a = (isJust r && fst jr == a && isEmpty (tl (snd jr)), s)
where
	s = write a [""]
	r = read s
	jr = fromJust r

Start :: [([Rose (Bin Bool)], Bool)] // Change the first type of the tuple to test other expressions.
Start = filter (not o snd) testn // Should be [].

testn :: [(a, Bool)] | serialize, ==, someExprs a
testn = [(x, fst (test x)) \\ x <- someExprs]

class someExprs a :: [a]

instance someExprs Bool where someExprs = [True,False]
instance someExprs Int where someExprs = [-3..3]
instance someExprs [a] | someExprs a where someExprs = tails someExprs
instance someExprs (Bin a) | someExprs a
where
	someExprs =
		[ Leaf
		, Bin Leaf (es!!0) Leaf
		, Bin (Bin (Bin (Bin Leaf (es!!1) Leaf) (es!!2) Leaf) (es!!3) Leaf) (es!!4) Leaf
		, Bin (Bin Leaf (es!!7) Leaf) (es!!6) (Bin Leaf (es!!5) Leaf)
		, Bin Leaf (es!!8) (Bin (Bin (Bin Leaf (es!!9) Leaf) (es!!10) Leaf) (es!!11) Leaf)
		] // Looking forward to using Gast.
	where
		es = cycle someExprs
instance someExprs (Rose a) | someExprs a
where
	someExprs = level1 ++ level2 ++ level3
	where
		level1 = [Rose x [] \\ x <- someExprs]
		level2 = [Rose x rs \\ x <- someExprs, rs <- tails level1]
		level3 = [Rose x rs \\ x <- someExprs, rs <- tails (level1 ++ level2)]
		// Would be better to use (a) permutations / subsequences or (b) do
		// something more intelligent, but (a) takes too much memory and (b)
		// requires thinking.