From 56bb940f305fb3d32cc218a6dbc8fa1b1fd7ef89 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Mon, 7 Oct 2019 16:47:39 -0400
Subject: Update urlification of unit values for RPC results, to track a
 previous change elsewhere

---
 src/cjr_print.sml | 59 ++++++++++++++++++++++---------------------------------
 tests/rpc_unit.ur |  8 ++++++++
 2 files changed, 31 insertions(+), 36 deletions(-)
 create mode 100644 tests/rpc_unit.ur

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>
-- 
cgit v1.2.3