Evaluator.hs

module Model.CellExpression.Evaluator (evaluate,Lookup)
    where

import Prelude hiding (lookup)
import Control.Applicative ((<$>))
import Control.Monad (forM)
import Model.CellContent (CellExpr (..),CellValue(..),RuntimeReason(..)
                         ,Reference(..),Symbol)
import Model.CellExpression.Evaluator.Common 
    (withNum,withList,withNumList,getNumList,fLength)
import Model.CellExpression.Evaluator.Math (mean,median)

type Lookup = Reference -> IO CellValue

evaluate :: Lookup -> CellExpr -> IO CellValue
evaluate lookup e =
    let binary f = return . mathBinary f
        eval = evaluate lookup
    in
      case e of
        EmptyExpr -> return $ EmptyValue
        NumberExpr a -> return $ NumberValue a
        StringExpr a -> return $ StringValue a
        ListExpr a -> ListValue <$> forM a eval
        Reference a -> lookup a
        UnaryOp "-" a -> forM [NumberExpr 0,a] eval >>= binary (-)
        BinaryOp "+" a b -> forM [a,b] eval >>= binary (+)
        BinaryOp "-" a b -> forM [a,b] eval >>= binary (-)
        BinaryOp "*" a b -> forM [a,b] eval >>= binary (*)
        BinaryOp "/" a b -> forM [a,b] eval >>= binary (/)
        BinaryOp "^" a b -> forM [a,b] eval >>= binary (**)
        Call f arg -> evaluateFun f <$> eval arg
        Sub a -> eval a
        NamedReference _ -> error "Model.CellExpression.Evaluator.evaluate: NamedReference"
        CompileErrorExpr a -> return $ Error $ CompileError a

evaluateFun :: Symbol -> CellValue -> CellValue
evaluateFun f arg = 
    case f of
      "sum" -> withNumList arg $ NumberValue . sum
      "count" -> withList arg $ NumberValue . fLength
      "abs" -> withNum arg $ NumberValue . abs
      "mean" -> withNumList arg $ NumberValue . mean
      "median" -> withNumList arg $ NumberValue . median
      unknown -> Error $ UnknownIdentifier unknown

mathBinary :: (Double -> Double -> Double) -> [CellValue] -> CellValue
mathBinary f = 
    either Error (\[a,b] -> NumberValue $ f a b) . getNumList