module Lib
    ( 
    ) where
import Control.Applicative((<*))

import Data.Ratio

import Text.Parsec
import Text.Parsec.Char
import Text.Parsec.String
import Text.Parsec.Expr
import Text.Parsec.Token
import Text.Parsec.Language

data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr
    deriving Show
data BinaryOperator = Plus | Minus | Multiply | Divide | Power
    deriving Show

naturalRatio a = a % 1

def = emptyDef{ commentStart = ""
              , commentEnd = ""
              , identStart = letter <|> char '_'
              , identLetter = alphaNum <|> char '_'
              , opStart = oneOf "+-/*^"
              , opLetter = oneOf "+-/*^"
              , reservedOpNames = ["+", "-", "/", "*", "^"]
              , reservedNames = ["pi", "e"]
              }

TokenParser{ parens = m_parens
           , identifier = m_identifier
           , reservedOp = m_reservedOp
           , reserved   = m_reserved
           , semiSep1   = m_semiSep1
           , natural    = m_natural
           , integer    = m_integer
           , whiteSpace = m_whiteSpace } = makeTokenParser def

exprparser :: Parser Expr
exprparser = buildExpressionParser table term <?> "expression"

table = [
            [
                Infix (m_reservedOp "^" >> return (Binary Power)) AssocLeft
            ],
            [
                Infix (m_reservedOp "*" >> return (Binary Multiply)) AssocLeft,
                Infix (m_reservedOp "/" >> return (Binary Divide)) AssocLeft
            ],
            [
                Infix (m_reservedOp "+" >> return (Binary Plus)) AssocLeft,
                Infix (m_reservedOp "-" >> return (Binary Minus)) AssocLeft
            ]
        ]

constantInteger :: Parser Rational
constantInteger = try (do
        n <- m_integer
        notFollowedBy . char $ '.'
        return (n % 1)
    )

constantRational :: Parser Rational
constantRational = do
    natural <- m_natural
    _       <- char '.'
    decimal <- m_natural
    let natural_length = length . show $ natural
    let decimal_length = length . show $ decimal
    let numerator   = natural * (10 ^ decimal_length) + decimal
    let denominator = 10 ^ (decimal_length + natural_length - 2)
    return (numerator % denominator)

{-
 - a/b ^ c/d
 - (a ^ c/d) / b ^ (c/d)
 - root(a ^ c, d) / root(b ^ c, d)
 -}
rationalPower :: Rational -> Rational -> Rational
rationalPower a b = rationalPower' (numerator a, denominator a) (numerator b, denominator b)
    where
        rationalPower' (a, b) (c, 1) = a ^ c % b ^ c

term = m_parens exprparser
       <|> fmap Variable m_identifier
       <|> fmap Constant constantInteger
       <|> fmap Constant constantRational

evaluate :: Expr -> Rational
evaluate (Constant c) = c
evaluate (Binary Plus     a b) = evaluate a + evaluate b
evaluate (Binary Minus    a b) = evaluate a - evaluate b
evaluate (Binary Divide   a b) = evaluate a / evaluate b
evaluate (Binary Multiply a b) = evaluate a * evaluate b
evaluate (Binary Power    a b) = rationalPower (evaluate a) (evaluate b)