module Lib
    ( exprparser, evaluate, replaceVars 
    ) where
import Control.Applicative((<*))

import Data.Ratio
import Data.Map (Map)
import qualified Data.Map as Map

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 = []
              }

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_digits <- many digit
    let decimal = read decimal_digits :: Integer
    let natural_length = length . show $ natural
    let decimal_length = length decimal_digits
    let numerator   = natural * (10 ^ decimal_length) + decimal
    let denominator = 10 ^ (decimal_length + natural_length - 1)
    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
        rationalPower' _ _ = error "Powers with unnatural numbers are not supported yet"

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

replaceVars :: Expr -> Map.Map String Rational -> Expr
replaceVars (Variable name) vs = Constant . maybe (0 % 1) id $ Map.lookup name vs
replaceVars (Binary op a b) vs = Binary op (replaceVars a vs) (replaceVars b vs) 
replaceVars (Constant c)    vs = Constant c

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)