mp.hs

import Control.Monad

data T = L | B T T

instance Show T where
	show L = "L"
	show (B left right) = 'B' : (show left ++ show right)

newtype Parser a = Parser (String -> (a, String))

parse (Parser p) = p

instance Monad Parser where
	return a = Parser $ \cs -> (a, cs)
	m >>= f = Parser $ \cs -> let (a, cs') = parse m cs in parse (f a) cs'

char = Parser $ \(c : cs) -> (c, cs)

parseTree = do
	c <- char
	case c of
		'L' -> return L
		'B' -> liftM2 B parseTree parseTree
{-
		'B' -> do
			left <- parseTree
			right <- parseTree
			return $ B left right
-}
main = print $ parse parseTree "BBLLL"