module RestyScript.Parser where
import RestyScript.AST
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Monad (liftM)
unescapes :: [(Char, Char)]
unescapes = zipWith pair "bnfrt" "\b\n\f\r\t"
where pair a b = (a, b)
quotedChar :: Char -> Parser Char
quotedChar c = do c <- char '\\' >> anyChar
return $ case lookup c unescapes of
Just r -> r
Nothing -> c
<|> noneOf [c]
<|> do try (string [c,c])
return c
parens :: Parser a -> Parser a
parens = between (char '(' >> spaces) (char ')' >> spaces)
keyword :: String -> Parser String
keyword s = try (do string s
notFollowedBy alphaNum
return s)
symbol :: Parser String
symbol = do char '"'
s <- word
char '"'
return s
<|> word
word :: Parser String
word = do x <- letter
xs <- many (alphaNum <|> char '_')
return (x:xs)
listSep :: Parser ()
listSep = opSep ","
parseWhere :: Parser RSVal
parseWhere = do keyword "where" >> many1 space
cond <- parseExpr
return $ Where cond
<?> "where clause"
parseExpr :: Parser RSVal
parseExpr = buildExpressionParser opTable parseArithAtom
<?> "expression"
opTable = [
[ op "::" TypeCast AssocNone ],
[ preOp "-" Minus, preOp "+" Plus ],
[
arithOp "^"
],
[
arithOp "*", arithOp "/", arithOp "%"
],
[
arithOp "+", arithOp "-"
],
[
arithOp "||"
],
[
relOp "@@", relOp "@>", relOp "@<", relOp "~", relOp "@",
relOp "<<=", relOp "<<", relOp ">>=", relOp ">>",
relOp ">=", relOp ">",
relOp "<=", relOp "<>", relOp "<",
relOp "=", relOp "!=", relOp' "like",
relOp' "is not",
relOp' "is"
],
[ preOp' "not" Not ],
[
op' "and" And AssocLeft
],
[
op' "or" Or AssocLeft
]
]
where
preOp s f
= Prefix (do { reservedOp s; spaces; return f} <?> "operator")
preOp' s f
= Prefix (do { reservedWord s; spaces; return f} <?> "operator")
op s f assoc
= Infix (do { reservedOp s; spaces; return f} <?> "operator") assoc
op' s f assoc
= Infix (do { reservedWord s; spaces; return f} <?> "operator") assoc
relOp s
= op s (Compare s) AssocNone
relOp' s
= op' s (Compare s) AssocNone
arithOp s
= op s (Arith s) AssocLeft
reservedWord :: String -> Parser String
reservedWord s = try(do string s; notFollowedBy alphaNum; spaces; return s)
reservedOp :: String -> Parser String
reservedOp s = try(do string s; spaces; return s)
opSep :: String -> Parser ()
opSep op = string op >> spaces
parseArithAtom :: Parser RSVal
parseArithAtom = parseNumber
<|> parseString
<|> parseBool
<|> parseNull
<|> parseDistinct
<|> try (parseVerbatimString)
<|> try (do {
r <- parseVariable;
notFollowedBy (char '.' <|> char '(');
return r })
<|> try (parseFuncCall)
<|> try(parseArrayIndex)
<|> parseColumn
<|> parens parseExpr
parseArrayIndex :: Parser RSVal
parseArrayIndex = do
array <- (parseColumn <|> parens parseExpr)
ind <- between (char '[' >> spaces) (char ']' >> spaces) parseExpr
return $ ArrayIndex array ind
parseBool :: Parser RSVal
parseBool = (keyword "true" >> spaces >> return RSTrue)
<|> (keyword "false" >> spaces >> return RSFalse)
parseNull :: Parser RSVal
parseNull = keyword "null" >> spaces >> return Null
parseDistinct :: Parser RSVal
parseDistinct = do
mod <- (keyword "distinct" <|> keyword "all")
spaces
cols <- sepBy1 parseExpr listSep
spaces
return $ case mod of
"distinct" -> Distinct cols
otherwise -> All cols
parseFuncCall :: Parser RSVal
parseFuncCall = do f <- parseIdent
args <- parens parseArgs
return $ FuncCall f args
parseArgs :: Parser [RSVal]
parseArgs = do v <- parseAnyColumn
return [v]
<|> sepBy parseExpr listSep
parseAnyColumn :: Parser RSVal
parseAnyColumn = do char '*'
spaces
return AnyColumn
parseVariable :: Parser RSVal
parseVariable = do char '$'
pos <- getPosition
prefix <- option "" $ string "_"
v <- symbol
spaces
return $ Variable pos $ prefix ++ v
parseNumber :: Parser RSVal
parseNumber = try (parseFloat)
<|> parseInteger
<?> "number"
parseInteger :: Parser RSVal
parseInteger = do digits <- many1 digit
spaces
return $ Integer $ read digits
parseFloat :: Parser RSVal
parseFloat = do int <- many1 digit
dec <- char '.' >> many digit
spaces
return $ Float $
read (int ++ "." ++ noEmpty dec)
<|> do dec <- char '.' >> many1 digit
spaces
return $ Float $ read ("0." ++ dec)
<?> "floating-point number"
where noEmpty s = if s == "" then "0" else s
parseString :: Parser RSVal
parseString = do s <- between (char '\'') (char '\'')
$ many $ quotedChar '\''
spaces
return $ String s
<?> "string"
parseVerbatimString :: Parser RSVal
parseVerbatimString = do delim <- char '$' >> option "" identifier
char '$'
str <- manyTill anyChar (try (char '$' >> string delim >> char '$'))
spaces
-- char '$' >> string delim >> char '$'
return $ String str
identifier :: Parser String
identifier = do c <- letter <|> char '_'
s <- many (alphaNum <|> char '_')
return (c : s)
parseColumn :: Parser RSVal
parseColumn = do a <- parseIdent
spaces
b <- option Empty (char '.' >> spaces >> parseIdent)
return $ case b of
Empty -> Column a
otherwise -> QualifiedColumn a b
<?> "column"
parseModel :: Parser RSVal
parseModel = liftM Model parseIdent
parseIdent :: Parser RSVal
parseIdent = do s <- symbol
spaces
return $ Symbol s
<|> do char '"'
s <- symbol
char '"' >> spaces
return $ Symbol s
<|> parseVariable
<?> "identifier entry"