From 2899658a1c02dda6abbd0274e48e90159c2f9e9f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Tue, 19 Nov 2024 15:22:06 +0100 Subject: [PATCH] native runtime: add array fns (#37) --- CHANGES.md | 2 ++ ppx/native/ppx_deriving_json_runtime.ml | 7 +++++++ ppx/test/example.ml | 2 ++ ppx/test/ppx_deriving_json_js.e2e.t | 2 ++ ppx/test/ppx_deriving_json_native.e2e.t | 2 ++ 5 files changed, 15 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 5ef2198..b313f3b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -21,6 +21,8 @@ ([#33](https://github.com/melange-community/melange-json/pull/33)) - PPX: remove `string_to_json` usage on js side ([#35](https://github.com/melange-community/melange-json/pull/35)) +- PPX: Add array functions to native runtime + ([#37](https://github.com/melange-community/melange-json/pull/37)) ## 1.3.0 (2024-08-28) 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/example.ml b/ppx/test/example.ml index 88516cb..edb99a1 100644 --- a/ppx/test/example.ml +++ b/ppx/test/example.ml @@ -21,6 +21,7 @@ type ('a, 'b) p2 = A of 'a | B of 'b [@@deriving json] 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] +type array_list = { a: int array; b: int list} [@@deriving json] type json = Ppx_deriving_json_runtime.t type of_json = C : string * (json -> 'a) * ('a -> json) * 'a -> of_json @@ -55,6 +56,7 @@ let of_json_cases = [ C ({|["A",{"a":1,"b":2}]|}, allow_extra_fields2_of_json, allow_extra_fields2_to_json, A {a=1}); C ({|{"a":1}|}, drop_default_option_of_json, drop_default_option_to_json, {a=1; b_opt=None}); C ({|{"a":1,"b_opt":2}|}, drop_default_option_of_json, drop_default_option_to_json, {a=1; b_opt=Some 2}); + C ({|{"a":[1],"b":[2]}|}, array_list_of_json, array_list_to_json, {a=[|1|]; b=[2]}); ] let run' (C (data, of_json, to_json, v)) = print_endline (Printf.sprintf "JSON DATA: %s" data); diff --git a/ppx/test/ppx_deriving_json_js.e2e.t b/ppx/test/ppx_deriving_json_js.e2e.t index 5434be6..f678e5d 100644 --- a/ppx/test/ppx_deriving_json_js.e2e.t +++ b/ppx/test/ppx_deriving_json_js.e2e.t @@ -87,6 +87,8 @@ 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] diff --git a/ppx/test/ppx_deriving_json_native.e2e.t b/ppx/test/ppx_deriving_json_native.e2e.t index 4e05296..05d867d 100644 --- a/ppx/test/ppx_deriving_json_native.e2e.t +++ b/ppx/test/ppx_deriving_json_native.e2e.t @@ -77,6 +77,8 @@ 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]