ppx: drop special encoding of enum like variants

Fixes #25

ppx/browser/ppx_deriving_json_js.ml

@@ -101,48 +101,28 @@ module Of_json = struct
 
   let derive_of_variant _derive t body x =
     let loc = t.vrt_loc in
-    let is_enum =
-      List.for_all t.vrt_cases ~f:(function
-        | Vcs_enum _ -> true
-        | _ -> false)
-    in
-    match is_enum with
-    | true ->
-        [%expr
-          let tag =
-            Ppx_deriving_json_runtime.Primitives.string_of_json [%e x]
-          in
-          [%e body]]
-    | false ->
-        [%expr
-          if Js.Array.isArray [%e x] then
-            let array = (Obj.magic [%e x] : Js.Json.t array) in
-            let len = Js.Array.length array in
-            if Stdlib.( > ) len 0 then
-              let tag = Js.Array.unsafe_get array 0 in
-              if Stdlib.( = ) (Js.typeof tag) "string" then
-                let tag = (Obj.magic tag : string) in
-                [%e body]
-              else
-                Ppx_deriving_json_runtime.of_json_error
-                  "expected a non empty JSON array with element being a \
-                   string"
-            else
-              Ppx_deriving_json_runtime.of_json_error
-                "expected a non empty JSON array"
+    [%expr
+      if Js.Array.isArray [%e x] then
+        let array = (Obj.magic [%e x] : Js.Json.t array) in
+        let len = Js.Array.length array in
+        if Stdlib.( > ) len 0 then
+          let tag = Js.Array.unsafe_get array 0 in
+          if Stdlib.( = ) (Js.typeof tag) "string" then
+            let tag = (Obj.magic tag : string) in
+            [%e body]
           else
             Ppx_deriving_json_runtime.of_json_error
-              "expected a non empty JSON array"]
+              "expected a non empty JSON array with element being a \
+               string"
+        else
+          Ppx_deriving_json_runtime.of_json_error
+            "expected a non empty JSON array"
+      else
+        Ppx_deriving_json_runtime.of_json_error
+          "expected a non empty JSON array"]
 
   let derive_of_variant_case derive make c next =
     match c with
-    | Vcs_enum (n, ctx) ->
-        let loc = n.loc in
-        let n = Option.value ~default:n (vcs_attr_json_as ctx) in
-        [%expr
-          if Stdlib.( = ) tag [%e estring ~loc:n.loc n.txt] then
-            [%e make None]
-          else [%e next]]
     | Vcs_record (n, r) ->
         let loc = n.loc in
         let n = Option.value ~default:n (vcs_attr_json_as r.rcd_ctx) in
@@ -211,11 +191,6 @@ module To_json = struct
 
   let derive_of_variant_case derive c es =
     match c with
-    | Vcs_enum (n, ctx) ->
-        let loc = n.loc in
-        let n = Option.value ~default:n (vcs_attr_json_as ctx) in
-        let tag = [%expr string_to_json [%e estring ~loc:n.loc n.txt]] in
-        as_json ~loc tag
     | Vcs_record (n, r) ->
         let loc = n.loc in
         let n = Option.value ~default:n (vcs_attr_json_as r.rcd_ctx) in

ppx/native/ppx_deriving_json_native.ml

@@ -133,10 +133,6 @@ module Of_json = struct
 
   let derive_of_variant_case derive make vcs =
     match vcs with
-    | Vcs_enum (n, ctx) ->
-        let loc = n.loc in
-        let n = Option.value ~default:n (vcs_attr_json_as ctx) in
-        [%pat? `String [%p pstring ~loc:n.loc n.txt]] --> make None
     | Vcs_tuple (n, t) ->
         let loc = n.loc in
         let n = Option.value ~default:n (vcs_attr_json_as t.tpl_ctx) in
@@ -212,10 +208,6 @@ module To_json = struct
 
   let derive_of_variant_case derive vcs es =
     match vcs with
-    | Vcs_enum (n, ctx) ->
-        let loc = n.loc in
-        let n = Option.value ~default:n (vcs_attr_json_as ctx) in
-        [%expr `String [%e estring ~loc:n.loc n.txt]]
     | Vcs_tuple (n, t) ->
         let loc = n.loc in
         let n = Option.value ~default:n (vcs_attr_json_as t.tpl_ctx) in

ppx/test/example.ml

@@ -19,7 +19,7 @@ type allow_extra_fields = {a: int} [@@deriving json] [@@json.allow_extra_fields]
 type allow_extra_fields2 = A of {a: int} [@json.allow_extra_fields] [@@deriving json]
 type drop_default_option = { a: int; b_opt: int option; [@option] [@json.drop_default] } [@@deriving json]
 
-module Cases = struct 
+module Cases = struct
   type json = Ppx_deriving_json_runtime.t
   type of_json = C : string * (json -> 'a) * ('a -> json) * 'a -> of_json
   let of_json_cases = [
@@ -40,10 +40,6 @@ module Cases = struct
     C ({|["B", 42]|}, poly_of_json, poly_to_json, (`B 42 : poly));
     C ({|["Fix",["Fix",["Fix",["A"]]]]|}, recur_of_json, recur_to_json, (Fix (Fix (Fix A))));
     C ({|["Fix",["Fix",["Fix",["A"]]]]|}, polyrecur_of_json, polyrecur_to_json, (`Fix (`Fix (`Fix `A))));
-    C ({|"A"|}, evar_of_json, evar_to_json, (A : evar));
-    C ({|"b_aliased"|}, evar_of_json, evar_to_json, (B : evar)); (* variant B repr as "b_aliased" in JSON *)
-    C ({|"b"|}, epoly_of_json, epoly_to_json, (`b : epoly));
-    C ({|"A_aliased"|}, epoly_of_json, epoly_to_json, (`a : epoly)); (* polyvariant `a aliased to "A_aliased"*)
     C ({|{"my_name":"N","my_age":1}|}, record_aliased_of_json, record_aliased_to_json, {name="N"; age=1});
     C ({|{"my_name":"N"}|}, record_aliased_of_json, record_aliased_to_json, {name="N"; age=100});
     C ({|{}|}, record_opt_of_json, record_opt_to_json, {k=None});
@@ -66,4 +62,3 @@ module Cases = struct
   let run ~json_of_string ~json_to_string () =
     List.iter (run' ~json_of_string ~json_to_string) of_json_cases
 end
-

ppx/test/ppx_deriving_json_js.e2e.t

@@ -60,14 +60,6 @@
   JSON REPRINT: ["Fix",["Fix",["Fix",["A"]]]]
   JSON    DATA: ["Fix",["Fix",["Fix",["A"]]]]
   JSON REPRINT: ["Fix",["Fix",["Fix",["A"]]]]
-  JSON    DATA: "A"
-  JSON REPRINT: "A"
-  JSON    DATA: "b_aliased"
-  JSON REPRINT: "b_aliased"
-  JSON    DATA: "b"
-  JSON REPRINT: "b"
-  JSON    DATA: "A_aliased"
-  JSON REPRINT: "A_aliased"
   JSON    DATA: {"my_name":"N","my_age":1}
   JSON REPRINT: {"my_name":"N","my_age":1}
   JSON    DATA: {"my_name":"N"}

ppx/test/ppx_deriving_json_js.t

@@ -387,8 +387,29 @@
   
     let rec other_of_json_poly =
       (fun x ->
-         let tag = Ppx_deriving_json_runtime.Primitives.string_of_json x in
-         if Stdlib.( = ) tag "C" then Some `C else None
+         if Js.Array.isArray x then
+           let array = (Obj.magic x : Js.Json.t array) in
+           let len = Js.Array.length array in
+           if Stdlib.( > ) len 0 then
+             let tag = Js.Array.unsafe_get array 0 in
+             if Stdlib.( = ) (Js.typeof tag) "string" then
+               let tag = (Obj.magic tag : string) in
+               if Stdlib.( = ) tag "C" then (
+                 if Stdlib.( <> ) len 1 then
+                   Ppx_deriving_json_runtime.of_json_error
+                     "expected a JSON array of length 1";
+                 Some `C)
+               else None
+             else
+               Ppx_deriving_json_runtime.of_json_error
+                 "expected a non empty JSON array with element being a \
+                  string"
+           else
+             Ppx_deriving_json_runtime.of_json_error
+               "expected a non empty JSON array"
+         else
+           Ppx_deriving_json_runtime.of_json_error
+             "expected a non empty JSON array"
         : Js.Json.t -> other option)
   
     and other_of_json =
@@ -405,7 +426,8 @@
   
     let rec other_to_json =
       (fun x ->
-         match x with `C -> (Obj.magic (string_to_json "C") : Js.Json.t)
+         match x with
+         | `C -> (Obj.magic [| string_to_json "C" |] : Js.Json.t)
         : other -> Js.Json.t)
   
     let _ = other_to_json
@@ -670,10 +692,34 @@
   
     let rec evar_of_json =
       (fun x ->
-         let tag = Ppx_deriving_json_runtime.Primitives.string_of_json x in
-         if Stdlib.( = ) tag "A" then A
-         else if Stdlib.( = ) tag "b_aliased" then B
-         else Ppx_deriving_json_runtime.of_json_error "invalid JSON"
+         if Js.Array.isArray x then
+           let array = (Obj.magic x : Js.Json.t array) in
+           let len = Js.Array.length array in
+           if Stdlib.( > ) len 0 then
+             let tag = Js.Array.unsafe_get array 0 in
+             if Stdlib.( = ) (Js.typeof tag) "string" then
+               let tag = (Obj.magic tag : string) in
+               if Stdlib.( = ) tag "A" then (
+                 if Stdlib.( <> ) len 1 then
+                   Ppx_deriving_json_runtime.of_json_error
+                     "expected a JSON array of length 1";
+                 A)
+               else if Stdlib.( = ) tag "b_aliased" then (
+                 if Stdlib.( <> ) len 1 then
+                   Ppx_deriving_json_runtime.of_json_error
+                     "expected a JSON array of length 1";
+                 B)
+               else Ppx_deriving_json_runtime.of_json_error "invalid JSON"
+             else
+               Ppx_deriving_json_runtime.of_json_error
+                 "expected a non empty JSON array with element being a \
+                  string"
+           else
+             Ppx_deriving_json_runtime.of_json_error
+               "expected a non empty JSON array"
+         else
+           Ppx_deriving_json_runtime.of_json_error
+             "expected a non empty JSON array"
         : Js.Json.t -> evar)
   
     let _ = evar_of_json
@@ -683,8 +729,8 @@
     let rec evar_to_json =
       (fun x ->
          match x with
-         | A -> (Obj.magic (string_to_json "A") : Js.Json.t)
-         | B -> (Obj.magic (string_to_json "b_aliased") : Js.Json.t)
+         | A -> (Obj.magic [| string_to_json "A" |] : Js.Json.t)
+         | B -> (Obj.magic [| string_to_json "b_aliased" |] : Js.Json.t)
         : evar -> Js.Json.t)
   
     let _ = evar_to_json
@@ -702,10 +748,34 @@
   
     let rec epoly_of_json_poly =
       (fun x ->
-         let tag = Ppx_deriving_json_runtime.Primitives.string_of_json x in
-         if Stdlib.( = ) tag "A_aliased" then Some `a
-         else if Stdlib.( = ) tag "b" then Some `b
-         else None
+         if Js.Array.isArray x then
+           let array = (Obj.magic x : Js.Json.t array) in
+           let len = Js.Array.length array in
+           if Stdlib.( > ) len 0 then
+             let tag = Js.Array.unsafe_get array 0 in
+             if Stdlib.( = ) (Js.typeof tag) "string" then
+               let tag = (Obj.magic tag : string) in
+               if Stdlib.( = ) tag "A_aliased" then (
+                 if Stdlib.( <> ) len 1 then
+                   Ppx_deriving_json_runtime.of_json_error
+                     "expected a JSON array of length 1";
+                 Some `a)
+               else if Stdlib.( = ) tag "b" then (
+                 if Stdlib.( <> ) len 1 then
+                   Ppx_deriving_json_runtime.of_json_error
+                     "expected a JSON array of length 1";
+                 Some `b)
+               else None
+             else
+               Ppx_deriving_json_runtime.of_json_error
+                 "expected a non empty JSON array with element being a \
+                  string"
+           else
+             Ppx_deriving_json_runtime.of_json_error
+               "expected a non empty JSON array"
+         else
+           Ppx_deriving_json_runtime.of_json_error
+             "expected a non empty JSON array"
         : Js.Json.t -> epoly option)
   
     and epoly_of_json =
@@ -723,8 +793,8 @@
     let rec epoly_to_json =
       (fun x ->
          match x with
-         | `a -> (Obj.magic (string_to_json "A_aliased") : Js.Json.t)
-         | `b -> (Obj.magic (string_to_json "b") : Js.Json.t)
+         | `a -> (Obj.magic [| string_to_json "A_aliased" |] : Js.Json.t)
+         | `b -> (Obj.magic [| string_to_json "b" |] : Js.Json.t)
         : epoly -> Js.Json.t)
   
     let _ = epoly_to_json

ppx/test/ppx_deriving_json_native.e2e.t

@@ -52,14 +52,6 @@
   JSON REPRINT: ["Fix",["Fix",["Fix",["A"]]]]
   JSON    DATA: ["Fix",["Fix",["Fix",["A"]]]]
   JSON REPRINT: ["Fix",["Fix",["Fix",["A"]]]]
-  JSON    DATA: "A"
-  JSON REPRINT: "A"
-  JSON    DATA: "b_aliased"
-  JSON REPRINT: "b_aliased"
-  JSON    DATA: "b"
-  JSON REPRINT: "b"
-  JSON    DATA: "A_aliased"
-  JSON REPRINT: "A_aliased"
   JSON    DATA: {"my_name":"N","my_age":1}
   JSON REPRINT: {"my_name":"N","my_age":1}
   JSON    DATA: {"my_name":"N"}

ppx/test/ppx_deriving_json_native.t

@@ -372,7 +372,8 @@
     [@@@ocaml.warning "-39-11-27"]
 
     let rec other_of_json_poly =
-      (fun x -> match x with `String "C" -> Some `C | x -> None
+      (fun x ->
+         match x with `List (`String "C" :: []) -> Some `C | x -> None
         : Yojson.Basic.t -> other option)
 
     and other_of_json =
@@ -388,7 +389,8 @@
     [@@@ocaml.warning "-39-11-27"]
 
     let rec other_to_json =
-      (fun x -> match x with `C -> `String "C" : other -> Yojson.Basic.t)
+      (fun x -> match x with `C -> `List [ `String "C" ]
+        : other -> Yojson.Basic.t)
 
     let _ = other_to_json
   end [@@ocaml.doc "@inline"] [@@merlin.hide]
@@ -553,8 +555,8 @@
     let rec evar_of_json =
       (fun x ->
          match x with
-         | `String "A" -> A
-         | `String "b_aliased" -> B
+         | `List (`String "A" :: []) -> A
+         | `List (`String "b_aliased" :: []) -> B
          | _ -> Ppx_deriving_json_runtime.of_json_error "invalid JSON"
         : Yojson.Basic.t -> evar)
 
@@ -563,7 +565,10 @@
     [@@@ocaml.warning "-39-11-27"]
 
     let rec evar_to_json =
-      (fun x -> match x with A -> `String "A" | B -> `String "b_aliased"
+      (fun x ->
+         match x with
+         | A -> `List [ `String "A" ]
+         | B -> `List [ `String "b_aliased" ]
         : evar -> Yojson.Basic.t)
 
     let _ = evar_to_json
@@ -582,8 +587,8 @@
     let rec epoly_of_json_poly =
       (fun x ->
          match x with
-         | `String "A_aliased" -> Some `a
-         | `String "b" -> Some `b
+         | `List (`String "A_aliased" :: []) -> Some `a
+         | `List (`String "b" :: []) -> Some `b
          | x -> None
         : Yojson.Basic.t -> epoly option)
 
@@ -600,7 +605,10 @@
     [@@@ocaml.warning "-39-11-27"]
 
     let rec epoly_to_json =
-      (fun x -> match x with `a -> `String "A_aliased" | `b -> `String "b"
+      (fun x ->
+         match x with
+         | `a -> `List [ `String "A_aliased" ]
+         | `b -> `List [ `String "b" ]
         : epoly -> Yojson.Basic.t)
 
     let _ = epoly_to_json