{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RelaxedPolyRec #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}

-- | A parser for 'Expr's.
module ExprParser (parseExpr) where

import Generics.Annotations.Token
import qualified ExprLexer as L
import Expr
import Generics.Annotations.ParsecInstance ()
import Generics.Annotations.Yield
import Generics.Annotations.ParsecYield
import Generics.Annotations.Any

import Control.Monad
import Control.Applicative
import Control.Monad.Either
import qualified Text.Parsec as P

type ExprParser = P.ParsecT [Token L.ExprToken] () (Yield Bounds ExprFam)

pExpr :: ExprParser Expr
pExpr = chainl pTerm (Add <$ tSymbol L.Plus <|> Sub <$ tSymbol L.Minus)

pTerm :: ExprParser Expr
pTerm = chainl pFactor (Mul <$ tSymbol L.Star <|> Div <$ tSymbol L.Slash)

pFactor :: ExprParser Expr
pFactor = pNum <|> tSymbol L.POpen *> pExpr <* tSymbol L.PClose

pNum :: ExprParser Expr
pNum = unit $ (\(L.Num n) -> Num n) <$> tSatisfy L.isNum

-- | Parses an expression, yielding the raw expression and annotated expression upon success.
parseExpr :: String -> Either P.ParseError (Maybe (WithBounds ExprFam Expr))
parseExpr input = case P.runParser (L.pTokens <* P.eof) () "" input of
  -- Lexical error
  Left perr -> Left perr
  
  Right toks ->
    case runYieldG (P.runParserT (pExpr <* P.eof) () "" toks) of
      -- Parse error
      (Left perr, _) -> Left perr
      
      -- All okay
      (Right _, expr) -> Right (expr >>= matchAnyF Expr)