Mercurial > urweb
changeset 748:5f9b9972e6b8
Switch to using sql_from_items
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Tue, 28 Apr 2009 09:45:17 -0400 |
| parents | e42f08f96eb5 |
| children | 16bfd9e244cd |
| files | lib/ur/basis.urs src/monoize.sml src/urweb.grm tests/join.ur tests/join.urp tests/join.urs tests/query.ur |
| diffstat | 7 files changed, 93 insertions(+), 37 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/ur/basis.urs Sun Apr 26 12:47:53 2009 -0400 +++ b/lib/ur/basis.urs Tue Apr 28 09:45:17 2009 -0400 @@ -220,18 +220,28 @@ (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
--- a/src/monoize.sml Sun Apr 26 12:47:53 2009 -0400 +++ b/src/monoize.sml Tue Apr 28 09:45:17 2009 -0400 @@ -151,6 +151,8 @@ (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 @@ 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 @@ (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 @@ 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 @@ | 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 (
--- a/src/urweb.grm Sun Apr 26 12:47:53 2009 -0400 +++ b/src/urweb.grm Tue Apr 28 09:45:17 2009 -0400 @@ -304,12 +304,13 @@ | 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 @@ 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 @@ 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 @@ 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 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 @@ | 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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/join.ur Tue Apr 28 09:45:17 2009 -0400 @@ -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/>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/join.urp Tue Apr 28 09:45:17 2009 -0400 @@ -0,0 +1,5 @@ +debug +database dbname=join +sql join.sql + +join
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/join.urs Tue Apr 28 09:45:17 2009 -0400 @@ -0,0 +1,1 @@ +val main : unit -> transaction page
--- a/tests/query.ur Sun Apr 26 12:47:53 2009 -0400 +++ b/tests/query.ur Tue Apr 28 09:45:17 2009 -0400 @@ -6,18 +6,18 @@ 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>