summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/cjr_print.sml110
-rw-r--r--tests/rpcDO.ur25
-rw-r--r--tests/rpcDO.urp5
3 files changed, 73 insertions, 67 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 8b15af4d..630f9f7c 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -927,11 +927,14 @@ fun urlify env t =
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 @@ fun urlify env t =
(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,
- p_typ env t,
+ string "void",
space,
- string "*unurlify_",
+ string "urlify_",
string (Int.toString i),
- string "(void) {",
+ string "(",
+ p_typ env t,
+ space,
+ 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 ";",
- newline,
- string "tmp;",
+ string "uw_write(ctx, \"",
+ string has_arg,
+ string "/\");",
newline,
- string "})"],
- string ")",
- newline,
- string ":",
- space,
- string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x
- ^ "\"), NULL))));"),
+ urlify' rf 1 t,
+ string ";",
+ 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 --git a/tests/rpcDO.ur b/tests/rpcDO.ur
new file mode 100644
index 00000000..4ba6015c
--- /dev/null
+++ b/tests/rpcDO.ur
@@ -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 --git a/tests/rpcDO.urp b/tests/rpcDO.urp
new file mode 100644
index 00000000..7d9bb6a6
--- /dev/null
+++ b/tests/rpcDO.urp
@@ -0,0 +1,5 @@
+debug
+sql rpcDO.sql
+database dbname=rpcdo
+
+rpcDO