diff --git a/TODO b/TODO
index 74b594d..2fafefc 100644
--- a/TODO
+++ b/TODO
@@ -1,85 +1,100 @@
next release:
-quoted identifiers: implement as a dot operator
-review tests to copy from hssqlppp
+lateral since it is easy. I think it is effectively just a prefix
+ operator on tablerefs (can appear like this from lateral a, from
+ lateral a,b, from a, lateral b, from a natural join lateral b
+ (although all of these are sematically garbage, this is the
+ valid syntax)
+more dots: implement as dot operator
+
+row ctor: row(a,b) is fine, but also when there is 2 or more elements,
+ the word row can be omitted: (a,b)
+more symbolic operators, array access a[5]? don't think this is
+ standard sql, if not, leave for now. There is something about
+ arrays in sql:2008
+
window frames and named windows
-dialect framework
-try to implement fixity without the hse hack
-position annotation?
-row ctor
-more symbolic operators, array access a[5]?
-review abstract syntax (e.g. combine App with SpecialOp?)
-more dots
+
+
+review tests to copy from hssqlppp
+
order by nulls first/last
extend case
-group by extensions
+group by extensions. Question: some of the syntax can be represented
+ by app and row ctor, should this be reused or new syntax created
+ (the standard has special syntax for cube and rollup).
table, values
-collate? -> postfix operator which binds very tightly:
+collate? -> postfix operator which binds very tightly:
a < 'foo' collate 'C'
->
Op "<" [Iden "a", SpecialOp "collate" [StringLit 'foo', StringLit
'C']]
also postfix in order by:
-select a from t order by a collate 'C': add to order by syntax
+select a from t order by a collate 'C': add to order by syntax, one
+ collation per column
function table reference
-much more table reference tests
+much more table reference tests, for joins and aliases etc.
ansi standard versions of limit and offset
-sql server top
+
+OFFSET start { ROW | ROWS }
+FETCH { FIRST | NEXT } [ count ] { ROW | ROWS } ONLY
+-> + fix the abstract syntax to match this instead of postgres
+(keep the postgres syntax version parser)
+in the postgresql docs, the start and count must be in parens unless
+ they are a single integer
+
++ sql server top syntax
+
+quoted identifiers and proper character sets for identifiers
+
+run through postgres docs and add example sql as tests
+review internal sql collection for more syntax/tests
+all ansi sql operators
+
+escapes in string literals
+
+
+----
+
add to website: pretty printed tpch, maybe other queries as
demonstration
-demo: convert tpch to sql server syntax
-review internal sql collection for more syntax/tests
-run through postgres docs and add example sql as tests
+demo: convert tpch to sql server syntax exe processor
+
+----
+
+dialect framework
+try to implement fixity without the hse hack
+position annotation?
+review abstract syntax (e.g. combine App with SpecialOp?)
+
----
Later general tasks:
+run through other manuals for example queries and features: sql in a
+ nutshell, sql guide, sql reference guide, sql standard, sql server
+ manual, oracle manual, teradata manual + re-through postgresql
+ manual and make notes in each case of all syntax and which isn't
+ currently supported also.
+
check the order of exports, imports and functions/cases in the files
fix up the import namespaces/explicit names nicely
do some tests for parse errors?
-dialect switching
-
left factor parsing code in remaining places
-reimplement the fixity thing natively
-
-position annotation?
-
quasi quotes?
= sql support
-scalar function syntax:
+placeholder/positional arg
- review all ansi sql operators
- placeholder/positional arg
-
-other missing operators
- row constructors -> needed for stuff like
- 'where (a,b) = any (select a,b from t)'
-
-
-review allowed identifier syntax
- add quoted identifiers
-more dots in identifiers
-order by nulls first/last
-extend case
-escapes in string literals
full number literals -> other bases?
-group by (), grouping sets(), cube, rollup
-lateral
-named windows
-table, values
apply, pivot
-collate
within group aggregate syntax
-support the ansi version for limit and offset, plus review other
- dialects
-
try to do full review of sql2003 query syntax
make ansi dialect which only supports ansi sql. Maybe there is a use
@@ -94,3 +109,4 @@ mysql?
db2?
maybe later: other dml
+ insert, update, delete, truncate, merge + set, show?
diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal
index e99199d..ce477a2 100644
--- a/simple-sql-parser.cabal
+++ b/simple-sql-parser.cabal
@@ -52,7 +52,14 @@ Test-Suite Tests
Language.SQL.SimpleSQL.Parser,
Language.SQL.SimpleSQL.Syntax,
Language.SQL.SimpleSQL.Fixity,
+ Language.SQL.SimpleSQL.FullQueries,
+ Language.SQL.SimpleSQL.Misc,
+ Language.SQL.SimpleSQL.Postgres,
+ Language.SQL.SimpleSQL.ScalarExprs,
+ Language.SQL.SimpleSQL.TableRefs,
+ Language.SQL.SimpleSQL.TestTypes,
Language.SQL.SimpleSQL.Tests,
+ Language.SQL.SimpleSQL.Tpch,
Tpch
other-extensions: TupleSections
default-language: Haskell2010
diff --git a/tools/Language/SQL/SimpleSQL/FullQueries.lhs b/tools/Language/SQL/SimpleSQL/FullQueries.lhs
new file mode 100644
index 0000000..9f29769
--- /dev/null
+++ b/tools/Language/SQL/SimpleSQL/FullQueries.lhs
@@ -0,0 +1,38 @@
+
+Some tests for parsing full queries.
+
+> module Language.SQL.SimpleSQL.FullQueries (fullQueriesTests) where
+
+> import Language.SQL.SimpleSQL.TestTypes
+> import Language.SQL.SimpleSQL.Syntax
+
+
+> fullQueriesTests :: TestItem
+> fullQueriesTests = Group "queries" $ map (uncurry TestQueryExpr)
+> [("select count(*) from t"
+> ,makeSelect
+> {qeSelectList = [(Nothing, App "count" [Star])]
+> ,qeFrom = [TRSimple "t"]
+> }
+> )
+
+> ,("select a, sum(c+d) as s\n\
+> \ from t,u\n\
+> \ where a > 5\n\
+> \ group by a\n\
+> \ having count(1) > 5\n\
+> \ order by s"
+> ,makeSelect
+> {qeSelectList = [(Nothing, Iden "a")
+> ,(Just "s"
+> ,App "sum" [BinOp (Iden "c")
+> "+" (Iden "d")])]
+> ,qeFrom = [TRSimple "t", TRSimple "u"]
+> ,qeWhere = Just $ BinOp (Iden "a") ">" (NumLit "5")
+> ,qeGroupBy = [Iden "a"]
+> ,qeHaving = Just $ BinOp (App "count" [NumLit "1"])
+> ">" (NumLit "5")
+> ,qeOrderBy = [(Iden "s", Asc)]
+> }
+> )
+> ]
diff --git a/tools/Language/SQL/SimpleSQL/Misc.lhs b/tools/Language/SQL/SimpleSQL/Misc.lhs
new file mode 100644
index 0000000..c29367c
--- /dev/null
+++ b/tools/Language/SQL/SimpleSQL/Misc.lhs
@@ -0,0 +1,196 @@
+
+These is the tests for all the bits which aren't in the other files,
+mainly query exprs except the tablerefs. These tests focus on one part
+of the query expression. The FullQueries tests focus on parsing more
+complex query expressions.
+
+> module Language.SQL.SimpleSQL.Misc (miscTests) where
+
+> import Language.SQL.SimpleSQL.TestTypes
+> import Language.SQL.SimpleSQL.Syntax
+
+
+> miscTests :: TestItem
+> miscTests = Group "miscTests"
+> [duplicates
+> ,selectLists
+> ,whereClause
+> ,groupByClause
+> ,having
+> ,orderBy
+> ,limit
+> ,combos
+> ,withQueries
+> ,queryExprsTests
+> ]
+
+
+
+> duplicates :: TestItem
+> duplicates = Group "duplicates" $ map (uncurry TestQueryExpr)
+> [("select a from t" ,ms All)
+> ,("select all a from t" ,ms All)
+> ,("select distinct a from t", ms Distinct)
+> ]
+> where
+> ms d = makeSelect
+> {qeDuplicates = d
+> ,qeSelectList = [(Nothing,Iden "a")]
+> ,qeFrom = [TRSimple "t"]}
+
+> selectLists :: TestItem
+> selectLists = Group "selectLists" $ map (uncurry TestQueryExpr)
+> [("select 1",
+> makeSelect {qeSelectList = [(Nothing,NumLit "1")]})
+
+> ,("select a"
+> ,makeSelect {qeSelectList = [(Nothing,Iden "a")]})
+
+> ,("select a,b"
+> ,makeSelect {qeSelectList = [(Nothing,Iden "a")
+> ,(Nothing,Iden "b")]})
+
+> ,("select 1+2,3+4"
+> ,makeSelect {qeSelectList =
+> [(Nothing,BinOp (NumLit "1") "+" (NumLit "2"))
+> ,(Nothing,BinOp (NumLit "3") "+" (NumLit "4"))]})
+
+> ,("select a as a, /*comment*/ b as b"
+> ,makeSelect {qeSelectList = [(Just "a", Iden "a")
+> ,(Just "b", Iden "b")]})
+
+> ,("select a a, b b"
+> ,makeSelect {qeSelectList = [(Just "a", Iden "a")
+> ,(Just "b", Iden "b")]})
+> ]
+
+> whereClause :: TestItem
+> whereClause = Group "whereClause" $ map (uncurry TestQueryExpr)
+> [("select a from t where a = 5"
+> ,makeSelect {qeSelectList = [(Nothing,Iden "a")]
+> ,qeFrom = [TRSimple "t"]
+> ,qeWhere = Just $ BinOp (Iden "a") "=" (NumLit "5")})
+> ]
+
+> groupByClause :: TestItem
+> groupByClause = Group "groupByClause" $ map (uncurry TestQueryExpr)
+> [("select a,sum(b) from t group by a"
+> ,makeSelect {qeSelectList = [(Nothing, Iden "a")
+> ,(Nothing, App "sum" [Iden "b"])]
+> ,qeFrom = [TRSimple "t"]
+> ,qeGroupBy = [Iden "a"]
+> })
+
+> ,("select a,b,sum(c) from t group by a,b"
+> ,makeSelect {qeSelectList = [(Nothing, Iden "a")
+> ,(Nothing, Iden "b")
+> ,(Nothing, App "sum" [Iden "c"])]
+> ,qeFrom = [TRSimple "t"]
+> ,qeGroupBy = [Iden "a",Iden "b"]
+> })
+> ]
+
+> having :: TestItem
+> having = Group "having" $ map (uncurry TestQueryExpr)
+> [("select a,sum(b) from t group by a having sum(b) > 5"
+> ,makeSelect {qeSelectList = [(Nothing, Iden "a")
+> ,(Nothing, App "sum" [Iden "b"])]
+> ,qeFrom = [TRSimple "t"]
+> ,qeGroupBy = [Iden "a"]
+> ,qeHaving = Just $ BinOp (App "sum" [Iden "b"])
+> ">" (NumLit "5")
+> })
+> ]
+
+> orderBy :: TestItem
+> orderBy = Group "orderBy" $ map (uncurry TestQueryExpr)
+> [("select a from t order by a"
+> ,ms [(Iden "a", Asc)])
+
+> ,("select a from t order by a, b"
+> ,ms [(Iden "a", Asc), (Iden "b", Asc)])
+
+> ,("select a from t order by a asc"
+> ,ms [(Iden "a", Asc)])
+
+> ,("select a from t order by a desc, b desc"
+> ,ms [(Iden "a", Desc), (Iden "b", Desc)])
+> ]
+> where
+> ms o = makeSelect {qeSelectList = [(Nothing,Iden "a")]
+> ,qeFrom = [TRSimple "t"]
+> ,qeOrderBy = o}
+
+> limit :: TestItem
+> limit = Group "limit" $ map (uncurry TestQueryExpr)
+> [("select a from t limit 10"
+> ,ms (Just $ NumLit "10") Nothing)
+
+> ,("select a from t limit 10 offset 10"
+> ,ms (Just $ NumLit "10") (Just $ NumLit "10"))
+> ]
+> where
+> ms l o = makeSelect
+> {qeSelectList = [(Nothing,Iden "a")]
+> ,qeFrom = [TRSimple "t"]
+> ,qeLimit = l
+> ,qeOffset = o}
+
+> combos :: TestItem
+> combos = Group "combos" $ map (uncurry TestQueryExpr)
+> [("select a from t union select b from u"
+> ,CombineQueryExpr ms1 Union All Respectively ms2)
+
+> ,("select a from t intersect select b from u"
+> ,CombineQueryExpr ms1 Intersect All Respectively ms2)
+
+> ,("select a from t except all select b from u"
+> ,CombineQueryExpr ms1 Except All Respectively ms2)
+
+> ,("select a from t union distinct corresponding \
+> \select b from u"
+> ,CombineQueryExpr ms1 Union Distinct Corresponding ms2)
+
+> ,("select a from t union select a from t union select a from t"
+> -- TODO: union should be left associative. I think the others also
+> -- so this needs to be fixed (new optionSuffix variation which
+> -- handles this)
+> ,CombineQueryExpr ms1 Union All Respectively
+> (CombineQueryExpr ms1 Union All Respectively ms1))
+> ]
+> where
+> ms1 = makeSelect
+> {qeSelectList = [(Nothing,Iden "a")]
+> ,qeFrom = [TRSimple "t"]}
+> ms2 = makeSelect
+> {qeSelectList = [(Nothing,Iden "b")]
+> ,qeFrom = [TRSimple "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 = [TRSimple t]}
+> ms1 = ms "a" "t"
+> ms2 = ms "a" "u"
+> ms3 = ms "a" "x"
+
+> queryExprsTests :: TestItem
+> queryExprsTests = Group "query exprs" $ map (uncurry TestQueryExprs)
+> [("select 1",[ms])
+> ,("select 1;",[ms])
+> ,("select 1;select 1",[ms,ms])
+> ,(" select 1;select 1; ",[ms,ms])
+> ]
+> where
+> ms = makeSelect {qeSelectList = [(Nothing,NumLit "1")]}
diff --git a/tools/Language/SQL/SimpleSQL/Postgres.lhs b/tools/Language/SQL/SimpleSQL/Postgres.lhs
new file mode 100644
index 0000000..9b40b44
--- /dev/null
+++ b/tools/Language/SQL/SimpleSQL/Postgres.lhs
@@ -0,0 +1,280 @@
+
+Here are some tests taken from the SQL in the postgres manual. Almost
+all of the postgres specific syntax has been skipped, this can be
+revisited when the dialect support is added.
+
+> module Language.SQL.SimpleSQL.Postgres (postgresTests) where
+
+> import Language.SQL.SimpleSQL.TestTypes
+> import Language.SQL.SimpleSQL.Syntax
+
+> postgresTests :: TestItem
+> postgresTests = Group "postgresTests"
+> [
+> ]
+
+lexical syntax
+
+SELECT 'foo'
+'bar'; -> if there is a newline, this parses to select 'foobar'
+
+SELECT name, (SELECT max(pop) FROM cities WHERE cities.state = states.name)
+ FROM states;
+
+SELECT ROW(1,2.5,'this is a test');
+
+SELECT ROW(t.*, 42) FROM t; -- needs the .* parsing to be enabled in more contexts
+SELECT ROW(t.f1, t.f2, 42) FROM t;
+SELECT getf1(CAST(ROW(11,'this is a test',2.5) AS myrowtype));
+
+SELECT ROW(1,2.5,'this is a test') = ROW(1, 3, 'not the same');
+
+SELECT ROW(table.*) IS NULL FROM table;
+
+SELECT true OR somefunc();
+
+SELECT somefunc() OR true;
+
+queries
+SELECT * FROM t1 CROSS JOIN t2;
+SELECT * FROM t1 INNER JOIN t2 ON t1.num = t2.num;
+SELECT * FROM t1 INNER JOIN t2 USING (num);
+SELECT * FROM t1 NATURAL INNER JOIN t2;
+SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num;
+SELECT * FROM t1 LEFT JOIN t2 USING (num);
+SELECT * FROM t1 RIGHT JOIN t2 ON t1.num = t2.num;
+SELECT * FROM t1 FULL JOIN t2 ON t1.num = t2.num;
+SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num AND t2.value = 'xxx';
+SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num WHERE t2.value = 'xxx';
+
+> {-f = mapM_ (putStrLn . either peFormattedError show . parseQueryExpr "" Nothing)
+> ["SELECT * FROM t1 CROSS JOIN t2;"
+> ,"SELECT * FROM t1 INNER JOIN t2 ON t1.num = t2.num;"
+> ,"SELECT * FROM t1 INNER JOIN t2 USING (num);"
+> ,"SELECT * FROM t1 NATURAL INNER JOIN t2;"
+> ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num;"
+> ,"SELECT * FROM t1 LEFT JOIN t2 USING (num);"
+> ,"SELECT * FROM t1 RIGHT JOIN t2 ON t1.num = t2.num;"
+> ,"SELECT * FROM t1 FULL JOIN t2 ON t1.num = t2.num;"
+> ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num AND t2.value = 'xxx';"
+> - ,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num WHERE t2.value = 'xxx';"]-}
+
+
+SELECT * FROM some_very_long_table_name s JOIN another_fairly_long_name a ON s.id = a.num;
+SELECT * FROM people AS mother JOIN people AS child ON mother.id = child.mother_id;
+SELECT * FROM my_table AS a CROSS JOIN my_table AS b;
+SELECT * FROM (my_table AS a CROSS JOIN my_table) AS b;
+SELECT * FROM getfoo(1) AS t1;
+SELECT * FROM foo
+ WHERE foosubid IN (
+ SELECT foosubid
+ FROM getfoo(foo.fooid) z
+ WHERE z.fooid = foo.fooid
+ );
+SELECT *
+ FROM dblink('dbname=mydb', 'SELECT proname, prosrc FROM pg_proc')
+ AS t1(proname name, prosrc text)
+ WHERE proname LIKE 'bytea%';
+
+SELECT * FROM foo, LATERAL (SELECT * FROM bar WHERE bar.id = foo.bar_id) ss;
+SELECT * FROM foo, bar WHERE bar.id = foo.bar_id;
+
+SELECT p1.id, p2.id, v1, v2
+FROM polygons p1, polygons p2,
+ LATERAL vertices(p1.poly) v1,
+ LATERAL vertices(p2.poly) v2
+WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;
+
+SELECT p1.id, p2.id, v1, v2
+FROM polygons p1 CROSS JOIN LATERAL vertices(p1.poly) v1,
+ polygons p2 CROSS JOIN LATERAL vertices(p2.poly) v2
+WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;
+
+SELECT m.name
+FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true
+WHERE pname IS NULL;
+
+
+SELECT * FROM fdt WHERE c1 > 5
+
+SELECT * FROM fdt WHERE c1 IN (1, 2, 3)
+
+SELECT * FROM fdt WHERE c1 IN (SELECT c1 FROM t2)
+
+SELECT * FROM fdt WHERE c1 IN (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10)
+
+SELECT * FROM fdt WHERE c1 BETWEEN (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10) AND 100
+
+SELECT * FROM fdt WHERE EXISTS (SELECT c1 FROM t2 WHERE c2 > fdt.c1)
+
+SELECT * FROM test1;
+
+SELECT x FROM test1 GROUP BY x;
+SELECT x, sum(y) FROM test1 GROUP BY x;
+SELECT product_id, p.name, (sum(s.units) * p.price) AS sales
+ FROM products p LEFT JOIN sales s USING (product_id)
+ GROUP BY product_id, p.name, p.price;
+
+SELECT x, sum(y) FROM test1 GROUP BY x HAVING sum(y) > 3;
+SELECT x, sum(y) FROM test1 GROUP BY x HAVING x < 'c';
+SELECT product_id, p.name, (sum(s.units) * (p.price - p.cost)) AS profit
+ FROM products p LEFT JOIN sales s USING (product_id)
+ WHERE s.date > CURRENT_DATE - INTERVAL '4 weeks'
+ GROUP BY product_id, p.name, p.price, p.cost
+ HAVING sum(p.price * s.units) > 5000;
+
+SELECT a, b, c FROM t
+
+SELECT tbl1.a, tbl2.a, tbl1.b FROM t
+
+SELECT tbl1.*, tbl2.a FROM t
+
+SELECT a AS value, b + c AS sum FROM t
+
+-- bad keyword
+--SELECT a value, b + c AS sum FROM ...
+
+SELECT a "value", b + c AS sum FROM t
+
+SELECT DISTINCT select_list t
+
+VALUES (1, 'one'), (2, 'two'), (3, 'three');
+
+SELECT 1 AS column1, 'one' AS column2
+UNION ALL
+SELECT 2, 'two'
+UNION ALL
+SELECT 3, 'three';
+
+SELECT * FROM (VALUES (1, 'one'), (2, 'two'), (3, 'three')) AS t (num,letter);
+
+WITH regional_sales AS (
+ SELECT region, SUM(amount) AS total_sales
+ FROM orders
+ GROUP BY region
+ ), top_regions AS (
+ SELECT region
+ FROM regional_sales
+ WHERE total_sales > (SELECT SUM(total_sales)/10 FROM regional_sales)
+ )
+SELECT region,
+ product,
+ SUM(quantity) AS product_units,
+ SUM(amount) AS product_sales
+FROM orders
+WHERE region IN (SELECT region FROM top_regions)
+GROUP BY region, product;
+
+WITH RECURSIVE t(n) AS (
+ VALUES (1)
+ UNION ALL
+ SELECT n+1 FROM t WHERE n < 100
+)
+SELECT sum(n) FROM t
+
+WITH RECURSIVE included_parts(sub_part, part, quantity) AS (
+ SELECT sub_part, part, quantity FROM parts WHERE part = 'our_product'
+ UNION ALL
+ SELECT p.sub_part, p.part, p.quantity
+ FROM included_parts pr, parts p
+ WHERE p.part = pr.sub_part
+ )
+SELECT sub_part, SUM(quantity) as total_quantity
+FROM included_parts
+GROUP BY sub_part
+
+WITH RECURSIVE search_graph(id, link, data, depth) AS (
+ SELECT g.id, g.link, g.data, 1
+ FROM graph g
+ UNION ALL
+ SELECT g.id, g.link, g.data, sg.depth + 1
+ FROM graph g, search_graph sg
+ WHERE g.id = sg.link
+)
+SELECT * FROM search_graph;
+
+WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (
+ SELECT g.id, g.link, g.data, 1,
+ ARRAY[g.id],
+ false
+ FROM graph g
+ UNION ALL
+ SELECT g.id, g.link, g.data, sg.depth + 1,
+ path || g.id,
+ g.id = ANY(path)
+ FROM graph g, search_graph sg
+ WHERE g.id = sg.link AND NOT cycle
+)
+SELECT * FROM search_graph;
+
+WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (
+ SELECT g.id, g.link, g.data, 1,
+ ARRAY[ROW(g.f1, g.f2)],
+ false
+ FROM graph g
+ UNION ALL
+ SELECT g.id, g.link, g.data, sg.depth + 1,
+ path || ROW(g.f1, g.f2),
+ ROW(g.f1, g.f2) = ANY(path)
+ FROM graph g, search_graph sg
+ WHERE g.id = sg.link AND NOT cycle
+)
+SELECT * FROM search_graph;
+
+WITH RECURSIVE t(n) AS (
+ SELECT 1
+ UNION ALL
+ SELECT n+1 FROM t
+)
+SELECT n FROM t LIMIT 100;
+
+select page reference
+
+SELECT f.title, f.did, d.name, f.date_prod, f.kind
+ FROM distributors d, films f
+ WHERE f.did = d.did
+
+SELECT kind, sum(len) AS total
+ FROM films
+ GROUP BY kind
+ HAVING sum(len) < interval '5 hours';
+
+SELECT * FROM distributors ORDER BY name;
+SELECT * FROM distributors ORDER BY 2;
+
+SELECT distributors.name
+ FROM distributors
+ WHERE distributors.name LIKE 'W%'
+UNION
+SELECT actors.name
+ FROM actors
+ WHERE actors.name LIKE 'W%';
+
+WITH t AS (
+ SELECT random() as x FROM generate_series(1, 3)
+ )
+SELECT * FROM t
+UNION ALL
+SELECT * FROM t
+
+WITH RECURSIVE employee_recursive(distance, employee_name, manager_name) AS (
+ SELECT 1, employee_name, manager_name
+ FROM employee
+ WHERE manager_name = 'Mary'
+ UNION ALL
+ SELECT er.distance + 1, e.employee_name, e.manager_name
+ FROM employee_recursive er, employee e
+ WHERE er.employee_name = e.manager_name
+ )
+SELECT distance, employee_name FROM employee_recursive;
+
+SELECT m.name AS mname, pname
+FROM manufacturers m, LATERAL get_product_names(m.id) pname;
+
+SELECT m.name AS mname, pname
+FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true;
+
+SELECT 2+2;
+
+SELECT distributors.* WHERE distributors.name = 'Westward';
+
diff --git a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs
new file mode 100644
index 0000000..91fefcc
--- /dev/null
+++ b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs
@@ -0,0 +1,235 @@
+
+Tests for parsing scalar expressions
+
+> module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where
+
+> import Language.SQL.SimpleSQL.TestTypes
+> import Language.SQL.SimpleSQL.Syntax
+
+> scalarExprTests :: TestItem
+> scalarExprTests = Group "scalarExprTests"
+> [literals
+> ,identifiers
+> ,star
+> ,app
+> ,caseexp
+> ,operators
+> ,parens
+> ,subqueries
+> ,aggregates
+> ,windowFunctions
+> ]
+
+> literals :: TestItem
+> literals = Group "literals" $ map (uncurry TestScalarExpr)
+> [("3", NumLit "3")
+> ,("3.", NumLit "3.")
+> ,("3.3", NumLit "3.3")
+> ,(".3", NumLit ".3")
+> ,("3.e3", NumLit "3.e3")
+> ,("3.3e3", NumLit "3.3e3")
+> ,(".3e3", NumLit ".3e3")
+> ,("3e3", NumLit "3e3")
+> ,("3e+3", NumLit "3e+3")
+> ,("3e-3", NumLit "3e-3")
+> ,("'string'", StringLit "string")
+> ,("'1'", StringLit "1")
+> ,("interval '3' day", IntervalLit "3" "day" Nothing)
+> ,("interval '3' day (3)", IntervalLit "3" "day" $ Just 3)
+> ]
+
+> identifiers :: TestItem
+> identifiers = Group "identifiers" $ map (uncurry TestScalarExpr)
+> [("iden1", Iden "iden1")
+> ,("t.a", Iden2 "t" "a")
+> ]
+
+> star :: TestItem
+> star = Group "star" $ map (uncurry TestScalarExpr)
+> [("*", Star)
+> ,("t.*", Star2 "t")
+> ]
+
+> app :: TestItem
+> app = Group "app" $ map (uncurry TestScalarExpr)
+> [("f()", App "f" [])
+> ,("f(a)", App "f" [Iden "a"])
+> ,("f(a,b)", App "f" [Iden "a", Iden "b"])
+> ]
+
+> caseexp :: TestItem
+> caseexp = Group "caseexp" $ map (uncurry TestScalarExpr)
+> [("case a when 1 then 2 end"
+> ,Case (Just $ Iden "a") [(NumLit "1"
+> ,NumLit "2")] Nothing)
+
+> ,("case a when 1 then 2 when 3 then 4 end"
+> ,Case (Just $ Iden "a") [(NumLit "1", NumLit "2")
+> ,(NumLit "3", NumLit "4")] Nothing)
+
+> ,("case a when 1 then 2 when 3 then 4 else 5 end"
+> ,Case (Just $ Iden "a") [(NumLit "1", NumLit "2")
+> ,(NumLit "3", NumLit "4")] (Just $ NumLit "5"))
+
+> ,("case when a=1 then 2 when a=3 then 4 else 5 end"
+> ,Case Nothing [(BinOp (Iden "a") "=" (NumLit "1"), NumLit "2")
+> ,(BinOp (Iden "a") "=" (NumLit "3"), NumLit "4")]
+> (Just $ NumLit "5"))
+
+> ]
+
+> operators :: TestItem
+> operators = Group "operators"
+> [binaryOperators
+> ,unaryOperators
+> ,casts
+> ,miscOps]
+
+> binaryOperators :: TestItem
+> binaryOperators = Group "binaryOperators" $ map (uncurry TestScalarExpr)
+> [("a + b", BinOp (Iden "a") "+" (Iden "b"))
+> -- sanity check fixities
+> -- todo: add more fixity checking
+
+> ,("a + b * c"
+> ,BinOp (Iden "a") "+"
+> (BinOp (Iden "b") "*" (Iden "c")))
+
+> ,("a * b + c"
+> ,BinOp (BinOp (Iden "a") "*" (Iden "b"))
+> "+" (Iden "c"))
+> ]
+
+> unaryOperators :: TestItem
+> unaryOperators = Group "unaryOperators" $ map (uncurry TestScalarExpr)
+> [("not a", PrefixOp "not" $ Iden "a")
+> ,("not not a", PrefixOp "not" $ PrefixOp "not" $ Iden "a")
+> ,("+a", PrefixOp "+" $ Iden "a")
+> ,("-a", PrefixOp "-" $ Iden "a")
+> ]
+
+
+> casts :: TestItem
+> casts = Group "operators" $ map (uncurry TestScalarExpr)
+> [("cast('1' as int)"
+> ,Cast (StringLit "1") $ TypeName "int")
+
+> ,("int '3'"
+> ,CastOp (TypeName "int") "3")
+
+> ,("cast('1' as double precision)"
+> ,Cast (StringLit "1") $ TypeName "double precision")
+
+> ,("double precision '3'"
+> ,CastOp (TypeName "double precision") "3")
+> ]
+
+> subqueries :: TestItem
+> subqueries = Group "unaryOperators" $ map (uncurry TestScalarExpr)
+> [("exists (select a from t)", SubQueryExpr SqExists ms)
+> ,("(select a from t)", SubQueryExpr SqSq ms)
+
+> ,("a in (select a from t)"
+> ,In True (Iden "a") (InQueryExpr ms))
+
+> ,("a not in (select a from t)"
+> ,In False (Iden "a") (InQueryExpr ms))
+
+> ,("a > all (select a from t)"
+> ,BinOp (Iden "a") ">" (SubQueryExpr SqAll ms))
+
+> ,("a = some (select a from t)"
+> ,BinOp (Iden "a") "=" (SubQueryExpr SqSome ms))
+
+> ,("a <= any (select a from t)"
+> ,BinOp (Iden "a") "<=" (SubQueryExpr SqAny ms))
+> ]
+> where
+> ms = makeSelect
+> {qeSelectList = [(Nothing,Iden "a")]
+> ,qeFrom = [TRSimple "t"]
+> }
+
+> miscOps :: TestItem
+> miscOps = Group "unaryOperators" $ map (uncurry TestScalarExpr)
+> [("a in (1,2,3)"
+> ,In True (Iden "a") $ InList $ map NumLit ["1","2","3"])
+
+> ,("a between b and c", SpecialOp "between" [Iden "a"
+> ,Iden "b"
+> ,Iden "c"])
+
+> ,("a not between b and c", SpecialOp "not between" [Iden "a"
+> ,Iden "b"
+> ,Iden "c"])
+
+> ,("a is null", PostfixOp "is null" (Iden "a"))
+> ,("a is not null", PostfixOp "is not null" (Iden "a"))
+> ,("a is true", PostfixOp "is true" (Iden "a"))
+> ,("a is not true", PostfixOp "is not true" (Iden "a"))
+> ,("a is false", PostfixOp "is false" (Iden "a"))
+> ,("a is not false", PostfixOp "is not false" (Iden "a"))
+> ,("a is unknown", PostfixOp "is unknown" (Iden "a"))
+> ,("a is not unknown", PostfixOp "is not unknown" (Iden "a"))
+> ,("a is distinct from b", BinOp (Iden "a") "is distinct from"(Iden "b"))
+
+> ,("a is not distinct from b"
+> ,BinOp (Iden "a") "is not distinct from" (Iden "b"))
+
+> ,("a like b", BinOp (Iden "a") "like" (Iden "b"))
+> ,("a not like b", BinOp (Iden "a") "not like" (Iden "b"))
+> ,("a is similar to b", BinOp (Iden "a") "is similar to" (Iden "b"))
+
+> ,("a is not similar to b"
+> ,BinOp (Iden "a") "is not similar to" (Iden "b"))
+
+> ,("a overlaps b", BinOp (Iden "a") "overlaps" (Iden "b"))
+> ,("extract(day from t)", SpecialOp "extract" [Iden "day", Iden "t"])
+
+> ,("substring(x from 1 for 2)"
+> ,SpecialOp "substring" [Iden "x", NumLit "1", NumLit "2"])
+
+> ]
+
+> aggregates :: TestItem
+> aggregates = Group "aggregates" $ map (uncurry TestScalarExpr)
+> [("count(*)",App "count" [Star])
+
+> ,("sum(a order by a)"
+> ,AggregateApp "sum" Nothing [Iden "a"] [(Iden "a", Asc)])
+
+> ,("sum(all a)"
+> ,AggregateApp "sum" (Just All) [Iden "a"] [])
+
+> ,("count(distinct a)"
+> ,AggregateApp "count" (Just Distinct) [Iden "a"] [])
+> ]
+
+> windowFunctions :: TestItem
+> windowFunctions = Group "windowFunctions" $ map (uncurry TestScalarExpr)
+> [("max(a) over ()", WindowApp "max" [Iden "a"] [] [])
+> ,("count(*) over ()", WindowApp "count" [Star] [] [])
+
+> ,("max(a) over (partition by b)"
+> ,WindowApp "max" [Iden "a"] [Iden "b"] [])
+
+> ,("max(a) over (partition by b,c)"
+> ,WindowApp "max" [Iden "a"] [Iden "b",Iden "c"] [])
+
+> ,("sum(a) over (order by b)"
+> ,WindowApp "sum" [Iden "a"] [] [(Iden "b", Asc)])
+
+> ,("sum(a) over (order by b desc,c)"
+> ,WindowApp "sum" [Iden "a"] [] [(Iden "b", Desc)
+> ,(Iden "c", Asc)])
+
+> ,("sum(a) over (partition by b order by c)"
+> ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)])
+> -- todo: check order by options, add frames
+> ]
+
+> parens :: TestItem
+> parens = Group "parens" $ map (uncurry TestScalarExpr)
+> [("(a)", Parens (Iden "a"))
+> ,("(a + b)", Parens (BinOp (Iden "a") "+" (Iden "b")))
+> ]
diff --git a/tools/Language/SQL/SimpleSQL/TableRefs.lhs b/tools/Language/SQL/SimpleSQL/TableRefs.lhs
new file mode 100644
index 0000000..5feaf3c
--- /dev/null
+++ b/tools/Language/SQL/SimpleSQL/TableRefs.lhs
@@ -0,0 +1,73 @@
+
+These are the tests for parsing focusing on the from part of query
+expression
+
+> module Language.SQL.SimpleSQL.TableRefs (tableRefTests) where
+
+> import Language.SQL.SimpleSQL.TestTypes
+> import Language.SQL.SimpleSQL.Syntax
+
+
+> tableRefTests :: TestItem
+> tableRefTests = Group "tableRefTests" $ map (uncurry TestQueryExpr)
+> [("select a from t"
+> ,ms [TRSimple "t"])
+
+> ,("select a from t,u"
+> ,ms [TRSimple "t", TRSimple "u"])
+
+> ,("select a from t inner join u on expr"
+> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u")
+> (Just $ JoinOn $ Iden "expr")])
+
+> ,("select a from t left join u on expr"
+> ,ms [TRJoin (TRSimple "t") JLeft (TRSimple "u")
+> (Just $ JoinOn $ Iden "expr")])
+
+> ,("select a from t right join u on expr"
+> ,ms [TRJoin (TRSimple "t") JRight (TRSimple "u")
+> (Just $ JoinOn $ Iden "expr")])
+
+> ,("select a from t full join u on expr"
+> ,ms [TRJoin (TRSimple "t") JFull (TRSimple "u")
+> (Just $ JoinOn $ Iden "expr")])
+
+> ,("select a from t cross join u"
+> ,ms [TRJoin (TRSimple "t")
+> JCross (TRSimple "u") Nothing])
+
+> ,("select a from t natural inner join u"
+> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u")
+> (Just JoinNatural)])
+
+> ,("select a from t inner join u using(a,b)"
+> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u")
+> (Just $ JoinUsing ["a", "b"])])
+
+> ,("select a from (select a from t)"
+> ,ms [TRQueryExpr $ ms [TRSimple "t"]])
+
+> ,("select a from t as u"
+> ,ms [TRAlias (TRSimple "t") "u" Nothing])
+
+> ,("select a from t u"
+> ,ms [TRAlias (TRSimple "t") "u" Nothing])
+
+> ,("select a from t u(b)"
+> ,ms [TRAlias (TRSimple "t") "u" $ Just ["b"]])
+
+> ,("select a from (t cross join u) as u"
+> ,ms [TRAlias (TRParens $
+> TRJoin (TRSimple "t") JCross (TRSimple "u") Nothing)
+> "u" Nothing])
+> -- todo: not sure if the associativity is correct
+
+> ,("select a from t cross join u cross join v",
+> ms [TRJoin
+> (TRJoin (TRSimple "t")
+> JCross (TRSimple "u") Nothing)
+> JCross (TRSimple "v") Nothing])
+> ]
+> where
+> ms f = makeSelect {qeSelectList = [(Nothing,Iden "a")]
+> ,qeFrom = f}
diff --git a/tools/Language/SQL/SimpleSQL/TestTypes.lhs b/tools/Language/SQL/SimpleSQL/TestTypes.lhs
new file mode 100644
index 0000000..f8711dc
--- /dev/null
+++ b/tools/Language/SQL/SimpleSQL/TestTypes.lhs
@@ -0,0 +1,20 @@
+
+This is the types used to define the tests as pure data. See the
+Tests.lhs module for the 'interpreter'.
+
+> module Language.SQL.SimpleSQL.TestTypes where
+
+> import Language.SQL.SimpleSQL.Syntax
+
+> data TestItem = Group String [TestItem]
+> | TestScalarExpr String ScalarExpr
+> | TestQueryExpr String QueryExpr
+> | TestQueryExprs String [QueryExpr]
+
+this just checks the sql parses without error, mostly just a
+intermediate when I'm too lazy to write out the parsed AST. These
+should all be TODO to convert to a testqueryexpr test.
+
+> | ParseQueryExpr String
+> deriving (Eq,Show)
+
diff --git a/tools/Language/SQL/SimpleSQL/Tests.lhs b/tools/Language/SQL/SimpleSQL/Tests.lhs
index 0859fec..7396fdc 100644
--- a/tools/Language/SQL/SimpleSQL/Tests.lhs
+++ b/tools/Language/SQL/SimpleSQL/Tests.lhs
@@ -8,31 +8,6 @@ other queryexpr parts: not enough to split into multiple files
full queries
tpch tests
-postgres queries - take all the examples from the postgres docs which
-aren't too postgres specific and create tests from them
-
-postgres queries:
-SELECT 'foo'
-'bar'; -> if there is a newline, this parses to select 'foobar'
-
-SELECT name, (SELECT max(pop) FROM cities WHERE cities.state = states.name)
- FROM states;
-
-SELECT ROW(1,2.5,'this is a test');
-
-SELECT ROW(t.*, 42) FROM t;
-SELECT ROW(t.f1, t.f2, 42) FROM t;
-Note: Before PostgreSQL 8.2, the .* syntax was not expanded
-SELECT getf1(CAST(ROW(11,'this is a test',2.5) AS myrowtype));
-
-SELECT ROW(1,2.5,'this is a test') = ROW(1, 3, 'not the same');
-
-SELECT ROW(table.*) IS NULL FROM table;
-
-SELECT true OR somefunc();
-
-SELECT somefunc() OR true;
-
> module Language.SQL.SimpleSQL.Tests
> (testData
@@ -40,539 +15,35 @@ SELECT somefunc() OR true;
> ,TestItem(..)
> ) where
+> import Test.Framework
+> import Test.Framework.Providers.HUnit
+> import qualified Test.HUnit as H
+
> import Language.SQL.SimpleSQL.Syntax
> import Language.SQL.SimpleSQL.Pretty
> import Language.SQL.SimpleSQL.Parser
-> import qualified Test.HUnit as H
-> import Tpch
-> import Test.Framework
-> import Test.Framework.Providers.HUnit
-> data TestItem = Group String [TestItem]
-> | TestScalarExpr String ScalarExpr
-> | TestQueryExpr String QueryExpr
-> | TestQueryExprs String [QueryExpr]
-> | ParseQueryExpr String
-> deriving (Eq,Show)
+> import Language.SQL.SimpleSQL.TestTypes
-> scalarExprParserTests :: TestItem
-> scalarExprParserTests = Group "scalarExprParserTests"
-> [literals
-> ,identifiers
-> ,star
-> ,app
-> ,caseexp
-> ,operators
-> ,parens
-> ,subqueries
-> ,aggregates
-> ,windowFunctions
-> ]
+> import Language.SQL.SimpleSQL.FullQueries
+> import Language.SQL.SimpleSQL.Misc
+> import Language.SQL.SimpleSQL.Postgres
+> import Language.SQL.SimpleSQL.TableRefs
+> import Language.SQL.SimpleSQL.ScalarExprs
+> import Language.SQL.SimpleSQL.Tpch
-> literals :: TestItem
-> literals = Group "literals" $ map (uncurry TestScalarExpr)
-> [("3", NumLit "3")
-> ,("3.", NumLit "3.")
-> ,("3.3", NumLit "3.3")
-> ,(".3", NumLit ".3")
-> ,("3.e3", NumLit "3.e3")
-> ,("3.3e3", NumLit "3.3e3")
-> ,(".3e3", NumLit ".3e3")
-> ,("3e3", NumLit "3e3")
-> ,("3e+3", NumLit "3e+3")
-> ,("3e-3", NumLit "3e-3")
-> ,("'string'", StringLit "string")
-> ,("'1'", StringLit "1")
-> ,("interval '3' day", IntervalLit "3" "day" Nothing)
-> ,("interval '3' day (3)", IntervalLit "3" "day" $ Just 3)
-> ]
-> identifiers :: TestItem
-> identifiers = Group "identifiers" $ map (uncurry TestScalarExpr)
-> [("iden1", Iden "iden1")
-> ,("t.a", Iden2 "t" "a")
-> ]
-> star :: TestItem
-> star = Group "star" $ map (uncurry TestScalarExpr)
-> [("*", Star)
-> ,("t.*", Star2 "t")
-> ]
-> app :: TestItem
-> app = Group "app" $ map (uncurry TestScalarExpr)
-> [("f()", App "f" [])
-> ,("f(a)", App "f" [Iden "a"])
-> ,("f(a,b)", App "f" [Iden "a", Iden "b"])
-> ]
-
-> caseexp :: TestItem
-> caseexp = Group "caseexp" $ map (uncurry TestScalarExpr)
-> [("case a when 1 then 2 end"
-> ,Case (Just $ Iden "a") [(NumLit "1"
-> ,NumLit "2")] Nothing)
-
-> ,("case a when 1 then 2 when 3 then 4 end"
-> ,Case (Just $ Iden "a") [(NumLit "1", NumLit "2")
-> ,(NumLit "3", NumLit "4")] Nothing)
-
-> ,("case a when 1 then 2 when 3 then 4 else 5 end"
-> ,Case (Just $ Iden "a") [(NumLit "1", NumLit "2")
-> ,(NumLit "3", NumLit "4")] (Just $ NumLit "5"))
-
-> ,("case when a=1 then 2 when a=3 then 4 else 5 end"
-> ,Case Nothing [(BinOp (Iden "a") "=" (NumLit "1"), NumLit "2")
-> ,(BinOp (Iden "a") "=" (NumLit "3"), NumLit "4")]
-> (Just $ NumLit "5"))
-
-> ]
-
-> operators :: TestItem
-> operators = Group "operators"
-> [binaryOperators
-> ,unaryOperators
-> ,casts
-> ,miscOps]
-
-> binaryOperators :: TestItem
-> binaryOperators = Group "binaryOperators" $ map (uncurry TestScalarExpr)
-> [("a + b", BinOp (Iden "a") "+" (Iden "b"))
-> -- sanity check fixities
-> -- todo: add more fixity checking
-
-> ,("a + b * c"
-> ,BinOp (Iden "a") "+"
-> (BinOp (Iden "b") "*" (Iden "c")))
-
-> ,("a * b + c"
-> ,BinOp (BinOp (Iden "a") "*" (Iden "b"))
-> "+" (Iden "c"))
-> ]
-
-> unaryOperators :: TestItem
-> unaryOperators = Group "unaryOperators" $ map (uncurry TestScalarExpr)
-> [("not a", PrefixOp "not" $ Iden "a")
-> ,("not not a", PrefixOp "not" $ PrefixOp "not" $ Iden "a")
-> ,("+a", PrefixOp "+" $ Iden "a")
-> ,("-a", PrefixOp "-" $ Iden "a")
-> ]
-
-
-> casts :: TestItem
-> casts = Group "operators" $ map (uncurry TestScalarExpr)
-> [("cast('1' as int)"
-> ,Cast (StringLit "1") $ TypeName "int")
-
-> ,("int '3'"
-> ,CastOp (TypeName "int") "3")
-
-> ,("cast('1' as double precision)"
-> ,Cast (StringLit "1") $ TypeName "double precision")
-
-> ,("double precision '3'"
-> ,CastOp (TypeName "double precision") "3")
-> ]
-
-> subqueries :: TestItem
-> subqueries = Group "unaryOperators" $ map (uncurry TestScalarExpr)
-> [("exists (select a from t)", SubQueryExpr SqExists ms)
-> ,("(select a from t)", SubQueryExpr SqSq ms)
-
-> ,("a in (select a from t)"
-> ,In True (Iden "a") (InQueryExpr ms))
-
-> ,("a not in (select a from t)"
-> ,In False (Iden "a") (InQueryExpr ms))
-
-> ,("a > all (select a from t)"
-> ,BinOp (Iden "a") ">" (SubQueryExpr SqAll ms))
-
-> ,("a = some (select a from t)"
-> ,BinOp (Iden "a") "=" (SubQueryExpr SqSome ms))
-
-> ,("a <= any (select a from t)"
-> ,BinOp (Iden "a") "<=" (SubQueryExpr SqAny ms))
-> ]
-> where
-> ms = makeSelect
-> {qeSelectList = [(Nothing,Iden "a")]
-> ,qeFrom = [TRSimple "t"]
-> }
-
-> miscOps :: TestItem
-> miscOps = Group "unaryOperators" $ map (uncurry TestScalarExpr)
-> [("a in (1,2,3)"
-> ,In True (Iden "a") $ InList $ map NumLit ["1","2","3"])
-
-> ,("a between b and c", SpecialOp "between" [Iden "a"
-> ,Iden "b"
-> ,Iden "c"])
-
-> ,("a not between b and c", SpecialOp "not between" [Iden "a"
-> ,Iden "b"
-> ,Iden "c"])
-
-> ,("a is null", PostfixOp "is null" (Iden "a"))
-> ,("a is not null", PostfixOp "is not null" (Iden "a"))
-> ,("a is true", PostfixOp "is true" (Iden "a"))
-> ,("a is not true", PostfixOp "is not true" (Iden "a"))
-> ,("a is false", PostfixOp "is false" (Iden "a"))
-> ,("a is not false", PostfixOp "is not false" (Iden "a"))
-> ,("a is unknown", PostfixOp "is unknown" (Iden "a"))
-> ,("a is not unknown", PostfixOp "is not unknown" (Iden "a"))
-> ,("a is distinct from b", BinOp (Iden "a") "is distinct from"(Iden "b"))
-
-> ,("a is not distinct from b"
-> ,BinOp (Iden "a") "is not distinct from" (Iden "b"))
-
-> ,("a like b", BinOp (Iden "a") "like" (Iden "b"))
-> ,("a not like b", BinOp (Iden "a") "not like" (Iden "b"))
-> ,("a is similar to b", BinOp (Iden "a") "is similar to" (Iden "b"))
-
-> ,("a is not similar to b"
-> ,BinOp (Iden "a") "is not similar to" (Iden "b"))
-
-> ,("a overlaps b", BinOp (Iden "a") "overlaps" (Iden "b"))
-> ,("extract(day from t)", SpecialOp "extract" [Iden "day", Iden "t"])
-
-> ,("substring(x from 1 for 2)"
-> ,SpecialOp "substring" [Iden "x", NumLit "1", NumLit "2"])
-
-> ]
-
-> aggregates :: TestItem
-> aggregates = Group "aggregates" $ map (uncurry TestScalarExpr)
-> [("count(*)",App "count" [Star])
-
-> ,("sum(a order by a)"
-> ,AggregateApp "sum" Nothing [Iden "a"] [(Iden "a", Asc)])
-
-> ,("sum(all a)"
-> ,AggregateApp "sum" (Just All) [Iden "a"] [])
-
-> ,("count(distinct a)"
-> ,AggregateApp "count" (Just Distinct) [Iden "a"] [])
-> ]
-
-> windowFunctions :: TestItem
-> windowFunctions = Group "windowFunctions" $ map (uncurry TestScalarExpr)
-> [("max(a) over ()", WindowApp "max" [Iden "a"] [] [])
-> ,("count(*) over ()", WindowApp "count" [Star] [] [])
-
-> ,("max(a) over (partition by b)"
-> ,WindowApp "max" [Iden "a"] [Iden "b"] [])
-
-> ,("max(a) over (partition by b,c)"
-> ,WindowApp "max" [Iden "a"] [Iden "b",Iden "c"] [])
-
-> ,("sum(a) over (order by b)"
-> ,WindowApp "sum" [Iden "a"] [] [(Iden "b", Asc)])
-
-> ,("sum(a) over (order by b desc,c)"
-> ,WindowApp "sum" [Iden "a"] [] [(Iden "b", Desc)
-> ,(Iden "c", Asc)])
-
-> ,("sum(a) over (partition by b order by c)"
-> ,WindowApp "sum" [Iden "a"] [Iden "b"] [(Iden "c", Asc)])
-> -- todo: check order by options, add frames
-> ]
-
-> parens :: TestItem
-> parens = Group "parens" $ map (uncurry TestScalarExpr)
-> [("(a)", Parens (Iden "a"))
-> ,("(a + b)", Parens (BinOp (Iden "a") "+" (Iden "b")))
-> ]
-
-> queryExprParserTests :: TestItem
-> queryExprParserTests = Group "queryExprParserTests"
-> [duplicates
-> ,selectLists
-> ,from
-> ,whereClause
-> ,groupByClause
-> ,having
-> ,orderBy
-> ,limit
-> ,combos
-> ,withQueries
-> ,fullQueries
-> ]
-
-
-
-> duplicates :: TestItem
-> duplicates = Group "duplicates" $ map (uncurry TestQueryExpr)
-> [("select a from t" ,ms All)
-> ,("select all a from t" ,ms All)
-> ,("select distinct a from t", ms Distinct)
-> ]
-> where
-> ms d = makeSelect
-> {qeDuplicates = d
-> ,qeSelectList = [(Nothing,Iden "a")]
-> ,qeFrom = [TRSimple "t"]}
-
-> selectLists :: TestItem
-> selectLists = Group "selectLists" $ map (uncurry TestQueryExpr)
-> [("select 1",
-> makeSelect {qeSelectList = [(Nothing,NumLit "1")]})
-
-> ,("select a"
-> ,makeSelect {qeSelectList = [(Nothing,Iden "a")]})
-
-> ,("select a,b"
-> ,makeSelect {qeSelectList = [(Nothing,Iden "a")
-> ,(Nothing,Iden "b")]})
-
-> ,("select 1+2,3+4"
-> ,makeSelect {qeSelectList =
-> [(Nothing,BinOp (NumLit "1") "+" (NumLit "2"))
-> ,(Nothing,BinOp (NumLit "3") "+" (NumLit "4"))]})
-
-> ,("select a as a, /*comment*/ b as b"
-> ,makeSelect {qeSelectList = [(Just "a", Iden "a")
-> ,(Just "b", Iden "b")]})
-
-> ,("select a a, b b"
-> ,makeSelect {qeSelectList = [(Just "a", Iden "a")
-> ,(Just "b", Iden "b")]})
-> ]
-
-> from :: TestItem
-> from = Group "from" $ map (uncurry TestQueryExpr)
-> [("select a from t"
-> ,ms [TRSimple "t"])
-
-> ,("select a from t,u"
-> ,ms [TRSimple "t", TRSimple "u"])
-
-> ,("select a from t inner join u on expr"
-> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u")
-> (Just $ JoinOn $ Iden "expr")])
-
-> ,("select a from t left join u on expr"
-> ,ms [TRJoin (TRSimple "t") JLeft (TRSimple "u")
-> (Just $ JoinOn $ Iden "expr")])
-
-> ,("select a from t right join u on expr"
-> ,ms [TRJoin (TRSimple "t") JRight (TRSimple "u")
-> (Just $ JoinOn $ Iden "expr")])
-
-> ,("select a from t full join u on expr"
-> ,ms [TRJoin (TRSimple "t") JFull (TRSimple "u")
-> (Just $ JoinOn $ Iden "expr")])
-
-> ,("select a from t cross join u"
-> ,ms [TRJoin (TRSimple "t")
-> JCross (TRSimple "u") Nothing])
-
-> ,("select a from t natural inner join u"
-> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u")
-> (Just JoinNatural)])
-
-> ,("select a from t inner join u using(a,b)"
-> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u")
-> (Just $ JoinUsing ["a", "b"])])
-
-> ,("select a from (select a from t)"
-> ,ms [TRQueryExpr $ ms [TRSimple "t"]])
-
-> ,("select a from t as u"
-> ,ms [TRAlias (TRSimple "t") "u" Nothing])
-
-> ,("select a from t u"
-> ,ms [TRAlias (TRSimple "t") "u" Nothing])
-
-> ,("select a from t u(b)"
-> ,ms [TRAlias (TRSimple "t") "u" $ Just ["b"]])
-
-> ,("select a from (t cross join u) as u"
-> ,ms [TRAlias (TRParens $
-> TRJoin (TRSimple "t") JCross (TRSimple "u") Nothing)
-> "u" Nothing])
-> -- todo: not sure if the associativity is correct
-
-> ,("select a from t cross join u cross join v",
-> ms [TRJoin
-> (TRJoin (TRSimple "t")
-> JCross (TRSimple "u") Nothing)
-> JCross (TRSimple "v") Nothing])
-> ]
-> where
-> ms f = makeSelect {qeSelectList = [(Nothing,Iden "a")]
-> ,qeFrom = f}
-
-> whereClause :: TestItem
-> whereClause = Group "whereClause" $ map (uncurry TestQueryExpr)
-> [("select a from t where a = 5"
-> ,makeSelect {qeSelectList = [(Nothing,Iden "a")]
-> ,qeFrom = [TRSimple "t"]
-> ,qeWhere = Just $ BinOp (Iden "a") "=" (NumLit "5")})
-> ]
-
-> groupByClause :: TestItem
-> groupByClause = Group "groupByClause" $ map (uncurry TestQueryExpr)
-> [("select a,sum(b) from t group by a"
-> ,makeSelect {qeSelectList = [(Nothing, Iden "a")
-> ,(Nothing, App "sum" [Iden "b"])]
-> ,qeFrom = [TRSimple "t"]
-> ,qeGroupBy = [Iden "a"]
-> })
-
-> ,("select a,b,sum(c) from t group by a,b"
-> ,makeSelect {qeSelectList = [(Nothing, Iden "a")
-> ,(Nothing, Iden "b")
-> ,(Nothing, App "sum" [Iden "c"])]
-> ,qeFrom = [TRSimple "t"]
-> ,qeGroupBy = [Iden "a",Iden "b"]
-> })
-> ]
-
-> having :: TestItem
-> having = Group "having" $ map (uncurry TestQueryExpr)
-> [("select a,sum(b) from t group by a having sum(b) > 5"
-> ,makeSelect {qeSelectList = [(Nothing, Iden "a")
-> ,(Nothing, App "sum" [Iden "b"])]
-> ,qeFrom = [TRSimple "t"]
-> ,qeGroupBy = [Iden "a"]
-> ,qeHaving = Just $ BinOp (App "sum" [Iden "b"])
-> ">" (NumLit "5")
-> })
-> ]
-
-> orderBy :: TestItem
-> orderBy = Group "orderBy" $ map (uncurry TestQueryExpr)
-> [("select a from t order by a"
-> ,ms [(Iden "a", Asc)])
-
-> ,("select a from t order by a, b"
-> ,ms [(Iden "a", Asc), (Iden "b", Asc)])
-
-> ,("select a from t order by a asc"
-> ,ms [(Iden "a", Asc)])
-
-> ,("select a from t order by a desc, b desc"
-> ,ms [(Iden "a", Desc), (Iden "b", Desc)])
-> ]
-> where
-> ms o = makeSelect {qeSelectList = [(Nothing,Iden "a")]
-> ,qeFrom = [TRSimple "t"]
-> ,qeOrderBy = o}
-
-> limit :: TestItem
-> limit = Group "limit" $ map (uncurry TestQueryExpr)
-> [("select a from t limit 10"
-> ,ms (Just $ NumLit "10") Nothing)
-
-> ,("select a from t limit 10 offset 10"
-> ,ms (Just $ NumLit "10") (Just $ NumLit "10"))
-> ]
-> where
-> ms l o = makeSelect
-> {qeSelectList = [(Nothing,Iden "a")]
-> ,qeFrom = [TRSimple "t"]
-> ,qeLimit = l
-> ,qeOffset = o}
-
-> combos :: TestItem
-> combos = Group "combos" $ map (uncurry TestQueryExpr)
-> [("select a from t union select b from u"
-> ,CombineQueryExpr ms1 Union All Respectively ms2)
-
-> ,("select a from t intersect select b from u"
-> ,CombineQueryExpr ms1 Intersect All Respectively ms2)
-
-> ,("select a from t except all select b from u"
-> ,CombineQueryExpr ms1 Except All Respectively ms2)
-
-> ,("select a from t union distinct corresponding \
-> \select b from u"
-> ,CombineQueryExpr ms1 Union Distinct Corresponding ms2)
-
-> ,("select a from t union select a from t union select a from t"
-> -- is this the correct associativity?
-> ,CombineQueryExpr ms1 Union All Respectively
-> (CombineQueryExpr ms1 Union All Respectively ms1))
-> ]
-> where
-> ms1 = makeSelect
-> {qeSelectList = [(Nothing,Iden "a")]
-> ,qeFrom = [TRSimple "t"]}
-> ms2 = makeSelect
-> {qeSelectList = [(Nothing,Iden "b")]
-> ,qeFrom = [TRSimple "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 = [TRSimple 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"
-> ,makeSelect
-> {qeSelectList = [(Nothing, App "count" [Star])]
-> ,qeFrom = [TRSimple "t"]
-> }
-> )
-
-> ,("select a, sum(c+d) as s\n\
-> \ from t,u\n\
-> \ where a > 5\n\
-> \ group by a\n\
-> \ having count(1) > 5\n\
-> \ order by s"
-> ,makeSelect
-> {qeSelectList = [(Nothing, Iden "a")
-> ,(Just "s"
-> ,App "sum" [BinOp (Iden "c")
-> "+" (Iden "d")])]
-> ,qeFrom = [TRSimple "t", TRSimple "u"]
-> ,qeWhere = Just $ BinOp (Iden "a") ">" (NumLit "5")
-> ,qeGroupBy = [Iden "a"]
-> ,qeHaving = Just $ BinOp (App "count" [NumLit "1"])
-> ">" (NumLit "5")
-> ,qeOrderBy = [(Iden "s", Asc)]
-> }
-> )
-> ]
-
-> queryExprsParserTests :: TestItem
-> queryExprsParserTests = Group "query exprs" $ map (uncurry TestQueryExprs)
-> [("select 1",[ms])
-> ,("select 1;",[ms])
-> ,("select 1;select 1",[ms,ms])
-> ,(" select 1;select 1; ",[ms,ms])
-> ]
-> where
-> ms = makeSelect {qeSelectList = [(Nothing,NumLit "1")]}
-
-> tpchTests :: TestItem
-> tpchTests =
-> Group "parse tpch"
-> $ map (ParseQueryExpr . snd) tpchQueries
> testData :: TestItem
> testData =
> Group "parserTest"
-> [scalarExprParserTests
-> ,queryExprParserTests
-> ,queryExprsParserTests
+> [fullQueriesTests
+> ,miscTests
+> ,postgresTests
+> ,tableRefTests
+> ,scalarExprTests
> ,tpchTests
> ]
diff --git a/tools/Language/SQL/SimpleSQL/Tpch.lhs b/tools/Language/SQL/SimpleSQL/Tpch.lhs
new file mode 100644
index 0000000..662896c
--- /dev/null
+++ b/tools/Language/SQL/SimpleSQL/Tpch.lhs
@@ -0,0 +1,13 @@
+
+Some tests for parsing the tpch queries
+
+
+> module Language.SQL.SimpleSQL.Tpch (tpchTests) where
+
+> import Language.SQL.SimpleSQL.TestTypes
+> import Tpch
+
+> tpchTests :: TestItem
+> tpchTests =
+> Group "parse tpch"
+> $ map (ParseQueryExpr . snd) tpchQueries