module Parser where

{-
S -> Q | R
Q -> 'a' 'b'
R -> 'b' Q Q
R -> 'b' Q 'c'
-}

-- look-ahead of one token
la :: [Char] -> [Char] -> Bool
la xs l = length xs > 0 && (head xs) `elem` l

data NT   = S | Q |R
          deriving Show
data Tree = Leaf Char
          | Node NT [Tree]
          deriving Show

parseS :: [Char] -> (Tree, [Char])
parseS xs | la xs "a"  = (Node S [tq], ys) -- Q
          | la xs "bc" = (Node S [tr], zs) -- R
          | otherwise  = error "parse error in S"
  where (tq, ys) = parseQ xs
        (tr, zs) = parseR xs

parseQ :: [Char] -> (Tree, [Char])
parseQ ('a':'b':xs) = (Node Q [Leaf 'a', Leaf 'b'], xs)
parseQ xs = error "parse error in Q"

parseR :: [Char] -> (Tree, [Char])
parseR ('b':xs) = (Node R [Leaf 'b', t1, t2], zs)
 where (t1, ys) = parseQ xs
       (t2, zs) = parseQ ys
parseR ('c':xs) = (Node R [Leaf 'b', t1, Leaf 'c'], zs)
 where (t1, ys) = parseQ xs
       ('c':zs) = ys

