From 258eff5298164ae2cae2846029796c4e6baad1de Mon Sep 17 00:00:00 2001
From: Han Joosten <han.joosten.han@gmail.com>
Date: Sat, 14 Mar 2015 12:40:35 +0100
Subject: [PATCH 1/3] Introduction of Comment in syntax, to facilitate comments
in programatically generated SQL
---
Language/SQL/SimpleSQL/Parser.lhs | 4 ++--
Language/SQL/SimpleSQL/Pretty.lhs | 21 ++++++++++++-------
Language/SQL/SimpleSQL/Syntax.lhs | 14 ++++++++++++-
.../SQL/SimpleSQL/QueryExprComponents.lhs | 10 ++++-----
4 files changed, 34 insertions(+), 15 deletions(-)
diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index f731a4e..b347f97 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -1343,7 +1343,7 @@ and union, etc..
> mkSelect d sl Nothing =
> makeSelect{qeSetQuantifier = d, qeSelectList = sl}
> mkSelect d sl (Just (TableExpression f w g h od ofs fe)) =
-> Select d sl f w g h od ofs fe
+> Select d sl f w g h od ofs fe []
> values = keyword_ "values"
> >> Values <$> commaSep (parens (commaSep valueExpr))
> table = keyword_ "table" >> Table <$> names
@@ -1379,7 +1379,7 @@ be in the public syntax?
> <*> option SQDefault duplicates
> <*> corr
> where
-> cq o d c q0 q1 = CombineQueryExpr q0 o d c q1
+> cq o d c q0 q1 = CombineQueryExpr q0 o d c q1 []
> setOpK = choice [Union <$ keyword_ "union"
> ,Intersect <$ keyword_ "intersect"
> ,Except <$ keyword_ "except"]
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index a73c430..aa011af 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -13,7 +13,7 @@ which have been changed to try to improve the layout of the output.
> import Language.SQL.SimpleSQL.Syntax
> import Text.PrettyPrint (render, vcat, text, (<>), (<+>), empty, parens,
-> nest, Doc, punctuate, comma, sep, quotes,
+> nest, Doc, punctuate, comma, sep, fsep, quotes,
> doubleQuotes, brackets,hcat)
> import Data.Maybe (maybeToList, catMaybes)
> import Data.List (intercalate)
@@ -221,6 +221,8 @@ which have been changed to try to improve the layout of the output.
> valueExpr _ (NextValueFor ns) =
> text "next value for" <+> names ns
+> valueExpr d (QEComment cmt v) =
+> vcat $ map comment cmt ++ [valueExpr d v]
> doubleUpQuotes :: String -> String
> doubleUpQuotes [] = []
@@ -312,8 +314,9 @@ which have been changed to try to improve the layout of the output.
= query expressions
> queryExpr :: Dialect -> QueryExpr -> Doc
-> queryExpr dia (Select d sl fr wh gb hv od off fe) =
-> sep [text "select"
+> queryExpr dia (Select d sl fr wh gb hv od off fe cmt) =
+> fsep $ map comment cmt++
+> [sep [text "select"
> ,case d of
> SQDefault -> empty
> All -> text "all"
@@ -326,7 +329,7 @@ which have been changed to try to improve the layout of the output.
> ,orderBy dia od
> ,me (\e -> text "offset" <+> valueExpr dia e <+> text "rows") off
> ,fetchFirst
-> ]
+> ]]
> where
> fetchFirst =
> me (\e -> if dia == MySQL
@@ -334,8 +337,9 @@ which have been changed to try to improve the layout of the output.
> else text "fetch first" <+> valueExpr dia e
> <+> text "rows only") fe
-> queryExpr dia (CombineQueryExpr q1 ct d c q2) =
-> sep [queryExpr dia q1
+> queryExpr dia (CombineQueryExpr q1 ct d c q2 cmt) =
+> fsep $ map comment cmt++
+> [sep [queryExpr dia q1
> ,text (case ct of
> Union -> "union"
> Intersect -> "intersect"
@@ -347,7 +351,7 @@ which have been changed to try to improve the layout of the output.
> <+> case c of
> Corresponding -> text "corresponding"
> Respectively -> empty
-> ,queryExpr dia q2]
+> ,queryExpr dia q2]]
> queryExpr d (With rc withs qe) =
> text "with" <+> (if rc then text "recursive" else empty)
> <+> vcat [nest 5
@@ -441,3 +445,6 @@ which have been changed to try to improve the layout of the output.
> me :: (a -> Doc) -> Maybe a -> Doc
> me = maybe empty
+
+> comment :: Comment -> Doc
+> comment (Comment str) = text "/*" <+> text str <+> text "*/"
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 87ac07c..8542f1f 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -32,6 +32,8 @@
> ,JoinCondition(..)
> -- * dialect
> ,Dialect(..)
+> -- * comment
+> ,Comment(..)
> ) where
> import Data.Data
@@ -161,6 +163,7 @@
> | MultisetCtor [ValueExpr]
> | MultisetQueryCtor QueryExpr
> | NextValueFor [Name]
+> | QEComment [Comment] ValueExpr
> deriving (Eq,Show,Read,Data,Typeable)
> -- | Represents an identifier name, which can be quoted or unquoted.
@@ -278,6 +281,7 @@ This would make some things a bit cleaner?
> ,qeOrderBy :: [SortSpec]
> ,qeOffset :: Maybe ValueExpr
> ,qeFetchFirst :: Maybe ValueExpr
+> ,qeComment :: [Comment]
> }
> | CombineQueryExpr
> {qe0 :: QueryExpr
@@ -285,6 +289,7 @@ This would make some things a bit cleaner?
> ,qeSetQuantifier :: SetQuantifier
> ,qeCorresponding :: Corresponding
> ,qe1 :: QueryExpr
+> ,qeComment :: [Comment]
> }
> | With
> {qeWithRecursive :: Bool
@@ -321,7 +326,8 @@ I'm not sure if this is valid syntax or not.
> ,qeHaving = Nothing
> ,qeOrderBy = []
> ,qeOffset = Nothing
-> ,qeFetchFirst = Nothing}
+> ,qeFetchFirst = Nothing
+> ,qeComment = []}
> -- | Represents the Distinct or All keywords, which can be used
@@ -383,3 +389,9 @@ I'm not sure if this is valid syntax or not.
> data Dialect = SQL2011
> | MySQL
> deriving (Eq,Show,Read,Data,Typeable)
+
+
+> -- | Comment. Useful when geterating SQL code programmatically.
+> data Comment = Comment String
+> deriving (Eq,Show,Read,Data,Typeable)
+
diff --git a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
index 7427bc3..5828a3a 100644
--- a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
+++ b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
@@ -144,24 +144,24 @@ These are a few misc tests which don't fit anywhere else.
> combos :: TestItem
> combos = Group "combos" $ map (uncurry (TestQueryExpr SQL2011))
> [("select a from t union select b from u"
-> ,CombineQueryExpr ms1 Union SQDefault Respectively ms2)
+> ,CombineQueryExpr ms1 Union SQDefault Respectively ms2 [])
> ,("select a from t intersect select b from u"
-> ,CombineQueryExpr ms1 Intersect SQDefault Respectively ms2)
+> ,CombineQueryExpr ms1 Intersect SQDefault Respectively ms2 [])
> ,("select a from t except all select b from u"
-> ,CombineQueryExpr ms1 Except All Respectively ms2)
+> ,CombineQueryExpr ms1 Except All Respectively ms2 [])
> ,("select a from t union distinct corresponding \
> \select b from u"
-> ,CombineQueryExpr ms1 Union Distinct Corresponding ms2)
+> ,CombineQueryExpr ms1 Union Distinct Corresponding ms2 [])
> ,("select a from t union select a from t union select a from t"
> -- TODO: union should be left associative. I think the others also
> -- so this needs to be fixed (new optionSuffix variation which
> -- handles this)
> ,CombineQueryExpr ms1 Union SQDefault Respectively
-> (CombineQueryExpr ms1 Union SQDefault Respectively ms1))
+> (CombineQueryExpr ms1 Union SQDefault Respectively ms1 []) [])
> ]
> where
> ms1 = makeSelect
From dc5ca57124b339935bf4f58f5f2b8f95580e4d1a Mon Sep 17 00:00:00 2001
From: Han Joosten <han.joosten.han@gmail.com>
Date: Sat, 14 Mar 2015 14:28:05 +0100
Subject: [PATCH 2/3] Introduced QEComment, constructor, likewise the VEComment
constructor
---
Language/SQL/SimpleSQL/Parser.lhs | 4 ++--
Language/SQL/SimpleSQL/Pretty.lhs | 22 +++++++++----------
Language/SQL/SimpleSQL/Syntax.lhs | 11 ++++------
.../SQL/SimpleSQL/QueryExprComponents.lhs | 10 ++++-----
4 files changed, 22 insertions(+), 25 deletions(-)
diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index b347f97..f731a4e 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -1343,7 +1343,7 @@ and union, etc..
> mkSelect d sl Nothing =
> makeSelect{qeSetQuantifier = d, qeSelectList = sl}
> mkSelect d sl (Just (TableExpression f w g h od ofs fe)) =
-> Select d sl f w g h od ofs fe []
+> Select d sl f w g h od ofs fe
> values = keyword_ "values"
> >> Values <$> commaSep (parens (commaSep valueExpr))
> table = keyword_ "table" >> Table <$> names
@@ -1379,7 +1379,7 @@ be in the public syntax?
> <*> option SQDefault duplicates
> <*> corr
> where
-> cq o d c q0 q1 = CombineQueryExpr q0 o d c q1 []
+> cq o d c q0 q1 = CombineQueryExpr q0 o d c q1
> setOpK = choice [Union <$ keyword_ "union"
> ,Intersect <$ keyword_ "intersect"
> ,Except <$ keyword_ "except"]
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index aa011af..0351fa9 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -13,7 +13,7 @@ which have been changed to try to improve the layout of the output.
> import Language.SQL.SimpleSQL.Syntax
> import Text.PrettyPrint (render, vcat, text, (<>), (<+>), empty, parens,
-> nest, Doc, punctuate, comma, sep, fsep, quotes,
+> nest, Doc, punctuate, comma, sep, quotes,
> doubleQuotes, brackets,hcat)
> import Data.Maybe (maybeToList, catMaybes)
> import Data.List (intercalate)
@@ -221,7 +221,7 @@ which have been changed to try to improve the layout of the output.
> valueExpr _ (NextValueFor ns) =
> text "next value for" <+> names ns
-> valueExpr d (QEComment cmt v) =
+> valueExpr d (VEComment cmt v) =
> vcat $ map comment cmt ++ [valueExpr d v]
> doubleUpQuotes :: String -> String
@@ -314,9 +314,8 @@ which have been changed to try to improve the layout of the output.
= query expressions
> queryExpr :: Dialect -> QueryExpr -> Doc
-> queryExpr dia (Select d sl fr wh gb hv od off fe cmt) =
-> fsep $ map comment cmt++
-> [sep [text "select"
+> queryExpr dia (Select d sl fr wh gb hv od off fe) =
+> sep [text "select"
> ,case d of
> SQDefault -> empty
> All -> text "all"
@@ -329,7 +328,7 @@ which have been changed to try to improve the layout of the output.
> ,orderBy dia od
> ,me (\e -> text "offset" <+> valueExpr dia e <+> text "rows") off
> ,fetchFirst
-> ]]
+> ]
> where
> fetchFirst =
> me (\e -> if dia == MySQL
@@ -337,9 +336,8 @@ which have been changed to try to improve the layout of the output.
> else text "fetch first" <+> valueExpr dia e
> <+> text "rows only") fe
-> queryExpr dia (CombineQueryExpr q1 ct d c q2 cmt) =
-> fsep $ map comment cmt++
-> [sep [queryExpr dia q1
+> queryExpr dia (CombineQueryExpr q1 ct d c q2) =
+> sep [queryExpr dia q1
> ,text (case ct of
> Union -> "union"
> Intersect -> "intersect"
@@ -351,7 +349,7 @@ which have been changed to try to improve the layout of the output.
> <+> case c of
> Corresponding -> text "corresponding"
> Respectively -> empty
-> ,queryExpr dia q2]]
+> ,queryExpr dia q2]
> queryExpr d (With rc withs qe) =
> text "with" <+> (if rc then text "recursive" else empty)
> <+> vcat [nest 5
@@ -362,6 +360,8 @@ which have been changed to try to improve the layout of the output.
> text "values"
> <+> nest 7 (commaSep (map (parens . commaSep . map (valueExpr d)) vs))
> queryExpr _ (Table t) = text "table" <+> names t
+> queryExpr d (QEComment cmt v) =
+> vcat $ map comment cmt ++ [queryExpr d v]
> alias :: Alias -> Doc
@@ -447,4 +447,4 @@ which have been changed to try to improve the layout of the output.
> me = maybe empty
> comment :: Comment -> Doc
-> comment (Comment str) = text "/*" <+> text str <+> text "*/"
+> comment (BlockComment str) = text "/*" <+> text str <+> text "*/"
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 8542f1f..b945610 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -163,7 +163,7 @@
> | MultisetCtor [ValueExpr]
> | MultisetQueryCtor QueryExpr
> | NextValueFor [Name]
-> | QEComment [Comment] ValueExpr
+> | VEComment [Comment] ValueExpr
> deriving (Eq,Show,Read,Data,Typeable)
> -- | Represents an identifier name, which can be quoted or unquoted.
@@ -281,7 +281,6 @@ This would make some things a bit cleaner?
> ,qeOrderBy :: [SortSpec]
> ,qeOffset :: Maybe ValueExpr
> ,qeFetchFirst :: Maybe ValueExpr
-> ,qeComment :: [Comment]
> }
> | CombineQueryExpr
> {qe0 :: QueryExpr
@@ -289,7 +288,6 @@ This would make some things a bit cleaner?
> ,qeSetQuantifier :: SetQuantifier
> ,qeCorresponding :: Corresponding
> ,qe1 :: QueryExpr
-> ,qeComment :: [Comment]
> }
> | With
> {qeWithRecursive :: Bool
@@ -297,6 +295,7 @@ This would make some things a bit cleaner?
> ,qeQueryExpression :: QueryExpr}
> | Values [[ValueExpr]]
> | Table [Name]
+> | QEComment [Comment] QueryExpr
> deriving (Eq,Show,Read,Data,Typeable)
TODO: add queryexpr parens to deal with e.g.
@@ -326,9 +325,7 @@ I'm not sure if this is valid syntax or not.
> ,qeHaving = Nothing
> ,qeOrderBy = []
> ,qeOffset = Nothing
-> ,qeFetchFirst = Nothing
-> ,qeComment = []}
-
+> ,qeFetchFirst = Nothing}
> -- | Represents the Distinct or All keywords, which can be used
> -- before a select list, in an aggregate/window function
@@ -392,6 +389,6 @@ I'm not sure if this is valid syntax or not.
> -- | Comment. Useful when geterating SQL code programmatically.
-> data Comment = Comment String
+> data Comment = BlockComment String
> deriving (Eq,Show,Read,Data,Typeable)
diff --git a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
index 5828a3a..7427bc3 100644
--- a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
+++ b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
@@ -144,24 +144,24 @@ These are a few misc tests which don't fit anywhere else.
> combos :: TestItem
> combos = Group "combos" $ map (uncurry (TestQueryExpr SQL2011))
> [("select a from t union select b from u"
-> ,CombineQueryExpr ms1 Union SQDefault Respectively ms2 [])
+> ,CombineQueryExpr ms1 Union SQDefault Respectively ms2)
> ,("select a from t intersect select b from u"
-> ,CombineQueryExpr ms1 Intersect SQDefault Respectively ms2 [])
+> ,CombineQueryExpr ms1 Intersect SQDefault Respectively ms2)
> ,("select a from t except all select b from u"
-> ,CombineQueryExpr ms1 Except All Respectively ms2 [])
+> ,CombineQueryExpr ms1 Except All Respectively ms2)
> ,("select a from t union distinct corresponding \
> \select b from u"
-> ,CombineQueryExpr ms1 Union Distinct Corresponding ms2 [])
+> ,CombineQueryExpr ms1 Union Distinct Corresponding ms2)
> ,("select a from t union select a from t union select a from t"
> -- TODO: union should be left associative. I think the others also
> -- so this needs to be fixed (new optionSuffix variation which
> -- handles this)
> ,CombineQueryExpr ms1 Union SQDefault Respectively
-> (CombineQueryExpr ms1 Union SQDefault Respectively ms1 []) [])
+> (CombineQueryExpr ms1 Union SQDefault Respectively ms1))
> ]
> where
> ms1 = makeSelect
From 2e6f2fc3f2e6b5cd212a933a17f794b173efdbed Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Sat, 14 Mar 2015 16:15:37 +0200
Subject: [PATCH 3/3] update changelog
---
Language/SQL/SimpleSQL/Syntax.lhs | 4 ++--
changelog | 2 ++
2 files changed, 4 insertions(+), 2 deletions(-)
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index b945610..d7d7e80 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -388,7 +388,7 @@ I'm not sure if this is valid syntax or not.
> deriving (Eq,Show,Read,Data,Typeable)
-> -- | Comment. Useful when geterating SQL code programmatically.
-> data Comment = BlockComment String
+> -- | Comment. Useful when generating SQL code programmatically.
+> data Comment = BlockComment String
> deriving (Eq,Show,Read,Data,Typeable)
diff --git a/changelog b/changelog
index 446ebfc..6e58ae1 100644
--- a/changelog
+++ b/changelog
@@ -3,6 +3,8 @@ please email jakewheatmail@gmail.com or use the github bug tracker,
https://github.com/JakeWheat/simple-sql-parser/issues.
0.4.1 (unreleased)
simple demonstration of how dialects could be handled internally
+ add ability to add comments to syntax tree to help with generating
+ SQL code
0.4.0 (commit 7914898cc8f07bbaf8358d208469392346341964)
now targets SQL:2011
update to ghc 7.8.2