Expr.hs

module Calculator.Parser.Expr (parseExpr) where

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

import           Calculator.Prim.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     <* spaces
  rest <- parseRestExpr <* spaces
  if null rest
    then return term
    else return $ BinOp (term, rest)

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

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

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

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

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

parseFact :: Parser Expr
parseFact = do
  val <- parseVal   <* spaces
  pow <- parsePower <* spaces
  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
               _    <- spaces
               _    <- char '^'  <* spaces
               fact <- parseFact <* spaces
               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
  _     <- spaces
  ident <- optionMaybe parseId <* spaces
  _     <- char '('            <* spaces
  expr  <- parseExpr           <* spaces
  _     <- char ')'            <* spaces
  return $ case ident of
             Nothing -> expr
             Just s  -> Function s expr

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