Skip to content

Commit

Permalink
ppx: add runtime for result
Browse files Browse the repository at this point in the history
  • Loading branch information
jchavarri committed Aug 29, 2024
1 parent f92373c commit bebc886
Show file tree
Hide file tree
Showing 5 changed files with 50 additions and 0 deletions.
28 changes: 28 additions & 0 deletions ppx/browser/ppx_deriving_json_runtime.ml
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,11 @@ module To_json = struct

let option_to_json v_to_json v : t =
match v with None -> Obj.magic Js.null | Some v -> v_to_json v

let result_to_json a_to_json b_to_json v : t =
match v with
| Ok x -> Obj.magic [| string_to_json "Ok"; a_to_json x |]
| Error x -> Obj.magic [| string_to_json "Error"; b_to_json x |]
end

module Of_json = struct
Expand Down Expand Up @@ -65,6 +70,29 @@ module Of_json = struct
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 a_of_json b_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 (a_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 (b_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"
end

module Primitives = struct
Expand Down
11 changes: 11 additions & 0 deletions ppx/native/ppx_deriving_json_runtime.ml
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,11 @@ module To_json = struct
let option_to_json v_to_json = function
| None -> `Null
| Some v -> v_to_json v

let result_to_json a_to_json b_to_json v =
match v with
| Ok x -> `List [ `String "Ok"; a_to_json x ]
| Error x -> `List [ `String "Error"; b_to_json x ]
end

module Of_json = struct
Expand All @@ -36,6 +41,12 @@ module Of_json = struct

let list_of_json v_of_json json =
List.map v_of_json (Yojson.Basic.Util.to_list json)

let result_of_json a_of_json b_of_json json =
match json with
| `List [ `String "Ok"; x ] -> Ok (a_of_json x)
| `List [ `String "Error"; x ] -> Error (b_of_json x)
| _ -> of_json_error "invalid JSON"
end

module Primitives = struct
Expand Down
3 changes: 3 additions & 0 deletions ppx/test/example.ml
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
type user = int [@@deriving json]
type 'a param = 'a [@@deriving json]
type opt = string option [@@deriving json]
type res = (int, string) result [@@deriving json]
type tuple = int * string [@@deriving json]
type record = { name : string; age : int } [@@deriving json]
type record_aliased = { name : string; [@json.key "my_name"] age : int; [@json.key "my_age"] [@json.default 100] } [@@deriving json]
Expand All @@ -23,6 +24,8 @@ module Cases = struct
C ({|1|}, user_of_json, user_to_json, 1);
C ({|"OK"|}, (param_of_json string_of_json), (param_to_json string_to_json), "OK");
C ({|"some"|}, opt_of_json, opt_to_json, (Some "some"));
C ({|["Ok", 1]|}, res_of_json, res_to_json, Ok 1);
C ({|["Error", "oops"]|}, res_of_json, res_to_json, Error "oops");
C ({|[42, "works"]|}, tuple_of_json, tuple_to_json, (42, "works"));
C ({|{"name":"N","age":1}|}, record_of_json, record_to_json, {name="N"; age=1});
C ({|["A"]|}, sum_of_json, sum_to_json, (A : sum));
Expand Down
4 changes: 4 additions & 0 deletions ppx/test/ppx_deriving_json_js.e2e.t
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,10 @@
JSON REPRINT: "OK"
JSON DATA: "some"
JSON REPRINT: "some"
JSON DATA: ["Ok", 1]
JSON REPRINT: ["Ok",1]
JSON DATA: ["Error", "oops"]
JSON REPRINT: ["Error","oops"]
JSON DATA: [42, "works"]
JSON REPRINT: [42,"works"]
JSON DATA: {"name":"N","age":1}
Expand Down
4 changes: 4 additions & 0 deletions ppx/test/ppx_deriving_json_native.e2e.t
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,10 @@
JSON REPRINT: "OK"
JSON DATA: "some"
JSON REPRINT: "some"
JSON DATA: ["Ok", 1]
JSON REPRINT: ["Ok",1]
JSON DATA: ["Error", "oops"]
JSON REPRINT: ["Error","oops"]
JSON DATA: [42, "works"]
JSON REPRINT: [42,"works"]
JSON DATA: {"name":"N","age":1}
Expand Down

0 comments on commit bebc886

Please sign in to comment.