starlitcanopy/simple-sql-parser
1
Fork 0
Code Activity

add lexing for \' only in e' strings and dollar strings in pg dialect

Browse source
This commit is contained in:
Jake Wheat 2016-02-13 17:07:27 +02:00
parent b41803427d
commit 5084c0c3ab
2 changed files with 36 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
Language/SQL/SimpleSQL/Lex.lhs
View file

@ -228,30 +228,32 @@ x'hexidecimal string'
> sqlString :: Dialect -> Parser Token
> sqlString d =
> choice [csString
> ,normalString
> ]
> sqlString d = dollarString <|> csString <|> normalString
> where
> normalString = SqlString "'" "'" <$> (char '\'' *> normalStringSuffix "")
> normalStringSuffix t
> | diSyntaxFlavour d == Postgres = do
> s <- takeTill (`elem` "'\\")
> dollarString = do
> guard $ diSyntaxFlavour d == Postgres
> -- use try because of ambiguity with symbols and with
> -- positional arg
> s <- choice
> [do
> i <- try (char '$' *> identifierString <* char '$')
> return $ "$" ++ i ++ "$"
> ,try (string "$$")
> ]
> str <- manyTill anyChar (try $ string s)
> return $ SqlString s s str
> normalString = SqlString "'" "'" <$> (char '\'' *> normalStringSuffix False "")
> normalStringSuffix allowBackslash t = do
> s <- takeTill $ if allowBackslash
> then (`elem` "'\\")
> else (== '\'')
> -- deal with '' or \' as literal quote character
> choice [do
> ctu <- choice ["''" <$ try (string "''")
> ,"\\'" <$ string "\\'"
> ,"\\" <$ char '\\']
> normalStringSuffix $ concat [t,s,ctu]
> normalStringSuffix allowBackslash $ concat [t,s,ctu]
> ,concat [t,s] <$ char '\'']
> | otherwise = do
> s <- takeTill (=='\'')
> void $ char '\''
> -- deal with '' as literal quote character
> choice [do
> void $ char '\''
> normalStringSuffix $ concat [t,s,"''"]
> ,return $ concat [t,s]]
> -- try is used to to avoid conflicts with
> -- identifiers which can start with n,b,x,u
> -- once we read the quote type and the starting '
@ -260,9 +262,17 @@ x'hexidecimal string'
> -- but only pathalogical stuff, and I think the improved
> -- error messages and user predictability make it a good
> -- pragmatic choice
> csString = SqlString <$> try cs <*> return "'" <*> normalStringSuffix ""
> csPrefixes | diSyntaxFlavour d == Postgres = "nNbBxXEe"
> | otherwise = "nNbBxX"
> csString
> | diSyntaxFlavour d == Postgres =
> choice [SqlString <$> try (string "e'" <|> string "E'")
> <*> return "'" <*> normalStringSuffix True ""
> ,csString']
> | otherwise = csString'
> csString' = SqlString
> <$> try cs
> <*> return "'"
> <*> normalStringSuffix False ""
> csPrefixes = "nNbBxX"
> cs = choice $ (map (\x -> string ([x] ++ "'")) csPrefixes)
> ++ [string "u&'"
> ,string "U&'"]

10
tools/Language/SQL/SimpleSQL/LexerTests.lhs
View file

@ -196,10 +196,12 @@ assurance.
> ,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])
> ,("e'this '' quote'", [SqlString "e'" "'" "this '' quote"])
> ,("e'this \\' quote'", [SqlString "e'" "'" "this \\' quote"])
> -- todo: implement only allowing \' in e quoted strings
> {-,("'not this \\' quote", [SqlString "'" "'" "not this \\"
> ,Whitespace " "
> ,Identifier Nothing "quote"])-}
> ,("'not this \\' quote", [SqlString "'" "'" "not this \\"
> ,Whitespace " "
> ,Identifier Nothing "quote"])
> ,("$$ string 1 $$", [SqlString "$$" "$$" " string 1 "])
> ,("$$ string $ 2 $$", [SqlString "$$" "$$" " string $ 2 "])
> ,("$a$ $$string 3$$ $a$", [SqlString "$a$" "$a$" " $$string 3$$ "])
> ]
> -- csstrings
> ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))