module Calculator.Evaluator.Expr (evalExpr) where

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

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

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

import           Data.Function        (on)

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

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) =
  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@(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"]

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