Expr.hs

module Calculator.Parser.Expr (parseExpr) where

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

import           Calculator.Parser.Base        (parseId, parseNumber)
import           Calculator.Prim.Definitions   (binaryOps)
import           Calculator.Prim.Expr          (Expr (..), Operator, constEq)

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

import           Control.Applicative           ((<$>), (<*))
import           Text.ParserCombinators.Parsec

--------------------------------------------------------------------------------
-- expr -> term ( "+-" term )*

parseExpr :: Parser Expr
parseExpr = do
  term <- parseTerm
  rest <- parseRestExpr
  if null rest
    then return term
    else return $ BinOp (term, rest)

parseRestExpr :: Parser [(Operator, Expr)]
parseRestExpr = many $ do
  oper <- oneOf "+-"
  let (Just op) = lookup oper binaryOps
  expr <- parseTerm
  return (op, expr)

--------------------------------------------------------------------------------
-- term -> fact ( "*/" fact )*

parseTerm :: Parser Expr
parseTerm = do
  fact <- parseFact
  rest <- parseRestTerm
  if null rest
    then return fact
    else return $ BinOp (fact, rest)

parseRestTerm :: Parser [(Operator, Expr)]
parseRestTerm = many $ do
  oper <- oneOf "*/"
  let (Just op) = lookup oper binaryOps
  expr <- parseFact
  return (op, expr)

--------------------------------------------------------------------------------
-- fact -> val ( "^" fact )?
-- Right recursion for right associativity

parseFact :: Parser Expr
parseFact = do
  val <- parseVal
  pow <- parsePower
  if constEq (Constant 1) (snd pow)
    then return val
    else return $ BinOp (val, [pow])

parsePower :: Parser (Operator, Expr)
parsePower = let (Just op) = lookup '^' binaryOps
             in option (op, Constant 1) $ do
               _    <- char '^'
               fact <- parseFact
               return (op, fact)

--------------------------------------------------------------------------------
-- val -> ( expr ) | func ( expr ) | var | number

parseVal :: Parser Expr
parseVal = parseBrackets <|> parseCall <|> parseVariable <|> parseConstant

parseBrackets :: Parser Expr
parseBrackets = do
  _ <- try (char '(')
  e <- parseExpr
  _ <- char ')'
  return e

parseVariable :: Parser Expr
parseVariable = Variable <$> parseId

parseConstant :: Parser Expr
parseConstant = Constant <$> parseNumber

parseCall :: Parser Expr
parseCall = do
  ident <- try (parseId <* char '(')
  args  <- (parseExpr `sepBy` char ',') <* char ')'
  return $ Call ident args

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