import Data.Char
import Data.Maybe
import Test.QuickCheck

import Text.Parse  -- cabal install polyparse

-------------------------------------------------------------------------
-- the expression datatype

data Expr
  = Num Int
  | Add Expr Expr
  | Mul Expr Expr
 deriving ( Eq )

-------------------------------------------------------------------------
-- parsing numbers

num :: TextParser Expr
num = do
    n <- parseByRead ""
    return (Num n)

-------------------------------------------------------------------------
-- expr and term

{-
  * an expression is a '+'-chain of terms
  * a term is a '*'-chain of factors
-}

expr, term :: TextParser Expr
expr = chain term   '+' Add
term = chain factor '*' Mul

--{-
--chain p op f s1 parsers a "chain" of things.
--The things are parsed by the parser p.
--The things are separated by the symbol op.
--The things are combined by the function f.
--For example,
--  12+23+1+172
--is a chain of numbers, separated by the symbol '+'.
---}

chain :: TextParser a -> Char -> (a -> a -> a) -> TextParser a
chain p op f = do
    a <- p
    more a <|> return a
  where
    more a = do
        satisfy (\c -> c==op)
        b <- chain p op f
        return (f a b)

---------------------------------------------------------------------------
---- factor

factor :: TextParser Expr
factor = parentheses expr <|> num

parentheses :: TextParser a -> TextParser a
parentheses p = do
    satisfy (=='(')
    a <- p
    satisfy (==')')
    return a

-------------------------------------------------------------------------
-- reading expressions

readExpr :: String -> Maybe Expr
readExpr s = case readByParse expr s of
    [(a,"")] -> Just a
    _        -> Nothing

-------------------------------------------------------------------------
-- testing the parser

showExpr :: Expr -> String
showExpr (Num n)   = show n
showExpr (Add a b) = showExpr a ++ "+" ++ showExpr b
showExpr (Mul a b) = showFactor a ++ "*" ++ showFactor b

showFactor :: Expr -> String
showFactor (Add a b) = "(" ++ showExpr (Add a b) ++ ")"
showFactor e         = showExpr e

instance Show Expr where
  show = showExpr

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

instance Arbitrary Expr where
  arbitrary = sized arbExpr

arbExpr :: Int -> Gen Expr
arbExpr s =
  frequency [ (1, do n <- arbitrary
                     return (Num n))
            , (s, do a <- arbExpr s'
                     b <- arbExpr s'
                     return (Add a b))
            , (s, do a <- arbExpr s'
                     b <- arbExpr s'
                     return (Mul a b))
            ]
 where
  s' = s `div` 2

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

prop_ShowReadEval a =
  fmap eval (readExpr (show a)) == Just (eval a)

eval :: Expr -> Int
eval (Num n)   = n
eval (Add a b) = eval a + eval b
eval (Mul a b) = eval a * eval b

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

prop_ShowReadAssoc a =
  readExpr (show a) == Just (assoc a)

assoc :: Expr -> Expr
assoc (Add (Add a b) c) = assoc (Add a (Add b c))
assoc (Add a b)         = Add (assoc a) (assoc b)
assoc (Mul (Mul a b) c) = assoc (Mul a (Mul b c))
assoc (Mul a b)         = Mul (assoc a) (assoc b)
assoc a                 = a

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