From 0e04c9138731e9867f2087e2d01448370107616d Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 13 Dec 2025 16:04:00 -0800 Subject: [PATCH] fmt: format using OCamlformat 0.28 --- examples/decode.ml | 2 +- ppx/native/common/ppx_deriving_json_common.ml | 3 - ppx/native/common/ppx_deriving_tools.ml | 14 +- ppx/native/ppx_deriving_json_native.ml | 35 +- src/__tests__/Json_decode_test.ml | 309 +++++++++--------- src/errors.ml | 3 +- 6 files changed, 181 insertions(+), 185 deletions(-) diff --git a/examples/decode.ml b/examples/decode.ml index 4060575..ab6547b 100644 --- a/examples/decode.ml +++ b/examples/decode.ml @@ -2,7 +2,7 @@ let mapJsonObjectString f decoder (encoder : int -> Js.Json.t) str = let json = Melange_json.of_string str in Melange_json.Of_json.(js_dict decoder json) - |> Js.Dict.map ~f:(fun [@u] v -> f v) + |> Js.Dict.map ~f:(fun[@u] v -> f v) |> Melange_json.To_json.js_dict encoder |> Melange_json.to_string diff --git a/ppx/native/common/ppx_deriving_json_common.ml b/ppx/native/common/ppx_deriving_json_common.ml index ffb8d9e..a1b757c 100644 --- a/ppx/native/common/ppx_deriving_json_common.ml +++ b/ppx/native/common/ppx_deriving_json_common.ml @@ -7,7 +7,6 @@ let get_of_variant_case ?mark_as_seen ~variant ~polyvariant = function | Vcs_ctx_variant ctx -> Attribute.get ?mark_as_seen variant ctx | Vcs_ctx_polyvariant ctx -> Attribute.get ?mark_as_seen polyvariant ctx - let get_of_variant ?mark_as_seen ~variant ~polyvariant = function | Vrt_ctx_variant ctx -> Attribute.get ?mark_as_seen variant ctx | Vrt_ctx_polyvariant ctx -> Attribute.get ?mark_as_seen polyvariant ctx @@ -24,8 +23,6 @@ let vcs_attr_json_name = let polyvariant = attr_json_name Attribute.Context.rtag in get_of_variant_case ~variant ~polyvariant - - let attr_json_allow_any ctx = Attribute.declare_flag "json.allow_any" ctx let vcs_attr_json_allow_any = diff --git a/ppx/native/common/ppx_deriving_tools.ml b/ppx/native/common/ppx_deriving_tools.ml index d5e6e72..2b91038 100644 --- a/ppx/native/common/ppx_deriving_tools.ml +++ b/ppx/native/common/ppx_deriving_tools.ml @@ -409,7 +409,7 @@ module Conv = struct let allow_any_constr = cs |> List.find_opt ~f:(fun cs -> - is_allow_any_constr (Vcs_ctx_variant cs)) + is_allow_any_constr (Vcs_ctx_variant cs)) |> Option.map (fun cs e -> econstruct cs (Some e)) in let cs = @@ -479,13 +479,13 @@ module Conv = struct let allow_any_constr = cs |> List.find_opt ~f:(fun cs -> - is_allow_any_constr (Vcs_ctx_polyvariant cs)) + is_allow_any_constr (Vcs_ctx_polyvariant cs)) |> Option.map (fun cs -> - match cs.prf_desc with - | Rinherit _ -> - failwith "[@allow_any] placed on inherit clause" - | Rtag (n, _, _) -> - fun e -> pexp_variant ~loc:n.loc n.txt (Some e)) + match cs.prf_desc with + | Rinherit _ -> + failwith "[@allow_any] placed on inherit clause" + | Rtag (n, _, _) -> + fun e -> pexp_variant ~loc:n.loc n.txt (Some e)) in let cs = List.filter diff --git a/ppx/native/ppx_deriving_json_native.ml b/ppx/native/ppx_deriving_json_native.ml index e6e6b50..33fd04f 100644 --- a/ppx/native/ppx_deriving_json_native.ml +++ b/ppx/native/ppx_deriving_json_native.ml @@ -195,24 +195,23 @@ module To_json = struct let e = List.combine t.rcd_fields es |> List.fold_left ~init:ebnds ~f:(fun acc (ld, x) -> - let key = - Option.value ~default:ld.pld_name (ld_attr_json_key ld) - in - let k = estring ~loc:key.loc key.txt in - let v = derive ld.pld_type x in - let ebnds = - match ld_drop_default ld with - | `No -> [%expr ([%e k], [%e v]) :: [%e ebnds]] - | `Drop_option -> - [%expr - match [%e x] with - | Stdlib.Option.None -> [%e ebnds] - | Stdlib.Option.Some _ -> - ([%e k], [%e v]) :: [%e ebnds]] - in - [%expr - let [%p pbnds] = [%e ebnds] in - [%e acc]]) + let key = + Option.value ~default:ld.pld_name (ld_attr_json_key ld) + in + let k = estring ~loc:key.loc key.txt in + let v = derive ld.pld_type x in + let ebnds = + match ld_drop_default ld with + | `No -> [%expr ([%e k], [%e v]) :: [%e ebnds]] + | `Drop_option -> + [%expr + match [%e x] with + | Stdlib.Option.None -> [%e ebnds] + | Stdlib.Option.Some _ -> ([%e k], [%e v]) :: [%e ebnds]] + in + [%expr + let [%p pbnds] = [%e ebnds] in + [%e acc]]) in [%expr `Assoc diff --git a/src/__tests__/Json_decode_test.ml b/src/__tests__/Json_decode_test.ml index 21ffed3..00b7a66 100644 --- a/src/__tests__/Json_decode_test.ml +++ b/src/__tests__/Json_decode_test.ml @@ -40,7 +40,8 @@ let wrap_exn exp = try let _ = exp () in "not called" - with Melange_json.Of_json_error str -> (Melange_json.of_json_error_to_string str) + with Melange_json.Of_json_error str -> + Melange_json.of_json_error_to_string str let () = describe "id" (fun () -> @@ -84,8 +85,8 @@ let () = let inf = [%raw "Infinity"] in expect @@ wrap_exn (fun () -> - let (_ : int) = int (Encode.int inf) in - fail "should throw") + let (_ : int) = int (Encode.int inf) in + fail "should throw") |> toEqual "expected an integer but got inf"); Test.throws int [ Bool; Float; String; Null; Array; Object; Char ]); @@ -102,10 +103,10 @@ let () = test "object as string" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : string) = - string (Encode.jsonDict (Js.Dict.empty ())) - in - fail "should throw") + let (_ : string) = + string (Encode.jsonDict (Js.Dict.empty ())) + in + fail "should throw") |> toEqual "expected a string but got {}"); Test.throws string [ Bool; Float; Int; Null; Array; Object ]); @@ -131,15 +132,15 @@ let () = test "empty string" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : char) = char (Encode.string "") in - fail "should throw") + let (_ : char) = char (Encode.string "") in + fail "should throw") |> toEqual "expected a single-character string but got \"\""); test "multiple-character string" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : char) = char (Encode.string "abc") in - fail "should throw") + let (_ : char) = char (Encode.string "abc") in + fail "should throw") |> toEqual "expected a single-character string but got \"abc\""); Test.throws char [ Bool; Float; Int; Null; Array; Object ]); @@ -213,10 +214,10 @@ let () = test "array int -> array boolean" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : bool array) = - (array bool) (parseOrRaise {| [1, 2, 3] |}) - in - fail "should throw") + let (_ : bool array) = + (array bool) (parseOrRaise {| [1, 2, 3] |}) + in + fail "should throw") |> toEqual "expected a boolean but got 1\n\tin array at index 0"); test "non-Of_json_error exceptions in decoder should pass through" @@ -258,10 +259,10 @@ let () = test "array int -> list boolean" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : bool list) = - (list bool) (parseOrRaise {| [1, 2, 3] |}) - in - fail "should throw") + let (_ : bool list) = + (list bool) (parseOrRaise {| [1, 2, 3] |}) + in + fail "should throw") |> toEqual "expected a boolean but got 1\n\tin array at index 0"); test "non-Of_json_error exceptions in decoder should pass through" @@ -288,43 +289,43 @@ let () = test "too small" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int) = - (pair int int) (parseOrRaise {| [4] |}) - in - fail "should throw") + let (_ : int * int) = + (pair int int) (parseOrRaise {| [4] |}) + in + fail "should throw") |> toEqual "expected tuple as array of length 2 but got [4]"); test "too large" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int) = - (pair int int) (parseOrRaise {| [3, 4, 5] |}) - in - fail "should throw") + let (_ : int * int) = + (pair int int) (parseOrRaise {| [3, 4, 5] |}) + in + fail "should throw") |> toEqual "expected tuple as array of length 2 but got [3, 4, 5]"); test "bad type a" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int) = - (pair int int) (parseOrRaise {| ["3", 4] |}) - in - fail "should throw") + let (_ : int * int) = + (pair int int) (parseOrRaise {| ["3", 4] |}) + in + fail "should throw") |> toEqual "expected an integer but got \"3\"\n\tin pair/tuple2"); test "bad type b" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : string * string) = - (pair string string) (parseOrRaise {| ["3", 4] |}) - in - fail "should throw") + let (_ : string * string) = + (pair string string) (parseOrRaise {| ["3", 4] |}) + in + fail "should throw") |> toEqual "expected a string but got 4\n\tin pair/tuple2"); test "not array" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int) = - (pair int int) (parseOrRaise {| 4 |}) - in - fail "should throw") + let (_ : int * int) = + (pair int int) (parseOrRaise {| 4 |}) + in + fail "should throw") |> toEqual "expected tuple as array but got 4"); test "non-Of_json_error exceptions in decoder should pass through" (fun () -> @@ -344,43 +345,43 @@ let () = test "too small" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int) = - (tuple2 int int) (parseOrRaise {| [4] |}) - in - fail "should throw") + let (_ : int * int) = + (tuple2 int int) (parseOrRaise {| [4] |}) + in + fail "should throw") |> toEqual "expected tuple as array of length 2 but got [4]"); test "too large" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int) = - (tuple2 int int) (parseOrRaise {| [3, 4, 5] |}) - in - fail "should throw") + let (_ : int * int) = + (tuple2 int int) (parseOrRaise {| [3, 4, 5] |}) + in + fail "should throw") |> toEqual "expected tuple as array of length 2 but got [3, 4, 5]"); test "bad type a" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int) = - (tuple2 int int) (parseOrRaise {| ["3", 4] |}) - in - fail "should throw") + let (_ : int * int) = + (tuple2 int int) (parseOrRaise {| ["3", 4] |}) + in + fail "should throw") |> toEqual "expected an integer but got \"3\"\n\tin pair/tuple2"); test "bad type b" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : string * string) = - (tuple2 string string) (parseOrRaise {| ["3", 4] |}) - in - fail "should throw") + let (_ : string * string) = + (tuple2 string string) (parseOrRaise {| ["3", 4] |}) + in + fail "should throw") |> toEqual "expected a string but got 4\n\tin pair/tuple2"); test "not array" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int) = - (tuple2 int int) (parseOrRaise {| 4 |}) - in - fail "should throw") + let (_ : int * int) = + (tuple2 int int) (parseOrRaise {| 4 |}) + in + fail "should throw") |> toEqual "expected tuple as array but got 4"); test "non-Of_json_error exceptions in decoder should pass through" (fun () -> @@ -402,54 +403,53 @@ let () = test "too small" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int * int) = - (tuple3 int int int) (parseOrRaise {| [4] |}) - in - fail "should throw") + let (_ : int * int * int) = + (tuple3 int int int) (parseOrRaise {| [4] |}) + in + fail "should throw") |> toEqual "expected tuple as array of length 3 but got [4]"); test "too large" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int * int) = - (tuple3 int int int) - (parseOrRaise {| [3, 4, 5, 6, 7] |}) - in - fail "should throw") + let (_ : int * int * int) = + (tuple3 int int int) (parseOrRaise {| [3, 4, 5, 6, 7] |}) + in + fail "should throw") |> toEqual "expected tuple as array of length 3 but got [3, 4, 5, 6, \ 7]"); test "bad type a" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int * int) = - (tuple3 int int int) (parseOrRaise {| ["3", 4, 5] |}) - in - fail "should throw") + let (_ : int * int * int) = + (tuple3 int int int) (parseOrRaise {| ["3", 4, 5] |}) + in + fail "should throw") |> toEqual "expected an integer but got \"3\"\n\tin tuple3"); test "bad type b" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : string * string * string) = - (tuple3 string string string) - (parseOrRaise {| ["3", 4, "5"] |}) - in - fail "should throw") + let (_ : string * string * string) = + (tuple3 string string string) + (parseOrRaise {| ["3", 4, "5"] |}) + in + fail "should throw") |> toEqual "expected a string but got 4\n\tin tuple3"); test "not array" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int * int) = - (tuple3 int int int) (parseOrRaise {| 4 |}) - in - fail "should throw") + let (_ : int * int * int) = + (tuple3 int int int) (parseOrRaise {| 4 |}) + in + fail "should throw") |> toEqual "expected tuple as array but got 4"); test "not array" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int * int) = - (tuple3 int int int) (parseOrRaise {| 4 |}) - in - fail "should throw") + let (_ : int * int * int) = + (tuple3 int int int) (parseOrRaise {| 4 |}) + in + fail "should throw") |> toEqual "expected tuple as array but got 4"); test "non-Of_json_error exceptions in decoder should pass through" (fun () -> @@ -472,47 +472,47 @@ let () = test "too small" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int * int * int) = - (tuple4 int int int int) (parseOrRaise {| [4] |}) - in - fail "should throw") + let (_ : int * int * int * int) = + (tuple4 int int int int) (parseOrRaise {| [4] |}) + in + fail "should throw") |> toEqual "expected tuple as array of length 4 but got [4]"); test "too large" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int * int * int) = - (tuple4 int int int int) - (parseOrRaise {| [3, 4, 5, 6, 7, 8] |}) - in - fail "should throw") + let (_ : int * int * int * int) = + (tuple4 int int int int) + (parseOrRaise {| [3, 4, 5, 6, 7, 8] |}) + in + fail "should throw") |> toEqual "expected tuple as array of length 4 but got [3, 4, 5, 6, \ 7, 8]"); test "bad type a" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int * int * int) = - (tuple4 int int int int) - (parseOrRaise {| ["3", 4, 5, 6] |}) - in - fail "should throw") + let (_ : int * int * int * int) = + (tuple4 int int int int) + (parseOrRaise {| ["3", 4, 5, 6] |}) + in + fail "should throw") |> toEqual "expected an integer but got \"3\"\n\tin tuple4"); test "bad type b" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : string * string * string * string) = - (tuple4 string string string string) - (parseOrRaise {| ["3", 4, "5", "6"] |}) - in - fail "should throw") + let (_ : string * string * string * string) = + (tuple4 string string string string) + (parseOrRaise {| ["3", 4, "5", "6"] |}) + in + fail "should throw") |> toEqual "expected a string but got 4\n\tin tuple4"); test "not array" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int * int * int * int) = - (tuple4 int int int int) (parseOrRaise {| 4 |}) - in - fail "should throw") + let (_ : int * int * int * int) = + (tuple4 int int int int) (parseOrRaise {| 4 |}) + in + fail "should throw") |> toEqual "expected tuple as array but got 4"); test "non-Of_json_error exceptions in decoder should pass through" (fun () -> @@ -553,11 +553,11 @@ let () = test "null -> dict string" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : string Js.Dict.t) = - (dict string) - (parseOrRaise {| { "a": null, "b": null } |}) - in - fail "should throw") + let (_ : string Js.Dict.t) = + (dict string) + (parseOrRaise {| { "a": null, "b": null } |}) + in + fail "should throw") |> toEqual "expected a string but got null\n\tin object at key 'a'"); test "non-Of_json_error exceptions in decoder should pass through" @@ -598,22 +598,22 @@ let () = test "missing key" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : string) = - (field "c" string) - (parseOrRaise {| { "a": null, "b": null } |}) - in - fail "should throw") + let (_ : string) = + (field "c" string) + (parseOrRaise {| { "a": null, "b": null } |}) + in + fail "should throw") |> toEqual "expected object with field 'c' but got {\"a\": _, \"b\": \ _}"); test "decoder error" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : string) = - (field "b" string) - (parseOrRaise {| { "a": null, "b": null } |}) - in - fail "should throw") + let (_ : string) = + (field "b" string) + (parseOrRaise {| { "a": null, "b": null } |}) + in + fail "should throw") |> toEqual "expected a string but got null\n\tat field 'b'"); test "non-Of_json_error exceptions in decoder should pass through" @@ -654,30 +654,30 @@ let () = test "missing key" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : 'a Js.null) = - (at [ "a"; "y" ] (nullAs Js.null)) - (parseOrRaise - {| { + let (_ : 'a Js.null) = + (at [ "a"; "y" ] (nullAs Js.null)) + (parseOrRaise + {| { "a": { "x" : null }, "b": null } |}) - in - fail "should throw") + in + fail "should throw") |> toEqual "expected object with field 'y' but got {\"x\": _}\n\ \tat field 'a'"); test "decoder error" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : 'a Js.null) = - (at [ "a"; "x"; "y" ] (nullAs Js.null)) - (parseOrRaise - {| { + let (_ : 'a Js.null) = + (at [ "a"; "x"; "y" ] (nullAs Js.null)) + (parseOrRaise + {| { "a": { "x" : { "y": "foo" } }, "b": null } |}) - in - fail "should throw") + in + fail "should throw") |> toEqual "expected null but got \"foo\"\n\ \tat field 'y'\n\ @@ -753,11 +753,10 @@ let () = test "field optional - no such field" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int option) = - (field "y" (optional int)) - (parseOrRaise {| { "x": 2} |}) - in - fail "should throw") + let (_ : int option) = + (field "y" (optional int)) (parseOrRaise {| { "x": 2} |}) + in + fail "should throw") |> toEqual "expected object with field 'y' but got {\"x\": _}"); test "non-Of_json_error exceptions in decoder should pass through" @@ -805,9 +804,9 @@ let () = test "object as string in either" (fun () -> expect @@ wrap_exn (fun () -> - let a = Encode.jsonDict (Js.Dict.empty ()) in - let (_ : string) = either string string a in - fail "should throw") + let a = Encode.jsonDict (Js.Dict.empty ()) in + let (_ : string) = either string string a in + fail "should throw") |> toEqual "All decoders given to oneOf failed. Here are all the \ errors: \n\ @@ -901,12 +900,12 @@ let () = test "dict array array int - heterogenous structure" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int array array Js.Dict.t) = - (dict (array (array int))) - (parseOrRaise - {| { "a": [[1, 2], [true]], "b": [[4], [5, 6]] } |}) - in - fail "should throw") + let (_ : int array array Js.Dict.t) = + (dict (array (array int))) + (parseOrRaise + {| { "a": [[1, 2], [true]], "b": [[4], [5, 6]] } |}) + in + fail "should throw") |> toEqual "expected an integer but got true\n\ \tin array at index 0\n\ @@ -915,12 +914,12 @@ let () = test "dict array array int - heterogenous structure 2" (fun () -> expect @@ wrap_exn (fun () -> - let (_ : int array array Js.Dict.t) = - (dict (array (array int))) - (parseOrRaise - {| { "a": [[1, 2], "foo"], "b": [[4], [5, 6]] } |}) - in - fail "should throw") + let (_ : int array array Js.Dict.t) = + (dict (array (array int))) + (parseOrRaise + {| { "a": [[1, 2], "foo"], "b": [[4], [5, 6]] } |}) + in + fail "should throw") |> toEqual "expected an array but got \"foo\"\n\ \tin array at index 1\n\ diff --git a/src/errors.ml b/src/errors.ml index 4b60519..02ac5e7 100644 --- a/src/errors.ml +++ b/src/errors.ml @@ -99,7 +99,8 @@ let of_json_error ?(depth = 2) ?(width = 8) ~json msg = emit " but got "; emit (show_json_error ~depth ~width json))) -let of_json_msg_unexpected_variant msg = raise (Of_json_error (Unexpected_variant msg)) +let of_json_msg_unexpected_variant msg = + raise (Of_json_error (Unexpected_variant msg)) let of_json_unexpected_variant ?(depth = 2) ?(width = 8) ~json msg = of_json_msg_unexpected_variant