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