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



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

-- The expression data type
data Expr
    = Num Int
    | Add Expr Expr
    | Mul Expr Expr
  deriving ( Eq, Show )



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

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

-- `number` parses a number
number :: Parser Int
number (c:s) | isDigit c = Just (digits 0 (c:s))
number ('-':s)           = fmap negate' (number s)
number _                 = Nothing

negate' :: (Int,String) -> (Int,String)
negate' (n,s) = (-n,s)

-- Helper function to convert a string to an integer
digits :: Int -> String -> (Int,String)
digits n (c:s) | isDigit c = digits (10*n + digitToInt c) s
digits n s                 = (n,s)

-- `num` parses a numeric expression
num :: Parser Expr
num s = case number s of
    Just (n,s') -> Just (Num n, s')
    Nothing     -> Nothing



expr' :: Parser Expr
expr' s = case num s of
           Just (a,'+':s2) -> case expr s2 of
                                Just (b,s4) -> Just (Add a b, s4)
                                Nothing     -> Just (a,'+':s2)
           Just (a, s2)    -> Just (a, s2)
           Nothing     -> Nothing

expr :: Parser Expr
expr = chain term '+' Add

term :: Parser Expr
term = chain factor '*' Mul

chain :: Parser a -> Char -> (a -> a -> a) -> Parser a
chain part sep comb s =
    case part s of
           Just (a,s2) -> case s2 of
                            c:s3 | c==sep ->
                                 case chain part sep comb s3 of
                                        Just (b,s4) -> Just (comb a b, s4)
                                        Nothing     -> Just (a, s2)
                            _      -> Just (a, s2)
           Nothing     -> Nothing

factor :: Parser Expr
factor ('(':s) = case expr s of
                   Just (e, ')':s2) -> Just (e, s2)
                   _                -> Nothing
factor s = num s

readExpr :: String -> Maybe Expr
readExpr s = case expr s of
               Just (e,"") -> Just e
               _           -> Nothing




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 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_readShow e = readExpr (showExpr e) == Just e



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



prop_readShowEval e =
    fmap eval (readExpr (showExpr e)) == Just (eval e)

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

prop_readShowAssoc e = readExpr (showExpr e) == Just (assoc e)