Tweaking SQL parsing and typing

6 files changed, 33 insertions, 12 deletions

diff --git a/CHANGELOG b/CHANGELOG
index 36267b96..15e92fd5 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -3,6 +3,9 @@ Next
 ========
 
 - 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 --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 545e65aa..4b53659d 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -320,12 +320,14 @@ val sql_query1 : tables ::: {{Type}}
                  -> 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 --git a/src/monoize.sml b/src/monoize.sml
index 0a1990c7..f3c8b5f6 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1772,11 +1772,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             (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 --git a/src/urweb.grm b/src/urweb.grm
index 2251dde7..da40945a 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1169,6 +1169,7 @@ eterm  : LPAREN eexp RPAREN             (#1 eexp, s (LPARENleft, RPARENright))
        | 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 @@ query1 : SELECT dopt select FROM tables wopt gopt hopt
                                         (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 @@ query1 : SELECT dopt select FROM tables wopt gopt hopt
                                                      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 @@ query1 : SELECT dopt select FROM tables wopt gopt hopt
                                                            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 : SELECT dopt select FROM tables wopt gopt hopt
        | 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 --git a/tests/relops.ur b/tests/relops.ur
index b876c482..77a352dc 100644
--- a/tests/relops.ur
+++ b/tests/relops.ur
@@ -25,6 +25,6 @@ val r2 : transaction string =
 
 val main : unit -> transaction page = fn () =>
         s <- r2;
-        return <html><body>
+        return <xml><body>
                 {cdata s}
-        </body></html>
+        </body></xml>
diff --git a/tests/relops.urp b/tests/relops.urp
new file mode 100644
index 00000000..5d0cae77
--- /dev/null
+++ b/tests/relops.urp
@@ -0,0 +1,4 @@
+debug
+database dbname=test
+
+relops