don't unescape quotes in string literals and identifiers
This commit is contained in:
parent
a892d6d2ee
commit
a59f19aae9
5 changed files with 89 additions and 58 deletions
Language/SQL/SimpleSQL
|
@ -112,22 +112,9 @@ todo: public documentation on dialect definition - and dialect flags
|
|||
> prettyToken :: Dialect -> Token -> String
|
||||
> prettyToken _ (Symbol s) = s
|
||||
> prettyToken _ (Identifier Nothing t) = t
|
||||
> prettyToken _ (Identifier (Just (q1,q2)) t) =
|
||||
> q1 ++
|
||||
> -- todo: a bit hacky, do a better design
|
||||
> -- the dialect will know how to escape and unescape
|
||||
> -- contents, but the parser here also needs to know
|
||||
> -- about parsing escaped quotes
|
||||
> (if '"' `elem` q1 then doubleChars '"' t else t)
|
||||
> ++ q2
|
||||
> --prettyToken _ (UQIdentifier t) =
|
||||
> -- "u&\"" ++ doubleChars '"' t ++ "\""
|
||||
> --prettyToken _ (DQIdentifier s e t) =
|
||||
> -- s ++ t ++ e
|
||||
> prettyToken _ (Identifier (Just (q1,q2)) t) = q1 ++ t ++ q2
|
||||
> prettyToken _ (HostParam p) = ':':p
|
||||
> prettyToken _ (SqlString s e t) =
|
||||
> s ++ (if '\'' `elem` s then doubleChars '\'' t else t) ++ e
|
||||
> --prettyToken _ (CSSqlString cs t) = cs ++ "'" ++ t ++ "'"
|
||||
> prettyToken _ (SqlString s e t) = s ++ t ++ e
|
||||
> prettyToken _ (SqlNumber r) = r
|
||||
> prettyToken _ (Whitespace t) = t
|
||||
> prettyToken _ (LineComment l) = l
|
||||
|
@ -136,18 +123,6 @@ todo: public documentation on dialect definition - and dialect flags
|
|||
> prettyTokens :: Dialect -> [Token] -> String
|
||||
> prettyTokens d ts = concat $ map (prettyToken d) ts
|
||||
|
||||
When parsing a quoted identifier, you can have a double quote
|
||||
character in the identifier like this: "quotes""identifier" ->
|
||||
quoted"identifer. The double double quotes character is changed to a
|
||||
single character in the lexer and expanded back to two characters in
|
||||
the pretty printer. This also applies to strings, which can embed a
|
||||
single quote like this: 'string''with quote'.
|
||||
|
||||
> doubleChars :: Char -> String -> String
|
||||
> doubleChars _ [] = []
|
||||
> doubleChars c (d:ds) | c == d = c:d:doubleChars c ds
|
||||
> | otherwise = d:doubleChars c ds
|
||||
|
||||
TODO: try to make all parsers applicative only
|
||||
|
||||
> -- | Lex some SQL to a list of tokens.
|
||||
|
@ -222,7 +197,7 @@ u&"unicode quoted identifier"
|
|||
> -- deal with "" as literal double quote character
|
||||
> choice [do
|
||||
> void $ char '"'
|
||||
> qidenSuffix $ concat [t,s,"\""]
|
||||
> qidenSuffix $ concat [t,s,"\"\""]
|
||||
> ,return $ concat [t,s]]
|
||||
> -- mysql can quote identifiers with `
|
||||
> mySqlQIden = do
|
||||
|
@ -259,12 +234,16 @@ x'hexidecimal string'
|
|||
> -- deal with '' as literal quote character
|
||||
> choice [do
|
||||
> void $ char '\''
|
||||
> normalStringSuffix $ concat [t,s,"'"]
|
||||
> 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 '
|
||||
> -- then we commit to a string
|
||||
> -- it's possible that this will reject some valid syntax
|
||||
> -- 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 ""
|
||||
> cs = choice $ (map (\x -> string ([x] ++ "'")) "nNbBxX")
|
||||
> ++ [string "u&'"
|
||||
|
|
|
@ -40,8 +40,7 @@ which have been changed to try to improve the layout of the output.
|
|||
= value expressions
|
||||
|
||||
> valueExpr :: Dialect -> ValueExpr -> Doc
|
||||
> valueExpr _ (StringLit s e t) =
|
||||
> text (s ++ (if '\'' `elem` s then doubleUpQuotes t else t) ++ e)
|
||||
> valueExpr _ (StringLit s e t) = text s <> text t <> text e
|
||||
|
||||
> valueExpr _ (NumLit s) = text s
|
||||
> valueExpr _ (IntervalLit s v f t) =
|
||||
|
@ -227,22 +226,10 @@ which have been changed to try to improve the layout of the output.
|
|||
> valueExpr d (VEComment cmt v) =
|
||||
> vcat $ map comment cmt ++ [valueExpr d v]
|
||||
|
||||
> doubleUpQuotes :: String -> String
|
||||
> doubleUpQuotes [] = []
|
||||
> doubleUpQuotes ('\'':cs) = '\'':'\'':doubleUpQuotes cs
|
||||
> doubleUpQuotes (c:cs) = c:doubleUpQuotes cs
|
||||
|
||||
> doubleUpDoubleQuotes :: String -> String
|
||||
> doubleUpDoubleQuotes [] = []
|
||||
> doubleUpDoubleQuotes ('"':cs) = '"':'"':doubleUpDoubleQuotes cs
|
||||
> doubleUpDoubleQuotes (c:cs) = c:doubleUpDoubleQuotes cs
|
||||
|
||||
|
||||
|
||||
> unname :: Name -> String
|
||||
> unname (Name Nothing n) = n
|
||||
> unname (Name (Just (s,e)) n) =
|
||||
> s ++ (if '"' `elem` s then doubleUpDoubleQuotes n else n) ++ e
|
||||
> s ++ n ++ e
|
||||
|
||||
> unnames :: [Name] -> String
|
||||
> unnames ns = intercalate "." $ map unname ns
|
||||
|
@ -250,8 +237,7 @@ which have been changed to try to improve the layout of the output.
|
|||
|
||||
> name :: Name -> Doc
|
||||
> name (Name Nothing n) = text n
|
||||
> name (Name (Just (s,e)) n) =
|
||||
> text s <> text (if '"' `elem` s then doubleUpDoubleQuotes n else n) <> text e
|
||||
> name (Name (Just (s,e)) n) = text s <> text n <> text e
|
||||
|
||||
> names :: [Name] -> Doc
|
||||
> names ns = hcat $ punctuate (text ".") $ map name ns
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue