module Parser where

import Control.Monad (void)
import Data.Char (isSpace)
import Data.Functor.Identity (Identity)
import Text.Parsec
import Text.Parsec.Expr
import Debug.Trace

import Expr


type Parser = Parsec String ()

pLexemeSuffix :: Parser ()
pLexemeSuffix = eof <|> lookAhead (void (oneOf "()")) <|> void (many1 space)

lexeme :: String -> Parser ()
lexeme s = try $ string s >> pLexemeSuffix

operators :: OperatorTable String () Identity Expr
operators =
  [[Prefix (symPrefix "+")]
  ,[Infix (symInfix "*") AssocLeft]
  ,[Infix (symInfix "+") AssocLeft
   ,Infix (symInfix "-") AssocLeft]
  ,[Infix (symInfix ":≤") AssocNone]]
  where
    symInfix :: String -> Parser (Expr -> Expr -> Expr)
    symInfix name = do
      lexeme name
      return (einfix name)

    symPrefix :: String -> Parser (Expr -> Expr)
    symPrefix name = do
      lexeme name
      return (EPrefix name)

pAtom :: Parser Expr
pAtom = do
  e <- pAtom'
  traceM ("pAtom: " ++ show e)
  return e

pAtom' :: Parser Expr
pAtom' = choice
  [do _ <- char '('
      _ <- many space
      e <- pExpr
      lexeme ")"
      return e
  ,do s <- many1 digit
      pLexemeSuffix
      return (ELitInt (read s))
  ,do s <- many1 (satisfy (\c -> not (isSpace c) && c `notElem` "(){}"))
      pLexemeSuffix
      return (EVar s)]

pExpr :: Parser Expr
pExpr = buildExpressionParser operators pAtom

parseExpr :: Parser Expr
parseExpr = do
  _ <- many space
  e <- pExpr
  eof
  return e