module Text.ParserCombinators.Parsec.ParserFunction
(functionParse) where
import Data.Char (toLower)
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
data Expr = Num Double | Var String | Sub Expr Expr
| Div Expr Expr | Exp Expr Expr | Log Expr
| Abs Expr | Sqrt Expr | Cbrt Expr
| ArcSinh Expr | ArcCosh Expr | ArcTanh Expr
| ArcSin Expr | ArcCos Expr | ArcTan Expr
| Sinh Expr | Cosh Expr | Tanh Expr
| Sin Expr | Cos Expr | Tan Expr
| ArcSech Expr | ArcCsch Expr | ArcCoth Expr
| ArcSec Expr | ArcCsc Expr | ArcCot Expr
| Sech Expr | Csch Expr | Coth Expr
| Sec Expr | Csc Expr | Cot Expr
| Mul Expr Expr | Add Expr Expr deriving (Show, Eq, Ord)
functionParse :: String -> Maybe Expr
functionParse xs = either (const Nothing) (Just) (parse getFunction "" handleString)
where
handleString = "(" ++ (map toLower $ filter (/=' ') xs) ++ ")"
getFunction :: Parser Expr
getFunction = buildExpressionParser expressionTable factor
expressionTable :: [[Operator Char st Expr]]
expressionTable = [[pr "arcsinh" ArcSinh, pr "arcsin" ArcSin, pr "sinh" Sinh, pr "sin" Sin],
[pr "arccosh" ArcCosh, pr "arccos" ArcCos, pr "cosh" Cosh, pr "cos" Cos],
[pr "arctanh" ArcTanh, pr "arctan" ArcTan, pr "tanh" Tanh, pr "tan" Tan],
[pr "arcsech" ArcSech, pr "arcsec" ArcSec, pr "sech" Sech, pr "sec" Sec],
[pr "arccsch" ArcCsch, pr "arccsc" ArcCsc, pr "csch" Csch, pr "csc" Csc],
[pr "arccoth" ArcCoth, pr "arccot" ArcCot, pr "coth" Coth, pr "cot" Cot],
[pr "log" Log, pr "abs" Abs],
[pr "sqrt" Sqrt, pr "cbrt" Cbrt],
[op "^" Exp AssocLeft],
[op "*" Mul AssocLeft, op "/" Div AssocLeft],
[op "+" Add AssocLeft, op "-" Sub AssocLeft]]
where
op s f assoc = Infix (do{ string s; return f}) assoc
pr s f = Prefix (try (string s) >> return f)
factor :: Parser Expr
factor = do
char '('
e <- getFunction
char ')'
return e
<|> variables
variables :: Parser Expr
variables = do
ds <- many1 letter
return $
case ds of
ds | (length ds) == 1 -> Var ds
ds -> error $ "parser error on `" ++ ds ++ "'"
<|> number
number :: Parser Expr
number = do
br <- many digit
let d :: Double
d = fromInteger (foldl ((. ch2num) . (+) . (*10)) 0 br)
option (Num (d)) (try (do
char '.'
ar <- many1 digit
return $ (Num (d + foldr (fd) 0 ar)) ))
where
fd a b = (fromInteger (ch2num a) + b) / 10
fe = toInteger . fromEnum
ch2num = (subtract $ fe '0') . fe