type Parse a = String -> Maybe ( a, String )


char :: Char -> Parse Char
char c []     = Nothing
char c (x:xs) = if c == x then return (c, xs) else Nothing

string :: String -> Parse String
string ""     = \str -> return ("", str)
string (c:cs) = (char c <.> string cs) <!> uncurry (:)

bit :: Parse Bit
bit = (char 'O' <!> const O) <|> (char 'I' <!> const I)

leaf :: Parse (Tree Bit)
leaf = string "Leaf " <.> bit <!> (Leaf . snd)

node :: Parse (Tree Bit)
node =    (string "Node (" <.>> tree <>.> string ") " <!> Node)
      <.>  bit <!> uncurry ($)
      <>.> string " (" <.> tree <>.> string ")" <!> uncurry ($)

tree :: Parse (Tree Bit)
tree = node <|> leaf

-- Entscheidung zwischen zwei Alternativen
(<|>) :: Parse a -> Parse a -> Parse a
pa <|> pb = \str -> let r1 = pa str
                     in if isJust r1 then r1 else pb str

-- Sequenz von Parsern
(<.>) :: Parse a -> Parse b -> Parse (a,b)
pa <.> pb = \str -> do (x,xs) <- pa str
                       (y,ys) <- pb xs
                       return ((x,y),ys)

-- Sequenz von Parsern (erstes Ergebnis nehmen)
(<>.>) :: Parse a -> Parse b -> Parse a
pa <>.> pb = (pa <.> pb) <!> fst

-- Sequenz von Parsern (zweites Ergebnis nehmen)
(<.>>) :: Parse a -> Parse b -> Parse b
pa <.>> pb = (pa <.> pb) <!> snd

-- Cast-Operator
(<!>) :: Parse a -> (a -> b) -> Parse b
p <!> f = \str -> do (x,s) <- p str
                     return (f x,s)

parse :: String -> Tree Bit
parse = fst . fromJust . tree