Expression parser example from section 8.8 of Programming in Haskell,
Graham Hutton, Cambridge University Press, 2007.


Parser for simple arithmetic expressions
----------------------------------------

> import Parsing
> import Control.Monad
> 
> expr                          :: Parser Int
> expr                          =  do t <- term
>                                     do symbol "+"               
>                                        e <- expr
>                                        return (t+e)
>                                      +++ return t
>
> term                          :: Parser Int
> term                          =  do f <- factor
>                                     do symbol "*"
>                                        t <- term
>                                        return (f * t)
>                                      +++ return f
>
> factor                        :: Parser Int
> factor                        =  do symbol "("
>                                     e <- expr
>                                     symbol ")"
>                                     return e
>                                   +++ natural
>
> pare                          :: Parser a -> String -> a
> pare p xs                     =  case (parse p xs) of
>                                     [(n,[])]  -> n
>                                     [(_,out)] -> error ("unused input " ++ out)
>                                     []        -> error "invalid input"

> eval = pare expr


---------------
Added by Fritz:
---------------

Note that the original definition of eval above was generalized to include a
parser argument, using "expr" for Hutton's eval.

Then we can provide an alternate target type in terms of algebraic terms;
we also include their syntax (infx) and semantics (evalg):
semantics:

> data Expr a = Lit a | Bop Opr (Expr a) (Expr a)   deriving Show
> data Opr = Add | Mul  deriving Show

> syn Add = "+" ;  syn Mul = "*"
> sem Add = (+) ;  sem Mul = (*)

> fold f g (Lit n) = f n
> fold f g (Bop o l r) = g o (fold f g l) (fold f g r)

> infx exp = fold show (inpar . syn) exp
>            where inpar o l r = concat ["(",l,o,r,")"]

> evalg :: Expr Int -> Int
> evalg = fold id sem


------------------

Now we can re-write the parsers above to generate general algebraic terms:
that way we can do other things with the terms besides evaluating them.

> popr o i s c = do { x<-i; do { symbol s; y<-o; return (Bop c x y) } +++ return x }

> brak l e r a = do { symbol l; x <- e; symbol r; return x } +++ a

> expr' = popr expr' term' "+" Add
> term' = popr term' fact' "*" Mul
> fact' = brak "(" expr' ")" (liftM Lit natural)

> tree :: String -> Expr Int
> tree = pare expr'

> full = infx . tree

----------------------

Here's a quick attempt to generalie the above, so that we might easily generate parsers
for other kinds of terms:

> layer u [] = u
> layer u ((s,c) : xs) = let e = popr e (layer u xs) s c in e

> algebra ops l r atom = let e = layer f ops
>                            f = brak l e r (liftM Lit atom)
>                        in e

> tree' :: String -> Expr Int
> tree' = pare (algebra [("+", Add), ("*", Mul)] "(" ")" natural)


>