module RefactoredReadExpr where
-- Lecture 4B part II
-- Use the refactored parser
-- to build a parser for Expr

-- Since the lecture: 
-- * the parser for num has been completed
-- * the small bug has been fixed!

import RefactoredParser

import Data.Char(isSpace)
import Data.Maybe
import Test.QuickCheck

data Expr
  = Num Integer
  | Add Expr Expr
  | Mul Expr Expr
 deriving (Eq
          ,Show
          )
-- instance Show Expr where 
--    show = showExpr

-------------------------------------------------------------
-- parse an integer
-- with help from Read class
integer :: Parser Integer 
integer = nat +++ neg -- natural or negative
        where nat = pmap read $ oneOrMore digit 
              neg = char '-' >-> pmap negate nat

num :: Parser Expr
num  = pmap Num integer

expr = pmap (foldr1 Add) $ term <:> zeroOrMore (char '+' >-> term )
term = pmap (foldr1 Mul) $ factor <:> zeroOrMore (char '*' >-> factor )
factor = char '(' >-> expr <-< char ')' +++ num

-- Note: should refactor expr and term 
-- again to use a common function "chain"

  
-- top level parser
-- remove spaces and expect no junk!
readExpr :: String -> Maybe Expr              

readExpr s = let s' = filter (not.isSpace) s
             in case parse expr s' of
                     Just (e,"") -> Just e
                     _           -> Nothing
----------------------------------------------
-- show, eval and quickCheck

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

showFactor (Add e1 e2) = "(" ++ showExpr (Add e1 e2) ++ ")"
showFactor e           = showExpr e

eval :: Expr -> Integer
eval (Num n)    = n
eval (Add e1 e2)    = eval e1 + eval e2
eval (Mul e1 e2)= eval e1 * eval e2


rExpr :: Int -> Gen Expr
rExpr s = frequency [(1,rNum),(s,rOp)]
  where
   s' = s `div` 2
   rNum = do 
       n <- arbitrary
       return $ Num n

   rOp = do 
      op <- elements [Add,Mul]
      e1 <- rExpr s'
      e2 <- rExpr s'
      return $ op e1 e2

instance Arbitrary Expr where
  arbitrary = sized rExpr