module buildclient.config.BuildParser where

import  Data.MicroParsec as MP

data Token =
      BareWord {bval::String}
    | Number {nval::String}
    | BraceOpen
    | BraceClose
    | NewLine
    | QuotedString {sval::String}
    | ERROR {position::Int, message:: String}
derive Eq Token
derive Show Token

protected type Parser = MP.Parser [] Token

protected isIdentifierStartChar :: Char -> Bool
protected isIdentifierStartChar char = ('A' <= char && char <= 'Z') || ('a' <= char && char <= 'z') || char == '_'

protected isDigit :: Char -> Bool
protected isDigit char = ('0' <= char && char <= '9')

protected isIdentifierChar :: Char -> Bool
protected isIdentifierChar char = isIdentifierStartChar char || isDigit char

lexer :: String -> [Token]
lexer s = lex s 0

private lex :: String -> Int -> [Token]
private lex !cs !start
    | start >= cs.length = []
    | ch == '\\' && at 1 == '\n' = lex cs (start + 2)
    | ch == '\n' = Token.NewLine : lex cs (start + 1)
    | ch.isWhitespace = lex cs (start + 1)
    | ch == '"' = string 1 []
    | ch == '{' = Token.BraceOpen : lex cs (start + 1)
    | ch == '}' = Token.BraceClose : lex cs (start + 1)
    | isDigit ch = takeWhile isDigit Token.Number 0 []
    | isIdentifierStartChar ch = takeWhile isIdentifierChar Token.BareWord 0 []
    | otherwise -> [Token.ERROR{position=start, message="Unexpected character " ++ (show ch)}]
    where
        ch = at 0
        at i = if start + i >= cs.length  then '\0' else cs.charAt (start + i)
        takeWhile charTest mapper off !acc
            | charTest $ at off = takeWhile charTest mapper (off + 1) (at off : acc)
            | otherwise = (mapper $ packed $ reverse acc) : lex cs (start + off)
        string off !acc
            | start + off >= cs.length = [Token.ERROR{position=start + off, message="Unterminated string literal"}]
            | ch == '"' -> (Token.QuotedString $ packed (reverse acc)) : lex cs (start + off + 1)
            | ch >= ' ' || ch == '\n' || ch == '\t' -> string (off + 1) (ch : acc)
            | otherwise -> [Token.ERROR{position=start+off, message="Unknown string character"}]
            where
                ch = at off



runParser :: Parser a -> [Token]  -> (String | a)
runParser p ts = case MP.runid p ts of
    (Left msg, ts) →  Left (MP.reporterror ts msg)
    (right, _)     →  right



protected parseNewLine :: Parser ()
protected parseNewLine = const () <$> expect Token.NewLine <?> "newline expected"

protected parseLBrace :: Parser ()
protected parseLBrace = const () <$> expect Token.BraceOpen <?> "opening braces expected"

protected parseRBrace :: Parser ()
protected parseRBrace = const () <$> expect Token.BraceClose <?> "closing braces expected"

protected parseEndOfStatement :: Parser ()
protected parseEndOfStatement = (parseNewLine <|> parseRBrace <|> eos) <?> "expected end of statement"

protected parseBareWord :: Parser String
protected parseBareWord = (_.bval) <$> satisfy _.{bval?} <?> "bareword expected"

protected parseQuotedString :: Parser String
protected parseQuotedString = (_.sval) <$> satisfy _.{sval?} <?> "string expected"

protected parseNumber :: Parser String
protected parseNumber = (_.nval) <$> satisfy _.{nval?} <?> "number expected"

data ASTValue = ASTString String | ASTWord String | ASTNumber Int
data ASTDirective = ASTDirective {name::String, arguments:: [ASTValue], block:: [ASTDirective]}
derive Show ASTValue
derive Show ASTDirective

protected parseValue :: Parser ASTValue
protected parseValue = ASTString <$> parseQuotedString <|> ASTWord <$> parseBareWord <|> (ASTNumber . read) <$> parseNumber

protected parseShortDirective :: Parser ASTDirective
protected parseShortDirective = do
    skip parseNewLine
    name <- parseBareWord <?> "directive name expected"
    args <- many parseValue
    cond (parseEndOfStatement)
        (return $ ASTDirective name args [])
        do
            parseLBrace
            subdirectives <- many parseShortDirective
            skip parseNewLine
            parseRBrace
            return $ ASTDirective name args subdirectives

parseFile :: Parser [ASTDirective]
parseFile = (many parseShortDirective) <* (skip parseNewLine) <* eos

findDirective :: String -> [ASTDirective] -> Maybe ASTDirective
findDirective name (directive:ds)
    | directive.name == name = Just directive
    | otherwise = findDirective name ds
findDirective _ [] = Nothing