changeset 641:b98f547a6a45

RPC returning an option
author Adam Chlipala <adamc@hcoop.net>
date Sun, 08 Mar 2009 13:41:55 -0400
parents 63b0bcacd535
children 4a125bbc602d
files src/cjr_print.sml src/jscomp.sml tests/rpcO.ur tests/rpcO.urp
diffstat 4 files changed, 53 insertions(+), 29 deletions(-) [+]
line wrap: on
line diff
--- a/src/cjr_print.sml	Sun Mar 08 13:28:21 2009 -0400
+++ b/src/cjr_print.sml	Sun Mar 08 13:41:55 2009 -0400
@@ -1087,42 +1087,36 @@
                              newline]
                     end
 
-              | TOption t => box []
-                (*box [string "(request[0] == '/' ? ++request : request, ",
-                     string "((!strncmp(request, \"None\", 4) ",
-                     string "&& (request[4] == 0 || request[4] == '/')) ",
-                     string "? (request += 4, NULL) ",
-                     string ": ((!strncmp(request, \"Some\", 4) ",
-                     string "&& request[4] == '/') ",
-                     string "? (request += 5, ",
-                     if isUnboxable  t then
-                         unurlify' rf (#1 t)
+              | TOption t =>
+                box [string "if (it",
+                     string (Int.toString level),
+                     string ") {",
+                     if isUnboxable t then
+                         box [string "uw_write(ctx, \"Some/\");",
+                              newline,
+                              urlify' rf level t]
                      else
-                         box [string "({",
-                              newline,
-                              p_typ env t,
+                         box [p_typ env t,
                               space,
-                              string "*tmp",
+                              string "it",
+                              string (Int.toString (level + 1)),
                               space,
                               string "=",
                               space,
-                              string "uw_malloc(ctx, sizeof(",
-                              p_typ env t,
-                              string "));",
-                              newline,
-                              string "*tmp",
-                              space,
-                              string "=",
-                              space,
-                              unurlify' rf (#1 t),
+                              string "*it",
+                              string (Int.toString level),
                               string ";",
                               newline,
-                              string "tmp;",
+                              string "uw_write(ctx, \"Some/\");",
                               newline,
-                              string "})"],
-                     string ") :",
-                     space,
-                     string "(uw_error(ctx, FATAL, \"Error unurlifying option type\"), NULL))))"]*)
+                              urlify' rf (level + 1) t,
+                              string ";",
+                              newline],
+                     string "} else {",
+                     box [string "uw_write(ctx, \"None\");",
+                          newline],
+                     string "}",
+                     newline]
 
               | _ => (ErrorMsg.errorAt loc "Unable to choose a URL encoding function";
                       space)
--- a/src/jscomp.sml	Sun Mar 08 13:28:21 2009 -0400
+++ b/src/jscomp.sml	Sun Mar 08 13:41:55 2009 -0400
@@ -338,7 +338,7 @@
                                     @ ["}"]), st)
                 end
 
-              | TFfi ("Basis", "string") => ("decode(t[i++])", st)
+              | TFfi ("Basis", "string") => ("unescape(t[i++])", st)
               | TFfi ("Basis", "int") => ("parseInt(t[i++])", st)
               | TFfi ("Basis", "float") => ("parseFloat(t[i++])", st)
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/rpcO.ur	Sun Mar 08 13:41:55 2009 -0400
@@ -0,0 +1,25 @@
+table t : {A : int}
+
+fun main () : transaction page =
+    let
+        fun check () =
+            r <- oneRow (SELECT SUM(t.A) AS X FROM t);
+            return (if r.X < 0 then
+                        (Some 3, None)
+                    else
+                        (None, Some "Hi"))
+
+        fun show (t ::: Type) (_ : show t) (opt : option t) =
+            case opt of
+                None => <xml>None</xml>
+              | Some v => <xml>{[v]}</xml>
+    in
+        s <- source (None, None);
+        return <xml><body>
+          <button value="Get It On!"
+                  onclick={r <- check ();
+                           set s r}/><br/>
+          <br/>
+          Current: <dyn signal={p <- signal s; return <xml>{show p.1}, {show p.2}</xml>}/>
+        </body></xml>
+    end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/rpcO.urp	Sun Mar 08 13:41:55 2009 -0400
@@ -0,0 +1,5 @@
+debug
+sql rpcO.sql
+database dbname=rpco
+
+rpcO