module Expr (parseE, Expr(..)) where

import Text.Parsec
import Text.Parsec.Language
import Text.Parsec.Token
import Text.Parsec.Expr
import qualified Data.Functor.Identity

data Expr = Plus Expr Expr
          | Negate Expr
          | Minus Expr Expr
          | Times Expr Expr
          | Div Expr Expr
          | EInt Integer
          | EFloat Double
          | E
          | Pi
          | Log Expr
          | Sin Expr
          | Cos Expr
          | Sqrt Expr

tokenParser :: TokenParser st
tokenParser = haskell

parseNumber :: Parsec String u Expr
parseNumber = do n <- naturalOrFloat tokenParser
                 case n of
                   Left i -> return (EInt i)
                   Right d -> return (EFloat d)

tokenS :: String -> Parsec String u ()
tokenS s = () <$ try (symbol tokenParser s)

inner :: Parsec String u Expr
inner = parseNumber <|> E <$ tokenS "e" <|> Pi <$ tokenS "pi" <|> parens tokenParser parseExpr

binary :: String -> (a -> a -> a) -> Assoc
       -> Operator String u Data.Functor.Identity.Identity a
binary name fun assoc =
  Infix (fun <$ tokenS name) assoc

prefix :: String -> (a -> a)
       -> Operator String u Data.Functor.Identity.Identity a
prefix name fun = Prefix (fun <$ tokenS name)

table :: [[Operator String u Data.Functor.Identity.Identity Expr]]
table = [ [ prefix "log" Log, prefix "sin" Sin, prefix "cos" Cos, prefix "sqrt" Sqrt ]
        , [ prefix "-" Negate ]
        , [ binary "*" Times AssocLeft
          , binary "/" Div AssocLeft
          ]
        , [ binary "+" Plus AssocLeft
          , binary "-" Minus AssocLeft
          ]
        ]

parseExpr :: Parsec String u Expr
parseExpr = buildExpressionParser table inner

parser :: Parsec String u Expr
parser = do whiteSpace tokenParser
            parseExpr

parseE :: String -> Either ParseError Expr
parseE s = parse parser "" s