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] 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