Mercurial > urweb
changeset 1076:dcf98ae3c48d
Allow same constructor shorthand for 'view' sig items as for 'table'
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Tue, 15 Dec 2009 11:11:49 -0500 |
| parents | 0657e5adc938 |
| children | a3273bee05a9 |
| files | lib/ur/top.ur lib/ur/top.urs src/urweb.grm |
| diffstat | 3 files changed, 27 insertions(+), 5 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/ur/top.ur Tue Dec 15 10:19:05 2009 -0500 +++ b/lib/ur/top.ur Tue Dec 15 11:11:49 2009 -0500 @@ -224,6 +224,13 @@ (fn fs acc => return <xml>{acc}{f fs}</xml>) <xml/> +fun queryX1 [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}] + (q : sql_query [nm = fs] []) + (f : $fs -> xml ctx inp []) = + query q + (fn fs acc => return <xml>{acc}{f fs.nm}</xml>) + <xml/> + fun queryX' [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}] [tables ~ exps] (q : sql_query tables exps) (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) @@ -253,7 +260,7 @@ (fn fs _ => return (Some fs.nm)) None -fun oneOrNoRowsE1 [tab ::: Name] [nm ::: Name] [t ::: Type] [[tab] ~ [nm]] (q : sql_query [tab = []] [nm = t]) = +fun oneOrNoRowsE1 [tabs ::: {Unit}] [nm ::: Name] [t ::: Type] [tabs ~ [nm]] (q : sql_query (mapU [] tabs) [nm = t]) = query q (fn fs _ => return (Some fs.nm)) None @@ -265,6 +272,12 @@ None => error <xml>Query returned no rows</xml> | Some r => r) +fun oneRow1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [nm = fs] []) = + o <- oneOrNoRows q; + return (case o of + None => error <xml>Query returned no rows</xml> + | Some r => r.nm) + fun oneRowE1 [tabs ::: {Unit}] [nm ::: Name] [t ::: Type] [tabs ~ [nm]] (q : sql_query (mapU [] tabs) [nm = t]) = o <- oneOrNoRows q; return (case o of
--- a/lib/ur/top.urs Tue Dec 15 10:19:05 2009 -0500 +++ b/lib/ur/top.urs Tue Dec 15 11:11:49 2009 -0500 @@ -132,6 +132,11 @@ -> xml ctx inp []) -> transaction (xml ctx inp []) +val queryX1 : nm ::: Name -> fs ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type} + -> sql_query [nm = fs] [] + -> ($fs -> xml ctx inp []) + -> transaction (xml ctx inp []) + val queryX' : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type} -> [tables ~ exps] => sql_query tables exps @@ -156,9 +161,9 @@ -> sql_query [nm = fs] [] -> transaction (option $fs) -val oneOrNoRowsE1 : tab ::: Name -> nm ::: Name -> t ::: Type - -> [[tab] ~ [nm]] => - sql_query [tab = []] [nm = t] +val oneOrNoRowsE1 : tabs ::: {Unit} -> nm ::: Name -> t ::: Type + -> [tabs ~ [nm]] => + sql_query (mapU [] tabs) [nm = t] -> transaction (option t) val oneRow : tables ::: {{Type}} -> exps ::: {Type} @@ -168,6 +173,10 @@ $(exps ++ map (fn fields :: {Type} => $fields) tables) +val oneRow1 : nm ::: Name -> fs ::: {Type} + -> sql_query [nm = fs] [] + -> transaction $fs + val oneRowE1 : tabs ::: {Unit} -> nm ::: Name -> t ::: Type -> [tabs ~ [nm]] => sql_query (mapU [] tabs) [nm = t]
--- a/src/urweb.grm Tue Dec 15 10:19:05 2009 -0500 +++ b/src/urweb.grm Tue Dec 15 11:11:49 2009 -0500 @@ -703,7 +703,7 @@ | VIEW SYMBOL COLON cexp (let val loc = s (VIEWleft, cexpright) val t = (CVar (["Basis"], "sql_view"), loc) - val t = (CApp (t, cexp), loc) + val t = (CApp (t, entable cexp), loc) in (SgiVal (SYMBOL, t), loc) end)