new syntax for names and string literals

Language/SQL/SimpleSQL/Lex.lhs

@@ -50,26 +50,20 @@ parsec
 >     --
 >     | Identifier String
 >
->     -- | This is an identifier quoted with "
+>     -- | This is a quoted identifier, the quotes can be " or u&,
->     | QIdentifier String
+>     -- etc. or something dialect specific like []
->     -- | This is an identifier quoted with u&"
+>     -- the first two fields are the start and end quotes
->     | UQIdentifier String
+>     | QuotedIdentifier String -- start quote
-
+>                        String -- end quote
->     -- | This is a dialect specific quoted identifier with the quote
+>                        String -- content
->     -- characters explicit. The first and second fields are the
->     -- starting and ending quote characters.
->     | DQIdentifier String String String
->
 >     -- | This is a host param symbol, e.g. :param
 >     | HostParam String
 >
->     -- | This is a string literal.
+>     -- | This is a string literal. The first two fields are the --
->     | SqlString String
+>     -- start and end quotes, which are usually both ', but can be
->
+>     -- the character set (one of nNbBxX, or u&, U&), or a dialect
->     -- | This is a character set string literal. The first field is
+>     -- specific string quoting (such as $$ in postgres)
->     -- the character set (one of nNbBxX, or u&, U&).
+>     | SqlString String String String
->     | CSSqlString 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) =
+> prettyToken _ (QuotedIdentifier q1 q2 t) =
->     "\"" ++ doubleChars '"' t ++ "\""
+>     q1 ++
-> prettyToken _ (UQIdentifier t) =
+>     -- todo: a bit hacky, do a better design
->     "u&\"" ++ doubleChars '"' t ++ "\""
+>     (if '"' `elem` q1 then doubleChars '"' t else t)
-> prettyToken _ (DQIdentifier s e t) =
+>     ++ q2
->     s ++ t ++ e
+> --prettyToken _ (UQIdentifier t) =
+> --    "u&\"" ++ doubleChars '"' t ++ "\""
+> --prettyToken _ (DQIdentifier s e t) =
+> --    s ++ t ++ e
 > prettyToken _ (HostParam p) = ':':p
-> prettyToken _ (SqlString t) = "'" ++ doubleChars '\'' t ++ "'"
+> prettyToken _ (SqlString s e t) =
-> prettyToken _ (CSSqlString cs t) = cs ++ "'" ++ 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 ""
+>     csString = SqlString <$> try cs <*> return "'" <*> normalStringSuffix ""
->     cs = choice [(:[]) <$> oneOf "nNbBxX"
+>     cs = choice $ (map (\x -> string ([x] ++ "'")) "nNbBxX")
->                 ,string "u&"
+>                   ++ [string "u&'"
->                 ,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 (try . string) [">=","<=","!=","<>","||"]
->                  ++ map (string . (:[])) "+-^*/%~&|?<>[]=,;()")
+>                 ++ map (string . (:[])) "+-^*/%~&|?<>[]=,;()")
 
 > sqlWhitespace :: Dialect -> Parser Token
 > sqlWhitespace _ = Whitespace <$> many1 (satisfy isSpace)

Language/SQL/SimpleSQL/Parse.lhs

@@ -330,10 +330,8 @@ u&"example quoted"
 > name :: Parser Name
 > name = do
 >     d <- getState
->     choice [QName <$> qidentifierTok
+>     choice [Name <$> identifierTok (blacklist d) Nothing
->            ,UQName <$> uqidentifierTok
+>            ,(\(s,e,t) -> QuotedName s e t) <$> qidentifierTok
->            ,Name <$> identifierTok (blacklist d) Nothing
->            ,(\(s,e,t) -> DQName s e t) <$> dqidentifierTok
 >            ]
 
 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)
+> stringTok :: Parser (String,String,String)
-> csSqlStringLitTok = mytoken (\tok ->
->     case tok of
->       L.CSSqlString p s -> Just (p,s)
->       _ -> Nothing)
-
-> stringTok :: Parser 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)
+>          do
->         ,return x
+>          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

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

Language/SQL/SimpleSQL/Syntax.lhs

@@ -88,9 +88,9 @@
 >       --
 >       -- * 12.34e-6
 >       NumLit String
->       -- | string literal, currently only basic strings between
+>       -- | string literal, with the start and end quote
->       -- single quotes with a single quote escaped using ''
+>       -- e.g. 'test' -> StringLit "'" "'" "test"
->     | StringLit String
+>     | 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
+>           | QuotedName String String String
->           | UQName 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 "
->           | 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 "
 >             deriving (Eq,Show,Read,Data,Typeable)
 
 > -- | Represents a type name, used in casts.

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])]
+> ansiLexerTable :: [(String,[Token])]
-> lexerTable =
+> 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"])
+>     ++ [("'string'", [SqlString "'" "'" "string"])
->        ,("'normal '' quote'", [SqlString "normal ' quote"])
+>        ,("'normal '' quote'", [SqlString "'" "'" "normal ' quote"])
->        ,("'normalendquote '''", [SqlString "normalendquote '"])]
+>        ,("'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 "lexer token tests" [ansiLexerTests]]
->     ,Group "generated combination lexer tests" $
+
+
+> 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
+>     | (s,t) <- ansiLexerTable
->     , (s1,t1) <- lexerTable
+>     , (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)
+>                ,(isDQIdentifier, isDQIdentifier)
->                ,(isUQIdentifier, isQIdentifier)
+>                ,(isCQIdentifier, isDQIdentifier)
->                ,(isString, isString)
+>                ,(isString, isNonCsString)
->                ,(isCsString, isString)
 >                ,(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
+>    isDQIdentifier (QuotedIdentifier "\"" _ _) = True
->    isQIdentifier _ = False
+>    isDQIdentifier _ = False
->    isUQIdentifier (UQIdentifier _) = True
+>    isCQIdentifier (QuotedIdentifier (x:_) _ _) | isAlpha x = True
->    isUQIdentifier _ = False
+>    isCQIdentifier _ = False
->    isCsString (CSSqlString {}) = True
+>    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

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`"]
 >     )

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'", StringLit "N'" "'" "something")
->     ,("n'something'", CSStringLit "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'", StringLit "X'" "'" "7f7f7f")
->     ,("X'7f7f7f' escape z", Escape (CSStringLit "X" "7f7f7f") 'z')
+>     ,("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 [QuotedName "\"" "\"" "quoted iden"])
->     ,("\"quoted \"\" iden\"", Iden [QName "quoted \" iden"])
+>     ,("\"quoted \"\" iden\"", Iden [QuotedName "\"" "\"" "quoted \" iden"])
->     ,("U&\"quoted iden\"", Iden [UQName "quoted iden"])
+>     ,("U&\"quoted iden\"", Iden [QuotedName "U&\"" "\"" "quoted iden"])
->     ,("U&\"quoted \"\" iden\"", Iden [UQName "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"
+>          ,("datetime(3) without time zone"
->           ,TimeTypeName [Name "timestamp"] (Just 3) False)
+>           ,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"])])]
 

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'", StringLit "'" "'" "string")
->      ,("'string with a '' quote'", StringLit "string with a ' quote")
+>      ,("'string with a '' quote'", StringLit "'" "'" "string with a ' quote")
->      ,("'1'", StringLit "1")
+>      ,("'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"])])