From 4308acb982c0310a0c2306698f1c24f77ce2c671 Mon Sep 17 00:00:00 2001 From: Jake Wheat 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",