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 )



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

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

-- `number` parses a number
number :: Parser Int
-- number ('-':s)           = fmap negate' (number s)
number (c:s)
    | isDigit c = Just (numb,rest)
    | otherwise = Nothing
  where
    numb = read (takeWhile isDigit (c:s))
    rest = dropWhile isDigit (c:s)

negate' :: (Int,String) -> (Int,String)
negate' (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



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

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

expr, term :: Parser 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 :: Parser a -> Char -> (a -> a -> a) -> Parser a
chain p op f s1 =
  case p s1 of
    Just (a,s2) -> case s2 of
                     c:s3 | c == op -> case chain p op f s3 of
                                         Just (b,s4) -> Just (f a b, s4)
                                         Nothing     -> Just (a,s2)
                     _              -> Just (a,s2)
    Nothing     -> Nothing

-- `factor` parses a "factor": either a number or an expression surrounded by
-- parentheses
factor :: Parser Expr
factor ('(':s) =
   case expr s of
      Just (a, ')':s1) -> Just (a, s1)
      _                -> Nothing
factor s = num s



-- `readExpr` reads a string into an expression
readExpr :: String -> Maybe Expr
readExpr s =
  case expr s of
    Just (a,"") -> Just a
    _           -> 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 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

-- this property fails (even after fixing number) -- do you see why?
prop_ShowRead a =
  readExpr (show a) == Just a

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