Mercurial > urweb

changeset 746:2c7244c066f1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sql_ufunc and octet_length
author Adam Chlipala <adamc@hcoop.net>
date Sun, 26 Apr 2009 12:35:45 -0400
parents ee2feab275db
children e42f08f96eb5
files lib/ur/basis.urs src/monoize.sml src/urweb.grm tests/blob.ur
diffstat 4 files changed, 48 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- a/lib/ur/basis.urs	Sun Apr 26 11:07:25 2009 -0400
+++ b/lib/ur/basis.urs	Sun Apr 26 12:35:45 2009 -0400
@@ -363,6 +363,13 @@
                 -> 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 *)
 
--- a/src/monoize.sml	Sun Apr 26 11:07:25 2009 -0400
+++ b/src/monoize.sml	Sun Apr 26 12:35:45 2009 -0400
@@ -201,6 +201,8 @@
                     (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 @@
             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 (
--- a/src/urweb.grm	Sun Apr 26 11:07:25 2009 -0400
+++ b/src/urweb.grm	Sun Apr 26 12:35:45 2009 -0400
@@ -329,6 +329,7 @@
  | ofopt of exp
  | sqlint of exp
  | sqlagg of string
+ | fname of exp
 
  | texp of exp
  | fields of con list
@@ -1536,6 +1537,17 @@
                                          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))
--- a/tests/blob.ur	Sun Apr 26 11:07:25 2009 -0400
+++ b/tests/blob.ur	Sun Apr 26 12:35:45 2009 -0400
@@ -12,8 +12,8 @@
     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}