module Parser where

import Ast
import Data.Maybe (isJust)
import Lexer
import Text.Parsec
import qualified Text.Parsec.Expr as E
import Text.Parsec.String (Parser)

binary s f assoc = E.Infix (reservedOp s >> return (BinOp f)) assoc

opTable =
  [ [ binary "*" Mul E.AssocLeft,
      binary "/" Div E.AssocLeft
    ],
    [ binary "+" Plus E.AssocLeft,
      binary "-" Minus E.AssocLeft
    ]
  ]

expr :: Parser Expr
expr = E.buildExpressionParser opTable factor

number :: Parser Expr
number = do
  pos <- getPosition
  n <- integer
  return $ Num n pos

true :: Parser Expr
true = do
  pos <- getPosition
  reserved "true"
  return $ Bool' True pos

false :: Parser Expr
false = do
  pos <- getPosition
  reserved "false"
  return $ Bool' False pos

variable :: Parser Expr
variable = do
  pos <- getPosition
  var <- identifier
  return $ Variable var pos

typ :: Parser Type
typ = do
  p <- identifier
  return $ Type p

typFn :: Parser Type
typFn = do
  p <- parens $ commaSep typ
  r <- optionMaybe $ do
    reserved "->"
    typ
  return $ FuncType p r

type' :: Parser Type
type' = do
  try typFn
    <|> typ <?> "type"

-- argument
arg :: Parser (String, Type, Bool, SourcePos)
arg = do
  pos <- getPosition
  i <- identifier
  _ <- colonSep <?> "\":\" before type"
  t <- type' <?> "type"
  return $ (i, t, True, pos)

-- function definition (common to def and lambda)
fdef :: Ident -> Bool -> Bool -> SourcePos -> Parser Expr
fdef ident priv anon pos = do
  args <- parens $ commaSep arg
  rtyp <-
    optionMaybe
      ( do
          _ <- colonSep <?> "\":\" before type"
          rtyp <- type' <?> "return type"
          return $ rtyp
      )
  body <-
    braces $
      many $
        try (grVar False) <|> do
          x <- statement
          pure $ [x]
  return $ Func ident args rtyp (concat $ body) priv anon pos

function :: Bool -> Parser Expr
function priv = do
  pos <- getPosition
  reserved "def"
  ident <- identifier
  fdef ident priv False pos

-- ident: type = value
varWithValue :: Bool -> Parser Expr
varWithValue priv = do
  (ident, typ, _, pos) <- arg
  -- FIXME: this error hint is not being used
  reservedOp "=" <?> "assignation"
  value <- expr
  return $ Var ident typ value priv pos

-- group variable declaration
grVar :: Bool -> Parser [Expr]
grVar priv = do
  reserved "var"
  xs <- parens $ commaSep $ varWithValue priv
  reservedOp ";"
  return $ xs

-- variable declaration
var :: Bool -> Parser Expr
var priv = do
  reserved "var"
  x <- varWithValue priv
  reservedOp ";"
  return $ x

-- private definition
privateDf :: (Bool -> Parser Expr) -> Parser Expr
privateDf f = do
  priv <- optionMaybe $ reserved "private"
  f (isJust priv)

-- private group definition
privateDfn :: (Bool -> Parser [Expr]) -> Parser [Expr]
privateDfn f = do
  priv <- optionMaybe $ reserved "private"
  f (isJust priv)

lambdaId :: SourcePos -> Ident
lambdaId s =
  "lambda" ++ "@" ++ show (sourceLine s) ++ "," ++ show (sourceColumn s)

lambda :: Parser Expr
lambda = do
  pos <- getPosition
  fdef (lambdaId pos) True True pos

return' :: Parser Expr
return' = do
  pos <- getPosition
  reserved "return"
  value <- optionMaybe expr
  reservedOp ";"
  return $ Return value pos

call :: Parser Expr
call = do
  pos <- getPosition
  ident <- try lambda <|> variable
  args <- parens $ commaSep expr
  return $ Call ident args pos

factor :: Parser Expr
factor =
  number
    <|> true
    <|> false
    <|> try call
    <|> try lambda
    <|> try variable
    <|> parens expr

exprStmt :: Parser Expr
exprStmt = do
  e <- expr <|> factor
  reservedOp ";"
  return $ e

statement :: Parser Expr
statement = do
  try exprStmt
    <|> var False
    <|> return'

module' :: Parser Expr
module' = do
  pos <- getPosition
  reserved "module"
  ident <- identifier
  return $ Module ident pos

program :: Parser [Expr]
program = do
  m <- module'
  n <-
    many $
      try (privateDfn grVar) <|> do
        x <-
          try (privateDf function) <|> try (privateDf var)
            <|> statement
        pure $ [x]
  return $ [m] ++ (concat $ n)

parse :: Parser [Expr]
parse = program

parseFromFile p fname = do
  input <- readFile fname
  return (runParser p () fname input)