module Parser (parseExp, parseProgram) where

import AST (Exp (..), Val (ValBool, ValInt, ValPair, ValString),)
import Control.Applicative ((<|>))
import Lexer
  ( identifier,
    integer,
    reserved,
    reservedOp,
    symbol,
    whitespace,
    parens,
  )
import Text.Parsec (ParseError, eof, parse, many, notFollowedBy, noneOf, try)
import Text.Parsec.String (Parser)
import Control.Monad (void)

parseLet :: Parser Exp
parseLet = do
  reserved "let"
  v <- identifier
  reservedOp "="
  e1 <- parseExp
  reserved "in"
  Let v e1 <$> parseExp

parseExp :: Parser Exp
parseExp =
  parseConst
    <|> parseLambda
    <|> parseCond
    <|> parseLetRec
    <|> parseLet
    <|> parseApp
    <|> parseVar
    <|> parens parseExp

parseNonAppExp :: Parser Exp
parseNonAppExp =
  parseConst
    <|> parseLambda
    <|> parseCond
    <|> parseLetRec
    <|> parens parseExp
    <|> parseVar

parseApp :: Parser Exp
parseApp = do
  e1 <- parseNonAppExp
  es <- many (try (notFollowedBy (reserved "in" <|> reserved "then" <|> reserved "else") *> parseNonAppExp))
  return $ foldl App e1 es

parseConst :: Parser Exp
parseConst =
  Const . ValInt . fromIntegral <$> integer
    <|> (reserved "True" >> return (Const (ValBool True)))
    <|> (reserved "False" >> return (Const (ValBool False)))
    <|> parseString
    <|> parsePairConst


parseString :: Parser Exp
parseString = do
  symbol "\""
  s <- many (noneOf "\"")
  symbol "\""
  return $ Const (ValString s)

parsePairConst :: Parser Exp
parsePairConst = do
  symbol "["
  e1 <- parseExp
  symbol ","
  e2 <- parseExp
  symbol "]"
  return $ Pair e1 e2


parseVar :: Parser Exp
parseVar = Var <$> identifier

parseLambda :: Parser Exp
parseLambda = do
  symbol "\\"
  v <- identifier
  reservedOp "->"
  Lambda v <$> parseExp

parseCond :: Parser Exp
parseCond = do
  reserved "if"
  e1 <- parseExp
  reserved "then"
  e2 <- parseExp
  reserved "else"
  Cond e1 e2 <$> parseExp

parseLetRec :: Parser Exp
parseLetRec = do
  reserved "letrec"
  f <- identifier
  x <- identifier
  reservedOp "="
  e1 <- parseExp
  reserved "in"
  LetRec f x e1 <$> parseExp

parseProgram :: String -> Either ParseError Exp
parseProgram = parse (whitespace *> parseExp <* eof) "<input>"