better errors, simplify code

melange-community · Dec 15, 2024 · 6a45efa · 6a45efa
1 parent fbeacdf
commit 6a45efa
Show file tree

Hide file tree

Showing 4 changed files with 83 additions and 105 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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 () ->