module Text.ParserCombinators.Parsec.ParserFunction
(functionParse) where
import Data.Char (toLower)
import Data.List (isInfixOf)
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Functions
functionParse :: String -> Maybe Expr
functionParse xs = if any (==True) (symbols failingSymbols xs)
then Nothing
else either (const Nothing) (Just) (parse getFunction "" handleString)
where
handleString = "(" ++ (map toLower $ filter (/=' ') xs) ++ ")"
symbols [] y = []
symbols x y = [isInfixOf (head x) y] ++ (symbols (drop 1 x) y)
failingSymbols = ["^^","^*","^/","^+","^-","*^","**","*/","*+","*-",
"/^","/*","//","/+","/-","+^","+*","+/","++","+-",
"-^","-*","-/","-+","--"]
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 "exp" Exp],
[pr "sqrt" Sqrt, pr "cbrt" Cbrt],
[op "^" Pow 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 <- letter
return $ Var 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