summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/ur/basis.urs3
-rw-r--r--src/monoize.sml17
-rw-r--r--src/urweb.grm8
-rw-r--r--tests/subquery.ur13
4 files changed, 37 insertions, 4 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 98390555..c75eea1b 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -295,6 +295,9 @@ con sql_from_items :: {{Type}} -> {{Type}} -> Type
val sql_from_table : free ::: {{Type}} -> t ::: Type -> fs ::: {Type}
-> fieldsOf t fs -> name :: Name
-> t -> sql_from_items free [name = fs]
+val sql_from_query : free ::: {{Type}} -> fs ::: {Type} -> name :: Name
+ -> sql_query free [] fs
+ -> sql_from_items free [name = fs]
val sql_from_comma : free ::: {{Type}} -> tabs1 ::: {{Type}} -> tabs2 ::: {{Type}}
-> [tabs1 ~ tabs2]
=> sql_from_items free tabs1 -> sql_from_items free tabs2
diff --git a/src/monoize.sml b/src/monoize.sml
index 9e5e1b38..5aebad63 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1882,7 +1882,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
strcatComma (map (fn (x, t) =>
strcat [
(L'.EField (gf "SelectExps", x), loc),
- sc (" AS _" ^ x)
+ sc (" AS uw_" ^ x)
]) sexps
@ map (fn (x, xts) =>
strcatComma
@@ -2059,6 +2059,19 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.EPrim (Prim.String (" AS T_" ^ name)), loc)]), loc),
fm)
end
+ | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_query"), _), _),
+ _), _), _),
+ (L.CName name, _)) =>
+ let
+ val s = (L'.TFfi ("Basis", "string"), loc)
+ fun sc s = (L'.EPrim (Prim.String s), loc)
+ in
+ ((L'.EAbs ("q", s, s,
+ strcat [sc "(",
+ (L'.ERel 0, loc),
+ sc (") AS T_" ^ name)]), loc),
+ fm)
+ end
| L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_comma"), _), _), _), _), _), _) =>
let
val s = (L'.TFfi ("Basis", "string"), loc)
@@ -2317,7 +2330,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_), _),
_), _),
_), _),
- (L.CName nm, _)) => ((L'.EPrim (Prim.String ("_" ^ lowercaseFirst nm)), loc), fm)
+ (L.CName nm, _)) => ((L'.EPrim (Prim.String ("uw_" ^ lowercaseFirst nm)), loc), fm)
| L.ECApp (
(L.ECApp (
diff --git a/src/urweb.grm b/src/urweb.grm
index f11c3cd5..995d4664 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1629,6 +1629,14 @@ fitem : table' ([#1 table'], #2 table')
(#1 fitem1 @ #1 fitem2,
(EApp (e, sqlexp), loc))
end)
+ | LPAREN query RPAREN AS tname (let
+ val loc = s (LPARENleft, RPARENright)
+
+ val e = (EVar (["Basis"], "sql_from_query", Infer), loc)
+ val e = (ECApp (e, tname), loc)
+ in
+ ([tname], (EApp (e, query), loc))
+ end)
tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
| LBRACE cexp RBRACE (cexp)
diff --git a/tests/subquery.ur b/tests/subquery.ur
index 302175e5..b7881817 100644
--- a/tests/subquery.ur
+++ b/tests/subquery.ur
@@ -6,5 +6,14 @@ fun main () =
WHERE t.B = (SELECT MAX(U.B) AS M
FROM t AS U
WHERE U.A = t.A))
- (fn r => <xml>{[r.A]},{[r.C]};</xml>);
- return <xml>{v}</xml>
+ (fn r => <xml>{[r.A]},{[r.C]};</xml>);
+ v' <- queryX1 (SELECT t.A, t.C
+ FROM (SELECT t.A AS A, MAX(t.B) AS B
+ FROM t
+ GROUP BY t.A) AS Maxes
+ JOIN t ON t.A = Maxes.A AND t.B = Maxes.B)
+ (fn r => <xml>{[r.A]},{[r.C]};</xml>);
+ return <xml><body>
+ {v}<br/>
+ {v'}
+ </body></xml>