From f64632bbac358ed697ae55455a8421d9f2fb75f4 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Fri, 18 Apr 2014 21:09:46 +0300
Subject: [PATCH] support two double quotes in quoted identifier plus unicode
quoted identifier syntax
---
Language/SQL/SimpleSQL/Parser.lhs | 23 +++++++++++++++++------
Language/SQL/SimpleSQL/Pretty.lhs | 13 +++++++++++--
Language/SQL/SimpleSQL/Syntax.lhs | 1 +
tools/Language/SQL/SimpleSQL/SQL2003.lhs | 7 ++++---
4 files changed, 33 insertions(+), 11 deletions(-)
diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index a7fbf99..bd86899 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -143,6 +143,7 @@ which parses as a typed literal
> name :: Parser Name
> name = choice [QName <$> quotedIdentifier
+> ,UQName <$> uquotedIdentifier
> ,Name <$> identifierBlacklist blacklist]
> names :: Parser [Name]
@@ -1119,10 +1120,23 @@ make this choice.
> nonFirstChar = digit <|> firstChar <?> ""
> quotedIdentifier :: Parser String
-> quotedIdentifier = char '"' *> manyTill anyChar doubleQuote
-> <?> "identifier"
+> quotedIdentifier = quotedIdenHelper
-TODO: add "" inside quoted identifiers
+> quotedIdenHelper :: Parser String
+> quotedIdenHelper =
+> lexeme (dq *> manyTill anyChar dq >>= optionSuffix moreIden)
+> <?> "identifier"
+> where
+> moreIden s0 = do
+> void dq
+> s <- manyTill anyChar dq
+> optionSuffix moreIden (s0 ++ "\"" ++ s)
+> dq = char '"' <?> "double quote"
+
+> uquotedIdentifier :: Parser String
+> uquotedIdentifier =
+> try (string "u&" <|> string "U&") *> quotedIdenHelper
+> <?> "identifier"
parses an identifier with a : prefix. The : isn't included in the
return value
@@ -1163,9 +1177,6 @@ todo: work out the symbol parsing better
> semi :: Parser Char
> semi = lexeme (char ';') <?> "semicolon"
-> doubleQuote :: Parser Char
-> doubleQuote = lexeme (char '"') <?> "double quotes"
-
> quote :: Parser Char
> quote = lexeme (char '\'') <?> "single quote"
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 6bfabb0..627c9c4 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -213,9 +213,16 @@ which have been changed to try to improve the layout of the output.
> 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 (QName n) = "\"" ++ n ++ "\""
+> unname (QName n) = "\"" ++ doubleUpDoubleQuotes n ++ "\""
+> unname (UQName n) = "U&\"" ++ doubleUpDoubleQuotes n ++ "\""
> unname (Name n) = n
> unnames :: [Name] -> String
@@ -223,7 +230,9 @@ which have been changed to try to improve the layout of the output.
> name :: Name -> Doc
-> name (QName n) = doubleQuotes $ text n
+> name (QName n) = doubleQuotes $ text $ doubleUpDoubleQuotes n
+> name (UQName n) =
+> text "U&" <> doubleQuotes (text $ doubleUpDoubleQuotes n)
> name (Name n) = text n
> names :: [Name] -> Doc
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index a56a29a..8150001 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -155,6 +155,7 @@
> -- | Represents an identifier name, which can be quoted or unquoted.
> data Name = Name String
> | QName String
+> | UQName String
> deriving (Eq,Show,Read,Data,Typeable)
TODO: add ref and scope, any others?
diff --git a/tools/Language/SQL/SimpleSQL/SQL2003.lhs b/tools/Language/SQL/SimpleSQL/SQL2003.lhs
index 9505965..7965663 100644
--- a/tools/Language/SQL/SimpleSQL/SQL2003.lhs
+++ b/tools/Language/SQL/SimpleSQL/SQL2003.lhs
@@ -805,9 +805,10 @@ TODO: language identifiers have different rules to generic identifiers
> ,("t1",Iden [Name "t1"])
> ,("a.b",Iden [Name "a", Name "b"])
> ,("a.b.c",Iden [Name "a", Name "b", Name "c"])
-> -- TODO: quoted idens
-> -- double double quotes in quoted idens
-> -- unicode idens syntax (needs escape?)
+> ,("\"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"])
> ]
TODO: module stuff