From 52f035b718b88e11bb9d352fe730a7b70c4d87bc Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Fri, 12 Feb 2016 13:09:58 +0200 Subject: [PATCH] new syntax for names and string literals --- Language/SQL/SimpleSQL/Lex.lhs | 74 ++++++++++--------- Language/SQL/SimpleSQL/Parse.lhs | 68 +++++++---------- Language/SQL/SimpleSQL/Pretty.lhs | 21 ++---- Language/SQL/SimpleSQL/Syntax.lhs | 14 ++-- tools/Language/SQL/SimpleSQL/LexerTests.lhs | 62 +++++++++------- tools/Language/SQL/SimpleSQL/MySQL.lhs | 2 +- .../Language/SQL/SimpleSQL/SQL2011Queries.lhs | 42 +++++------ tools/Language/SQL/SimpleSQL/ValueExprs.lhs | 32 ++++---- 8 files changed, 150 insertions(+), 165 deletions(-) diff --git a/Language/SQL/SimpleSQL/Lex.lhs b/Language/SQL/SimpleSQL/Lex.lhs index b8a9346..99a924f 100644 --- a/Language/SQL/SimpleSQL/Lex.lhs +++ b/Language/SQL/SimpleSQL/Lex.lhs @@ -50,26 +50,20 @@ parsec > -- > | Identifier String > -> -- | This is an identifier quoted with " -> | QIdentifier String -> -- | This is an identifier quoted with u&" -> | UQIdentifier String - -> -- | This is a dialect specific quoted identifier with the quote -> -- characters explicit. The first and second fields are the -> -- starting and ending quote characters. -> | DQIdentifier String String String -> +> -- | This is a quoted identifier, the quotes can be " or u&, +> -- etc. or something dialect specific like [] +> -- the first two fields are the start and end quotes +> | QuotedIdentifier String -- start quote +> String -- end quote +> String -- content > -- | This is a host param symbol, e.g. :param > | HostParam String > -> -- | This is a string literal. -> | SqlString String -> -> -- | This is a character set string literal. The first field is -> -- the character set (one of nNbBxX, or u&, U&). -> | CSSqlString String String -> +> -- | This is a string literal. The first two fields are the -- +> -- start and end quotes, which are usually both ', but can be +> -- the character set (one of nNbBxX, or u&, U&), or a dialect +> -- specific string quoting (such as $$ in postgres) +> | SqlString String String String > -- | A number literal (integral or otherwise), stored in original format > -- unchanged > | SqlNumber String @@ -95,15 +89,19 @@ parsec > prettyToken :: Dialect -> Token -> String > prettyToken _ (Symbol s) = s > prettyToken _ (Identifier t) = t -> prettyToken _ (QIdentifier t) = -> "\"" ++ doubleChars '"' t ++ "\"" -> prettyToken _ (UQIdentifier t) = -> "u&\"" ++ doubleChars '"' t ++ "\"" -> prettyToken _ (DQIdentifier s e t) = -> s ++ t ++ e +> prettyToken _ (QuotedIdentifier q1 q2 t) = +> q1 ++ +> -- todo: a bit hacky, do a better design +> (if '"' `elem` q1 then doubleChars '"' t else t) +> ++ q2 +> --prettyToken _ (UQIdentifier t) = +> -- "u&\"" ++ doubleChars '"' t ++ "\"" +> --prettyToken _ (DQIdentifier s e t) = +> -- s ++ t ++ e > prettyToken _ (HostParam p) = ':':p -> prettyToken _ (SqlString t) = "'" ++ doubleChars '\'' t ++ "'" -> prettyToken _ (CSSqlString cs t) = cs ++ "'" ++ t ++ "'" +> prettyToken _ (SqlString s e t) = +> s ++ (if '\'' `elem` s then doubleChars '\'' t else t) ++ e +> --prettyToken _ (CSSqlString cs t) = cs ++ "'" ++ t ++ "'" > prettyToken _ (SqlNumber r) = r > prettyToken _ (Whitespace t) = t > prettyToken _ (LineComment l) = l @@ -181,12 +179,14 @@ u&"unicode quoted identifier" > identifier :: Dialect -> Parser Token > identifier d = > choice -> [QIdentifier <$> qiden +> [QuotedIdentifier "\"" "\"" <$> qiden > -- try is used here to avoid a conflict with identifiers > -- and quoted strings which also start with a 'u' -> ,UQIdentifier <$> ((try (string "u&" <|> string "U&")) *> qiden) +> ,QuotedIdentifier "u&\"" "\"" <$> (try (string "u&") *> qiden) +> ,QuotedIdentifier "U&\"" "\"" <$> (try (string "U&") *> qiden) > ,Identifier <$> identifierString -> ,DQIdentifier "`" "`" <$> mySqlQIden +> -- todo: dialect protection +> ,QuotedIdentifier "`" "`" <$> mySqlQIden > ] > where > qiden = char '"' *> qidenSuffix "" @@ -226,7 +226,7 @@ x'hexidecimal string' > ,normalString > ] > where -> normalString = SqlString {-"'"-} <$> (char '\'' *> normalStringSuffix "") +> normalString = SqlString "'" "'" <$> (char '\'' *> normalStringSuffix "") > normalStringSuffix t = do > s <- takeTill (=='\'') > void $ char '\'' @@ -239,10 +239,10 @@ x'hexidecimal string' > -- identifiers which can start with n,b,x,u > -- once we read the quote type and the starting ' > -- then we commit to a string -> csString = CSSqlString <$> try (cs <* char '\'') <*> normalStringSuffix "" -> cs = choice [(:[]) <$> oneOf "nNbBxX" -> ,string "u&" -> ,string "U&"] +> csString = SqlString <$> try cs <*> return "'" <*> normalStringSuffix "" +> cs = choice $ (map (\x -> string ([x] ++ "'")) "nNbBxX") +> ++ [string "u&'" +> ,string "U&'"] > hostParam :: Dialect -> Parser Token > hostParam _ = HostParam <$> (char ':' *> identifierString) @@ -283,13 +283,15 @@ A symbol is one of the two character symbols, or one of the single character symbols in the two lists below. > symbol :: Dialect -> Parser Token -> symbol _ = Symbol <$> choice (many1 (char '.') : +> symbol _ = Symbol <$> +> choice ( +> many1 (char '.') : > -- try is used because most of the first > -- characters of the two character symbols > -- can also be part of a single character symbol > -- maybe this would be better with left factoring? -> map (try . string) [">=","<=","!=","<>","||"] -> ++ map (string . (:[])) "+-^*/%~&|?<>[]=,;()") +> map (try . string) [">=","<=","!=","<>","||"] +> ++ map (string . (:[])) "+-^*/%~&|?<>[]=,;()") > sqlWhitespace :: Dialect -> Parser Token > sqlWhitespace _ = Whitespace <$> many1 (satisfy isSpace) diff --git a/Language/SQL/SimpleSQL/Parse.lhs b/Language/SQL/SimpleSQL/Parse.lhs index 525153a..0473b7d 100644 --- a/Language/SQL/SimpleSQL/Parse.lhs +++ b/Language/SQL/SimpleSQL/Parse.lhs @@ -330,10 +330,8 @@ u&"example quoted" > name :: Parser Name > name = do > d <- getState -> choice [QName <$> qidentifierTok -> ,UQName <$> uqidentifierTok -> ,Name <$> identifierTok (blacklist d) Nothing -> ,(\(s,e,t) -> DQName s e t) <$> dqidentifierTok +> choice [Name <$> identifierTok (blacklist d) Nothing +> ,(\(s,e,t) -> QuotedName s e t) <$> qidentifierTok > ] todo: replace (:[]) with a named function all over @@ -558,16 +556,13 @@ factoring in this function, and it is a little dense. See the stringToken lexer below for notes on string literal syntax. > stringLit :: Parser ValueExpr -> stringLit = StringLit <$> stringTokExtend +> stringLit = (\(s,e,t) -> StringLit s e t) <$> stringTokExtend > numberLit :: Parser ValueExpr > numberLit = NumLit <$> sqlNumberTok False -> characterSetLit :: Parser ValueExpr -> characterSetLit = uncurry CSStringLit <$> csSqlStringLitTok - > simpleLiteral :: Parser ValueExpr -> simpleLiteral = numberLit <|> stringLit <|> characterSetLit +> simpleLiteral = numberLit <|> stringLit == star, param, host param @@ -690,7 +685,7 @@ this. also fix the monad -> applicative > intervalLit = try (keyword_ "interval" >> do > s <- optionMaybe $ choice [True <$ symbol_ "+" > ,False <$ symbol_ "-"] -> lit <- stringTok +> lit <- singleQuotesOnlyStringTok > q <- optionMaybe intervalQualifier > mkIt s lit q) > where @@ -716,7 +711,7 @@ all the value expressions which start with an identifier > idenExpr :: Parser ValueExpr > idenExpr = > -- todo: work out how to left factor this -> try (TypedLit <$> typeName <*> stringTokExtend) +> try (TypedLit <$> typeName <*> singleQuotesOnlyStringTok) > <|> multisetSetFunction > <|> (names <**> option Iden app) > where @@ -831,7 +826,7 @@ in the source > keyword "trim" >> > parens (mkTrim > <$> option "both" sides -> <*> option " " stringTok +> <*> option " " singleQuotesOnlyStringTok > <*> (keyword_ "from" *> valueExpr)) > where > sides = choice ["leading" <$ keyword_ "leading" @@ -839,7 +834,7 @@ in the source > ,"both" <$ keyword_ "both"] > mkTrim fa ch fr = > SpecialOpK [Name "trim"] Nothing -> $ catMaybes [Just (fa,StringLit ch) +> $ catMaybes [Just (fa,StringLit "'" "'" ch) > ,Just ("from", fr)] === app, aggregate, window @@ -1951,28 +1946,34 @@ unsigned integer match symbol matching keyword matching -> csSqlStringLitTok :: Parser (String,String) -> csSqlStringLitTok = mytoken (\tok -> -> case tok of -> L.CSSqlString p s -> Just (p,s) -> _ -> Nothing) - -> stringTok :: Parser String +> stringTok :: Parser (String,String,String) > stringTok = mytoken (\tok -> > case tok of -> L.SqlString s -> Just s +> L.SqlString s e t -> Just (s,e,t) +> _ -> Nothing) + +> singleQuotesOnlyStringTok :: Parser String +> singleQuotesOnlyStringTok = mytoken (\tok -> +> case tok of +> L.SqlString "'" "'" t -> Just t > _ -> Nothing) This is to support SQL strings where you can write 'part of a string' ' another part' and it will parse as a single string -> stringTokExtend :: Parser String +It is only allowed when all the strings are quoted with ' atm. + +> stringTokExtend :: Parser (String,String,String) > stringTokExtend = do -> x <- stringTok +> (s,e,x) <- stringTok > choice [ -> ((x++) <$> stringTokExtend) -> ,return x +> do +> guard (s == "'" && e == "'") +> (s',e',y) <- stringTokExtend +> guard (s' == "'" && e' == "'") +> return $ (s,e,x ++ y) +> ,return (s,e,x) > ] > hostParamTok :: Parser String @@ -2002,25 +2003,12 @@ and it will parse as a single string > (Just k, L.Identifier p) | k == map toLower p -> Just p > _ -> Nothing) -> qidentifierTok :: Parser String +> qidentifierTok :: Parser (String,String,String) > qidentifierTok = mytoken (\tok -> > case tok of -> L.QIdentifier p -> Just p +> L.QuotedIdentifier s e t -> Just (s,e,t) > _ -> Nothing) -> dqidentifierTok :: Parser (String,String,String) -> dqidentifierTok = mytoken (\tok -> -> case tok of -> L.DQIdentifier s e t -> Just (s,e,t) -> _ -> Nothing) - -> uqidentifierTok :: Parser String -> uqidentifierTok = mytoken (\tok -> -> case tok of -> L.UQIdentifier p -> Just p -> _ -> Nothing) - - > mytoken :: (L.Token -> Maybe a) -> Parser a > mytoken test = token showToken posToken testToken > where diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 9b9502a..f6c3560 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -16,7 +16,7 @@ which have been changed to try to improve the layout of the output. > import Language.SQL.SimpleSQL.Dialect > import Text.PrettyPrint (render, vcat, text, (<>), (<+>), empty, parens, > nest, Doc, punctuate, comma, sep, quotes, -> doubleQuotes, brackets,hcat) +> brackets,hcat) > import Data.Maybe (maybeToList, catMaybes) > import Data.List (intercalate) @@ -40,7 +40,8 @@ which have been changed to try to improve the layout of the output. = value expressions > valueExpr :: Dialect -> ValueExpr -> Doc -> valueExpr _ (StringLit s) = quotes $ text $ doubleUpQuotes s +> valueExpr _ (StringLit s e t) = +> text (s ++ (if '\'' `elem` s then doubleUpQuotes t else t) ++ e) > valueExpr _ (NumLit s) = text s > valueExpr _ (IntervalLit s v f t) = @@ -210,11 +211,6 @@ which have been changed to try to improve the layout of the output. > Distinct -> text "distinct" > ,valueExpr d b] - - -> valueExpr _ (CSStringLit cs st) = -> text cs <> quotes (text $ doubleUpQuotes st) - > valueExpr d (Escape v e) = > valueExpr d v <+> text "escape" <+> text [e] @@ -243,21 +239,18 @@ which have been changed to try to improve the layout of the output. > unname :: Name -> String -> unname (QName n) = "\"" ++ doubleUpDoubleQuotes n ++ "\"" -> unname (UQName n) = "U&\"" ++ doubleUpDoubleQuotes n ++ "\"" > unname (Name n) = n -> unname (DQName s e n) = s ++ n ++ e +> unname (QuotedName s e n) = +> s ++ (if '"' `elem` s then doubleUpDoubleQuotes n else n) ++ e > unnames :: [Name] -> String > unnames ns = intercalate "." $ map unname ns > name :: Name -> Doc -> name (QName n) = doubleQuotes $ text $ doubleUpDoubleQuotes n -> name (UQName n) = -> text "U&" <> doubleQuotes (text $ doubleUpDoubleQuotes n) > name (Name n) = text n -> name (DQName s e n) = text s <> text n <> text e +> name (QuotedName s e n) = +> text s <> text (if '"' `elem` s then doubleUpDoubleQuotes n else n) <> text e > names :: [Name] -> Doc > names ns = hcat $ punctuate (text ".") $ map name ns diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 0bbbb9c..78dc6cc 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -88,9 +88,9 @@ > -- > -- * 12.34e-6 > NumLit String -> -- | string literal, currently only basic strings between -> -- single quotes with a single quote escaped using '' -> | StringLit String +> -- | string literal, with the start and end quote +> -- e.g. 'test' -> StringLit "'" "'" "test" +> | StringLit String String String > -- | text of interval literal, units of interval precision, > -- e.g. interval 3 days (3) > | IntervalLit @@ -203,8 +203,6 @@ > -- second is the subscripts/ctor args > | ArrayCtor QueryExpr -- ^ this is used for the query expression version of array constructors, e.g. array(select * from t) -> | CSStringLit String String - todo: special syntax for like, similar with escape - escape cannot go in other places @@ -220,10 +218,8 @@ in other places > -- | Represents an identifier name, which can be quoted or unquoted. > data Name = Name String -> | QName String -> | UQName String -> | DQName String String String -> -- ^ dialect quoted name, the fields are start quote, end quote and the string itself, e.g. `something` is parsed to DQName "`" "`" "something, and $a$ test $a$ is parsed to DQName "$a$" "$a$" " test " +> | QuotedName String String String +> -- ^ quoted name, the fields are start quote, end quote and the string itself, these will usually be ", others are possible e.g. `something` is parsed to QuotedName "`" "`" "something, and $a$ test $a$ is parsed to QuotedName "$a$" "$a$" " test " > deriving (Eq,Show,Read,Data,Typeable) > -- | Represents a type name, used in casts. diff --git a/tools/Language/SQL/SimpleSQL/LexerTests.lhs b/tools/Language/SQL/SimpleSQL/LexerTests.lhs index 4103d6a..cc487fa 100644 --- a/tools/Language/SQL/SimpleSQL/LexerTests.lhs +++ b/tools/Language/SQL/SimpleSQL/LexerTests.lhs @@ -7,9 +7,10 @@ Test for the lexer > import Language.SQL.SimpleSQL.TestTypes > import Language.SQL.SimpleSQL.Lex (Token(..)) > --import Debug.Trace +> import Data.Char (isAlpha) -> lexerTable :: [(String,[Token])] -> lexerTable = +> ansiLexerTable :: [(String,[Token])] +> ansiLexerTable = > -- single char symbols > map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;()" > -- multi char symbols @@ -17,21 +18,21 @@ Test for the lexer > ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"] > -- simple identifiers > in map (\i -> (i, [Identifier i])) idens -> ++ map (\i -> ("\"" ++ i ++ "\"", [QIdentifier i])) idens +> ++ map (\i -> ("\"" ++ i ++ "\"", [QuotedIdentifier "\"" "\"" i])) idens > -- todo: in order to make lex . pretty id, need to > -- preserve the case of the u -> ++ map (\i -> ("u&\"" ++ i ++ "\"", [UQIdentifier i])) idens +> ++ map (\i -> ("u&\"" ++ i ++ "\"", [QuotedIdentifier "u&\"" "\"" i])) idens > -- host param > ++ map (\i -> (':':i, [HostParam i])) idens > ) > -- quoted identifiers with embedded double quotes -> ++ [("\"normal \"\" iden\"", [QIdentifier "normal \" iden"])] +> ++ [("\"normal \"\" iden\"", [QuotedIdentifier "\"" "\"" "normal \" iden"])] > -- strings -> ++ [("'string'", [SqlString "string"]) -> ,("'normal '' quote'", [SqlString "normal ' quote"]) -> ,("'normalendquote '''", [SqlString "normalendquote '"])] +> ++ [("'string'", [SqlString "'" "'" "string"]) +> ,("'normal '' quote'", [SqlString "'" "'" "normal ' quote"]) +> ,("'normalendquote '''", [SqlString "'" "'" "normalendquote '"])] > -- csstrings -> ++ map (\c -> (c ++ "'test'", [CSSqlString c "test"])) +> ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"])) > ["n", "N","b", "B","x", "X", "u&"] > -- numbers > ++ [("10", [SqlNumber "10"]) @@ -54,14 +55,18 @@ Test for the lexer > ,"/* this *is/ a comment */" > ] - > lexerTests :: TestItem > lexerTests = Group "lexerTests" $ -> [Group "lexer token tests" $ [LexerTest ansi2011 s t | (s,t) <- lexerTable] -> ,Group "generated combination lexer tests" $ +> [Group "lexer token tests" [ansiLexerTests]] + + +> ansiLexerTests :: TestItem +> ansiLexerTests = Group "ansiLexerTests" $ +> [Group "ansi lexer token tests" $ [LexerTest ansi2011 s t | (s,t) <- ansiLexerTable] +> ,Group "ansi generated combination lexer tests" $ > [ LexerTest ansi2011 (s ++ s1) (t ++ t1) -> | (s,t) <- lexerTable -> , (s1,t1) <- lexerTable +> | (s,t) <- ansiLexerTable +> , (s1,t1) <- ansiLexerTable which combinations won't work: <> <= >= || two single symbols which make a double char symbol @@ -101,17 +106,16 @@ number number (todo: double check more carefully) > ,symbolPair "*" "/" > ,(isIdentifier, isIdentifier) -> ,(isQIdentifier, isQIdentifier) -> ,(isUQIdentifier, isQIdentifier) -> ,(isString, isString) -> ,(isCsString, isString) +> ,(isDQIdentifier, isDQIdentifier) +> ,(isCQIdentifier, isDQIdentifier) +> ,(isString, isNonCsString) > ,(isEofLineComment, const True) > ,(isNumber, isNumber) > ,(isHostParam,isIdentifier) > ,(isHostParam,isCsString) -> ,(isHostParam,isUQIdentifier) +> ,(isHostParam,isCQIdentifier) > ,(isIdentifier,isCsString) -> ,(isIdentifier,isUQIdentifier) +> ,(isIdentifier,isCQIdentifier) > ,(isWhitespace, isWhitespace) > ,(isIdentifier, isNumber) > ,(isHostParam, isNumber) @@ -119,12 +123,17 @@ number number (todo: double check more carefully) > ] > isIdentifier (Identifier _) = True > isIdentifier _ = False -> isQIdentifier (QIdentifier _) = True -> isQIdentifier _ = False -> isUQIdentifier (UQIdentifier _) = True -> isUQIdentifier _ = False -> isCsString (CSSqlString {}) = True +> isDQIdentifier (QuotedIdentifier "\"" _ _) = True +> isDQIdentifier _ = False +> isCQIdentifier (QuotedIdentifier (x:_) _ _) | isAlpha x = True +> isCQIdentifier _ = False +> isCsString (SqlString (x:_) _ _) | isAlpha x = True > isCsString _ = False +> isString (SqlString _ _ _) = True +> isString _ = False +> isNonCsString (SqlString [] _ _) = True +> isNonCsString (SqlString (x:_) _ _) | not (isAlpha x) = True +> isNonCsString _ = False > isEofLineComment (LineComment s) = last s /= '\n' > isEofLineComment _ = False > isLineComment (LineComment {}) = True @@ -137,9 +146,6 @@ number number (todo: double check more carefully) > isWhitespace _ = False > isMinus (Symbol "-") = True > isMinus _ = False - -> isString (SqlString _) = True -> isString _ = False > symbolPair a b = ((==Symbol a), (==Symbol b)) > listPred :: ((Token -> Bool),(Token -> Bool)) -> [Token] -> Bool > listPred _ [] = False diff --git a/tools/Language/SQL/SimpleSQL/MySQL.lhs b/tools/Language/SQL/SimpleSQL/MySQL.lhs index 6c53eb6..4020de2 100644 --- a/tools/Language/SQL/SimpleSQL/MySQL.lhs +++ b/tools/Language/SQL/SimpleSQL/MySQL.lhs @@ -19,7 +19,7 @@ limit syntax > backtickQuotes :: TestItem > backtickQuotes = Group "backtickQuotes" (map (uncurry (TestValueExpr mysql)) -> [("`test`", Iden [DQName "`" "`" "test"]) +> [("`test`", Iden [QuotedName "`" "`" "test"]) > ] > ++ [ParseValueExprFails ansi2011 "`test`"] > ) diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs index 50a0767..819056b 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs @@ -506,17 +506,17 @@ Specify a non-null value. > characterStringLiterals = Group "character string literals" > $ map (uncurry (TestValueExpr ansi2011)) > [("'a regular string literal'" -> ,StringLit "a regular string literal") +> ,StringLit "'" "'" "a regular string literal") > ,("'something' ' some more' 'and more'" -> ,StringLit "something some moreand more") +> ,StringLit "'" "'" "something some moreand more") > ,("'something' \n ' some more' \t 'and more'" -> ,StringLit "something some moreand more") +> ,StringLit "'" "'" "something some moreand more") > ,("'something' -- a comment\n ' some more' /*another comment*/ 'and more'" -> ,StringLit "something some moreand more") +> ,StringLit "'" "'" "something some moreand more") > ,("'a quote: '', stuff'" -> ,StringLit "a quote: ', stuff") +> ,StringLit "'" "'" "a quote: ', stuff") > ,("''" -> ,StringLit "") +> ,StringLit "'" "'" "") I'm not sure how this should work. Maybe the parser should reject non ascii characters in strings and identifiers unless the current SQL @@ -533,8 +533,8 @@ character set allows them. > nationalCharacterStringLiterals :: TestItem > nationalCharacterStringLiterals = Group "national character string literals" > $ map (uncurry (TestValueExpr ansi2011)) -> [("N'something'", CSStringLit "N" "something") -> ,("n'something'", CSStringLit "n" "something") +> [("N'something'", StringLit "N'" "'" "something") +> ,("n'something'", StringLit "n'" "'" "something") > ] ::= @@ -550,11 +550,11 @@ character set allows them. > unicodeCharacterStringLiterals :: TestItem > unicodeCharacterStringLiterals = Group "unicode character string literals" > $ map (uncurry (TestValueExpr ansi2011)) -> [("U&'something'", CSStringLit "U&" "something") +> [("U&'something'", StringLit "U&'" "'" "something") > ,("u&'something' escape =" -> ,Escape (CSStringLit "u&" "something") '=') +> ,Escape (StringLit "u&'" "'" "something") '=') > ,("u&'something' uescape =" -> ,UEscape (CSStringLit "u&" "something") '=') +> ,UEscape (StringLit "u&'" "'" "something") '=') > ] TODO: unicode escape @@ -570,8 +570,8 @@ TODO: unicode escape > binaryStringLiterals = Group "binary string literals" > $ map (uncurry (TestValueExpr ansi2011)) > [--("B'101010'", CSStringLit "B" "101010") -> ("X'7f7f7f'", CSStringLit "X" "7f7f7f") -> ,("X'7f7f7f' escape z", Escape (CSStringLit "X" "7f7f7f") 'z') +> ("X'7f7f7f'", StringLit "X'" "'" "7f7f7f") +> ,("X'7f7f7f' escape z", Escape (StringLit "X'" "'" "7f7f7f") 'z') > ] ::= [ ] @@ -753,10 +753,10 @@ Specify names. > ,("t1",Iden [Name "t1"]) > ,("a.b",Iden [Name "a", Name "b"]) > ,("a.b.c",Iden [Name "a", Name "b", Name "c"]) -> ,("\"quoted iden\"", Iden [QName "quoted iden"]) -> ,("\"quoted \"\" iden\"", Iden [QName "quoted \" iden"]) -> ,("U&\"quoted iden\"", Iden [UQName "quoted iden"]) -> ,("U&\"quoted \"\" iden\"", Iden [UQName "quoted \" iden"]) +> ,("\"quoted iden\"", Iden [QuotedName "\"" "\"" "quoted iden"]) +> ,("\"quoted \"\" iden\"", Iden [QuotedName "\"" "\"" "quoted \" iden"]) +> ,("U&\"quoted iden\"", Iden [QuotedName "U&\"" "\"" "quoted iden"]) +> ,("U&\"quoted \"\" iden\"", Iden [QuotedName "U&\"" "\"" "quoted \" iden"]) > ] TODO: more identifiers, e.g. unicode escapes?, mixed quoted/unquoted @@ -1100,8 +1100,8 @@ create a list of type name variations: > -- 1 with and without tz > ,("time with time zone" > ,TimeTypeName [Name "time"] Nothing True) -> ,("timestamp(3) without time zone" -> ,TimeTypeName [Name "timestamp"] (Just 3) False) +> ,("datetime(3) without time zone" +> ,TimeTypeName [Name "datetime"] (Just 3) False) > -- chars: (single/multiname) x prec x charset x collate > -- 1111 > ,("char varying(5) character set something collate something_insensitive" @@ -1199,7 +1199,7 @@ expression > [(ctn ++ " 'test'", TypedLit stn "test") > ] > makeCastTests (ctn, stn) = -> [("cast('test' as " ++ ctn ++ ")", Cast (StringLit "test") stn) +> [("cast('test' as " ++ ctn ++ ")", Cast (StringLit "'" "'" "test") stn) > ] > makeTests a = makeSimpleTests a ++ makeCastTests a @@ -1215,7 +1215,7 @@ Define a field of a row type. > fieldDefinition = Group "field definition" > $ map (uncurry (TestValueExpr ansi2011)) > [("cast('(1,2)' as row(a int,b char))" -> ,Cast (StringLit "(1,2)") +> ,Cast (StringLit "'" "'" "(1,2)") > $ RowTypeName [(Name "a", TypeName [Name "int"]) > ,(Name "b", TypeName [Name "char"])])] diff --git a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs index a39b05f..0b16e74 100644 --- a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs +++ b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs @@ -34,9 +34,9 @@ Tests for parsing value expressions > ,("3e3", NumLit "3e3") > ,("3e+3", NumLit "3e+3") > ,("3e-3", NumLit "3e-3") -> ,("'string'", StringLit "string") -> ,("'string with a '' quote'", StringLit "string with a ' quote") -> ,("'1'", StringLit "1") +> ,("'string'", StringLit "'" "'" "string") +> ,("'string with a '' quote'", StringLit "'" "'" "string with a ' quote") +> ,("'1'", StringLit "'" "'" "1") > ,("interval '3' day" > ,IntervalLit Nothing "3" (Itf "day" Nothing) Nothing) > ,("interval '3' day (3)" @@ -48,7 +48,7 @@ Tests for parsing value expressions > identifiers = Group "identifiers" $ map (uncurry (TestValueExpr ansi2011)) > [("iden1", Iden [Name "iden1"]) > --,("t.a", Iden2 "t" "a") -> ,("\"quoted identifier\"", Iden [QName "quoted identifier"]) +> ,("\"quoted identifier\"", Iden [QuotedName "\"" "\"" "quoted identifier"]) > ] > star :: TestItem @@ -142,19 +142,19 @@ Tests for parsing value expressions > casts :: TestItem > casts = Group "operators" $ map (uncurry (TestValueExpr ansi2011)) > [("cast('1' as int)" -> ,Cast (StringLit "1") $ TypeName [Name "int"]) +> ,Cast (StringLit "'" "'" "1") $ TypeName [Name "int"]) > ,("int '3'" > ,TypedLit (TypeName [Name "int"]) "3") > ,("cast('1' as double precision)" -> ,Cast (StringLit "1") $ TypeName [Name "double precision"]) +> ,Cast (StringLit "'" "'" "1") $ TypeName [Name "double precision"]) > ,("cast('1' as float(8))" -> ,Cast (StringLit "1") $ PrecTypeName [Name "float"] 8) +> ,Cast (StringLit "'" "'" "1") $ PrecTypeName [Name "float"] 8) > ,("cast('1' as decimal(15,2))" -> ,Cast (StringLit "1") $ PrecScaleTypeName [Name "decimal"] 15 2) +> ,Cast (StringLit "'" "'" "1") $ PrecScaleTypeName [Name "decimal"] 15 2) > ,("double precision '3'" @@ -283,43 +283,43 @@ target_string > ,("trim(from target_string)" > ,SpecialOpK [Name "trim"] Nothing -> [("both", StringLit " ") +> [("both", StringLit "'" "'" " ") > ,("from", Iden [Name "target_string"])]) > ,("trim(leading from target_string)" > ,SpecialOpK [Name "trim"] Nothing -> [("leading", StringLit " ") +> [("leading", StringLit "'" "'" " ") > ,("from", Iden [Name "target_string"])]) > ,("trim(trailing from target_string)" > ,SpecialOpK [Name "trim"] Nothing -> [("trailing", StringLit " ") +> [("trailing", StringLit "'" "'" " ") > ,("from", Iden [Name "target_string"])]) > ,("trim(both from target_string)" > ,SpecialOpK [Name "trim"] Nothing -> [("both", StringLit " ") +> [("both", StringLit "'" "'" " ") > ,("from", Iden [Name "target_string"])]) > ,("trim(leading 'x' from target_string)" > ,SpecialOpK [Name "trim"] Nothing -> [("leading", StringLit "x") +> [("leading", StringLit "'" "'" "x") > ,("from", Iden [Name "target_string"])]) > ,("trim(trailing 'y' from target_string)" > ,SpecialOpK [Name "trim"] Nothing -> [("trailing", StringLit "y") +> [("trailing", StringLit "'" "'" "y") > ,("from", Iden [Name "target_string"])]) > ,("trim(both 'z' from target_string collate C)" > ,SpecialOpK [Name "trim"] Nothing -> [("both", StringLit "z") +> [("both", StringLit "'" "'" "z") > ,("from", Collate (Iden [Name "target_string"]) [Name "C"])]) > ,("trim(leading from target_string)" > ,SpecialOpK [Name "trim"] Nothing -> [("leading", StringLit " ") +> [("leading", StringLit "'" "'" " ") > ,("from", Iden [Name "target_string"])])