add array fns to native runtime

melange-community · Nov 19, 2024 · 6dac588 · 6dac588
1 parent 48abda6
commit 6dac588
Show file tree

Hide file tree

Showing 2 changed files with 81 additions and 12 deletions.
diff --git a/ppx/native/ppx_deriving_json_runtime.ml b/ppx/native/ppx_deriving_json_runtime.ml
@@ -37,6 +37,9 @@ module To_json = struct
   let unit_to_json () = `Null
   let list_to_json v_to_json vs = `List (List.map v_to_json vs)
 
+  let array_to_json v_to_json vs =
+    `List (Array.to_list (Array.map v_to_json vs))
+
   let option_to_json v_to_json = function
     | None -> `Null
     | Some v -> v_to_json v
@@ -93,6 +96,10 @@ module Of_json = struct
     | `List l -> List.map v_of_json l
     | json -> of_json_error_type_mismatch json "array"
 
+  let array_of_json v_of_json = function
+    | `List l -> Array.map v_of_json (Array.of_list l)
+    | json -> of_json_error_type_mismatch json "array"
+
   let result_of_json ok_of_json err_of_json json =
     match json with
     | `List [ `String "Ok"; x ] -> Ok (ok_of_json x)

diff --git a/ppx/test/ppx_deriving_json_native.e2e.t b/ppx/test/ppx_deriving_json_native.e2e.t
@@ -15,17 +15,79 @@
   > ' >> main.ml
 
   $ dune build ./main.exe
-  File "example.ml", line 24, characters 27-32:
-  24 | type array_list = { a: int array; b: int list} [@@deriving json]
-                                  ^^^^^
-  Error: Unbound value array_of_json
-  Hint: Did you mean param_of_json?
-  [1]
 
   $ dune exec ./main.exe
-  File "example.ml", line 24, characters 27-32:
-  24 | type array_list = { a: int array; b: int list} [@@deriving json]
-                                  ^^^^^
-  Error: Unbound value array_of_json
-  Hint: Did you mean param_of_json?
-  [1]
+  JSON    DATA: 1
+  JSON REPRINT: 1
+  JSON    DATA: "9223372036854775807"
+  JSON REPRINT: "9223372036854775807"
+  JSON    DATA: 1.1
+  JSON REPRINT: 1.1
+  JSON    DATA: 1.0
+  JSON REPRINT: 1.0
+  JSON    DATA: 42
+  JSON REPRINT: 42.0
+  JSON    DATA: "OK"
+  JSON REPRINT: "OK"
+  JSON    DATA: "some"
+  JSON REPRINT: "some"
+  JSON    DATA: ["Ok", 1]
+  JSON REPRINT: ["Ok",1]
+  JSON    DATA: ["Error", "oops"]
+  JSON REPRINT: ["Error","oops"]
+  JSON    DATA: [42, "works"]
+  JSON REPRINT: [42,"works"]
+  JSON    DATA: {"name":"N","age":1}
+  JSON REPRINT: {"name":"N","age":1}
+  JSON    DATA: ["A"]
+  JSON REPRINT: ["A"]
+  JSON    DATA: ["B", 42]
+  JSON REPRINT: ["B",42]
+  JSON    DATA: ["C", {"name": "cname"}]
+  JSON REPRINT: ["C",{"name":"cname"}]
+  JSON    DATA: ["A"]
+  JSON REPRINT: ["A"]
+  JSON    DATA: ["S2", 42, "hello"]
+  JSON REPRINT: ["S2",42,"hello"]
+  JSON    DATA: ["B", 42]
+  JSON REPRINT: ["B",42]
+  JSON    DATA: ["P2", 42, "hello"]
+  JSON REPRINT: ["P2",42,"hello"]
+  JSON    DATA: ["Fix",["Fix",["Fix",["A"]]]]
+  JSON REPRINT: ["Fix",["Fix",["Fix",["A"]]]]
+  JSON    DATA: ["Fix",["Fix",["Fix",["A"]]]]
+  JSON REPRINT: ["Fix",["Fix",["Fix",["A"]]]]
+  JSON    DATA: {"my_name":"N","my_age":1}
+  JSON REPRINT: {"my_name":"N","my_age":1}
+  JSON    DATA: {"my_name":"N"}
+  JSON REPRINT: {"my_name":"N","my_age":100}
+  JSON    DATA: {}
+  JSON REPRINT: {"k":null}
+  JSON    DATA: {"k":42}
+  JSON REPRINT: {"k":42}
+  JSON    DATA: ["A",1]
+  JSON REPRINT: ["A",1]
+  JSON    DATA: ["B","ok"]
+  JSON REPRINT: ["B","ok"]
+  JSON    DATA: {"a":1,"b":2}
+  JSON REPRINT: {"a":1}
+  JSON    DATA: ["A",{"a":1,"b":2}]
+  JSON REPRINT: ["A",{"a":1}]
+  JSON    DATA: {"a":1}
+  JSON REPRINT: {"a":1}
+  JSON    DATA: {"a":1,"b_opt":2}
+  JSON REPRINT: {"a":1,"b_opt":2}
+  JSON    DATA: {"a":[1],"b":[2]}
+  JSON REPRINT: {"a":[1],"b":[2]}
+  *** json_string deriver tests ***
+  ** To_json_string **
+  A 42 -> ["A",42]
+  B false -> ["B",false]
+  ** Of_json_string **
+  ["A", 42] = A 42 -> true
+  ["B", false] = B false -> true
+  ** Json_string **
+  A 42 -> ["A",42]
+  B false -> ["B",false]
+  ["A", 42] = A 42 -> true
+  ["B", false] = B false -> true