RPC returning an enumeration

4 files changed, 126 insertions, 96 deletions

diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index c1911c8d..8b15af4d 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -501,25 +501,32 @@ fun p_ensql t e =
 
 fun notLeaky env allowHeapAllocated =
     let
-        fun nl (t, _) =
+        fun nl ok (t, _) =
             case t of
                 TFun _ => false
               | TRecord n =>
                 let
                     val xts = E.lookupStruct env n
                 in
-                    List.all (fn (_, t) => nl t) xts
+                    List.all (fn (_, t) => nl ok t) xts
                 end
-              | TDatatype (dk, _, ref cons) =>
-                (allowHeapAllocated orelse dk = Enum)
-                andalso List.all (fn (_, _, to) => case to of
-                                                       NONE => true
-                                                     | SOME t => nl t) cons
+              | TDatatype (dk, n, ref cons) =>
+                IS.member (ok, n)
+                orelse
+                ((allowHeapAllocated orelse dk = Enum)
+                 andalso
+                 let
+                     val ok' = IS.add (ok, n)
+                 in
+                     List.all (fn (_, _, to) => case to of
+                                                    NONE => true
+                                                  | SOME t => nl ok' t) cons
+                 end)
               | TFfi ("Basis", "string") => false
               | TFfi _ => true
-              | TOption t => allowHeapAllocated andalso nl t
+              | TOption t => allowHeapAllocated andalso nl ok t
     in
-        nl
+        nl IS.empty
     end
 
 fun capitalize s =
@@ -896,33 +903,29 @@ fun urlify env t =
                     box (rev blocks)
                 end
 
-              | TDatatype (Enum, i, _) => box []
-                (*let
+              | TDatatype (Enum, i, _) =>
+                let
                     val (x, xncs) = E.lookupDatatype env i
 
                     fun doEm xncs =
                         case xncs of
-                            [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype "
-                                          ^ x ^ "\"), (enum __uwe_"
-                                          ^ x ^ "_" ^ Int.toString i ^ ")0)")
+                            [] => box [string ("uw_error(ctx, FATAL, \"Error urlifying datatype "
+                                               ^ x ^ "\");"),
+                                       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 ("] == '/')) ? __uwc_" ^ ident x' ^ "_" ^ Int.toString n),
-                                 space,
-                                 string ":",
-                                 space,
-                                 doEm rest,
-                                 string ")"]
+                            box [string ("if (it" ^ Int.toString level
+                                         ^ "==__uwc_" ^ ident x' ^ "_" ^ Int.toString n ^ ") {"),
+                                 newline,
+                                 box [string ("uw_write(ctx, \"" ^ x' ^ "\");"),
+                                      newline],
+                                 string "} else {",
+                                 newline,
+                                 box [doEm rest,
+                                      newline],
+                                 string "}"]
                 in
                     doEm xncs
-                end*)
+                end
 
               | TDatatype (Option, i, xncs) => box []
                 (*if IS.member (rf, i) then
@@ -1453,7 +1456,7 @@ fun p_exp' par env (e, loc) =
             val tables = ListUtil.mapConcat (fn (x, xts) =>
                                                 map (fn (x', t) => ("__uwf_" ^ ident x ^ ".__uwf_" ^ ident x', t)) xts)
                                             tables
-                                                                                              
+
             val outputs = exps @ tables
             val outputs = ListMergeSort.sort (fn ((s1, _), (s2, _)) => String.compare (s1, s2) = GREATER) outputs
 
@@ -1837,9 +1840,9 @@ fun p_fun env (fx, n, args, ran, e) =
              space,
              string "{",
              newline,
-             box[string "return(",
-                 p_exp env' e,
-                 string ");"],
+             box [string "return(",
+                  p_exp env' e,
+                  string ");"],
              newline,
              string "}"]
     end
@@ -2164,8 +2167,8 @@ fun is_not_null t =
 fun p_file env (ds, ps) =
     let
         val (pds, env) = ListUtil.foldlMap (fn (d, env) =>
-                                             (p_decl env d,
-                                              E.declBinds env d))
+                                               (p_decl env d,
+                                                E.declBinds env d))
                              env ds
 
         val fields = foldl (fn ((ek, _, _, ts, _), fields) =>
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 383a9f6f..1a85bba2 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -64,6 +64,7 @@ type state = {
      script : string list,
      included : IS.set,
      injectors : int IM.map,
+     decoders : int IM.map,
      maxName : int
 }
 
@@ -251,13 +252,12 @@ fun process file =
                      SOME n' => ((EApp ((ENamed n', loc), e), loc), st)
                    | NONE =>
                      let
-                         val dk = ElabUtil.classifyDatatype cs
-
                          val n' = #maxName st
                          val st = {decls = #decls st,
                                    script = #script st,
                                    included = #included st,
                                    injectors = IM.insert (#injectors st, n, n'),
+                                   decoders = #decoders st,
                                    maxName = n' + 1}
 
                          val (pes, st) = ListUtil.foldlMap
@@ -275,7 +275,7 @@ fun process file =
                                                        case dk of
                                                            Option =>
                                                            if isNullable t then
-                                                               strcat loc [str loc "{_v:",
+                                                               strcat loc [str loc "{v:",
                                                                            e,
                                                                            str loc "}"]
                                                            else
@@ -298,6 +298,7 @@ fun process file =
                                    script = #script st,
                                    included = #included st,
                                    injectors = #injectors st,
+                                   decoders= #decoders st,
                                    maxName = #maxName st}
                      in
                          ((EApp ((ENamed n', loc), e), loc), st)
@@ -321,13 +322,13 @@ fun process file =
                 let
                     val (e', st) = unurlifyExp loc (t, st)
                     val (es, st) = ListUtil.foldlMap
-                                   (fn ((x, t), st) =>
-                                       let
-                                           val (e, st) = unurlifyExp loc (t, st)
-                                       in
-                                           (",_" ^ x ^ ":" ^ e, st)
-                                       end)
-                                   st xts
+                                       (fn ((x, t), st) =>
+                                           let
+                                               val (e, st) = unurlifyExp loc (t, st)
+                                           in
+                                               (",_" ^ x ^ ":" ^ e, st)
+                                           end)
+                                       st xts
                 in
                     (String.concat ("{_"
                                     :: x
@@ -343,79 +344,66 @@ fun process file =
 
               | TFfi ("Basis", "bool") => ("t[i++] == \"True\"", st)
 
-              | TOption t => raise Fail "!!" (*
+              | TOption t =>
                 let
-                    val (e', st) = quoteExp loc t ((ERel 0, loc), st)
+                    val (e, st) = unurlifyExp loc (t, st)
+                    val e = if isNullable t then
+                                "{v:" ^ e ^ "}"
+                            else
+                                e
                 in
-                    ((ECase (e,
-                             [((PNone t, loc),
-                               str loc "null"),
-                              ((PSome (t, (PVar ("x", t), loc)), loc),
-                               if isNullable t then
-                                   strcat loc [str loc "{v:", e', str loc "}"]
-                               else
-                                   e')],
-                             {disc = (TOption t, loc),
-                              result = (TFfi ("Basis", "string"), loc)}), loc),
-                     st)
-                end*)
+                    ("(uu=t[i++],uu==\"Some\"?" ^ e ^ ":null)", st)
+                end
 
-              | TDatatype (n, ref (dk, cs)) => raise Fail "!!" (*
-                (case IM.find (#injectors st, n) of
-                     SOME n' => ((EApp ((ENamed n', loc), e), loc), st)
+              | TDatatype (n, ref (dk, cs)) =>
+                (case IM.find (#decoders st, n) of
+                     SOME n' => ("(tmp=_n" ^ Int.toString n' ^ "(t,i),i=tmp._1,tmp._2)", st)
                    | NONE =>
                      let
-                         val dk = ElabUtil.classifyDatatype cs
-
                          val n' = #maxName st
                          val st = {decls = #decls st,
                                    script = #script st,
                                    included = #included st,
-                                   injectors = IM.insert (#injectors st, n, n'),
+                                   injectors = #injectors st,
+                                   decoders = IM.insert (#decoders st, n, n'),
                                    maxName = n' + 1}
 
-                         val (pes, st) = ListUtil.foldlMap
-                                             (fn ((_, cn, NONE), st) =>
-                                                 (((PCon (dk, PConVar cn, NONE), loc),
-                                                   case dk of
-                                                       Option => str loc "null"
-                                                     | _ => str loc (Int.toString cn)),
+                         val (e, st) = foldl (fn ((x, cn, NONE), (e, st)) =>
+                                                 ("x==\"" ^ x ^ "\"?"
+                                                   ^ (case dk of
+                                                          Option => "null"
+                                                        | _ => Int.toString cn)
+                                                  ^ ":" ^ e,
                                                   st)
-                                               | ((_, cn, SOME t), st) =>
+                                               | ((x, cn, SOME t), (e, st)) =>
                                                  let
-                                                     val (e, st) = quoteExp loc t ((ERel 0, loc), st)
+                                                     val (e', st) = unurlifyExp loc (t, st)
                                                  in
-                                                     (((PCon (dk, PConVar cn, SOME (PVar ("x", t), loc)), loc),
-                                                       case dk of
-                                                           Option =>
-                                                           if isNullable t then
-                                                               strcat loc [str loc "{_v:",
-                                                                           e,
-                                                                           str loc "}"]
-                                                           else
-                                                               e
-                                                         | _ => strcat loc [str loc ("{n:" ^ Int.toString cn
-                                                                                     ^ ",v:"),
-                                                                            e,
-                                                                            str loc "}"]),
+                                                     ("x==\"" ^ x ^ "\"?"
+                                                       ^ (case dk of
+                                                              Option =>
+                                                              if isNullable t then
+                                                                  "{v:" ^ e' ^ "}"
+                                                              else
+                                                                  e'
+                                                            | _ => "{n:" ^ Int.toString cn ^ ",v:" ^ e' ^ "}")
+                                                      ^ ":" ^ e,
                                                       st)
                                                  end)
-                                             st cs
+                                             ("pf()", st) cs
 
-                         val s = (TFfi ("Basis", "string"), loc)
-                         val body = (ECase ((ERel 0, loc), pes,
-                                            {disc = t, result = s}), loc)
-                         val body = (EAbs ("x", t, s, body), loc)
+                         val body = "function _n" ^ Int.toString n' ^ "(t,i){var x=t[i++];var r="
+                                    ^ e ^ ";return {_1:i,_2:r}}\n\n"
 
-                         val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc),
-                                                      body, "jsify")], loc) :: #decls st,
-                                   script = #script st,
+                         val st = {decls = #decls st,
+                                   script = body :: #script st,
                                    included = #included st,
                                    injectors = #injectors st,
+                                   decoders = #decoders st,
                                    maxName = #maxName st}
                      in
-                         ((EApp ((ENamed n', loc), e), loc), st)
-                     end)*)
+                         ("(tmp=_n" ^ Int.toString n' ^ "(t,i),i=tmp._1,tmp._2)", st)
+                     end)
 
               | _ => (EM.errorAt loc "Don't know how to unurlify type in JavaScript";
                       Print.prefaces "Can't unurlify" [("t", MonoPrint.p_typ MonoEnv.empty t)];
@@ -602,6 +590,7 @@ fun process file =
                                                           script = #script st,
                                                           included = IS.add (#included st, n),
                                                           injectors = #injectors st,
+                                                          decoders = #decoders st,
                                                           maxName = #maxName st}
 
                                                 val (e, st) = jsExp mode skip [] 0 (e, st)
@@ -613,6 +602,7 @@ fun process file =
                                                  script = sc :: #script st,
                                                  included = #included st,
                                                  injectors = #injectors st,
+                                                 decoders= #decoders st,
                                                  maxName = #maxName st}
                                             end
                             in
@@ -986,6 +976,7 @@ fun process file =
                   script = #script st,
                   included = #included st,
                   injectors = #injectors st,
+                  decoders = #decoders st,
                   maxName = #maxName st})
             end
 
@@ -994,6 +985,7 @@ fun process file =
                         script = [],
                         included = IS.empty,
                         injectors = IM.empty,
+                        decoders = IM.empty,
                         maxName = U.File.maxName file + 1}
                        file
 
diff --git a/tests/rpcDE.ur b/tests/rpcDE.ur
new file mode 100644
index 00000000..64e190f5
--- /dev/null
+++ b/tests/rpcDE.ur
@@ -0,0 +1,30 @@
+datatype result = Neg | Zero | Pos
+
+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
+                        Neg
+                    else if r.X = 0 then
+                        Zero
+                    else
+                        Pos)
+
+        fun show r =
+            case r of
+                Neg => <xml>-</xml>
+              | Zero => <xml>0</xml>
+              | Pos => <xml>+</xml>
+    in
+        s <- source Zero;
+        return <xml><body>
+          <button value="Get It On!"
+                  onclick={r <- check ();
+                           set s r}/><br/>
+          <br/>
+          Current: <dyn signal={r <- signal s; return (show r)}/>
+        </body></xml>
+    end
diff --git a/tests/rpcDE.urp b/tests/rpcDE.urp
new file mode 100644
index 00000000..2027ff85
--- /dev/null
+++ b/tests/rpcDE.urp
@@ -0,0 +1,5 @@
+debug
+sql rpcDE.sql
+database dbname=rpcde
+
+rpcDE