Introduction of Comment in syntax, to facilitate comments in programatically generated SQL

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

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 "*/"

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)
+

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