diff options
| -rw-r--r-- | CHANGELOG | 3 | ||||
| -rw-r--r-- | lib/ur/basis.urs | 6 | ||||
| -rw-r--r-- | src/monoize.sml | 12 | ||||
| -rw-r--r-- | src/urweb.grm | 16 | ||||
| -rw-r--r-- | tests/relops.ur | 4 | ||||
| -rw-r--r-- | tests/relops.urp | 4 |
6 files changed, 33 insertions, 12 deletions
@@ -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 |