From 4308acb982c0310a0c2306698f1c24f77ce2c671 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Tue, 17 Dec 2013 13:41:06 +0200
Subject: [PATCH] add support for with recursive and column aliases in cte
---
Language/SQL/SimpleSQL/Parser.lhs | 21 +++++++++++--------
Language/SQL/SimpleSQL/Pretty.lhs | 20 ++++++++++--------
Language/SQL/SimpleSQL/Syntax.lhs | 15 +++++++++----
TODO | 1 +
tools/Language/SQL/SimpleSQL/Postgres.lhs | 20 +++++++++---------
.../SQL/SimpleSQL/QueryExprComponents.lhs | 10 +++++++--
tools/Language/SQL/SimpleSQL/TableRefs.lhs | 8 +++----
7 files changed, 57 insertions(+), 38 deletions(-)
diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 2d3a909..09dd213 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -491,8 +491,8 @@ expression tree (for efficiency and code clarity).
== select lists
> selectItem :: P (Maybe Name, ScalarExpr)
-> selectItem = flip (,) <$> scalarExpr <*> optionMaybe (try alias)
-> where alias = optional (try (keyword_ "as")) *> name
+> selectItem = flip (,) <$> scalarExpr <*> optionMaybe (try als)
+> where als = optional (try (keyword_ "as")) *> name
> selectList :: P [(Maybe Name,ScalarExpr)]
> selectList = commaSep1 selectItem
@@ -517,11 +517,7 @@ tref
> <*> parens (commaSep scalarExpr))
> ,TRSimple <$> name]
> >>= optionSuffix aliasSuffix
-> aliasSuffix j =
-> let tableAlias = optional (try $ keyword_ "as") *> name
-> columnAliases = optionMaybe $ try $ parens
-> $ commaSep1 name
-> in option j (TRAlias j <$> try tableAlias <*> try columnAliases)
+> aliasSuffix j = option j (TRAlias j <$> alias)
> joinTrefSuffix t = (do
> nat <- option False $ try (True <$ try (keyword_ "natural"))
> TRJoin t <$> joinType
@@ -546,6 +542,12 @@ tref
> JoinUsing <$> parens (commaSep1 name)
> ]
+> alias :: P Alias
+> alias = Alias <$> try tableAlias <*> try columnAliases
+> where
+> tableAlias = optional (try $ keyword_ "as") *> name
+> columnAliases = optionMaybe $ try $ parens $ commaSep1 name
+
== simple other parts
Parsers for where, group by, having, order by and limit, which are
@@ -585,10 +587,11 @@ where, having, limit, offset).
> with :: P QueryExpr
> with = try (keyword_ "with") >>
-> With <$> commaSep1 withQuery <*> queryExpr
+> With <$> option False (try (True <$ keyword_ "recursive"))
+> <*> commaSep1 withQuery <*> queryExpr
> where
> withQuery =
-> (,) <$> (name <* optional (try $ keyword_ "as"))
+> (,) <$> (alias <* optional (try $ keyword_ "as"))
> <*> parens queryExpr
== query expression
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 427a8aa..54a7e2e 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -171,21 +171,26 @@
> Corresponding -> text "corresponding"
> Respectively -> empty
> ,queryExpr q2]
-> queryExpr (With withs qe) =
-> text "with"
+> queryExpr (With rc withs qe) =
+> text "with" <+> (if rc then text "recursive" else empty)
> <+> vcat [nest 5
> (vcat $ punctuate comma $ flip map withs $ \(n,q) ->
-> name n <+> text "as" <+> parens (queryExpr q))
+> alias n <+> text "as" <+> parens (queryExpr q))
> ,queryExpr qe]
> queryExpr (Values vs) =
> text "values"
> <+> nest 7 (commaSep (map (parens . commaSep . map scalarExpr) vs))
+> alias :: Alias -> Doc
+> alias (Alias nm cols) =
+> text "as" <+> name nm
+> <+> maybe empty (parens . commaSep . map name) cols
+
> selectList :: [(Maybe Name, ScalarExpr)] -> Doc
> selectList is = commaSep $ map si is
> where
-> si (al,e) = scalarExpr e <+> maybe empty alias al
-> alias al = text "as" <+> name al
+> si (al,e) = scalarExpr e <+> maybe empty als al
+> als al = text "as" <+> name al
> from :: [TableRef] -> Doc
> from [] = empty
@@ -197,10 +202,7 @@
> tr (TRLateral t) = text "lateral" <+> tr t
> tr (TRFunction f as) =
> name f <> parens (commaSep $ map scalarExpr as)
-> tr (TRAlias t a cs) =
-> sep [tr t
-> ,text "as" <+> name a
-> <+> maybe empty (parens . commaSep . map name) cs]
+> tr (TRAlias t a) = sep [tr t, alias a]
> tr (TRParens t) = parens $ tr t
> tr (TRQueryExpr q) = parens $ queryExpr q
> tr (TRJoin t0 jt t1 jc) =
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 0b48d26..3d9c413 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -14,6 +14,7 @@
> ,makeSelect
> ,CombineOp(..)
> ,Corresponding(..)
+> ,Alias(..)
> -- ** From
> ,TableRef(..)
> ,JoinType(..)
@@ -152,13 +153,16 @@
> ,qeOffset :: Maybe ScalarExpr
> }
> | CombineQueryExpr
-> {qe1 :: QueryExpr
+> {qe0 :: QueryExpr
> ,qeCombOp :: CombineOp
> ,qeDuplicates :: Duplicates
> ,qeCorresponding :: Corresponding
-> ,qe2 :: QueryExpr
+> ,qe1 :: QueryExpr
> }
-> | With [(Name,QueryExpr)] QueryExpr
+> | With
+> {qeWithRecursive :: Bool
+> ,qeViews :: [(Alias,QueryExpr)]
+> ,qeQueryExpression :: QueryExpr}
> | Values [[ScalarExpr]]
> deriving (Eq,Show,Read)
@@ -200,7 +204,7 @@ I'm not sure if this is valid syntax or not.
> -- | from (a)
> | TRParens TableRef
> -- | from a as b(c,d)
-> | TRAlias TableRef Name (Maybe [Name])
+> | TRAlias TableRef Alias
> -- | from (query expr)
> | TRQueryExpr QueryExpr
> -- | from function(args)
@@ -209,6 +213,9 @@ I'm not sure if this is valid syntax or not.
> | TRLateral TableRef
> deriving (Eq,Show,Read)
+> data Alias = Alias Name (Maybe [Name])
+> deriving (Eq,Show,Read)
+
TODO: add function table ref
> -- | The type of a join
diff --git a/TODO b/TODO
index 2fafefc..9cc6256 100644
--- a/TODO
+++ b/TODO
@@ -53,6 +53,7 @@ all ansi sql operators
escapes in string literals
+review syntax to replace maybe and bool with better ctors
----
diff --git a/tools/Language/SQL/SimpleSQL/Postgres.lhs b/tools/Language/SQL/SimpleSQL/Postgres.lhs
index bb4b6dc..21a9761 100644
--- a/tools/Language/SQL/SimpleSQL/Postgres.lhs
+++ b/tools/Language/SQL/SimpleSQL/Postgres.lhs
@@ -149,14 +149,14 @@ queries section
> \WHERE region IN (SELECT region FROM top_regions)\n\
> \GROUP BY region, product;"
-> {-,"WITH RECURSIVE t(n) AS (\n\
+> ,"WITH RECURSIVE t(n) AS (\n\
> \ VALUES (1)\n\
> \ UNION ALL\n\
> \ SELECT n+1 FROM t WHERE n < 100\n\
> \)\n\
-> \SELECT sum(n) FROM t"-} -- full alias in cte
+> \SELECT sum(n) FROM t"
-> {-,"WITH RECURSIVE included_parts(sub_part, part, quantity) AS (\n\
+> ,"WITH RECURSIVE included_parts(sub_part, part, quantity) AS (\n\
> \ SELECT sub_part, part, quantity FROM parts WHERE part = 'our_product'\n\
> \ UNION ALL\n\
> \ SELECT p.sub_part, p.part, p.quantity\n\
@@ -177,7 +177,7 @@ queries section
> \)\n\
> \SELECT * FROM search_graph;"
-> ,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
+> {-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
> \ SELECT g.id, g.link, g.data, 1,\n\
> \ ARRAY[g.id],\n\
> \ false\n\
@@ -189,9 +189,9 @@ queries section
> \ FROM graph g, search_graph sg\n\
> \ WHERE g.id = sg.link AND NOT cycle\n\
> \)\n\
-> \SELECT * FROM search_graph;"
+> \SELECT * FROM search_graph;"-} -- ARRAY
-> ,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
+> {-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
> \ SELECT g.id, g.link, g.data, 1,\n\
> \ ARRAY[ROW(g.f1, g.f2)],\n\
> \ false\n\
@@ -203,14 +203,14 @@ queries section
> \ FROM graph g, search_graph sg\n\
> \ WHERE g.id = sg.link AND NOT cycle\n\
> \)\n\
-> \SELECT * FROM search_graph;"
+> \SELECT * FROM search_graph;"-} -- ARRAY
> ,"WITH RECURSIVE t(n) AS (\n\
> \ SELECT 1\n\
> \ UNION ALL\n\
> \ SELECT n+1 FROM t\n\
> \)\n\
-> \SELECT n FROM t LIMIT 100;"-}
+> \SELECT n FROM t LIMIT 100;"
select page reference
@@ -241,7 +241,7 @@ select page reference
> \UNION ALL\n\
> \SELECT * FROM t"
-> {-,"WITH RECURSIVE employee_recursive(distance, employee_name, manager_name) AS (\n\
+> ,"WITH RECURSIVE employee_recursive(distance, employee_name, manager_name) AS (\n\
> \ SELECT 1, employee_name, manager_name\n\
> \ FROM employee\n\
> \ WHERE manager_name = 'Mary'\n\
@@ -250,7 +250,7 @@ select page reference
> \ FROM employee_recursive er, employee e\n\
> \ WHERE er.employee_name = e.manager_name\n\
> \ )\n\
-> \SELECT distance, employee_name FROM employee_recursive;"-} -- with recursive, full cte alias
+> \SELECT distance, employee_name FROM employee_recursive;"
> ,"SELECT m.name AS mname, pname\n\
> \FROM manufacturers m, LATERAL get_product_names(m.id) pname;"
diff --git a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
index 8eb288f..e43a554 100644
--- a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
+++ b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
@@ -172,12 +172,18 @@ These are a few misc tests which don't fit anywhere else.
> withQueries :: TestItem
> withQueries = Group "with queries" $ map (uncurry TestQueryExpr)
> [("with u as (select a from t) select a from u"
-> ,With [("u", ms1)] ms2)
+> ,With False [(Alias "u" Nothing, ms1)] ms2)
+
+> ,("with u(b) as (select a from t) select a from u"
+> ,With False [(Alias "u" (Just ["b"]), ms1)] ms2)
> ,("with x as (select a from t),\n\
> \ u as (select a from x)\n\
> \select a from u"
-> ,With [("x", ms1), ("u",ms3)] ms2)
+> ,With False [(Alias "x" Nothing, ms1), (Alias "u" Nothing,ms3)] ms2)
+
+> ,("with recursive u as (select a from t) select a from u"
+> ,With True [(Alias "u" Nothing, ms1)] ms2)
> ]
> where
> ms c t = makeSelect
diff --git a/tools/Language/SQL/SimpleSQL/TableRefs.lhs b/tools/Language/SQL/SimpleSQL/TableRefs.lhs
index 6aa2968..466d3d6 100644
--- a/tools/Language/SQL/SimpleSQL/TableRefs.lhs
+++ b/tools/Language/SQL/SimpleSQL/TableRefs.lhs
@@ -80,18 +80,18 @@ these lateral queries make no sense but the syntax is valid
> ,ms [TRQueryExpr $ ms [TRSimple "t"]])
> ,("select a from t as u"
-> ,ms [TRAlias (TRSimple "t") "u" Nothing])
+> ,ms [TRAlias (TRSimple "t") (Alias "u" Nothing)])
> ,("select a from t u"
-> ,ms [TRAlias (TRSimple "t") "u" Nothing])
+> ,ms [TRAlias (TRSimple "t") (Alias "u" Nothing)])
> ,("select a from t u(b)"
-> ,ms [TRAlias (TRSimple "t") "u" $ Just ["b"]])
+> ,ms [TRAlias (TRSimple "t") (Alias "u" $ Just ["b"])])
> ,("select a from (t cross join u) as u"
> ,ms [TRAlias (TRParens $
> TRJoin (TRSimple "t") JCross (TRSimple "u") Nothing)
-> "u" Nothing])
+> (Alias "u" Nothing)])
> -- todo: not sure if the associativity is correct
> ,("select a from t cross join u cross join v",