Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

unify: fix tests #46

Merged
merged 9 commits into from
Dec 16, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion README.md
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ Based on [@glennsl/bs-json](https://github.com/glennsl/bs-json).
The Decode module in particular provides a basic set of decoder functions to be
composed into more complex decoders. A decoder is a function that takes a
`Js.Json.t` and either returns a value of the desired type if successful or
raises a `DecodeError` exception if not. Other functions accept a decoder and
raises an `Of_json_error` exception if not. Other functions accept a decoder and
produce another decoder. Like `array`, which when given a decoder for type `t`
will return a decoder that tries to produce a value of type `t array`. So to
decode an `int array` you combine `Json.Decode.int` with `Json.Decode.array`
Expand Down
1 change: 1 addition & 0 deletions examples/complex.ml
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
[@@@alert "-deprecated"]
type line = { start : point; end_ : point; thickness : int option }
and point = { x : int; y : int }

Expand Down
6 changes: 4 additions & 2 deletions examples/decode.ml
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
[@@@alert "-deprecated"]

(* Decoding a fixed JSON data structure using Json.Decode *)
let mapJsonObjectString f decoder (encoder : int -> Js.Json.t) str =
let json = Json.parseOrRaise str in
Expand Down Expand Up @@ -26,5 +28,5 @@ let _ =
let json = {|{ "y": 42 } |} |> Json.parseOrRaise in
match Json.Decode.(field "x" int json) with
| x -> Js.log x
| exception Json.Decode.DecodeError err ->
Js.log ("Error:" ^ Json.Decode.error_to_string err)
| exception Json.Of_json_error err ->
Js.log ("Error:" ^ Json.of_json_error_to_string err)
2 changes: 2 additions & 0 deletions examples/dynamicDict_Ocaml.ml
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
[@@@alert "-deprecated"]

(*
Handling an object with dynamic keys for sub-objects.
example:
Expand Down
2 changes: 2 additions & 0 deletions examples/dynamicDict_Reason.re
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
[@alert "-deprecated"];

/*
Handling an object with dynamic keys for sub-objects.
example:
Expand Down
1 change: 1 addition & 0 deletions examples/encode.ml
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
[@@@alert "-deprecated"]
(* Encoding a JSON data structure using Json.Encode *)

(* prints ["foo", "bar"] *)
Expand Down
2 changes: 2 additions & 0 deletions examples/parse.ml
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
[@@@alert "-deprecated"]

(* Parsing a JSON string using Json.parseOrRaise *)

let arrayOfInts str =
Expand Down
1 change: 1 addition & 0 deletions examples/tree.ml
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
[@@@alert "-deprecated"]
(* Decode a JSON tree structure *)
type 'a tree = Node of 'a * 'a tree list | Leaf of 'a

Expand Down
95 changes: 20 additions & 75 deletions ppx/browser/ppx_deriving_json_runtime.ml
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
[@@@alert "-deprecated"]

type t = Js.Json.t

let to_json t = t
let of_json t = t
let to_string t = Js.Json.stringify t

exception Of_string_error of string

let of_string s =
try Js.Json.parseExn s
with exn ->
Expand All @@ -18,13 +18,13 @@ let of_string s =
(* msg really cannot be None in browser or any sane JS runtime *)
Option.value msg ~default:"JSON error"
in
raise (Of_string_error msg)
raise (Json.Of_string_error msg)

type error = Json.Decode.error =
type error = Json.of_json_error =
| Json_error of string
| Unexpected_variant of string

exception Of_json_error = Json.Decode.DecodeError
exception Of_json_error = Json.Of_json_error

let of_json_error msg = raise (Of_json_error (Json_error msg))

Expand Down Expand Up @@ -60,75 +60,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
Expand All @@ -137,6 +78,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
Expand All @@ -153,7 +98,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
Expand Down
3 changes: 1 addition & 2 deletions ppx/native/ppx_deriving_json_runtime.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading
Loading