fix some error msgs

melange-community · Dec 15, 2024 · 040b786 · 040b786
1 parent e53346c
commit 040b786
Show file tree

Hide file tree

Showing 2 changed files with 77 additions and 37 deletions.
diff --git a/src/Json.ml b/src/Json.ml
@@ -19,6 +19,9 @@ let to_string t = Js.Json.stringify t
 
 exception Of_string_error of string
 
+external _unsafeCreateUninitializedArray : int -> 'a array = "Array"
+[@@mel.new]
+
 let of_string s =
   try Js.Json.parseExn s
   with exn ->
@@ -38,18 +41,21 @@ module Of_json = struct
 
   let string (json : t) : string =
     if Js.typeof json = "string" then (Obj.magic json : string)
-    else of_json_error "expected a string"
+    else of_json_error ("Expected string, got " ^ Js.Json.stringify json)
 
   let char (json : t) =
     if Js.typeof json = "string" then
       let s = (Obj.magic json : string) in
       if String.length s = 1 then String.get s 0
-      else of_json_error "expected a single-character string"
+      else
+        of_json_error
+          ("Expected a single-character string, got "
+          ^ Js.Json.stringify json)
     else of_json_error "expected a string"
 
   let bool (json : t) : bool =
     if Js.typeof json = "boolean" then (Obj.magic json : bool)
-    else of_json_error "expected a boolean"
+    else of_json_error ("Expected boolean, got " ^ Js.Json.stringify json)
 
   let is_int value =
     Js.Float.isFinite value && Js.Math.floor_float value == value
@@ -58,8 +64,9 @@ module Of_json = struct
     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"
+      else
+        of_json_error ("Expected integer, got " ^ Js.Json.stringify json)
+    else of_json_error ("Expected number, got " ^ Js.Json.stringify json)
 
   let int64 (json : t) : int64 =
     if Js.typeof json = "string" then
@@ -77,11 +84,22 @@ module Of_json = struct
     if (Obj.magic json : 'a Js.null) == Js.null then ()
     else of_json_error "expected null"
 
-  let array v_of_json (json : t) : _ array =
-    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 array v_of_json (json : t) =
+    if Js.Array.isArray json then (
+      let source = (Obj.magic (json : Js.Json.t) : Js.Json.t array) in
+      let length = Js.Array.length source in
+      let target = _unsafeCreateUninitializedArray length in
+      for i = 0 to length - 1 do
+        let value =
+          try v_of_json (Array.unsafe_get source i)
+          with Of_json_error (Json_error err) ->
+            of_json_error
+              (err ^ "\n\tin array at index " ^ string_of_int i)
+        in
+        Array.unsafe_set target i value
+      done;
+      target)
+    else of_json_error ("Expected array, got " ^ Js.Json.stringify json)
 
   let list v_of_json (json : t) : _ list =
     array v_of_json json |> Array.to_list
@@ -163,7 +181,11 @@ module Of_json = struct
         let value =
           try decode (Js.Dict.unsafeGet source key)
           with Of_json_error err ->
-            of_json_error (of_json_error_to_string err ^ "\n\tin dict")
+            of_json_error
+              (of_json_error_to_string err
+              ^ "\n\tin object at key '"
+              ^ key
+              ^ "'")
         in
         Js.Dict.set target key value
       done;

diff --git a/src/__tests__/Json_decode_test.ml b/src/__tests__/Json_decode_test.ml
@@ -1,4 +1,5 @@
 [@@@alert "-deprecated"]
+
 open Jest
 open Expect
 
@@ -77,7 +78,7 @@ let () =
             let (_ : int) = int (Encode.int inf) in
             fail "should throw"
           with
-          | Json.Of_json_error (Json_error "expected an integer")
+          | Json.Of_json_error (Json_error "Expected integer, got null")
           ->
             pass);
 
@@ -118,7 +119,7 @@ let () =
             fail "should throw"
           with
           | Json.Of_json_error
-              (Json_error "expected a single-character string")
+              (Json_error "Expected a single-character string, got \"\"")
           ->
             pass);
 
@@ -128,7 +129,8 @@ let () =
             fail "should throw"
           with
           | Json.Of_json_error
-              (Json_error "expected a single-character string")
+              (Json_error
+                 "Expected a single-character string, got \"abc\"")
           ->
             pass);
 
@@ -208,7 +210,7 @@ let () =
             fail "should throw"
           with
           | Json.Of_json_error
-              (Json_error "expected a boolean")
+              (Json_error "Expected boolean, got 1\n\tin array at index 0")
           ->
             pass);
       test "non-DecodeError exceptions in decoder should pass through"
@@ -255,7 +257,7 @@ let () =
             fail "should throw"
           with
           | Json.Of_json_error
-              (Json_error "expected a boolean")
+              (Json_error "Expected boolean, got 1\n\tin array at index 0")
           ->
             pass);
       test "non-DecodeError exceptions in decoder should pass through"
@@ -311,7 +313,7 @@ let () =
             fail "should throw"
           with
           | Json.Of_json_error
-              (Json_error "expected an integer\n\tin pair/tuple2")
+              (Json_error "Expected number, got \"3\"\n\tin pair/tuple2")
           ->
             pass);
       test "bad type b" (fun () ->
@@ -322,14 +324,15 @@ let () =
             fail "should throw"
           with
           | Json.Of_json_error
-              (Json_error "expected a string\n\tin pair/tuple2")
+              (Json_error "Expected string, got 4\n\tin pair/tuple2")
           ->
             pass);
       test "not array" (fun () ->
           try
             let (_ : int * int) = (pair int int) (parseOrRaise {| 4 |}) in
             fail "should throw"
-          with Of_json_error (Json_error "Expected array, got 4") -> pass);
+          with Of_json_error (Json_error "Expected array, got 4") ->
+            pass);
       test "non-DecodeError exceptions in decoder should pass through"
         (fun () ->
           try
@@ -377,7 +380,7 @@ let () =
             fail "should throw"
           with
           | Json.Of_json_error
-              (Json_error "expected an integer\n\tin pair/tuple2")
+              (Json_error "Expected number, got \"3\"\n\tin pair/tuple2")
           ->
             pass);
       test "bad type b" (fun () ->
@@ -388,7 +391,7 @@ let () =
             fail "should throw"
           with
           | Json.Of_json_error
-              (Json_error "expected a string\n\tin pair/tuple2")
+              (Json_error "Expected string, got 4\n\tin pair/tuple2")
           ->
             pass);
       test "not array" (fun () ->
@@ -397,7 +400,8 @@ let () =
               (tuple2 int int) (parseOrRaise {| 4 |})
             in
             fail "should throw"
-          with Of_json_error (Json_error "Expected array, got 4") -> pass);
+          with Of_json_error (Json_error "Expected array, got 4") ->
+            pass);
       test "non-DecodeError exceptions in decoder should pass through"
         (fun () ->
           try
@@ -447,7 +451,7 @@ let () =
             fail "should throw"
           with
           | Json.Of_json_error
-              (Json_error "expected an integer\n\tin tuple3")
+              (Json_error "Expected number, got \"3\"\n\tin tuple3")
           ->
             pass);
       test "bad type b" (fun () ->
@@ -458,7 +462,8 @@ let () =
             in
             fail "should throw"
           with
-          | Json.Of_json_error (Json_error "expected a string\n\tin tuple3")
+          | Json.Of_json_error
+              (Json_error "Expected string, got 4\n\tin tuple3")
           ->
             pass);
       test "not array" (fun () ->
@@ -467,7 +472,8 @@ let () =
               (tuple3 int int int) (parseOrRaise {| 4 |})
             in
             fail "should throw"
-          with Of_json_error (Json_error "Expected array, got 4") -> pass);
+          with Of_json_error (Json_error "Expected array, got 4") ->
+            pass);
       test "non-DecodeError exceptions in decoder should pass through"
         (fun () ->
           try
@@ -519,7 +525,7 @@ let () =
             fail "should throw"
           with
           | Json.Of_json_error
-              (Json_error "expected an integer\n\tin tuple4")
+              (Json_error "Expected number, got \"3\"\n\tin tuple4")
           ->
             pass);
       test "bad type b" (fun () ->
@@ -530,7 +536,8 @@ let () =
             in
             fail "should throw"
           with
-          | Json.Of_json_error (Json_error "expected a string\n\tin tuple4")
+          | Json.Of_json_error
+              (Json_error "Expected string, got 4\n\tin tuple4")
           ->
             pass);
       test "not array" (fun () ->
@@ -539,7 +546,8 @@ let () =
               (tuple4 int int int int) (parseOrRaise {| 4 |})
             in
             fail "should throw"
-          with Of_json_error (Json_error "Expected array, got 4") -> pass);
+          with Of_json_error (Json_error "Expected array, got 4") ->
+            pass);
       test "non-DecodeError exceptions in decoder should pass through"
         (fun () ->
           try
@@ -584,7 +592,8 @@ let () =
             fail "should throw"
           with
           | Json.Of_json_error
-              (Json_error "expected a string\n\tin dict")
+              (Json_error
+                 "Expected string, got null\n\tin object at key 'a'")
           ->
             pass);
       test "non-DecodeError exceptions in decoder should pass through"
@@ -639,7 +648,7 @@ let () =
             fail "should throw"
           with
           | Of_json_error
-              (Json_error "expected a string\n\tat field 'b'")
+              (Json_error "Expected string, got null\n\tat field 'b'")
           ->
             pass);
 
@@ -690,7 +699,8 @@ let () =
             in
             fail "should throw"
           with
-          | Json.Of_json_error (Json_error "Expected field 'y'\n\tat field 'a'")
+          | Json.Of_json_error
+              (Json_error "Expected field 'y'\n\tat field 'a'")
           ->
             pass);
       test "decoder error" (fun () ->
@@ -707,7 +717,10 @@ let () =
           with
           | Json.Of_json_error
               (Json_error
-                 "Expected null\n\tat field 'y'\n\tat field 'x'\n\tat field 'a'")
+                 "Expected null\n\
+                  \tat field 'y'\n\
+                  \tat field 'x'\n\
+                  \tat field 'a'")
           ->
             pass);
       test "empty list of keys should raise Invalid_argument" (fun () ->
@@ -919,9 +932,12 @@ let () =
             in
             fail "should throw"
           with
-          | Json.Of_json_error
+          | Of_json_error
               (Json_error
-                 "expected an integer\n\tin dict")
+                 "Expected number, got true\n\
+                  \tin array at index 0\n\
+                  \tin array at index 1\n\
+                  \tin object at key 'a'")
           ->
             pass);
       test "dict array array int - heterogenous structure 2" (fun () ->
@@ -933,9 +949,11 @@ let () =
             in
             fail "should throw"
           with
-          | Json.Of_json_error
-              (Json.Json_error
-                 "expected a JSON array\n\tin dict")
+          | Of_json_error
+              (Json_error
+                 "Expected array, got \"foo\"\n\
+                  \tin array at index 1\n\
+                  \tin object at key 'a'")
           ->
             pass);
       test "field" (fun () ->