diff options
| -rw-r--r-- | lib/ur/basis.urs | 7 | ||||
| -rw-r--r-- | src/monoize.sml | 27 | ||||
| -rw-r--r-- | src/urweb.grm | 12 | ||||
| -rw-r--r-- | tests/blob.ur | 4 |
4 files changed, 48 insertions, 2 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 46218932..cd2ca588 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -363,6 +363,13 @@ val sql_nfunc : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> sql_nfunc t -> sql_exp tables agg exps t val sql_current_timestamp : sql_nfunc time +con sql_ufunc :: Type -> Type -> Type +val sql_ufunc : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} + -> dom ::: Type -> ran ::: Type + -> sql_ufunc dom ran -> sql_exp tables agg exps dom + -> sql_exp tables agg exps ran +val sql_octet_length : sql_ufunc blob int + (*** Executing queries *) diff --git a/src/monoize.sml b/src/monoize.sml index 90440807..780f6923 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -201,6 +201,8 @@ fun monoType env = (L'.TRecord [], loc) | L.CApp ((L.CFfi ("Basis", "sql_nfunc"), _), _) => (L'.TFfi ("Basis", "string"), loc) + | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_ufunc"), _), _), _), _) => + (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CFfi ("Basis", "channel"), _), _) => (L'.TFfi ("Basis", "channel"), loc) @@ -1990,6 +1992,31 @@ fun monoExp (env, st, fm) (all as (e, loc)) = end | L.EFfi ("Basis", "sql_current_timestamp") => ((L'.EPrim (Prim.String "CURRENT_TIMESTAMP"), loc), fm) + | L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.EFfi ("Basis", "sql_ufunc"), _), + _), _), + _), _), + _), _), + _), _), + _) => + let + val s = (L'.TFfi ("Basis", "string"), loc) + fun sc s = (L'.EPrim (Prim.String s), loc) + in + ((L'.EAbs ("f", s, (L'.TFun (s, s), loc), + (L'.EAbs ("x", s, s, + strcat [(L'.ERel 1, loc), + sc "(", + (L'.ERel 0, loc), + sc ")"]), loc)), loc), + fm) + end + | L.EFfi ("Basis", "sql_octet_length") => ((L'.EPrim (Prim.String "octet_length"), loc), fm) + | (L.ECApp ( (L.ECApp ( (L.ECApp ( diff --git a/src/urweb.grm b/src/urweb.grm index 50d0c803..be67ea7b 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -329,6 +329,7 @@ datatype attr = Class of exp | Normal of con * exp | ofopt of exp | sqlint of exp | sqlagg of string + | fname of exp | texp of exp | fields of con list @@ -1536,6 +1537,17 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In in (EApp (e, sqlexp), loc) end) + | fname LPAREN sqlexp RPAREN (let + val loc = s (fnameleft, RPARENright) + + val e = (EVar (["Basis"], "sql_ufunc", Infer), loc) + val e = (EApp (e, fname), loc) + in + (EApp (e, sqlexp), loc) + end) + +fname : SYMBOL (EVar (["Basis"], "sql_" ^ SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)) + | LBRACE eexp RBRACE (eexp) wopt : (sql_inject (EVar (["Basis"], "True", Infer), dummy)) diff --git a/tests/blob.ur b/tests/blob.ur index 82a631b9..4c368a86 100644 --- a/tests/blob.ur +++ b/tests/blob.ur @@ -12,8 +12,8 @@ fun save r = main () and main () = - ls <- queryX (SELECT t.Id, t.Desc, t.Data FROM t ORDER BY t.Desc) - (fn r => <xml><li><a link={view r.T.Id}>{[r.T.Desc]} ({[blobSize r.T.Data]})</a></li></xml>); + ls <- queryX (SELECT t.Id, t.Desc, octet_length(t.Data) AS Len FROM t ORDER BY t.Desc) + (fn r => <xml><li><a link={view r.T.Id}>{[r.T.Desc]} ({[r.Len]})</a></li></xml>); return <xml><body> {ls} |