module Syntax where
import Lexer
import Type
import Value

import Text.Parsec hiding (newline)
import Text.Parsec.Expr

data ID = ID String
  deriving (Eq, Ord, Show)

data BOP
  = BPlus
  | BMinus
  | BMul
  | BDiv
  | BMod
  | BEqual
  | BNEqual
  | BLt
  | BGt
  | BLeq
  | BGeq
  | BAnd
  | BOr
  deriving (Eq, Ord, Show)

data Expr
  = Var ID
  | Lit PrimValue
  | BinOp BOP Expr Expr
  deriving (Eq, Show)

data Stmt
  = DeclVar Type ID Expr
  | Assign ID Expr
  | WhileStmt Expr [Stmt]
  | IfStmt [(Expr, [Stmt])] (Maybe [Stmt])
  | Expr Expr
  | Debug Expr
  deriving (Eq, Show)

type P u a = Parsec [TokPair] u a

ident :: P u ID
ident = try $ do
  p <- tokAny
  case p of
    TIdent name -> return (ID name)
    _ -> unexpected "non ident"

keyword :: String -> P u ()
keyword str = try $ tok (TKeyword str) *> return ()

newline = tok TNewline

termP :: P u Expr
termP = varExpP <|> litExpP where
  varExpP = Var <$> ident
  litExpP = try $ do
    p <- tokAny
    case p of
      TLitInt x -> return (Lit (IntV x))
      TKeyword "True" -> return (Lit (BoolV True))
      TKeyword "False" -> return (Lit (BoolV False))
      _ -> unexpected "non literal"

exprP :: P u Expr
exprP = buildExpressionParser table termP where
  table = [
      [binary "*" BMul AssocLeft, binary "/" BDiv AssocLeft, binary "%" BMod AssocLeft],
      [binary "+" BPlus AssocLeft, binary "-" BMinus AssocLeft],
      [binary "<" BLt AssocNone, binary ">" BGt AssocNone, binary "<=" BLeq AssocNone, binary ">=" BGeq AssocNone],
      [binary "==" BEqual AssocNone, binary "/=" BNEqual AssocNone],
      [binary "&" BAnd AssocLeft],
      [binary "|" BOr AssocRight]
    ]
  binary name op assoc = Infix (try $ tok (TOperator name) *> skipMany newline >> return (BinOp op)) assoc

stmtDelim :: P u ()
stmtDelim = skipMany1 newline <|> try (lookAhead (tok TCloseBrace) *> return ())

typeP :: P u Type
typeP = choice (map try pts) where
  pts = [keyword "Bool" *> return PTBool, keyword "Int" *> return PTInt]

stmtP :: P u Stmt
stmtP = choice (map try [declvarStmtP, assignStmtP, whileStmtP, ifStmtP, exprStmtP, debugStmtP]) <* stmtDelim where
  declvarStmtP = DeclVar <$> typeP <*> ident <*> (tok (TOperator "=") *> skipMany newline *> exprP)
  assignStmtP = Assign <$> ident <*> (tok (TOperator "=") *> skipMany newline *> exprP)
  whileStmtP = do
    keyword "while" <* skipMany newline
    WhileStmt <$> exprP <*> braceStmts
  ifStmtP = do
    keyword "if" <* skipMany newline
    pair <- (,) <$> exprP <*> braceStmts
    elseifs <- many $ do
      keyword "elseif" <* skipMany newline
      (,) <$> exprP <*> braceStmts
    elsebody <- optionMaybe $ keyword "else" *> braceStmts
    return $ IfStmt (pair : elseifs) elsebody
  exprStmtP = Expr <$> try exprP
  debugStmtP = keyword "debug" *> (Debug <$> exprP)

braceStmts :: Parsec [TokPair] u [Stmt]
braceStmts = skipMany newline *> tok TOpenBrace *> stmtsP <* skipMany newline <* tok TCloseBrace

stmtsP :: Parsec [TokPair] u [Stmt]
stmtsP = skipMany newline *> many stmtP

programP :: Parsec [TokPair] u [Stmt]
programP = skipMany (tok TNewline) *> stmtsP <* eof

