{-# OPTIONS -fglasgow-exts #-}

module Calculator where

import Monad
import Parser
import Char ( ord, isDigit )


instance Monad (Either String) where
  fail   = Left
  return = Right

  Left  err >>= _ = Left err
  Right val >>= f = f val


data Exp
  = Num Float | Sqrt Exp
  | Add Exp Exp | Sub Exp Exp | Mul Exp Exp | Div Exp Exp
 deriving (Eq,Show)

instance Read Exp where
  readsPrec _ = filter (null.snd) . parse pExp


sqrT :: (Float -> Either String Float) -> Float -> Either String Float
sqrT c x = if x<0 then fail "sqrt of negative" else c (sqrt x)

diV :: (Float -> Either String Float) -> Float -> Float -> Either String Float
diV c n m = if m==0 then fail "division by zero" else c (n/m)


evalM :: Exp -> Either String Float
evalM (Num   x) = return x
evalM (Sqrt  x) = evalM x >>= sqrT return
evalM (Add x y) = return (+) `ap` evalM x `ap` evalM y
evalM (Sub x y) = return (-) `ap` evalM x `ap` evalM y
evalM (Mul x y) = return (*) `ap` evalM x `ap` evalM y
evalM (Div x y) = join $ return (diV return) `ap` evalM x `ap` evalM y


eval :: Exp -> Either String Float
eval e = evalC e return

evalC :: Exp -> (Float -> Either String Float) -> Either String Float
evalC (Num   x) c = c x
evalC (Sqrt  x) c = evalC x (sqrT c)
evalC (Add x y) c = evalC x (\a -> evalC y (\b -> c (a+b)))
evalC (Sub x y) c = evalC x (\a -> evalC y (\b -> c (a-b)))
evalC (Mul x y) c = evalC x (\a -> evalC y (\b -> c (a*b)))
evalC (Div x y) c = evalC x (\a -> evalC y (\b -> diV c a b))


calc :: IO ()
calc = getLine >>= process

process :: String -> IO ()
process "Q" = return ()
process s   = (return.readExp.reads) s >>= either putStrLn print >> calc
  
readExp :: [(Exp,String)] -> Either String Float
readExp [(e,"")] = eval e
readExp _        = fail "parse error"

{- expression parser

Exp    ::= Term AddSub Exp | Term
Term   ::= Factor MulDiv Term | Factor
Factor ::= '(' Exp ')' | sqrt Exp | Num
AddSub ::= '+' | '-'
MulDiv ::= '*' | '/'
Num    ::= -?[0..9]+   (no floating point numbers..)

-}

pExp = do
  t <- pTerm
  op <- pAddSub
  e <- pExp
  return (op t e)
 <|> pTerm

pTerm = do
  f <- pFactor
  op <- pMulDiv
  t <- pTerm
  return (op f t)
 <|> pFactor

pFactor = pSym '(' *> pExp <* pSym ')'
      <|> Sqrt <$> (pSyms "sqrt " *> pExp)
      <|> pNum

pAddSub = Add <$ pSym '+' <|> Sub <$ pSym '-'

pMulDiv = Mul <$ pSym '*' <|> Div <$ pSym '/'

pSyms []     = pSucceed ()
pSyms (c:cs) = pSym c *> pSyms cs

pNum = pSym '-' *> ((\ (Num n) -> Num (negate n)) <$> pNat)
   <|> pNat

pNat = numeric <$> pSome (pPred isDigit)
 where
  numeric = Num . fromInteger . toInteger
          . foldl1 ((+).(10*)) . map (\c -> ord c - ord '0')