Annotate generated code with types to disambiguate OCaml classic variants

CHANGES.md

@@ -1,3 +1,7 @@
+2.12.0 (xxxx-xx-xx)
+
+* atdgen: Annotate generated code with types to disambiguate OCaml classic variants (#331)
+
 2.11.0 (2023-02-08)
 -------------------
 

atdgen/src/oj_emit.ml

@@ -287,8 +287,13 @@ let rec make_writer ?type_constraint p (x : Oj_mapping.t) : Indent.t list =
           )
         ]
       in
+      let xval =
+        match type_constraint with
+        | Some x -> sprintf "(x : %s)" x
+        | None -> "x"
+      in
       let standard_writer = [
-        Annot ("fun", Line "fun ob x ->");
+        Annot ("fun", Line (sprintf "fun ob %s ->" xval));
         Block body
       ] in
       let adapter = j.json_sum_adapter in

atdgen/test/bucklescript/bucklespec_j.expected.ml

@@ -371,7 +371,7 @@ and read_recurse = (
 and recurse_of_string s =
   read_recurse (Yojson.Safe.init_lexer ()) (Lexing.from_string s)
 let write_variant2 : _ -> variant2 -> _ = (
-  fun ob x ->
+  fun ob (x : variant2) ->
     match x with
       | A -> Buffer.add_string ob "\"A\""
       | C -> Buffer.add_string ob "\"C\""
@@ -415,7 +415,7 @@ let read_variant2 = (
 let variant2_of_string s =
   read_variant2 (Yojson.Safe.init_lexer ()) (Lexing.from_string s)
 let write_variant1 : _ -> variant1 -> _ = (
-  fun ob x ->
+  fun ob (x : variant1) ->
     match x with
       | A x ->
         Buffer.add_string ob "[\"A\",";
@@ -490,7 +490,7 @@ let read_valid = (
 let valid_of_string s =
   read_valid (Yojson.Safe.init_lexer ()) (Lexing.from_string s)
 let write_v2 : _ -> v2 -> _ = (
-  fun ob x ->
+  fun ob (x : v2) ->
     match x with
       | V1_foo x ->
         Buffer.add_string ob "[\"V1_foo\",";
@@ -572,7 +572,7 @@ let read_v2 = (
 let v2_of_string s =
   read_v2 (Yojson.Safe.init_lexer ()) (Lexing.from_string s)
 let write_v1 : _ -> v1 -> _ = (
-  fun ob x ->
+  fun ob (x : v1) ->
     match x with
       | V1_foo x ->
         Buffer.add_string ob "[\"V1_foo\",";

atdgen/test/dune

@@ -86,6 +86,18 @@
  (action
   (run %{bin:atdgen} -json -std-json -o test_ambiguous_record_j -open Test_ambiguous_record_t -ntd %{deps})))
 
+(rule
+ (targets test_ambiguous_variant_t.ml test_ambiguous_variant_t.mli)
+ (deps    test_ambiguous_variant.atd)
+ (action
+  (run %{bin:atdgen} -t %{deps})))
+
+(rule
+ (targets test_ambiguous_variant_j.ml test_ambiguous_variant_j.mli)
+ (deps    test_ambiguous_variant.atd)
+ (action
+  (run %{bin:atdgen} -j -j-std %{deps})))
+
 (rule
  (targets test_polymorphic_wrap_t.ml test_polymorphic_wrap_t.mli)
  (deps    test_polymorphic_wrap.atd)
@@ -173,6 +185,10 @@
  (package atdgen)
  (action (diff test_ambiguous_record_j.expected.ml test_ambiguous_record_j.ml)))
 
+(rule
+ (alias runtest)
+ (package atdgen)
+ (action (diff test_ambiguous_variant_j.expected.ml test_ambiguous_variant_j.ml)))
 
 (rule
  (alias runtest)
@@ -356,6 +372,8 @@
   test3j_t
   test_ambiguous_record_t
   test_ambiguous_record_j
+  test_ambiguous_variant_t
+  test_ambiguous_variant_j
   test_polymorphic_wrap_t
   test_polymorphic_wrap_j
   testjstd

atdgen/test/test_ambiguous_variant.atd

@@ -0,0 +1,13 @@
+type ambiguous = [
+  | Int of int
+  | String of string
+]
+  <json adapter.ocaml="Json_adapters.Identity">
+<ocaml repr="classic">
+
+type ambiguous' = [
+  | Int of int
+  | String of string
+]
+  <json adapter.ocaml="Json_adapters.Identity">
+<ocaml repr="classic">

atdgen/test/test_ambiguous_variant_j.expected.ml

@@ -0,0 +1,185 @@
+(* Auto-generated from "test_ambiguous_variant.atd" *)
+[@@@ocaml.warning "-27-32-33-35-39"]
+
+type ambiguous' = Test_ambiguous_variant_t.ambiguous' = 
+    Int of int
+  | String of string
+
+
+type ambiguous = Test_ambiguous_variant_t.ambiguous = 
+    Int of int
+  | String of string
+
+
+let write_ambiguous' : _ -> ambiguous' -> _ = (
+  Atdgen_runtime.Oj_run.write_with_adapter Json_adapters.Identity.restore (
+    fun ob (x : ambiguous') ->
+      match x with
+        | Int x ->
+          Buffer.add_string ob "[\"Int\",";
+          (
+            Yojson.Safe.write_int
+          ) ob x;
+          Buffer.add_char ob ']'
+        | String x ->
+          Buffer.add_string ob "[\"String\",";
+          (
+            Yojson.Safe.write_string
+          ) ob x;
+          Buffer.add_char ob ']'
+  )
+)
+let string_of_ambiguous' ?(len = 1024) x =
+  let ob = Buffer.create len in
+  write_ambiguous' ob x;
+  Buffer.contents ob
+let read_ambiguous' = (
+  Atdgen_runtime.Oj_run.read_with_adapter Json_adapters.Identity.normalize (
+    fun p lb ->
+      Yojson.Safe.read_space p lb;
+      match Yojson.Safe.start_any_variant p lb with
+        | `Edgy_bracket -> (
+            match Yojson.Safe.read_ident p lb with
+              | "Int" ->
+                Atdgen_runtime.Oj_run.read_until_field_value p lb;
+                let x = (
+                    Atdgen_runtime.Oj_run.read_int
+                  ) p lb
+                in
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_gt p lb;
+                (Int x : ambiguous')
+              | "String" ->
+                Atdgen_runtime.Oj_run.read_until_field_value p lb;
+                let x = (
+                    Atdgen_runtime.Oj_run.read_string
+                  ) p lb
+                in
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_gt p lb;
+                (String x : ambiguous')
+              | x ->
+                Atdgen_runtime.Oj_run.invalid_variant_tag p x
+          )
+        | `Double_quote -> (
+            match Yojson.Safe.finish_string p lb with
+              | x ->
+                Atdgen_runtime.Oj_run.invalid_variant_tag p x
+          )
+        | `Square_bracket -> (
+            match Atdgen_runtime.Oj_run.read_string p lb with
+              | "Int" ->
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_comma p lb;
+                Yojson.Safe.read_space p lb;
+                let x = (
+                    Atdgen_runtime.Oj_run.read_int
+                  ) p lb
+                in
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_rbr p lb;
+                (Int x : ambiguous')
+              | "String" ->
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_comma p lb;
+                Yojson.Safe.read_space p lb;
+                let x = (
+                    Atdgen_runtime.Oj_run.read_string
+                  ) p lb
+                in
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_rbr p lb;
+                (String x : ambiguous')
+              | x ->
+                Atdgen_runtime.Oj_run.invalid_variant_tag p x
+          )
+  )
+)
+let ambiguous'_of_string s =
+  read_ambiguous' (Yojson.Safe.init_lexer ()) (Lexing.from_string s)
+let write_ambiguous : _ -> ambiguous -> _ = (
+  Atdgen_runtime.Oj_run.write_with_adapter Json_adapters.Identity.restore (
+    fun ob (x : ambiguous) ->
+      match x with
+        | Int x ->
+          Buffer.add_string ob "[\"Int\",";
+          (
+            Yojson.Safe.write_int
+          ) ob x;
+          Buffer.add_char ob ']'
+        | String x ->
+          Buffer.add_string ob "[\"String\",";
+          (
+            Yojson.Safe.write_string
+          ) ob x;
+          Buffer.add_char ob ']'
+  )
+)
+let string_of_ambiguous ?(len = 1024) x =
+  let ob = Buffer.create len in
+  write_ambiguous ob x;
+  Buffer.contents ob
+let read_ambiguous = (
+  Atdgen_runtime.Oj_run.read_with_adapter Json_adapters.Identity.normalize (
+    fun p lb ->
+      Yojson.Safe.read_space p lb;
+      match Yojson.Safe.start_any_variant p lb with
+        | `Edgy_bracket -> (
+            match Yojson.Safe.read_ident p lb with
+              | "Int" ->
+                Atdgen_runtime.Oj_run.read_until_field_value p lb;
+                let x = (
+                    Atdgen_runtime.Oj_run.read_int
+                  ) p lb
+                in
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_gt p lb;
+                (Int x : ambiguous)
+              | "String" ->
+                Atdgen_runtime.Oj_run.read_until_field_value p lb;
+                let x = (
+                    Atdgen_runtime.Oj_run.read_string
+                  ) p lb
+                in
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_gt p lb;
+                (String x : ambiguous)
+              | x ->
+                Atdgen_runtime.Oj_run.invalid_variant_tag p x
+          )
+        | `Double_quote -> (
+            match Yojson.Safe.finish_string p lb with
+              | x ->
+                Atdgen_runtime.Oj_run.invalid_variant_tag p x
+          )
+        | `Square_bracket -> (
+            match Atdgen_runtime.Oj_run.read_string p lb with
+              | "Int" ->
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_comma p lb;
+                Yojson.Safe.read_space p lb;
+                let x = (
+                    Atdgen_runtime.Oj_run.read_int
+                  ) p lb
+                in
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_rbr p lb;
+                (Int x : ambiguous)
+              | "String" ->
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_comma p lb;
+                Yojson.Safe.read_space p lb;
+                let x = (
+                    Atdgen_runtime.Oj_run.read_string
+                  ) p lb
+                in
+                Yojson.Safe.read_space p lb;
+                Yojson.Safe.read_rbr p lb;
+                (String x : ambiguous)
+              | x ->
+                Atdgen_runtime.Oj_run.invalid_variant_tag p x
+          )
+  )
+)
+let ambiguous_of_string s =
+  read_ambiguous (Yojson.Safe.init_lexer ()) (Lexing.from_string s)

atdgen/test/test_atdgen_main.ml

@@ -586,6 +586,20 @@ let test_ambiguous_record () =
     Test_ambiguous_record_j.ambiguous'_of_string json_out' in
   check ((x, x') = (x2, x2'))
 
+let test_ambiguous_classic_variants () =
+  let json_in = {|["Int", 123]|} in
+  let json_in' = {|["Int", 456]|} in
+  let x, x' =
+    Test_ambiguous_variant_j.ambiguous_of_string json_in,
+    Test_ambiguous_variant_j.ambiguous'_of_string json_in' in
+  let json_out, json_out' =
+    Test_ambiguous_variant_j.string_of_ambiguous x,
+    Test_ambiguous_variant_j.string_of_ambiguous' x' in
+  let x2, x2' =
+    Test_ambiguous_variant_j.ambiguous_of_string json_out,
+    Test_ambiguous_variant_j.ambiguous'_of_string json_out' in
+  check ((x, x') = (x2, x2'))
+
 let test_polymorphic_wrap () =
   let json_in = {|["1", "2"]|} in
   let x =
@@ -667,6 +681,7 @@ let all_tests : (string * (unit -> unit)) list = [
    for unknown tags", test_tag_field_emulation_with_catchall;
   "test <json open_enum>", test_json_open_enum;
   "test ambiguous record with json adapters", test_ambiguous_record;
+  "test ambiguous classic variants with json adapters", test_ambiguous_classic_variants;
   "test wrapping of polymorphic types", test_polymorphic_wrap;
   "json encoding int64 as string", test_encoding_int64;
   "json encoding & decoding int64", test_encoding_decoding_int64;

atdgen/test/testj.expected.ml

@@ -174,7 +174,7 @@ let read__a_list read__a = (
 let _a_list_of_string read__a s =
   read__a_list read__a (Yojson.Safe.init_lexer ()) (Lexing.from_string s)
 let rec write_p' write__a : _ -> 'a p' -> _ = (
-  fun ob x ->
+  fun ob (x : 'a p') ->
     match x with
       | A -> Buffer.add_string ob "<\"A\">"
       | Bb x ->
@@ -644,7 +644,7 @@ and read_test_variant = (
 and test_variant_of_string s =
   read_test_variant (Yojson.Safe.init_lexer ()) (Lexing.from_string s)
 let rec write__int_p : _ -> _ p' -> _ = (
-  fun ob x ->
+  fun ob (x : _ p') ->
     match x with
       | A -> Buffer.add_string ob "<\"A\">"
       | Bb x ->

atdgen/test/testjstd.expected.ml

@@ -174,7 +174,7 @@ let read__a_list read__a = (
 let _a_list_of_string read__a s =
   read__a_list read__a (Yojson.Safe.init_lexer ()) (Lexing.from_string s)
 let rec write_p' write__a : _ -> 'a p' -> _ = (
-  fun ob x ->
+  fun ob (x : 'a p') ->
     match x with
       | A -> Buffer.add_string ob "\"A\""
       | Bb x ->
@@ -640,7 +640,7 @@ and read_test_variant = (
 and test_variant_of_string s =
   read_test_variant (Yojson.Safe.init_lexer ()) (Lexing.from_string s)
 let rec write__int_p : _ -> _ p' -> _ = (
-  fun ob x ->
+  fun ob (x : _ p') ->
     match x with
       | A -> Buffer.add_string ob "\"A\""
       | Bb x ->