module Ubc.Parse.Expression
( Expression(..)
, BinaryOperator(..)
, expressionParser
)
where
import Control.Monad ( (<$!>) )
import Data.Functor
import Text.Parsec.Expr (Operator(Infix), Assoc (AssocLeft), buildExpressionParser)
import qualified Ubc.Parse.Language as UbcLanguage
import Text.Parsec (ParsecT, (<|>), (<?>), choice, option)

data Expression = Binary BinaryOperator Expression Expression
        | ConstantInteger Integer
        | FunctionCall String [Expression]
        | Variable String
        | If Expression Expression (Maybe Expression)
        deriving (Show)
data BinaryOperator = Plus
        | Minus
        | Multiply
        | Divide
        | Modulo
        | ShiftLeft
        | ShiftRight
        | LessThan
        | GreaterThan
        | LessEqual
        | GreaterEqual
        | Equal
        | NotEqual
        | BitAnd
        | BitOr
        | BitXor
        deriving (Show)

operatorTable :: Monad m => [[Operator String u m Expression]]
operatorTable =
        [
                [ Infix (UbcLanguage.reservedOperator "*" >> return (Binary Multiply)) AssocLeft
                , Infix (UbcLanguage.reservedOperator "/" >> return (Binary Divide)) AssocLeft
                , Infix (UbcLanguage.reservedOperator "%" >> return (Binary Modulo)) AssocLeft
                ]
        ,
                [ Infix (UbcLanguage.reservedOperator "+" >> return (Binary Plus)) AssocLeft
                , Infix (UbcLanguage.reservedOperator "-" >> return (Binary Minus)) AssocLeft
                ]
        ,
                [ Infix (UbcLanguage.reservedOperator "<<" >> return (Binary ShiftLeft)) AssocLeft
                , Infix (UbcLanguage.reservedOperator ">>" >> return (Binary ShiftRight)) AssocLeft
                ]
        ,
                [ Infix (UbcLanguage.reservedOperator ">=" >> return (Binary GreaterEqual)) AssocLeft
                , Infix (UbcLanguage.reservedOperator "<=" >> return (Binary LessEqual)) AssocLeft
                , Infix (UbcLanguage.reservedOperator "<" >> return (Binary LessThan)) AssocLeft
                , Infix (UbcLanguage.reservedOperator ">" >> return (Binary GreaterThan)) AssocLeft
                ]
        ,
                [ Infix (UbcLanguage.reservedOperator "==" >> return (Binary Equal)) AssocLeft
                , Infix (UbcLanguage.reservedOperator "!=" >> return (Binary NotEqual)) AssocLeft
                ]
        ,
                [ Infix (UbcLanguage.reservedOperator "&" >> return (Binary BitAnd)) AssocLeft
                , Infix (UbcLanguage.reservedOperator "|" >> return (Binary BitOr)) AssocLeft
                , Infix (UbcLanguage.reservedOperator "^" >> return (Binary BitXor)) AssocLeft
                ]
        ]

expressionParser :: (Monad m) => ParsecT String u m Expression
expressionParser = buildExpressionParser operatorTable termParser <?> "expression"

termParser :: Monad m => ParsecT String u m Expression
termParser = UbcLanguage.parens expressionParser
        <|> fmap ConstantInteger UbcLanguage.integer
        <|> expressionIf
        <|> functionCallOrVariable

expressionIf :: Monad m => ParsecT String u m Expression
expressionIf = do
        _ <- UbcLanguage.reserved "if"
        condition <- expressionParser
        _ <- UbcLanguage.reserved "then"
        then_ <- expressionParser
        else_ <- option Nothing (UbcLanguage.reserved "else" >> expressionParser <&> Just)

        return $ If condition then_ else_

functionCallOrVariable :: Monad m => ParsecT String u m Expression
functionCallOrVariable = do
        name <- UbcLanguage.identifier
        choice
                [ FunctionCall name <$!> UbcLanguage.parens (UbcLanguage.commaSeparated expressionParser)
                , return $ Variable name
                ]