# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1236531247 14400
# Node ID 9da62680adc549244fb70015563d52fc1beb320b
# Parent  3ee6bb48f6e8c56b5df4496fc6790ab6e57809c5
RPC returning an option datatype

diff -r 3ee6bb48f6e8 -r 9da62680adc5 src/cjr_print.sml
--- a/src/cjr_print.sml	Sun Mar 08 12:37:42 2009 -0400
+++ b/src/cjr_print.sml	Sun Mar 08 12:54:07 2009 -0400
@@ -927,11 +927,14 @@
                     doEm xncs
                 end
 
-              | TDatatype (Option, i, xncs) => box []
-                (*if IS.member (rf, i) then
-                    box [string "unurlify_",
+              | TDatatype (Option, i, xncs) =>
+                if IS.member (rf, i) then
+                    box [string "urlify_",
                          string (Int.toString i),
-                         string "()"]
+                         string "(it",
+                         string (Int.toString level),
+                         string ");",
+                         newline]
                 else
                     let
                         val (x, _) = E.lookupDatatype env i
@@ -942,91 +945,64 @@
                                 (no_arg, has_arg, t)
                               | [(has_arg, _, SOME t), (no_arg, _, NONE)] =>
                                 (no_arg, has_arg, t)
-                              | _ => raise Fail "CjrPrint: unfooify misclassified Option datatype"
+                              | _ => raise Fail "CjrPrint: urlify misclassified Option datatype"
 
                         val rf = IS.add (rf, i)
                     in
                         box [string "({",
                              space,
+                             string "void",
+                             space,
+                             string "urlify_",
+                             string (Int.toString i),
+                             string "(",
                              p_typ env t,
                              space,
-                             string "*unurlify_",
-                             string (Int.toString i),
-                             string "(void) {",
+                             if isUnboxable t then
+                                 box []
+                             else
+                                 string "*",
+                             string "it0) {",
                              newline,
-                             box [string "return (request[0] == '/' ? ++request : request,",
-                                  newline,
-                                  string "((!strncmp(request, \"",
-                                  string no_arg,
-                                  string "\", ",
-                                  string (Int.toString (size no_arg)),
-                                  string ") && (request[",
-                                  string (Int.toString (size no_arg)),
-                                  string "] == 0 || request[",
-                                  string (Int.toString (size no_arg)),
-                                  string "] == '/')) ? (request",
-                                  space,
-                                  string "+=",
-                                  space,
-                                  string (Int.toString (size no_arg)),
-                                  string ", NULL) : ((!strncmp(request, \"",
-                                  string has_arg,
-                                  string "\", ",
-                                  string (Int.toString (size has_arg)),
-                                  string ") && (request[",
-                                  string (Int.toString (size has_arg)),
-                                  string "] == 0 || request[",
-                                  string (Int.toString (size has_arg)),
-                                  string "] == '/')) ? (request",
-                                  space,
-                                  string "+=",
-                                  space,
-                                  string (Int.toString (size has_arg)),
-                                  string ", (request[0] == '/' ? ++request : NULL), ",
-                                  newline,
-                                  
-                                  if isUnboxable  t then
-                                      unurlify' rf (#1 t)
+                             box [string "if (it0) {",
+                                  if isUnboxable t then
+                                      urlify' rf 0 t
                                   else
-                                      box [string "({",
-                                           newline,
-                                           p_typ env t,
+                                      box [p_typ env t,
                                            space,
-                                           string "*tmp",
+                                           string "it1",
                                            space,
                                            string "=",
                                            space,
-                                           string "uw_malloc(ctx, sizeof(",
-                                           p_typ env t,
-                                           string "));",
+                                           string "*it0;",
                                            newline,
-                                           string "*tmp",
-                                           space,
-                                           string "=",
-                                           space,
-                                           unurlify' rf (#1 t),
+                                           string "uw_write(ctx, \"",
+                                           string has_arg,
+                                           string "/\");",
+                                           newline,
+                                           urlify' rf 1 t,
                                            string ";",
-                                           newline,
-                                           string "tmp;",
-                                           newline,
-                                           string "})"],
-                                  string ")",
-                                  newline,
-                                  string ":",
-                                  space,
-                                  string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x
-                                          ^ "\"), NULL))));"),
+                                           newline],
+                                  string "} else {",
+                                  box [string "uw_write(ctx, \"",
+                                       string no_arg,
+                                       string "\");",
+                                       newline],
+                                  string "}",
                                   newline],
                              string "}",
                              newline,
                              newline,
 
-                             string "unurlify_",
+                             string "urlify_",
                              string (Int.toString i),
-                             string "();",
+                             string "(it",
+                             string (Int.toString level),
+                             string ");",
                              newline,
-                             string "})"]
-                    end*)
+                             string "});",
+                             newline]
+                    end
 
               | TDatatype (Default, i, _) => box []
                 (*if IS.member (rf, i) then
diff -r 3ee6bb48f6e8 -r 9da62680adc5 tests/rpcDO.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/rpcDO.ur	Sun Mar 08 12:54:07 2009 -0400
@@ -0,0 +1,25 @@
+datatype list t = Nil | Cons of t * list t
+
+table t : {A : int}
+
+fun main () : transaction page =
+    let
+        fun rows () =
+            query (SELECT * FROM t)
+            (fn r ls => return (Cons (r.T.A, ls)))
+            Nil
+
+        fun show ls =
+            case ls of
+                Nil => <xml/>
+              | Cons (x, ls') => <xml>{[x]}<br/>{show ls'}</xml>
+    in
+        s <- source Nil;
+        return <xml><body>
+          <button value="Get It On!"
+                  onclick={ls <- rows ();
+                           set s ls}/><br/>
+          <br/>
+          Current: <dyn signal={ls <- signal s; return (show ls)}/>
+        </body></xml>
+    end
diff -r 3ee6bb48f6e8 -r 9da62680adc5 tests/rpcDO.urp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/rpcDO.urp	Sun Mar 08 12:54:07 2009 -0400
@@ -0,0 +1,5 @@
+debug
+sql rpcDO.sql
+database dbname=rpcdo
+
+rpcDO