# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1240763745 14400
# Node ID 2c7244c066f1cd1eee24412e52a0005aad90627c
# Parent  ee2feab275dbf51e489d33f8984cb02cda83647c
sql_ufunc and octet_length

diff -r ee2feab275db -r 2c7244c066f1 lib/ur/basis.urs
--- 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 *)
 
diff -r ee2feab275db -r 2c7244c066f1 src/monoize.sml
--- 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 (
diff -r ee2feab275db -r 2c7244c066f1 src/urweb.grm
--- 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))
diff -r ee2feab275db -r 2c7244c066f1 tests/blob.ur
--- 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}