-- This module has been written by Enzo Haussecker
--
-- Evaluating Expressions/Functions 
--
-- > evaluate "(abs (-1) + cos 0)^3" []
-- 8.0
-- 
-- > evaluate "x^2" [('x',3)]
-- 9.0
--
-- > evaluate "x+y" [('x',1),('y',4)]
-- 5.0

module Text.ParserCombinators.Parsec.EvaluateFunction
    (evaluate) where

import Text.ParserCombinators.Parsec.ParserFunction (functionParse)
import Text.ParserCombinators.Parsec.Functions
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Char (toLower) 

type Expression = String
type Variable   = Char
type Value      = Double

evaluate :: Expression -> [(Variable,Value)] -> Double
evaluate str map = eval (M.fromAscList $ casing map) (fromMaybe failing1 $ functionParse str)
    where 
        casing   x = fmap (\ (a, b) -> ([toLower a], b)) x
        failing1   = error "Parser error in expression"
        failing2 x = error $ "M.lookup error in value for variable `" ++ [x] ++ "'"
        eval :: M.Map String Double -> Expr -> Double
        eval map expression =
            case expression of 
                (Num d)           -> d
                (Var c)           -> fromMaybe (failing2 c) (M.lookup [c] map)
                (Add expr1 expr2) -> (eval map expr1) +  (eval map expr2)
                (Sub expr1 expr2) -> (eval map expr1) -  (eval map expr2)
                (Mul expr1 expr2) -> (eval map expr1) *  (eval map expr2)
                (Div expr1 expr2) -> (eval map expr1) /  (eval map expr2)
                (Pow expr1 expr2) -> (eval map expr1) ** (eval map expr2)
                (Exp expr1)       -> exp (eval map expr1)
                (Sqrt expr1)      -> (eval map expr1) ** (0.5)
                (Cbrt expr1)      -> (eval map expr1) ** (1/3)
                (Log expr1)       -> log (eval map expr1)
                (Abs expr1)       -> abs (eval map expr1)
                (Sin expr1)       -> sin (eval map expr1) 
                (Cos expr1)       -> cos (eval map expr1)
                (Tan expr1)       -> tan (eval map expr1)
                (Sec expr1)       -> 1/sin (eval map expr1) 
                (Csc expr1)       -> 1/cos (eval map expr1)
                (Cot expr1)       -> 1/tan (eval map expr1)
                (Sinh expr1)      -> sinh (eval map expr1) 
                (Cosh expr1)      -> cosh (eval map expr1)
                (Tanh expr1)      -> tanh (eval map expr1)
                (Sech expr1)      -> 1/sinh (eval map expr1) 
                (Csch expr1)      -> 1/cosh (eval map expr1)
                (Coth expr1)      -> 1/tanh (eval map expr1)
                (ArcSin expr1)    -> asin (eval map expr1) 
                (ArcCos expr1)    -> acos (eval map expr1)
                (ArcTan expr1)    -> atan (eval map expr1)
                (ArcSec expr1)    -> 1/asin (eval map expr1) 
                (ArcCsc expr1)    -> 1/acos (eval map expr1)
                (ArcCot expr1)    -> 1/atan (eval map expr1)
                (ArcSinh expr1)   -> asinh (eval map expr1) 
                (ArcCosh expr1)   -> acosh (eval map expr1)
                (ArcTanh expr1)   -> atanh (eval map expr1)
                (ArcSech expr1)   -> 1/asinh (eval map expr1) 
                (ArcCsch expr1)   -> 1/acosh (eval map expr1)
                (ArcCoth expr1)   -> 1/atanh (eval map expr1)