diff --git a/ppx/browser/ppx_deriving_json_runtime.ml b/ppx/browser/ppx_deriving_json_runtime.ml index 44100e5..31484d5 100644 --- a/ppx/browser/ppx_deriving_json_runtime.ml +++ b/ppx/browser/ppx_deriving_json_runtime.ml @@ -3,8 +3,26 @@ type t = Js.Json.t let to_json t = t let of_json t = t let to_string t = Js.Json.stringify t -let of_string s = Js.Json.parseExn s -let of_json_error msg = raise @@ Json.Decode.DecodeError msg + +exception Of_string_error of string + +let of_string s = + try Js.Json.parseExn s + with exn -> + let msg = + match Js.Exn.asJsExn exn with + | Some jsexn -> Js.Exn.message jsexn + | None -> None + in + let msg = + (* msg really cannot be None in browser or any sane JS runtime *) + Option.value msg ~default:"JSON error" + in + raise (Of_string_error msg) + +exception Of_json_error = Json.Decode.DecodeError + +let of_json_error msg = raise (Of_json_error msg) module To_json = struct external string_to_json : string -> t = "%identity" diff --git a/ppx/native/ppx_deriving_json_runtime.ml b/ppx/native/ppx_deriving_json_runtime.ml index 6d0bcef..ff63b32 100644 --- a/ppx/native/ppx_deriving_json_runtime.ml +++ b/ppx/native/ppx_deriving_json_runtime.ml @@ -3,12 +3,31 @@ type t = Yojson.Basic.t let to_json t = t let of_json t = t let to_string t = Yojson.Basic.to_string t -let of_string s = Yojson.Basic.from_string s + +exception Of_string_error of string + +let of_string s = + try Yojson.Basic.from_string s + with Yojson.Json_error msg -> raise (Of_string_error msg) exception Of_json_error of string let of_json_error msg = raise (Of_json_error msg) +let show_json_type = function + | `Assoc _ -> "object" + | `Bool _ -> "bool" + | `Float _ -> "float" + | `Int _ -> "int" + | `List _ -> "array" + | `Null -> "null" + | `String _ -> "string" + +let of_json_error_type_mismatch json expected = + raise + (Of_json_error + ("expected " ^ expected ^ " but got " ^ show_json_type json)) + module To_json = struct let string_to_json v = `String v let bool_to_json v = `Bool v @@ -28,19 +47,43 @@ module To_json = struct end module Of_json = struct - let string_of_json = Yojson.Basic.Util.to_string - let bool_of_json = Yojson.Basic.Util.to_bool - let int_of_json = Yojson.Basic.Util.to_int - let float_of_json = Yojson.Basic.Util.to_number + let typeof = function + | `Assoc _ -> "object" + | `Bool _ -> "bool" + | `Float _ -> "float" + | `Int _ -> "int" + | `List _ -> "array" + | `Null -> "null" + | `String _ -> "string" + + let string_of_json = function + | `String s -> s + | json -> of_json_error_type_mismatch json "string" + + let bool_of_json = function + | `Bool b -> b + | json -> of_json_error_type_mismatch json "bool" + + let int_of_json = function + | `Int i -> i + | json -> of_json_error_type_mismatch json "int" + + let float_of_json = function + | `Float f -> f + | `Int i -> float_of_int i + | json -> of_json_error_type_mismatch json "float" let unit_of_json = function | `Null -> () | _ -> of_json_error "expected null" - let option_of_json v_of_json = Yojson.Basic.Util.to_option v_of_json + let option_of_json v_of_json = function + | `Null -> None + | json -> Some (v_of_json json) - let list_of_json v_of_json json = - List.map v_of_json (Yojson.Basic.Util.to_list json) + let list_of_json v_of_json = function + | `List l -> List.map v_of_json l + | json -> of_json_error_type_mismatch json "array" let result_of_json ok_of_json err_of_json json = match json with