summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/ur/basis.urs24
-rw-r--r--src/monoize.sml35
-rw-r--r--src/urweb.grm35
-rw-r--r--tests/join.ur6
-rw-r--r--tests/join.urp5
-rw-r--r--tests/join.urs1
-rw-r--r--tests/query.ur24
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>
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-24 22:55:23 +0000