Expr.hs

module Calculator.Evaluator.Expr (evalExpr) where

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

import           Calculator.Prim.Base (Number)
import           Calculator.Prim.Expr (Bindings, Expr (..), Operator (..),
                                       joinMessage)

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

evalExpr :: Bindings -> Expr -> Expr
evalExpr _ e@(Constant _)     = e
evalExpr _ e@(Message _) = e
-- evalExpr b (UnOp (UnaryOp op) e) = Constant . op . fromConst $ evalExpr b e
evalExpr b (BinOp (expr, rest))  = process b expr rest
evalExpr (vs, _) (Variable s) =
  case lookup s vs of
    Nothing -> Message ["Unknown variable " ++ show s]
    Just v  -> Constant v
evalExpr b (Function "" e) = evalExpr b e
evalExpr b@(_, fs) (Function f e)  =
  let func = lookup f fs :: Maybe (Number -> Number)
  in case evalExpr b e of
       Constant x    -> case func of
                          Nothing -> Message ["Unknown function " ++ show f]
                          Just g  -> Constant $ g x
       r@(Message _) -> r
       _             -> Message ["Recieved Impossible result from evalExpr"]
evalExpr _ _ = Message ["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) =
  case (evalExpr b e1, evalExpr b e2) of
    (Constant n1, Constant n2)     -> Constant $ op n1 n2
    (e@(Message _), f@(Message _)) -> joinMessage e f
    (_, e@(Message _))             -> e
    (e@(Message _), _)             -> e
    _ -> Message ["Could not find matching pairs for evalPart"]
evalPart _ _ _ = Message ["Could not find suitable pattern for evalPart"]

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