module GSA.Parser where

import Data.Char
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import Data.Void (Void)
import GSA.Types
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L

type Parser = Parsec Void Text

sc :: Parser ()
sc =
  L.space
    space1
    (L.skipLineComment "//")
    (L.skipBlockComment "/*" "*/")

lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc

symbol :: Text -> Parser Text
symbol = L.symbol sc

parens :: Parser a -> Parser a
parens = between (symbol "(") (symbol ")")

braces :: Parser a -> Parser a
braces = between (symbol "{") (symbol "}")

brackets :: Parser a -> Parser a
brackets = between (symbol "[") (symbol "]")

integer :: Parser Integer
integer = lexeme L.decimal

float :: Parser Double
float = lexeme L.float

signedInteger :: Parser Integer
signedInteger = L.signed sc integer

signedFloat :: Parser Double
signedFloat = L.signed sc float

charLiteral :: Parser Char
charLiteral = between (char '\'') (char '\'') L.charLiteral

stringLiteral :: Parser String
stringLiteral = char '\"' *> manyTill L.charLiteral (char '\"')

typParser :: Parser Typ
typParser = undefined

retTypParser :: Parser RetTyp
retTypParser = undefined

chunkParser :: Parser Chunk
chunkParser = undefined

signatureParser :: Parser Signature
signatureParser = undefined

nodeParser :: Parser Node
nodeParser = undefined

regParser :: Parser Reg
regParser = do
  char 'x'
  Reg . fromInteger <$> integer

identParser :: Parser Ident
identParser = undefined

ptrofsParser :: Parser Ptrofs
ptrofsParser = undefined

comparisonParser :: Parser Comparison
comparisonParser =
  choice
    [ string "==" >> return Ceq,
      string "!=" >> return Cne,
      string "<" >> return Clt,
      string "<=" >> return Cle,
      string ">" >> return Cgt,
      string ">=" >> return Cge
    ]

compParser :: (Comparison -> Condition) -> Text -> Parser (Condition, [Reg])
compParser f t = do
  r1 <- regParser
  comp <- comparisonParser <* symbol t
  r2 <- regParser
  return $ (f comp, [r1, r2])

conditionParser :: Parser (Condition, [Reg])
conditionParser =
  choice [ compParser Ccomp "s",
           compParser Ccompu "u",
           compParser Ccompl "ls",
           compParser Ccomplu "lu"
         ]

addressingParser :: Parser Addressing
addressingParser = undefined

omoveParser :: Parser (Operation, [Reg])
omoveParser = do
  r <- regParser
  return (Omove, [r])

ointconstParser :: Parser (Operation, [Reg])
ointconstParser = do
  i <- fromInteger <$> integer
  return (Ointconst i, [])

onegParser :: Parser (Operation, [Reg])
onegParser = do
  r <- parens (symbol "-" >> regParser)
  return (Oneg, [r])

obinopParser :: Operation -> Text -> Parser (Operation, [Reg])
obinopParser op t = do
  r1 <- regParser
  r2 <- symbol t >> regParser
  return (op, [r1, r2])

obinopimmParser :: (Int -> Operation) -> Text -> Parser (Operation, [Reg])
obinopimmParser op t = do
  r1 <- regParser
  i <- symbol t >> fromInteger <$> integer
  return (op i, [r1])

operationParser :: Parser (Operation, [Reg])
operationParser =
  choice
    [ omoveParser,
      ointconstParser,
      onegParser,
      obinopParser Osub "-",
      obinopParser Omul "*",
      obinopimmParser Omulimm "*",
      obinopParser Odiv "/s",
      obinopParser Odivu "/u",
      obinopParser Omod "%s",
      obinopParser Omodu "%u",
      obinopParser Oand "&",
      obinopimmParser Oandimm "&",
      obinopParser Oor "|",
      obinopimmParser Oorimm "|"
    ]

predicateParser :: Parser Predicate
predicateParser = undefined

mergeinstructionParser :: Parser Instruction
mergeinstructionParser = undefined

inopParser :: Int -> Parser Instruction
inopParser i = symbol "nop" >> return (Inop . Node $ i -1)

gotoParser' :: Parser Node
gotoParser' = symbol "goto" >> integer >>= (return . Node . fromInteger)

gotoParser :: Parser Instruction
gotoParser = Inop <$> gotoParser'

icondParser :: Parser Instruction
icondParser = do
  (cond, args) <- symbol "if" >> parens conditionParser
  n1 <- gotoParser'
  n2 <- symbol "else" >> gotoParser'
  return $ Icond cond args n1 n2

iopParser :: Int -> Parser Instruction
iopParser i = do
  r <- regParser
  symbol "="
  (op, args) <- operationParser
  goto <- optional gotoParser'
  case goto of
    Just goto' -> return $ Iop op args r goto'
    Nothing -> return $ Iop op args r (Node $ i -1)

instructionParser :: Parser (Int, Instruction)
instructionParser = do
  i <- fromInteger <$> integer
  symbol ":"
  instr <- choice [gotoParser, inopParser i, icondParser, iopParser i]
  return (i, instr)

codeParser :: Parser Code
codeParser =
  Code . IMap.fromList <$> many instructionParser

functionParser :: Parser (Text, Function)
functionParser = do
  name <- lexeme (takeWhile1P (Just "Function name") isAlphaNum)
  args <- parens $ regParser `sepBy` symbol ","
  code <- braces codeParser
  return (name, Function signatureMain args 0 code (Node 0) [])

gsaParser :: Parser Program
gsaParser = Program . Map.fromList <$> many functionParser

parse :: String -> Text -> Either String Program
parse file t =
  case runParser gsaParser file t of
    Left a -> Left (show a)
    Right a -> Right a