module Rpn (
    Lexeme(..),
    Token(..),
    showToken,
    showTokens,
    scanner,
    parserRPN,
    evaluateRPN,
    showFormulaRPN,
    evaluateFormula
) where

import Data.Char

data Lexeme = Number | Name | 
              Plus | Minus | Mul | Div | Power |
              LPar | RPar | EndLine | Illegal
              deriving (Eq, Ord, Show)

precedence :: Integral a => Lexeme -> a
precedence Number = 0
precedence RPar = 0
precedence Plus = 1
precedence Minus = 1
precedence Mul = 2
precedence Div = 2
precedence Power = 3
precedence LPar = 4
precedence Name = 5

isOperation :: Lexeme -> Bool
isOperation l = (l == Plus || l == Minus ||
    l == Mul || l == Div || l == Power)

mayBePerformedBefore :: Lexeme -> Lexeme -> Bool
mayBePerformedBefore op1 op2 =
    isOperation op1 && (
        precedence op1 > precedence op2 ||
        (precedence op1 == precedence op2 &&
        isLeftAssociative op2)
    )

isLeftAssociative :: Lexeme -> Bool
isLeftAssociative l = (l /= Power)

data Token = Token {
    lexeme :: Lexeme,
    text :: String,
    value :: Double
} deriving (Show, Eq, Ord)

spanToken :: String -> (Token, String)
spanToken "" = (Token EndLine "" 0, "")
spanToken str@(h:t)
    | isSpace h         =
      let (u, v) = span isSpace str
      in spanToken v
    | otherwise         =
      if h == '+' then (Token Plus [h] 0, t)
      else if h == '-' then (Token Minus [h] 0, t)
      else if h == '*' then (Token Mul [h] 0, t)
      else if h == '/' then (Token Div [h] 0, t)
      else if h == '^' then (Token Power [h] 0, t)
      else if h == '(' then (Token LPar [h] 0, t)
      else if h == ')' then (Token RPar [h] 0, t)
      else if isAlpha h then
          let (u, v) = span isAlphaNum str
          in (Token Name u 0, v)
      else if isDigit h then
          let (u, v) = span (\ c -> isDigit c || c == '.') str
              n = read u::Double
          in (Token Number u n, v)
      else (Token Illegal "Illegal" 0, t)

scanner :: String -> [Token]
scanner str = scanner' [] str

scanner' :: [Token] -> String -> [Token]
scanner' acc "" = reverse acc
scanner' acc str =
    let (token, rest) = spanToken str
    in
    if (lexeme token) == EndLine then reverse acc
    else scanner' (token:acc) rest

showToken :: Token -> String
showToken t = text t

showTokens :: [Token] -> String
showTokens [] = ""
showTokens [token] = showToken token
showTokens (token:rest) = (showToken token) ++ " " ++ (showTokens rest)

parserRPN :: [Token] -> [Token]
parserRPN tokens = parserRPN' ([], []) tokens

parserRPN' :: ([Token], [Token]) -> [Token] -> [Token]
parserRPN' (valueStack, operStack) [] =
    reverse ((reverse operStack) ++ valueStack)
parserRPN' (valueStack, operStack) (token:rest)
    | (lexeme token) == Number =
        parserRPN' (token:valueStack, operStack) rest
    | isOperation (lexeme token) =
        let
        op2 = (lexeme token)
        (u, v) = span (\ t -> mayBePerformedBefore (lexeme t) op2) operStack
        in
        parserRPN' ((reverse u) ++ valueStack, token:v) rest
    |  (lexeme token) == LPar =
        parserRPN' (valueStack, token:operStack) rest
    |  (lexeme token) == RPar =
        let
        (u, v) = span (\ t -> (lexeme t) /= LPar) operStack
        opStack = tail v        -- Remove '('
        in
        parserRPN' ((reverse u) ++ valueStack, opStack) rest
    | (lexeme token) == Name    = error "Name is not implemented"
    | (lexeme token) == Illegal = error "Illegal lexeme"

-------------------------------------------------------------
-- Calculate a value of RPN formula
-------------------------------------------------------------
evaluateRPN :: [Token] -> Double
evaluateRPN tokens = evaluateRPN' [] tokens

evaluateRPN' :: [Double] -> [Token] -> Double
evaluateRPN' stack [] = head stack
evaluateRPN' stack (token:rest)
    | isOperation (lexeme token) && length stack >= 2 =
        let 
        (y:x:st) = stack
        res = if (lexeme token) == Plus then x + y
              else if (lexeme token) == Minus then x - y
              else if (lexeme token) == Mul then x*y
              else if (lexeme token) == Div then x/y
              else if (lexeme token) == Power then x**y
              else error "Illegal operation"
        in evaluateRPN' (res:st) rest
    | isOperation (lexeme token) && length stack < 2 =
        error "Stack underflow"
    | (lexeme token) == Number =
        evaluateRPN' ((value token):stack) rest

evaluateFormula :: String -> Double
evaluateFormula formula =
    evaluateRPN $ parserRPN $ scanner formula

showFormulaRPN :: String -> String
showFormulaRPN formula =
    showTokens $ parserRPN $ scanner formula