From 258eff5298164ae2cae2846029796c4e6baad1de Mon Sep 17 00:00:00 2001 From: Han Joosten 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 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 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