Expr.hs

module Calculator.Parser.Expr (parseExpr) where

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

import           Calculator.Parser.Base        (parseId, parseNumber)
import           Calculator.Prim.Expr          (Expr (..), Operator, binaryOps,
                                                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 -> func? ( expr ) | number
-- Parentheses can be parsed as function calls with no function

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

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

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

parseCall :: Parser Expr
parseCall = do
  ident <- optionMaybe parseId
  _     <- char '('
  expr  <- parseExpr
  _     <- char ')'
  return $ case ident of
             Nothing -> expr
             Just s  -> Function s expr

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