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