diff --git a/ppx/test/classify_drop_option.t b/ppx/test/classify_drop_option.t new file mode 100644 index 0000000..f5c3309 --- /dev/null +++ b/ppx/test/classify_drop_option.t @@ -0,0 +1,81 @@ +We can classify the JSON produced by `to_json` for a record with a dropped optional field: + $ echo ' + > open Melange_json.Primitives + > type t = {a: int option; [@json.option] [@json.drop_default]} [@@deriving to_json] + > let () = + > match Melange_json.classify (to_json {a = None}) with + > | `Assoc xs -> xs |> List.iter (fun (k, v) -> + > let _ = k in + > let _v = Melange_json.classify v in + > ()); + > print_endline "OK" + > | _ -> print_endline "ERROR: Expected an object" + > ' | ./run.sh + === ppx output:native === + open Melange_json.Primitives + type t = { + a: int option [@json.option ][@json.drop_default ]}[@@deriving to_json] + include + struct + let _ = fun (_ : t) -> () + [@@@ocaml.warning "-39-11-27"] + let rec to_json = + (fun x -> + match x with + | { a = x_a } -> + `Assoc + (let bnds__001_ = [] in + let bnds__001_ = + match x_a with + | Stdlib.Option.None -> bnds__001_ + | Stdlib.Option.Some _ -> + ("a", ((option_to_json int_to_json) x_a)) :: bnds__001_ in + bnds__001_) : t -> Yojson.Basic.t) + let _ = to_json + end[@@ocaml.doc "@inline"][@@merlin.hide ] + let () = + match Melange_json.classify (to_json { a = None }) with + | `Assoc xs -> + (xs |> + (List.iter + (fun (k, v) -> + let _ = k in let _v = Melange_json.classify v in ())); + print_endline "OK") + | _ -> print_endline "ERROR: Expected an object" + === ppx output:browser === + open Melange_json.Primitives + type t = { + a: int option [@json.option ][@json.drop_default ]}[@@deriving to_json] + include + struct + let _ = fun (_ : t) -> () + [@@@ocaml.warning "-39-11-27"] + let rec to_json = + (fun x -> + match x with + | { a = x_a } -> + (Obj.magic + ([%mel.obj + { + a = + (match x_a with + | Stdlib.Option.None -> Js.Undefined.empty + | Stdlib.Option.Some _ -> + Js.Undefined.return + ((option_to_json int_to_json) x_a)) + }]) : Js.Json.t) : t -> Js.Json.t) + let _ = to_json + end[@@ocaml.doc "@inline"][@@merlin.hide ] + let () = + match Melange_json.classify (to_json { a = None }) with + | `Assoc xs -> + (xs |> + (List.iter + (fun (k, v) -> + let _ = k in let _v = Melange_json.classify v in ())); + print_endline "OK") + | _ -> print_endline "ERROR: Expected an object" + === stdout:native === + OK + === stdout:js === + OK diff --git a/src/classify.ml b/src/classify.ml index 51c1b6a..6289893 100644 --- a/src/classify.ml +++ b/src/classify.ml @@ -2,6 +2,18 @@ module J = Js.Json type t = J.t +let dict_to_list_without_undefined dict = + let keys = Js.Dict.keys dict in + let l = Array.length keys in + let xs = ref [] in + for i = l - 1 downto 0 do + let key = Array.unsafe_get keys i in + let value = Js.Dict.unsafeGet dict key in + if not ((Obj.magic value : _ Js.Undefined.t) == Js.undefined) then + xs := (key, value) :: !xs + done; + !xs + let classify : t -> [ `Null @@ -27,8 +39,9 @@ let classify : let xs = Array.to_list (Obj.magic json : t array) in `List xs else - let xs = Js.Dict.entries (Obj.magic json : t Js.Dict.t) in - `Assoc (Array.to_list xs) + `Assoc + (dict_to_list_without_undefined + (Obj.magic json : t Js.Dict.t)) | typ -> failwith ("unknown JSON value type: " ^ typ) let declassify :