add support for with recursive and column aliases in cte

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)
+> selectItem = flip (,) <$> scalarExpr <*> optionMaybe (try als)
->   where alias = optional (try (keyword_ "as")) *> name
+>   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 =
+>     aliasSuffix j = option j (TRAlias j <$> alias)
->         let tableAlias = optional (try $ keyword_ "as") *> name
->             columnAliases = optionMaybe $ try $ parens
->                             $ commaSep1 name
->         in option j (TRAlias j <$> try tableAlias <*> try columnAliases)
 >     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

Language/SQL/SimpleSQL/Pretty.lhs

@@ -171,21 +171,26 @@
 >                Corresponding -> text "corresponding"
 >                Respectively -> empty
 >       ,queryExpr q2]
-> queryExpr (With withs qe) =
+> queryExpr (With rc withs qe) =
->   text "with"
+>   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
+>     si (al,e) = scalarExpr e <+> maybe empty als al
->     alias al = text "as" <+> name 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) =
+>     tr (TRAlias t a) = sep [tr t, alias a]
->         sep [tr t
->             ,text "as" <+> name a
->              <+> maybe empty (parens . commaSep . map name) cs]
 >     tr (TRParens t) = parens $ tr t
 >     tr (TRQueryExpr q) = parens $ queryExpr q
 >     tr (TRJoin t0 jt t1 jc) =

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

TODO

@@ -53,6 +53,7 @@ all ansi sql operators
 
 escapes in string literals
 
+review syntax to replace maybe and bool with better ctors
 
 ----
 

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;"

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

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",