Expr.hs

module Calculator.Evaluator.Expr (evalExpr) where

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

import           Calculator.Prim.Base (Number)
import           Calculator.Prim.Expr (Bindings, Expr (..), Operator (..),
                                       dispatch, fromConst, isConst)

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

import           Data.Function        (on)

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

evalExpr :: Bindings -> Expr -> Expr
evalExpr _ e@(Constant _)     = e
evalExpr _ e@(InvalidError _) = e
-- evalExpr b (UnOp (UnaryOp op) e) = Constant . op . fromConst $ evalExpr b e
evalExpr b (BinOp (expr, rest))  = process b expr rest
evalExpr b (Variable s) =
  let val = lookup s b
  in case val of
      Nothing -> InvalidError $ "Unknown variable " ++ show s
      Just v  -> Constant v
evalExpr b (Function "" e) = evalExpr b e
evalExpr b (Function f e)  =
  let func = lookup f dispatch :: Maybe (Number -> Number)
  in case evalExpr b e of
      Constant x -> case func of
                     Nothing -> InvalidError $ "Unknown function " ++ show f
                     Just g  -> Constant $ g x
      e@(InvalidError _) -> e
      _ -> InvalidError "Recieved Impossible result from evalExpr"
evalExpr _ _ = InvalidError "Could not find suitable pattern for evalExpr"

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

process :: Bindings -> Expr -> [(Operator, Expr)] -> Expr
process bind expr rest = evalExpr bind $ foldl (evalPart bind) expr rest

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

evalPart :: Bindings -> Expr -> (Operator, Expr) -> Expr
evalPart b e1 ((BinaryOp op), e2) =
  let val1 = evalExpr b e1
      val2 = evalExpr b e2
  in if ((&&) `on` isConst) val1 val2
     then Constant $ (op `on` fromConst) val1 val2
     else case (val1, val2) of
           (e@(InvalidError _), _) -> e
           (_, e@(InvalidError _)) -> e
           _ -> InvalidError "Could not find matching pairs for evalPart"
evalPart _ _ _ = InvalidError "Could not find suitable pattern for evalPart"

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