RPC returning a default datatype

4 files changed, 109 insertions, 84 deletions

diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 630f9f7c..73024aa5 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1004,11 +1004,14 @@ fun urlify env t =
                              newline]
                     end
 
-              | TDatatype (Default, i, _) => box []
-                (*if IS.member (rf, i) then
-                    box [string "unurlify_",
+              | TDatatype (Default, i, _) =>
+                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, xncs) = E.lookupDatatype env i
@@ -1017,87 +1020,72 @@ fun urlify env t =
 
                         fun doEm xncs =
                             case xncs of
-                                [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype "
-                                              ^ x ^ "\"), NULL)")
+                                [] => box [string ("uw_error(ctx, FATAL, \"Error urlifying datatype "
+                                                   ^ x ^ " (%d)\", it0->data);"),
+                                           newline]
                               | (x', n, to) :: rest =>
-                                box [string "((!strncmp(request, \"",
-                                     string x',
-                                     string "\", ",
-                                     string (Int.toString (size x')),
-                                     string ") && (request[",
-                                     string (Int.toString (size x')),
-                                     string "] == 0 || request[",
-                                     string (Int.toString (size x')),
-                                     string "] == '/')) ? ({",
-                                     newline,
-                                     string "struct",
+                                box [string "if",
                                      space,
-                                     string ("__uwd_" ^ ident x ^ "_" ^ Int.toString i),
-                                     space,
-                                     string "*tmp = uw_malloc(ctx, sizeof(struct __uwd_",
-                                     string x,
+                                     string "(it0->tag==__uwc_",
+                                     string (ident x'),
                                      string "_",
-                                     string (Int.toString i),
-                                     string "));",
-                                     newline,
-                                     string "tmp->tag",
-                                     space,
-                                     string "=",
-                                     space,
-                                     string ("__uwc_" ^ ident x' ^ "_" ^ Int.toString n),
-                                     string ";",
-                                     newline,
-                                     string "request",
-                                     space,
-                                     string "+=",
-                                     space,
-                                     string (Int.toString (size x')),
-                                     string ";",
-                                     newline,
-                                     string "if (request[0] == '/') ++request;",
+                                     string (Int.toString n),
+                                     string ") {",
                                      newline,
                                      case to of
-                                         NONE => box []
-                                       | SOME (t, _) => box [string "tmp->data.uw_",
-                                                             p_ident x',
-                                                             space,
-                                                             string "=",
-                                                             space,
-                                                             unurlify' rf t,
-                                                             string ";",
-                                                             newline],
-                                     string "tmp;",
+                                         NONE => box [string "uw_write(ctx, \"",
+                                                      string x',
+                                                      string "\");",
+                                                      newline]
+                                       | SOME t => box [string "uw_write(ctx, \"",
+                                                        string x',
+                                                        string "/\");",
+                                                        newline,
+                                                        p_typ env t,
+                                                        space,
+                                                        string "it1",
+                                                        space,
+                                                        string "=",
+                                                        space,
+                                                        string "it0->data.uw_",
+                                                        string x',
+                                                        string ";",
+                                                        newline,
+                                                        urlify' rf 1 t,
+                                                        newline],
+                                     string "} else {",
                                      newline,
-                                     string "})",
-                                     space,
-                                     string ":",
-                                     space,
-                                     doEm rest,
-                                     string ")"]
+                                     box [doEm rest,
+                                          newline],
+                                     string "}",
+                                     newline]
                     in
                         box [string "({",
                              space,
-                             p_typ env (t, ErrorMsg.dummySpan),
+                             string "void",
                              space,
-                             string "unurlify_",
+                             string "urlify_",
                              string (Int.toString i),
-                             string "(void) {",
+                             string "(",
+                             p_typ env t,
+                             space,
+                             string "it0) {",
                              newline,
-                             box [string "return",
-                                  space,
-                                  doEm xncs,
-                                  string ";",
+                             box [doEm xncs,
                                   newline],
-                             string "}",
                              newline,
+                             string "}",
                              newline,
 
-                             string "unurlify_",
+                             string "urlify_",
                              string (Int.toString i),
-                             string "();",
+                             string "(it",
+                             string (Int.toString level),
+                             string ");",
                              newline,
-                             string "})"]
-                    end*)
+                             string "});",
+                             newline]
+                    end
 
               | TOption t => box []
                 (*box [string "(request[0] == '/' ? ++request : request, ",
@@ -1439,8 +1427,7 @@ fun p_exp' par env (e, loc) =
             val wontLeakStrings = notLeaky env true state
             val wontLeakAnything = notLeaky env false state
         in
-            box [string "(uw_begin_region(ctx), ",
-                 if wontLeakAnything then
+            box [if wontLeakAnything then
                      string "uw_begin_region(ctx), "
                  else
                      box [],
@@ -1448,6 +1435,18 @@ fun p_exp' par env (e, loc) =
                  newline,
                  string "PGconn *conn = uw_get_db(ctx);",
                  newline,
+                 p_typ env state,
+                 space,
+                 string "acc",
+                 space,
+                 string "=",
+                 space,
+                 p_exp env initial,
+                 string ";",
+                 newline,
+                 string "int n, i, dummy = (uw_begin_region(ctx), 0);",
+                 newline,
+                 
                  case prepared of
                      NONE => box [string "char *query = ",
                                   p_exp env query,
@@ -1481,17 +1480,7 @@ fun p_exp' par env (e, loc) =
                               newline,
                               newline]
                      end,
-                 string "int n, i;",
-                 newline,
-                 p_typ env state,
-                 space,
-                 string "acc",
-                 space,
-                 string "=",
-                 space,
-                 p_exp env initial,
-                 string ";",
-                 newline,
+
                  string "PGresult *res = ",
                  case prepared of
                      NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);"
@@ -1589,7 +1578,7 @@ fun p_exp' par env (e, loc) =
                      box [],
                  string "acc;",
                  newline,
-                 string "}))"]
+                 string "})"]
         end
 
       | EDml {dml, prepared} =>
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 16a82ec8..9d9ab36c 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -544,15 +544,20 @@ fun cjrize ds =
                                           let
                                               val (dop, pop, sm) = cifyDecl (d, sm)
 
+                                              val dsF = case dop of
+                                                            SOME (L'.DDatatype (dk, x, n, _), loc) =>
+                                                            (L'.DDatatypeForward (dk, x, n), loc) :: dsF
+                                                          | _ => dsF
+
+                                              val dsF = map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm)
+                                                        @ dsF
+
                                               val (dsF, ds) = case dop of
                                                                   NONE => (dsF, ds)
                                                                 | SOME (d as (L'.DDatatype _, loc)) =>
                                                                   (d :: dsF, ds)
                                                                 | SOME d => (dsF, d :: ds)
 
-                                              val dsF = map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm)
-                                                        @ dsF
-
                                               val ps = case pop of
                                                            NONE => ps
                                                          | SOME p => p :: ps
diff --git a/tests/rpcDD.ur b/tests/rpcDD.ur
new file mode 100644
index 00000000..13293b83
--- /dev/null
+++ b/tests/rpcDD.ur
@@ -0,0 +1,26 @@
+datatype list t = Nil | OtherNil | 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/>
+              | OtherNil => <xml>That's impossible!</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/rpcDD.urp b/tests/rpcDD.urp
new file mode 100644
index 00000000..118ea723
--- /dev/null
+++ b/tests/rpcDD.urp
@@ -0,0 +1,5 @@
+debug
+sql rpcDD.sql
+database dbname=rpcdd
+
+rpcDD