Skip to content

Commit

Permalink
native runtime: add array fns (#37)
Browse files Browse the repository at this point in the history
  • Loading branch information
jchavarri authored Nov 19, 2024
1 parent ac0f795 commit 2899658
Show file tree
Hide file tree
Showing 5 changed files with 15 additions and 0 deletions.
2 changes: 2 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
7 changes: 7 additions & 0 deletions ppx/native/ppx_deriving_json_runtime.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
2 changes: 2 additions & 0 deletions ppx/test/example.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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);
Expand Down
2 changes: 2 additions & 0 deletions ppx/test/ppx_deriving_json_js.e2e.t
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down
2 changes: 2 additions & 0 deletions ppx/test/ppx_deriving_json_native.e2e.t
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down

0 comments on commit 2899658

Please sign in to comment.