summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-12-13 10:13:06 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-12-13 10:13:06 -0500
commite376aee8f22ca46b5536803fc3d80e31f79da6ff (patch)
treeb8dfbb24caa3bc4cf3cf683e44a9ab92c4dc9e34
parent0a168e5f39165bd9e462813866c9a25dc2d6b688 (diff)
Tweaking SQL parsing and typing
-rw-r--r--CHANGELOG3
-rw-r--r--lib/ur/basis.urs6
-rw-r--r--src/monoize.sml12
-rw-r--r--src/urweb.grm16
-rw-r--r--tests/relops.ur4
-rw-r--r--tests/relops.urp4
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