rearrange the test code and add some notes on postgres

TODO

@@ -1,85 +1,100 @@
 
 next release:
-quoted identifiers: implement as a dot operator
+lateral since it is easy. I think it is effectively just a prefix
-review tests to copy from hssqlppp
+   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?
+review tests to copy from hssqlppp
-row ctor
+
-more symbolic operators, array access a[5]?
-review abstract syntax (e.g. combine App with SpecialOp?)
-more dots
 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
+demo: convert tpch to sql server syntax exe processor
-review internal sql collection for more syntax/tests
+
-run through postgres docs and add example sql as tests
+----
+
+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?

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

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)]
+>       }
+>      )
+>     ]

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")]}

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';
+

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")))
+>     ]

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}

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)
+

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]
+> import Language.SQL.SimpleSQL.TestTypes
->               | TestScalarExpr String ScalarExpr
->               | TestQueryExpr String QueryExpr
->               | TestQueryExprs String [QueryExpr]
->               | ParseQueryExpr String
->                 deriving (Eq,Show)
 
-> scalarExprParserTests :: TestItem
+> import Language.SQL.SimpleSQL.FullQueries
-> scalarExprParserTests = Group "scalarExprParserTests"
+> import Language.SQL.SimpleSQL.Misc
->     [literals
+> import Language.SQL.SimpleSQL.Postgres
->     ,identifiers
+> import Language.SQL.SimpleSQL.TableRefs
->     ,star
+> import Language.SQL.SimpleSQL.ScalarExprs
->     ,app
+> import Language.SQL.SimpleSQL.Tpch
->     ,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")))
->     ]
-
-> 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
+>     [fullQueriesTests
->     ,queryExprParserTests
+>     ,miscTests
->     ,queryExprsParserTests
+>     ,postgresTests
+>     ,tableRefTests
+>     ,scalarExprTests
 >     ,tpchTests
 >     ]
 

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