diff --git a/ppx/browser/ppx_deriving_json_runtime.ml b/ppx/browser/ppx_deriving_json_runtime.ml index ba9ca07..03dbefa 100644 --- a/ppx/browser/ppx_deriving_json_runtime.ml +++ b/ppx/browser/ppx_deriving_json_runtime.ml @@ -1,4 +1,5 @@ [@@@alert "-deprecated"] + type t = Js.Json.t let to_json t = t @@ -61,75 +62,16 @@ module To_json = struct end module Of_json = struct - let string_of_json (json : t) : string = - if Js.typeof json = "string" then (Obj.magic json : string) - else of_json_error "expected a string" - - let bool_of_json (json : t) : bool = - if Js.typeof json = "boolean" then (Obj.magic json : bool) - else of_json_error "expected a boolean" - - let is_int value = - Js.Float.isFinite value && Js.Math.floor_float value == value - - let int_of_json (json : t) : int = - if Js.typeof json = "number" then - let v = (Obj.magic json : float) in - if is_int v then (Obj.magic v : int) - else of_json_error "expected an integer" - else of_json_error "expected an integer" - - let int64_of_json (json : t) : int64 = - if Js.typeof json = "string" then - let v = (Obj.magic json : string) in - match Int64.of_string_opt v with - | Some v -> v - | None -> of_json_error "expected int64 as string" - else of_json_error "expected int64 as string" - - let float_of_json (json : t) : float = - if Js.typeof json = "number" then (Obj.magic json : float) - else of_json_error "expected a float" - - let unit_of_json (json : t) = - if (Obj.magic json : 'a Js.null) == Js.null then () - else of_json_error "expected null" - - let array_of_json v_of_json (json : t) = - if Js.Array.isArray json then - let json = (Obj.magic json : Js.Json.t array) in - Js.Array.map ~f:v_of_json json - else of_json_error "expected a JSON array" - - let list_of_json v_of_json (json : t) = - array_of_json v_of_json json |> Array.to_list - - let option_of_json v_of_json (json : t) = - if (Obj.magic json : 'a Js.null) == Js.null then None - else Some (v_of_json json) - - let result_of_json ok_of_json err_of_json (json : t) = - if Js.Array.isArray json then - let array = (Obj.magic json : Js.Json.t array) in - let len = Js.Array.length array in - if Stdlib.( > ) len 0 then - let tag = Js.Array.unsafe_get array 0 in - if Stdlib.( = ) (Js.typeof tag) "string" then - let tag = (Obj.magic tag : string) in - if Stdlib.( = ) tag "Ok" then ( - if Stdlib.( <> ) len 2 then - of_json_error "expected a JSON array of length 2"; - Ok (ok_of_json (Js.Array.unsafe_get array 1))) - else if Stdlib.( = ) tag "Error" then ( - if Stdlib.( <> ) len 2 then - of_json_error "expected a JSON array of length 2"; - Error (err_of_json (Js.Array.unsafe_get array 1))) - else of_json_error "invalid JSON" - else - of_json_error - "expected a non empty JSON array with element being a string" - else of_json_error "expected a non empty JSON array" - else of_json_error "expected a non empty JSON array" + let string_of_json = Json.Of_json.string + let bool_of_json = Json.Of_json.bool + let int_of_json = Json.Of_json.int + let int64_of_json = Json.Of_json.int64 + let float_of_json = Json.Of_json.float + let unit_of_json = Json.Of_json.unit + let array_of_json = Json.Of_json.array + let list_of_json = Json.Of_json.list + let option_of_json = Json.Of_json.option + let result_of_json = Json.Of_json.result end module Primitives = struct @@ -138,6 +80,10 @@ module Primitives = struct end module Classify = struct + (* This function is also defined in `Json` module, but not exposed on its mli *) + let is_int value = + Js.Float.isFinite value && Js.Math.floor_float value == value + let classify : t -> [ `Null @@ -154,7 +100,7 @@ module Classify = struct | "string" -> `String (Obj.magic json : string) | "number" -> let v = (Obj.magic json : float) in - if Of_json.is_int v then `Int (Obj.magic v : int) else `Float v + if is_int v then `Int (Obj.magic v : int) else `Float v | "boolean" -> `Bool (Obj.magic json : bool) | "object" -> if Js.Array.isArray json then diff --git a/ppx/native/ppx_deriving_json_runtime.ml b/ppx/native/ppx_deriving_json_runtime.ml index f043e9b..1d3b146 100644 --- a/ppx/native/ppx_deriving_json_runtime.ml +++ b/ppx/native/ppx_deriving_json_runtime.ml @@ -26,8 +26,7 @@ let show_json_type = function | `String _ -> "string" let of_json_error_type_mismatch json expected = - of_json_error - ("expected " ^ expected ^ " but got " ^ show_json_type json) + of_json_error ("Expected " ^ expected ^ ", got " ^ show_json_type json) module To_json = struct let string_to_json v = `String v diff --git a/src/Json.ml b/src/Json.ml index a654a7d..1ac1615 100644 --- a/src/Json.ml +++ b/src/Json.ml @@ -37,8 +37,6 @@ let of_string s = raise (Of_string_error msg) module Of_json = struct - external _stringify : Js.Json.t -> string = "JSON.stringify" - let string (json : t) : string = if Js.typeof json = "string" then (Obj.magic json : string) else of_json_error ("Expected string, got " ^ Js.Json.stringify json) @@ -51,7 +49,7 @@ module Of_json = struct of_json_error ("Expected single-character string, got " ^ Js.Json.stringify json) - else of_json_error "expected a string" + else of_json_error ("Expected string, got " ^ Js.Json.stringify json) let bool (json : t) : bool = if Js.typeof json = "boolean" then (Obj.magic json : bool) @@ -73,16 +71,22 @@ module Of_json = struct let v = (Obj.magic json : string) in match Int64.of_string_opt v with | Some v -> v - | None -> of_json_error "expected int64 as string" - else of_json_error "expected int64 as string" + | None -> + of_json_error + ("Expected int64 as string, got " ^ Js.Json.stringify json) + else + of_json_error + ("Expected int64 as string, got " ^ Js.Json.stringify json) let float (json : t) : float = if Js.typeof json = "number" then (Obj.magic json : float) - else of_json_error "expected a float" + else of_json_error ("Expected number, got " ^ Js.Json.stringify json) let unit (json : t) : unit = if (Obj.magic json : 'a Js.null) == Js.null then () - else of_json_error "expected null" + else + of_json_error + ("Expected null as unit, got " ^ Js.Json.stringify json) let array v_of_json (json : t) = if Js.Array.isArray json then ( @@ -128,8 +132,10 @@ module Of_json = struct else let length = Js.String.make length in of_json_error - {j|Expected array of length 2, got array of length $length|j} - else of_json_error ("Expected array, got " ^ _stringify json) + {j|Expected array of length 2 as tuple, got array of length $length|j} + else + of_json_error + ("Expected array as tuple, got " ^ Js.Json.stringify json) let tuple3 decodeA decodeB decodeC json : _ * _ * _ = if Js.Array.isArray json then @@ -145,8 +151,10 @@ module Of_json = struct else let length = Js.String.make length in of_json_error - {j|Expected array of length 3, got array of length $length|j} - else of_json_error ("Expected array, got " ^ _stringify json) + {j|Expected array of length 3 as tuple, got array of length $length|j} + else + of_json_error + ("Expected array as tuple, got " ^ Js.Json.stringify json) let tuple4 decodeA decodeB decodeC decodeD json : _ * _ * _ * _ = if Js.Array.isArray json then @@ -163,8 +171,10 @@ module Of_json = struct else let length = Js.String.make length in of_json_error - {j|Expected array of length 4, got array of length $length|j} - else of_json_error ("Expected array, got " ^ _stringify json) + {j|Expected array of length 4 as tuple, got array of length $length|j} + else + of_json_error + ("Expected array as tuple, got " ^ Js.Json.stringify json) let js_dict decode json : _ Js.Dict.t = if @@ -190,7 +200,9 @@ module Of_json = struct Js.Dict.set target key value done; target) - else of_json_error ("Expected object, got " ^ _stringify json) + else + of_json_error + ("Expected object as dict, got " ^ Js.Json.stringify json) let result ok_of_json err_of_json (json : t) : (_, _) result = if Js.Array.isArray json then @@ -202,18 +214,27 @@ module Of_json = struct let tag = (Obj.magic tag : string) in if Stdlib.( = ) tag "Ok" then ( if Stdlib.( <> ) len 2 then - of_json_error "expected a JSON array of length 2"; + of_json_error + ("Expected array of length 2 as result 'Ok', got " + ^ Js.Json.stringify json); Ok (ok_of_json (Js.Array.unsafe_get array 1))) else if Stdlib.( = ) tag "Error" then ( if Stdlib.( <> ) len 2 then - of_json_error "expected a JSON array of length 2"; + of_json_error + ("Expected array of length 2 as result 'Error', got " + ^ Js.Json.stringify json); Error (err_of_json (Js.Array.unsafe_get array 1))) else of_json_error "invalid JSON" else of_json_error - "expected a non empty JSON array with element being a string" - else of_json_error "expected a non empty JSON array" - else of_json_error "expected a non empty JSON array" + ("Expected non-empty array with element being a string, got " + ^ Js.Json.stringify json) + else + of_json_error + ("Expected non-empty array, got " ^ Js.Json.stringify json) + else + of_json_error + ("Expected a non-empty array, got " ^ Js.Json.stringify json) let at' key decode json = if @@ -230,7 +251,7 @@ module Of_json = struct (of_json_error_to_string err ^ "\n\tat field '" ^ key ^ "'") ) | None -> of_json_error {j|Expected field '$(key)'|j} - else of_json_error ("Expected object, got " ^ _stringify json) + else of_json_error ("Expected object, got " ^ Js.Json.stringify json) let rec at key_path decoder = match key_path with @@ -251,7 +272,7 @@ module Of_json = struct in of_json_error ({j|All decoders given to oneOf failed. Here are all the errors: $formattedErrors\nAnd the JSON being decoded: |j} - ^ _stringify json) + ^ Js.Json.stringify json) | decode :: rest -> ( try decode json with Of_json_error e -> inner rest (e :: errors)) diff --git a/src/__tests__/Json_decode_test.ml b/src/__tests__/Json_decode_test.ml index 649dd4a..a198e3d 100644 --- a/src/__tests__/Json_decode_test.ml +++ b/src/__tests__/Json_decode_test.ml @@ -288,7 +288,8 @@ let () = with | Of_json_error (Json_error - "Expected array of length 2, got array of length 1") + "Expected array of length 2 as tuple, got array of \ + length 1") -> pass); test "too large" (fun () -> @@ -300,7 +301,8 @@ let () = with | Of_json_error (Json_error - "Expected array of length 2, got array of length 3") + "Expected array of length 2 as tuple, got array of \ + length 3") -> pass); test "bad type a" (fun () -> @@ -329,7 +331,8 @@ let () = try let (_ : int * int) = (pair int int) (parseOrRaise {| 4 |}) in fail "should throw" - with Of_json_error (Json_error "Expected array, got 4") -> + with + | Of_json_error (Json_error "Expected array as tuple, got 4") -> pass); test "non-DecodeError exceptions in decoder should pass through" (fun () -> @@ -355,7 +358,8 @@ let () = with | Of_json_error (Json_error - "Expected array of length 2, got array of length 1") + "Expected array of length 2 as tuple, got array of \ + length 1") -> pass); test "too large" (fun () -> @@ -367,7 +371,8 @@ let () = with | Of_json_error (Json_error - "Expected array of length 2, got array of length 3") + "Expected array of length 2 as tuple, got array of \ + length 3") -> pass); test "bad type a" (fun () -> @@ -398,7 +403,8 @@ let () = (tuple2 int int) (parseOrRaise {| 4 |}) in fail "should throw" - with Of_json_error (Json_error "Expected array, got 4") -> + with + | Of_json_error (Json_error "Expected array as tuple, got 4") -> pass); test "non-DecodeError exceptions in decoder should pass through" (fun () -> @@ -426,7 +432,8 @@ let () = with | Of_json_error (Json_error - "Expected array of length 3, got array of length 1") + "Expected array of length 3 as tuple, got array of \ + length 1") -> pass); test "too large" (fun () -> @@ -438,7 +445,8 @@ let () = with | Of_json_error (Json_error - "Expected array of length 3, got array of length 5") + "Expected array of length 3 as tuple, got array of \ + length 5") -> pass); test "bad type a" (fun () -> @@ -470,7 +478,8 @@ let () = (tuple3 int int int) (parseOrRaise {| 4 |}) in fail "should throw" - with Of_json_error (Json_error "Expected array, got 4") -> + with + | Of_json_error (Json_error "Expected array as tuple, got 4") -> pass); test "non-DecodeError exceptions in decoder should pass through" (fun () -> @@ -499,7 +508,8 @@ let () = with | Of_json_error (Json_error - "Expected array of length 4, got array of length 1") + "Expected array of length 4 as tuple, got array of \ + length 1") -> pass); test "too large" (fun () -> @@ -512,7 +522,8 @@ let () = with | Of_json_error (Json_error - "Expected array of length 4, got array of length 6") + "Expected array of length 4 as tuple, got array of \ + length 6") -> pass); test "bad type a" (fun () -> @@ -544,7 +555,8 @@ let () = (tuple4 int int int int) (parseOrRaise {| 4 |}) in fail "should throw" - with Of_json_error (Json_error "Expected array, got 4") -> + with + | Of_json_error (Json_error "Expected array as tuple, got 4") -> pass); test "non-DecodeError exceptions in decoder should pass through" (fun () ->