Skip to content

Commit

Permalink
unify: fix tests (#46)
Browse files Browse the repository at this point in the history
  • Loading branch information
jchavarri authored Dec 16, 2024
1 parent 708763c commit b145688
Show file tree
Hide file tree
Showing 15 changed files with 194 additions and 171 deletions.
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

0 comments on commit b145688

Please sign in to comment.