module Micro.Parser
  ( Micro.Parser.parse,
    parseFromFile,
    parseFromString,
  )
where

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

binary :: String -> Op -> E.Assoc -> E.Operator String () Identity Expr
binary s f assoc =
  E.Infix
    ( reservedOp s
        >> do
          -- FIXME: this is the second operand
          pos <- getPosition
          return $ BinOp f pos
    )
    assoc

opTable :: [[E.Operator String () Identity Expr]]
opTable =
  [ [ binary "*" Mul E.AssocLeft,
      binary "/" Div E.AssocLeft
    ],
    [ binary "+" Plus E.AssocLeft,
      binary "-" Minus E.AssocLeft
    ],
    [binary "=" Assign 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 $
        do
          x <- fStatement
          pure $ [x]
          <|> grVar True
  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
  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

-- statements that appear in functions
fStatement :: Parser Expr
fStatement = try exprStmt <|> var True <|> return'

-- top level statement
statement :: Parser Expr
statement =
  try exprStmt <|> try (privateDf var)
    <|> return' -- this will raise an error

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

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

parse :: Parser [Expr]
parse = program

parseFromFile :: FilePath -> IO (Either ParseError [Expr])
parseFromFile filename = do
  input <- readFile filename
  return $ runParser (scan Micro.Parser.parse) () filename input

parseFromString :: String -> Either ParseError [Expr]
parseFromString input = runParser (scan Micro.Parser.parse) () "-" input