From 2fed5b6127511a1d7ce3dd693c3f97873918d865 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Tue, 19 Nov 2024 13:59:15 +0000 Subject: [PATCH] add array fns to native runtime --- ppx/native/ppx_deriving_json_runtime.ml | 7 ++ ppx/test/ppx_deriving_json_native.e2e.t | 86 +++++++++++++++++++++---- ppx/test/ppx_deriving_json_native.t | 68 +++++++++++++++++-- 3 files changed, 142 insertions(+), 19 deletions(-) diff --git a/ppx/native/ppx_deriving_json_runtime.ml b/ppx/native/ppx_deriving_json_runtime.ml index 047d813..ec11e9d 100644 --- 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 index 223c10a..05d867d 100644 --- 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 diff --git a/ppx/test/ppx_deriving_json_native.t b/ppx/test/ppx_deriving_json_native.t index 139c7c3..09ec4a1 100644 --- a/ppx/test/ppx_deriving_json_native.t +++ b/ppx/test/ppx_deriving_json_native.t @@ -1,22 +1,76 @@ $ alias run='../native/ppx_deriving_json_native_test.exe -impl - | ocamlformat - --impl' $ cat <<"EOF" | run - > type user = int [@@deriving json] + > type array_list = { a: int array; b: int list} [@@deriving json] > EOF - type user = int [@@deriving json] + type array_list = { a : int array; b : int list } [@@deriving json] include struct - let _ = fun (_ : user) -> () + let _ = fun (_ : array_list) -> () [@@@ocaml.warning "-39-11-27"] - let rec user_of_json = (fun x -> int_of_json x : Yojson.Basic.t -> user) - let _ = user_of_json + let rec array_list_of_json = + (fun x -> + match x with + | `Assoc fs -> + let x_a = ref Stdlib.Option.None in + let x_b = ref Stdlib.Option.None in + let rec iter = function + | [] -> () + | (n', v) :: fs -> + (match n' with + | "a" -> + x_a := + Stdlib.Option.Some ((array_of_json int_of_json) v) + | "b" -> + x_b := + Stdlib.Option.Some ((list_of_json int_of_json) v) + | name -> + Ppx_deriving_json_runtime.of_json_error + (Stdlib.Printf.sprintf "unknown field: %s" name)); + iter fs + in + iter fs; + { + a = + (match Stdlib.( ! ) x_a with + | Stdlib.Option.Some v -> v + | Stdlib.Option.None -> + Ppx_deriving_json_runtime.of_json_error + "missing field \"a\""); + b = + (match Stdlib.( ! ) x_b with + | Stdlib.Option.Some v -> v + | Stdlib.Option.None -> + Ppx_deriving_json_runtime.of_json_error + "missing field \"b\""); + } + | _ -> + Ppx_deriving_json_runtime.of_json_error + "expected a JSON object" + : Yojson.Basic.t -> array_list) + + let _ = array_list_of_json [@@@ocaml.warning "-39-11-27"] - let rec user_to_json = (fun x -> int_to_json x : user -> Yojson.Basic.t) - let _ = user_to_json + let rec array_list_to_json = + (fun x -> + match x with + | { a = x_a; b = x_b } -> + `Assoc + (let bnds__001_ = [] in + let bnds__001_ = + ("b", (list_to_json int_to_json) x_b) :: bnds__001_ + in + let bnds__001_ = + ("a", (array_to_json int_to_json) x_a) :: bnds__001_ + in + bnds__001_) + : array_list -> Yojson.Basic.t) + + let _ = array_list_to_json end [@@ocaml.doc "@inline"] [@@merlin.hide] $ cat <<"EOF" | run