{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use lambda-case" #-}
{-# HLINT ignore "Use tuple-section" #-}
module Parser where

import qualified Lexer as L
import Control.Applicative as Applicative
import Data.Void as Void

type CST = Expr

data Expr = Add Term Expr
          | Sub Term Expr
          | ETerm Term
          deriving Show

data Term = Mult Factor Term
          | Div Factor Term
          | TFactor Factor
          deriving Show

data Factor = Integer Int
            | Parantheses Expr
            | NegFactor Factor
            deriving Show

type Tokens = [L.Token]
newtype Parser a = Parser {
    runParser :: Tokens -> Maybe (Tokens, a)
}

instance Functor Parser where
    fmap f (Parser p) = Parser $ \input -> case p input of
        Nothing -> Nothing
        Just (rest, a) -> Just (rest, f a)

instance Applicative Parser where
    pure x = Parser $ \input -> Just (input, x)
    (<*>) (Parser fParser) (Parser a) = Parser $ \input -> case fParser input of
        Nothing -> Nothing
        Just (rest, f) -> case a rest of
            Nothing -> Nothing
            Just (rest', x) -> Just (rest', f x)

instance Alternative Parser where
    empty = Parser $ const Nothing
    (<|>) (Parser p1) (Parser p2) = Parser $ \input -> case p1 input of
        Nothing -> p2 input
        result -> result


parse :: Tokens -> Maybe CST
parse tokens = case runParser parseExpression tokens of
    Just ([], cst) -> Just cst
    _ -> Nothing


parseAdd :: Parser Expr
parseAdd = liftA2 Add (parseTerm <* expect L.Plus) parseExpression

parseSub :: Parser Expr
parseSub = liftA2 Sub (parseTerm <* expect L.Hyphen) parseExpression

parseETerm :: Parser Expr
parseETerm = ETerm <$> parseTerm

parseExpression :: Parser Expr
parseExpression = parseAdd <|> parseSub <|> parseETerm


parseMult :: Parser Term
parseMult = liftA2 Mult (parseFactor <* expect L.Asterisk) parseTerm

parseDiv :: Parser Term
parseDiv = liftA2 Div (parseFactor <* expect L.ForwardSlash) parseTerm

parseTFactor :: Parser Term
parseTFactor = TFactor <$> parseFactor

parseTerm :: Parser Term
parseTerm = parseMult <|> parseDiv <|> parseTFactor


parseFactor :: Parser Factor
parseFactor = parseInt <|> parseParatheses <|> parseNegFactor

parseInt :: Parser Factor
parseInt = Parser $ \(token:rest) -> case token of
    L.Integer i -> Just (rest, Integer i)
    _ -> Nothing

parseNegFactor :: Parser Factor
parseNegFactor = NegFactor <$> (expect L.Hyphen *> parseFactor)

parseParatheses :: Parser Factor
parseParatheses = Parantheses <$> (expect L.LBrace *> parseExpression <* expect L.RBrace)


expect :: L.Token -> Parser (Maybe Void)
expect token = Parser $ \stream -> case stream of
    (t:rest) -> if t == token
                then Just (rest, Nothing)
                else Nothing
    _ -> Nothing