From 52f035b718b88e11bb9d352fe730a7b70c4d87bc Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
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")
> ]
<Unicode character string literal> ::=
@@ -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')
> ]
<signed numeric literal> ::= [ <sign> ] <unsigned numeric literal>
@@ -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"])])