1
Fork 0

Introduced QEComment, constructor, likewise the VEComment constructor

This commit is contained in:
Han Joosten 2015-03-14 14:28:05 +01:00
parent 258eff5298
commit dc5ca57124
4 changed files with 22 additions and 25 deletions

View file

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

View file

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

View file

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

View file

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