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