Switch to using sql_from_items

7 files changed, 93 insertions, 37 deletions

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index cd2ca588..c6ba7b2c 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -220,18 +220,28 @@ val sql_subset : keep_drop :: {({Type} * {Type})}
                                      (map (fn fields :: ({Type} * {Type}) => fields.1) keep_drop)
 val sql_subset_all : tables :: {{Type}} -> sql_subset tables tables
 
-val sql_query1 : tables ::: {({Type} * {{Unit}})}
+con sql_from_items :: {{Type}} -> Type
+
+val sql_from_table : cols ::: {Type} -> keys ::: {{Unit}}
+                     -> name :: Name -> sql_table cols keys
+                     -> sql_from_items [name = cols]
+val sql_from_comma : tabs1 ::: {{Type}} -> tabs2 ::: {{Type}}
+                     -> [tabs1 ~ tabs2]
+    => sql_from_items tabs1 -> sql_from_items tabs2
+       -> sql_from_items (tabs1 ++ tabs2)
+
+val sql_query1 : tables ::: {{Type}}
                  -> grouped ::: {{Type}}
                  -> selectedFields ::: {{Type}}
                  -> selectedExps ::: {Type}
-                 -> {From : $(map (fn p :: ({Type} * {{Unit}}) => sql_table p.1 p.2) tables),
-                     Where : sql_exp (map (fn p :: ({Type} * {{Unit}}) => p.1) tables) [] [] bool,
-                     GroupBy : sql_subset (map (fn p :: ({Type} * {{Unit}}) => p.1) tables) grouped,
-                     Having : sql_exp grouped (map (fn p :: ({Type} * {{Unit}}) => p.1) tables) [] 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,
-                     SelectExps : $(map (sql_exp grouped (map (fn p :: ({Type} * {{Unit}}) => p.1) tables) [])
+                     SelectExps : $(map (sql_exp grouped tables [])
                                             selectedExps) }
-                 -> sql_query1 (map (fn p :: ({Type} * {{Unit}}) => p.1) tables) selectedFields selectedExps
+                 -> sql_query1 tables selectedFields selectedExps
 
 type sql_relop 
 val sql_union : sql_relop
diff --git a/src/monoize.sml b/src/monoize.sml
index 780f6923..8d8f07d4 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -151,6 +151,8 @@ fun monoType env =
                     (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query1"), _), _), _), _), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_from_items"), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CFfi ("Basis", "primary_key"), _), _), _), _) =>
@@ -1530,12 +1532,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val un = (L'.TRecord [], loc)
                 fun gf s = (L'.EField ((L'.ERel 0, loc), s), loc)
 
-                val tables = List.mapPartial
-                                 (fn (x, (L.CTuple [y, _], _)) => SOME (x, y)
-                                   | _ => (E.errorAt loc "Bad sql_query1 tables pair";
-                                           NONE))
-                             tables
-
                 fun doTables tables =
                     let
                         val tables = map (fn ((L.CName x, _), xts) =>
@@ -1568,7 +1564,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                         (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) sexps
                     in
                         ((L'.EAbs ("r",
-                                   (L'.TRecord [("From", (L'.TRecord (map (fn (x, _) => (x, s)) tables), loc)),
+                                   (L'.TRecord [("From", s),
                                                 ("Where", s),
                                                 ("GroupBy", un),
                                                 ("Having", s),
@@ -1588,8 +1584,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                                                sc (x ^ ".uw_" ^ x'))
                                                                            xts)) stables),
                                            sc " FROM ",
-                                           strcatComma (map (fn (x, _) => strcat [(L'.EField (gf "From", x), loc),
-                                                                                  sc (" AS " ^ x)]) tables),
+                                           gf "From",
                                            (L'.ECase (gf "Where",
                                                       [((L'.PPrim (Prim.String "TRUE"), loc),
                                                         sc ""),
@@ -1712,6 +1707,28 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
           | L.ECApp ((L.EFfi ("Basis", "sql_subset_all"), _), _) =>
             ((L'.ERecord [], loc), fm)
 
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_table"), _), _), _), _), _),
+                              (L.CName name, _)) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("tab", s, s,
+                           strcat [(L'.ERel 0, loc),
+                                   (L'.EPrim (Prim.String (" AS " ^ name)), loc)]), loc),
+                 fm)
+            end
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_comma"), _), _), _), _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("tab1", s, (L'.TFun (s, s), loc),
+                           (L'.EAbs ("tab2", s, s,
+                                     strcat [(L'.ERel 1, loc),
+                                             (L'.EPrim (Prim.String ", "), loc),
+                                             (L'.ERel 0, loc)]), loc)), loc),
+                 fm)
+            end
+
           | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) =>
             ((L'.EPrim (Prim.String ""), loc), fm)
           | L.ECApp (
diff --git a/src/urweb.grm b/src/urweb.grm
index be67ea7b..21030b4d 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -304,12 +304,13 @@ datatype attr = Class of exp | Normal of con * exp
 
  | query of exp
  | query1 of exp
- | tables of (con * exp) list
+ | tables of con list * exp
  | tname of con
  | tnameW of con * con
  | tnames of (con * con) * (con * con) list
  | tnames' of (con * con) * (con * con) list
  | table of con * exp
+ | table' of con * exp
  | tident of con
  | fident of con
  | seli of select_item
@@ -1356,15 +1357,15 @@ query1 : SELECT select FROM tables wopt gopt hopt
 
                                              val (sel, exps) =
                                                  case select of
-                                                     Star => (map (fn (nm, _) =>
+                                                     Star => (map (fn nm =>
                                                                       (nm, (CTuple [(CWild (KRecord (KType, loc), loc),
                                                                                      loc),
                                                                                     (CRecord [], loc)],
-                                                                            loc))) tables,
+                                                                            loc))) (#1 tables),
                                                               [])
                                                    | Items sis =>
                                                      let
-                                                         val tabs = map (fn (nm, _) => (nm, (CRecord [], loc))) tables
+                                                         val tabs = map (fn nm => (nm, (CRecord [], loc))) (#1 tables)
                                                          val (tabs, exps) = foldl (amend_select loc) (tabs, []) sis
                                                      in
                                                          (map (fn (nm, c) => (nm,
@@ -1383,8 +1384,8 @@ query1 : SELECT select FROM tables wopt gopt hopt
                                                                                    loc), loc)), loc)
                                                          | SOME gis =>
                                                            let
-                                                               val tabs = map (fn (nm, _) =>
-                                                                                  (nm, (CRecord [], loc))) tables
+                                                               val tabs = map (fn nm =>
+                                                                                  (nm, (CRecord [], loc))) (#1 tables)
                                                                val tabs = foldl (amend_group loc) tabs gis
 
                                                                val tabs = map (fn (nm, c) =>
@@ -1400,7 +1401,7 @@ query1 : SELECT select FROM tables wopt gopt hopt
 
                                              val e = (EVar (["Basis"], "sql_query1", Infer), loc)
                                              val re = (ERecord [((CName "From", loc),
-                                                                 (ERecord tables, loc)),
+                                                                 #2 tables),
                                                                 ((CName "Where", loc),
                                                                  wopt),
                                                                 ((CName "GroupBy", loc),
@@ -1421,8 +1422,16 @@ query1 : SELECT select FROM tables wopt gopt hopt
        | query1 INTERSECT query1        (sql_relop ("intersect", query11, query12, s (query11left, query12right)))
        | query1 EXCEPT query1           (sql_relop ("except", query11, query12, s (query11left, query12right)))
 
-tables : table                          ([table])
-       | table COMMA tables             (table :: tables)
+tables : table'                         ([#1 table'], #2 table')
+       | table' COMMA tables            (let
+                                             val loc = s (table'left, tablesright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_from_comma", Infer), loc)
+                                             val e = (EApp (e, #2 table'), loc)
+                                         in
+                                             (#1 table' :: #1 tables,
+                                              (EApp (e, #2 tables), loc))
+                                         end)
 
 tname  : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
        | LBRACE cexp RBRACE             (cexp)
@@ -1432,6 +1441,14 @@ table  : SYMBOL                         ((CName (capitalize SYMBOL), s (SYMBOLle
        | SYMBOL AS tname                (tname, (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)))
        | LBRACE LBRACE eexp RBRACE RBRACE AS tname    (tname, eexp)
 
+table' : table                          (let
+                                             val loc = s (tableleft, tableright)
+                                             val e = (EVar (["Basis"], "sql_from_table", Infer), loc)
+                                             val e = (ECApp (e, #1 table), loc)
+                                         in
+                                             (#1 table, (EApp (e, #2 table), loc))
+                                         end)
+
 tident : SYMBOL                         (CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright))
        | CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
        | LBRACE LBRACE cexp RBRACE RBRACE (cexp)
diff --git a/tests/join.ur b/tests/join.ur
new file mode 100644
index 00000000..a883e45f
--- /dev/null
+++ b/tests/join.ur
@@ -0,0 +1,6 @@
+table t : { A : int }
+
+fun main () =
+    r <- oneRow (SELECT * FROM t);
+    r <- oneRow (SELECT * FROM t AS T1, t AS T2);
+    return <xml/>
diff --git a/tests/join.urp b/tests/join.urp
new file mode 100644
index 00000000..2719ecc3
--- /dev/null
+++ b/tests/join.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=join
+sql join.sql
+
+join
diff --git a/tests/join.urs b/tests/join.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/join.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/query.ur b/tests/query.ur
index 334c3d41..5d6264c6 100644
--- a/tests/query.ur
+++ b/tests/query.ur
@@ -6,18 +6,18 @@ datatype list a = Nil | Cons of a * list a
 val q1 = (SELECT * FROM t1)
 
 val r1 : transaction (list {A : int, B : string, C : float, D : bool}) =
-        query q1
-        (fn fs acc => return (Cons (fs.T1, acc)))
-        Nil
+    query q1
+          (fn fs acc => return (Cons (fs.T1, acc)))
+          Nil
 
 val r2 : transaction string =
-        ls <- r1;
-        return (case ls of
-                    Nil => "Problem"
-                  | Cons ({B = b, ...}, _) => b)
+    ls <- r1;
+    return (case ls of
+                Nil => "Problem"
+              | Cons ({B = b, ...}, _) => b)
 
-val main : unit -> transaction page = fn () =>
-        s <- r2;
-        return <html><body>
-                {cdata s}
-        </body></html>
+fun main () : transaction page =
+    s <- r2;
+    return <xml><body>
+      {cdata s}
+    </body></xml>