From 931272d1dbe50c71e0a1f9336ad9978e4f7ec6dc Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Sat, 14 Dec 2013 00:58:12 +0200
Subject: [PATCH] add with expressions, all tpch appear to parse correct, some
 of the later ones pretty print badly though

---
 Language/SQL/SimpleSQL/Parser.lhs | 54 ++++++++++++++++++-------------
 Language/SQL/SimpleSQL/Pretty.lhs |  6 ++++
 Language/SQL/SimpleSQL/Syntax.lhs |  1 +
 Tests.lhs                         | 20 ++++++++++++
 tpch.sql                          |  7 +---
 5 files changed, 60 insertions(+), 28 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index ce112e4..db429b9 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -539,34 +539,44 @@ attempt to fix the precedence and associativity. Doesn't work
 > offset :: P (Maybe ScalarExpr)
 > offset = optionalScalarExpr "offset"
 
+> with :: P QueryExpr
+> with = try (keyword_ "with") >>
+>     With <$> commaSep1 withQuery
+>          <*> queryExpr
+>   where
+>     withQuery = (,) <$> (identifierString
+>                          <* optional (try $ keyword_ "as"))
+>                     <*> parens queryExpr
 
 > queryExpr :: P QueryExpr
 > queryExpr =
->     (try (keyword_ "select") >>
->      Select
->      <$> (fromMaybe All <$> duplicates)
->      <*> selectList
->      <*> from
->      <*> swhere
->      <*> sgroupBy
->      <*> having
->      <*> option [] orderBy
->      <*> limit
->      <*> offset)
->     >>= queryExprSuffix
+>   choice [select >>= queryExprSuffix, with]
+>   where
+>     select = try (keyword_ "select") >>
+>         Select
+>         <$> (fromMaybe All <$> duplicates)
+>         <*> selectList
+>         <*> from
+>         <*> swhere
+>         <*> sgroupBy
+>         <*> having
+>         <*> option [] orderBy
+>         <*> limit
+>         <*> offset
 
 > queryExprSuffix :: QueryExpr -> P QueryExpr
 > queryExprSuffix qe =
->     choice [CombineQueryExpr qe
->             <$> try (choice
->                      [Union <$ keyword_ "union"
->                      ,Intersect <$ keyword_ "intersect"
->                      ,Except <$ keyword_ "except"])
->             <*> (fromMaybe All <$> duplicates)
->             <*> (option Respectively
->                  $ try (Corresponding
->                         <$ keyword_ "corresponding"))
->             <*> queryExpr
+>     choice [(CombineQueryExpr qe
+>              <$> try (choice
+>                       [Union <$ keyword_ "union"
+>                       ,Intersect <$ keyword_ "intersect"
+>                       ,Except <$ keyword_ "except"])
+>              <*> (fromMaybe All <$> duplicates)
+>              <*> (option Respectively
+>                   $ try (Corresponding
+>                          <$ keyword_ "corresponding"))
+>              <*> queryExpr)
+>             >>= queryExprSuffix
 >            ,return qe]
 
 > queryExprs :: P [QueryExpr]
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index ccb4fc6..0d3a20e 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -143,6 +143,12 @@ back into SQL source text. It attempts to format the output nicely.
 >                Corresponding -> text "corresponding"
 >                Respectively -> empty
 >       ,queryExpr q2]
+> queryExpr (With withs qe) =
+>   text "with"
+>   <+> vcat [nest 4
+>             (vcat $ punctuate comma $ flip map withs $ \(n,q) ->
+>              text n <+> text "as" <+> parens (queryExpr q))
+>            ,queryExpr qe]
 
 > selectList :: [(Maybe String, ScalarExpr)] -> Doc
 > selectList is = commaSep $ map si is
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index ab51c70..38044cf 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -77,6 +77,7 @@
 >       ,qeCorresponding :: Corresponding
 >       ,qe2 :: QueryExpr
 >       }
+>     | With [(String,QueryExpr)] QueryExpr
 >       deriving (Eq,Show)
 
 > data Duplicates = Distinct | All deriving (Eq,Show)
diff --git a/Tests.lhs b/Tests.lhs
index 5cee6ad..cdba94b 100644
--- a/Tests.lhs
+++ b/Tests.lhs
@@ -221,6 +221,7 @@
 >     ,orderBy
 >     ,limit
 >     ,combos
+>     ,withQueries
 >     ,fullQueries
 >     ]
 
@@ -388,6 +389,25 @@
 >           {qeSelectList = [(Nothing,Iden "b")]
 >           ,qeFrom = [SimpleTableRef "u"]}
 
+
+> 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 x as (select a from t),\n\
+>       \     u as (select a from x)\n\
+>       \select a from u"
+>      ,With [("x", ms1), ("u",ms3)] ms2)
+>     ]
+>  where
+>    ms c t = makeSelect
+>             {qeSelectList = [(Nothing,Iden c)]
+>             ,qeFrom = [SimpleTableRef t]}
+>    ms1 = ms "a" "t"
+>    ms2 = ms "a" "u"
+>    ms3 = ms "a" "x"
+
+
 > fullQueries :: TestItem
 > fullQueries = Group "queries" $ map (uncurry TestQueryExpr)
 >     [("select count(*) from t"
diff --git a/tpch.sql b/tpch.sql
index f6d9b8f..cb0f161 100644
--- a/tpch.sql
+++ b/tpch.sql
@@ -360,8 +360,6 @@ order by
 
 -- q13
 
--- needs full table alias
-/*
 select
         c_count,
         count(*) as custdist
@@ -382,7 +380,6 @@ group by
 order by
         custdist desc,
         c_count desc;
-*/
 
 -- q14
 
@@ -401,7 +398,6 @@ where
         and l_shipdate < date '1994-12-01' + interval '1' month;
 
 -- q15
--- needs cte
 /*create view revenue0 (supplier_no, total_revenue) as
         select
                 l_suppkey,
@@ -413,7 +409,7 @@ where
                 and l_shipdate < date '1995-06-01' + interval '3' month
         group by
                 l_suppkey;*/
-/*
+
 with
 revenue0 as
         (select
@@ -445,7 +441,6 @@ where
         )
 order by
         s_suppkey;
-*/
 
 -- q16