summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2019-10-07 16:47:39 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2019-10-07 16:47:39 -0400
commit56bb940f305fb3d32cc218a6dbc8fa1b1fd7ef89 (patch)
treeb47f6daf74d0ebb7abdda4b78514527613ba21ae
parent39bfe4b44542852a656a3793d1f245bf31503b49 (diff)
Update urlification of unit values for RPC results, to track a previous change elsewhere
-rw-r--r--src/cjr_print.sml59
-rw-r--r--tests/rpc_unit.ur8
2 files changed, 31 insertions, 36 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 5dcfbe89..d7b8017e 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1014,52 +1014,39 @@ fun urlify env t =
let
fun urlify' level (t as (_, loc)) =
case #1 t of
- TFfi ("Basis", "unit") => box []
+ TFfi ("Basis", "unit") => box [string "uw_Basis_urlifyString_w(ctx, \"\");",
+ newline]
| TFfi (m, t) => box [string ("uw_" ^ ident m ^ "_urlify" ^ capitalize t
^ "_w(ctx, it" ^ Int.toString level ^ ");"),
newline]
- | TRecord 0 => box []
+ | TRecord 0 => box [string "uw_Basis_urlifyString_w(ctx, \"\");",
+ newline]
| TRecord i =>
let
- fun empty (t, _) =
- case t of
- TFfi ("Basis", "unit") => true
- | TRecord 0 => true
- | TRecord j =>
- List.all (fn (_, t) => empty t) (E.lookupStruct env j)
- | _ => false
-
val xts = E.lookupStruct env i
val (blocks, _) = foldl
(fn ((x, t), (blocks, printingSinceLastSlash)) =>
- let
- val thisEmpty = empty t
- in
- if thisEmpty then
- (blocks, printingSinceLastSlash)
- else
- (box [string "{",
- newline,
- p_typ env t,
- space,
- string ("it" ^ Int.toString (level + 1)),
- space,
- string "=",
- space,
- string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"),
- newline,
- box (if printingSinceLastSlash then
- [string "uw_write(ctx, \"/\");",
- newline]
- else
- []),
- urlify' (level + 1) t,
- string "}",
- newline] :: blocks,
- true)
- end)
+ (box [string "{",
+ newline,
+ p_typ env t,
+ space,
+ string ("it" ^ Int.toString (level + 1)),
+ space,
+ string "=",
+ space,
+ string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"),
+ newline,
+ box (if printingSinceLastSlash then
+ [string "uw_write(ctx, \"/\");",
+ newline]
+ else
+ []),
+ urlify' (level + 1) t,
+ string "}",
+ newline] :: blocks,
+ true))
([], false) xts
in
box (rev blocks)
diff --git a/tests/rpc_unit.ur b/tests/rpc_unit.ur
new file mode 100644
index 00000000..befd6045
--- /dev/null
+++ b/tests/rpc_unit.ur
@@ -0,0 +1,8 @@
+val callme = return ((), (), "A", (), ())
+
+val main : transaction page = return <xml><body>
+ <button value="CLICK ME"
+ onclick={fn _ =>
+ (_, _, s, _, _) <- rpc callme;
+ alert s}/>
+</body></xml>