# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1260717186 18000
# Node ID e933297c4e241b44aab496eb2dc79d50e2fd1d5d
# Parent  757397bb960990911b7ec303fd8734566d4f8a6d
Tweaking SQL parsing and typing

diff -r 757397bb9609 -r e933297c4e24 CHANGELOG
--- a/CHANGELOG	Sat Dec 12 14:51:10 2009 -0500
+++ b/CHANGELOG	Sun Dec 13 10:13:06 2009 -0500
@@ -3,6 +3,9 @@
 ========
 
 - Reifying expressions as URLs and redirecting to them explicitly
+- More syntactic sugar for SQL
+- Typing of SQL queries no longer exposes which tables were used in joins but
+  had none of their fields projected
 
 ========
 20091203
diff -r 757397bb9609 -r e933297c4e24 lib/ur/basis.urs
--- a/lib/ur/basis.urs	Sat Dec 12 14:51:10 2009 -0500
+++ b/lib/ur/basis.urs	Sun Dec 13 10:13:06 2009 -0500
@@ -320,12 +320,14 @@
                  -> grouped ::: {{Type}}
                  -> selectedFields ::: {{Type}}
                  -> selectedExps ::: {Type}
-                 -> {Distinct : bool,
+                 -> empties :: {Unit}
+                 -> [empties ~ selectedFields]
+                 => {Distinct : bool,
                      From : sql_from_items tables,
                      Where : sql_exp tables [] [] bool,
                      GroupBy : sql_subset tables grouped,
                      Having : sql_exp grouped tables [] bool,
-                     SelectFields : sql_subset grouped selectedFields,
+                     SelectFields : sql_subset grouped (map (fn _ => []) empties ++ selectedFields),
                      SelectExps : $(map (sql_exp grouped tables [])
                                             selectedExps) }
                  -> sql_query1 tables selectedFields selectedExps
diff -r 757397bb9609 -r e933297c4e24 src/monoize.sml
--- a/src/monoize.sml	Sat Dec 12 14:51:10 2009 -0500
+++ b/src/monoize.sml	Sun Dec 13 10:13:06 2009 -0500
@@ -1772,11 +1772,13 @@
             (L.ECApp (
              (L.ECApp (
               (L.ECApp (
-               (L.EFfi ("Basis", "sql_query1"), _),
-               (L.CRecord (_, tables), _)), _),
-              (L.CRecord (_, grouped), _)), _),
-             (L.CRecord (_, stables), _)), _),
-            sexps) =>
+               (L.ECApp (
+                (L.EFfi ("Basis", "sql_query1"), _),
+                (L.CRecord (_, tables), _)), _),
+               (L.CRecord (_, grouped), _)), _),
+              (L.CRecord (_, stables), _)), _),
+             sexps), _),
+            _) =>
             let
                 fun sc s = (L'.EPrim (Prim.String s), loc)
                 val s = (L'.TFfi ("Basis", "string"), loc)
diff -r 757397bb9609 -r e933297c4e24 src/urweb.grm
--- a/src/urweb.grm	Sat Dec 12 14:51:10 2009 -0500
+++ b/src/urweb.grm	Sun Dec 13 10:13:06 2009 -0500
@@ -1169,6 +1169,7 @@
        | LPAREN query RPAREN            (query)
        | LPAREN CWHERE sqlexp RPAREN    (sqlexp)
        | LPAREN SQL sqlexp RPAREN       (sqlexp)
+       | LPAREN FROM tables RPAREN      (#2 tables)
 
        | LPAREN INSERT INTO texp LPAREN fields RPAREN VALUES LPAREN sqlexps RPAREN RPAREN
                                         (let
@@ -1449,9 +1450,10 @@
                                         (let
                                              val loc = s (SELECTleft, tablesright)
 
-                                             val (sel, exps) =
+                                             val (empties, sel, exps) =
                                                  case select of
-                                                     Star => (map (fn nm =>
+                                                     Star => ([],
+                                                              map (fn nm =>
                                                                       (nm, (CTuple [(CWild (KRecord (KType, loc), loc),
                                                                                      loc),
                                                                                     (CRecord [], loc)],
@@ -1461,8 +1463,12 @@
                                                      let
                                                          val tabs = map (fn nm => (nm, (CRecord [], loc))) (#1 tables)
                                                          val (tabs, exps) = foldl (amend_select loc) (tabs, []) sis
+                                                         val empties = List.mapPartial (fn (nm, (CRecord [], _)) =>
+                                                                                           SOME nm
+                                                                                         | _ => NONE) tabs
                                                      in
-                                                         (map (fn (nm, c) => (nm,
+                                                         (empties,
+                                                          map (fn (nm, c) => (nm,
                                                                               (CTuple [c,
                                                                                        (CWild (KRecord (KType, loc), loc),
                                                                                         loc)], loc))) tabs,
@@ -1494,6 +1500,9 @@
                                                            end
 
                                              val e = (EVar (["Basis"], "sql_query1", Infer), loc)
+                                             val e = (ECApp (e, (CRecord (map (fn nm => (nm, (CUnit, loc))) empties),
+                                                                 loc)), loc)
+                                             val e = (EDisjointApp e, loc)
                                              val re = (ERecord [((CName "Distinct", loc),
                                                                  dopt),
                                                                 ((CName "From", loc),
@@ -1517,6 +1526,7 @@
        | query1 UNION query1            (sql_relop ("union", query11, query12, s (query11left, query12right)))
        | query1 INTERSECT query1        (sql_relop ("intersect", query11, query12, s (query11left, query12right)))
        | query1 EXCEPT query1           (sql_relop ("except", query11, query12, s (query11left, query12right)))
+       | LBRACE LBRACE LBRACE eexp RBRACE RBRACE RBRACE (eexp)
 
 tables : fitem                          (fitem)
        | fitem COMMA tables             (let
diff -r 757397bb9609 -r e933297c4e24 tests/relops.ur
--- a/tests/relops.ur	Sat Dec 12 14:51:10 2009 -0500
+++ b/tests/relops.ur	Sun Dec 13 10:13:06 2009 -0500
@@ -25,6 +25,6 @@
 
 val main : unit -> transaction page = fn () =>
         s <- r2;
-        return <html><body>
+        return <xml><body>
                 {cdata s}
-        </body></html>
+        </body></xml>
diff -r 757397bb9609 -r e933297c4e24 tests/relops.urp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/relops.urp	Sun Dec 13 10:13:06 2009 -0500
@@ -0,0 +1,4 @@
+debug
+database dbname=test
+
+relops