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

Drop the result compatibility package dependency #153

Merged
merged 1 commit into from
Mar 28, 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
1 change: 0 additions & 1 deletion ppx_deriving_yojson.opam
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,6 @@ depends: [
"ocaml" {>= "4.05.0"}
"dune" {>= "1.0"}
"yojson" {>= "1.6.0"}
"result"
"ppx_deriving" {>= "5.1"}
"ppxlib" {>= "0.26.0"}
"ounit2" {with-test}
Expand Down
2 changes: 1 addition & 1 deletion src/dune
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
(public_name ppx_deriving_yojson.runtime)
(synopsis "Runtime components of [@@deriving yojson]")
(modules ppx_deriving_yojson_runtime)
(libraries ppx_deriving.runtime result))
(libraries ppx_deriving.runtime))

(library
(name ppx_deriving_yojson)
Expand Down
60 changes: 30 additions & 30 deletions src/ppx_deriving_yojson.ml
Original file line number Diff line number Diff line change
Expand Up @@ -177,14 +177,14 @@ let rec desu_fold ~quoter ~loc ~path f typs =
List.fold_left (fun x (i, y) ->
let loc = x.pexp_loc in
[%expr [%e y] >>= fun [%p pvar (argn i)] -> [%e x]])
[%expr Result.Ok [%e f (List.mapi (fun i _ -> evar (argn i)) typs)]]
[%expr Ok [%e f (List.mapi (fun i _ -> evar (argn i)) typs)]]
and desu_expr_of_typ ~quoter ~path typ =
match attr_desu typ.ptyp_attributes with
| Some e -> Ppx_deriving.quote ~quoter e
| None -> desu_expr_of_only_typ ~quoter ~path typ
and desu_expr_of_only_typ ~quoter ~path typ =
let loc = typ.ptyp_loc in
let error = [%expr Result.Error [%e str (String.concat "." path)]] in
let error = [%expr Error [%e str (String.concat "." path)]] in
let decode' cases =
Exp.function_ (
List.map (fun (pat, exp) -> Exp.case pat exp) cases @
Expand All @@ -193,50 +193,50 @@ and desu_expr_of_only_typ ~quoter ~path typ =
let decode pat exp = decode' [pat, exp] in
let desu_expr_of_typ = desu_expr_of_typ ~quoter in
match typ with
| [%type: unit] -> decode [%pat? `Null] [%expr Result.Ok ()]
| [%type: int] -> decode [%pat? `Int x] [%expr Result.Ok x]
| [%type: unit] -> decode [%pat? `Null] [%expr Ok ()]
| [%type: int] -> decode [%pat? `Int x] [%expr Ok x]
| [%type: float] ->
decode' [[%pat? `Int x], [%expr Result.Ok (float_of_int x)];
[%pat? `Intlit x], [%expr Result.Ok (float_of_string x)];
[%pat? `Float x], [%expr Result.Ok x]]
| [%type: bool] -> decode [%pat? `Bool x] [%expr Result.Ok x]
| [%type: string] -> decode [%pat? `String x] [%expr Result.Ok x]
| [%type: bytes] -> decode [%pat? `String x] [%expr Result.Ok (Bytes.of_string x)]
decode' [[%pat? `Int x], [%expr Ok (float_of_int x)];
[%pat? `Intlit x], [%expr Ok (float_of_string x)];
[%pat? `Float x], [%expr Ok x]]
| [%type: bool] -> decode [%pat? `Bool x] [%expr Ok x]
| [%type: string] -> decode [%pat? `String x] [%expr Ok x]
| [%type: bytes] -> decode [%pat? `String x] [%expr Ok (Bytes.of_string x)]
| [%type: char] ->
decode [%pat? `String x] [%expr if String.length x = 1 then Result.Ok x.[0] else [%e error]]
decode [%pat? `String x] [%expr if String.length x = 1 then Ok x.[0] else [%e error]]
| [%type: int32] | [%type: Int32.t] ->
decode' [[%pat? `Int x], [%expr Result.Ok (Int32.of_int x)];
[%pat? `Intlit x], [%expr Result.Ok (Int32.of_string x)]]
decode' [[%pat? `Int x], [%expr Ok (Int32.of_int x)];
[%pat? `Intlit x], [%expr Ok (Int32.of_string x)]]
| [%type: int64] | [%type: Int64.t] ->
begin match attr_int_encoding typ.ptyp_attributes with
| `String ->
decode [%pat? `String x] [%expr Result.Ok (Int64.of_string x)]
decode [%pat? `String x] [%expr Ok (Int64.of_string x)]
| `Int ->
decode' [[%pat? `Int x], [%expr Result.Ok (Int64.of_int x)];
[%pat? `Intlit x], [%expr Result.Ok (Int64.of_string x)]]
decode' [[%pat? `Int x], [%expr Ok (Int64.of_int x)];
[%pat? `Intlit x], [%expr Ok (Int64.of_string x)]]
end
| [%type: nativeint] | [%type: Nativeint.t] ->
begin match attr_int_encoding typ.ptyp_attributes with
| `String ->
decode [%pat? `String x] [%expr Result.Ok (Nativeint.of_string x)]
decode [%pat? `String x] [%expr Ok (Nativeint.of_string x)]
| `Int ->
decode' [[%pat? `Int x], [%expr Result.Ok (Nativeint.of_int x)];
[%pat? `Intlit x], [%expr Result.Ok (Nativeint.of_string x)]]
decode' [[%pat? `Int x], [%expr Ok (Nativeint.of_int x)];
[%pat? `Intlit x], [%expr Ok (Nativeint.of_string x)]]
end
| [%type: [%t? typ] ref] ->
[%expr fun x -> [%e desu_expr_of_typ ~path:(path @ ["contents"]) typ] x >|= ref]
| [%type: [%t? typ] option] ->
[%expr function
| `Null -> Result.Ok None
| x -> [%e desu_expr_of_typ ~path typ] x >>= fun x -> Result.Ok (Some x)]
| `Null -> Ok None
| x -> [%e desu_expr_of_typ ~path typ] x >>= fun x -> Ok (Some x)]
| [%type: [%t? typ] list] ->
decode [%pat? `List xs]
[%expr map_bind [%e desu_expr_of_typ ~path typ] [] xs]
| [%type: [%t? typ] array] ->
decode [%pat? `List xs]
[%expr map_bind [%e desu_expr_of_typ ~path typ] [] xs >|= Array.of_list]
| [%type: Yojson.Safe.t]
| [%type: Yojson.Safe.json] -> [%expr fun x -> Result.Ok x]
| [%type: Yojson.Safe.json] -> [%expr fun x -> Ok x]
| { ptyp_desc = Ptyp_tuple typs } ->
decode [%pat? `List [%p plist (List.mapi (fun i _ -> pvar (argn i)) typs)]]
(desu_fold ~quoter ~loc ~path tuple typs)
Expand All @@ -252,7 +252,7 @@ and desu_expr_of_only_typ ~quoter ~path typ =
let label = label.txt in
let attrs = field.prf_attributes in
Exp.case [%pat? `List [`String [%p pstr (attr_name label attrs)]]]
[%expr Result.Ok [%e Exp.variant label None]]
[%expr Ok [%e Exp.variant label None]]
| Rtag(label, false, [{ ptyp_desc = Ptyp_tuple typs }]) ->
let label = label.txt in
let attrs = field.prf_attributes in
Expand All @@ -264,7 +264,7 @@ and desu_expr_of_only_typ ~quoter ~path typ =
let attrs = field.prf_attributes in
Exp.case [%pat? `List [`String [%p pstr (attr_name label attrs)]; x]]
[%expr [%e desu_expr_of_typ ~path typ] x >>= fun x ->
Result.Ok [%e Exp.variant label (Some [%expr x])]]
Ok [%e Exp.variant label (Some [%expr x])]]
| Rinherit ({ ptyp_desc = Ptyp_constr (tname, _) } as typ) ->
Exp.case [%pat? [%p Pat.type_ tname] as x]
[%expr [%e desu_expr_of_typ ~path typ] x]
Expand All @@ -280,8 +280,8 @@ and desu_expr_of_only_typ ~quoter ~path typ =
| _ -> assert false)
|> List.fold_left (fun expr typ -> [%expr
match [%e desu_expr_of_typ ~path typ] json with
| (Result.Ok result) -> Result.Ok (result :> [%t toplevel_typ])
| Result.Error _ -> [%e expr]]) error
| (Ok result) -> Ok (result :> [%t toplevel_typ])
| Error _ -> [%e expr]]) error
|> Exp.case [%pat? _]
in
[%expr fun (json : Yojson.Safe.t) ->
Expand Down Expand Up @@ -522,7 +522,7 @@ let desu_str_of_record ~quoter ~loc ~is_strict ~error ~path wrap_record labels =
List.mapi (fun i { pld_name = { txt = name } } ->
mknoloc (Lident name), evar (argn i)))
None in
[%expr Result.Ok [%e wrap_record r] ] )
[%expr Ok [%e wrap_record r] ] )
(labels |> List.mapi (fun i _ -> i)) in
let default_case = if is_strict then top_error else [%expr loop xs _state] in
let cases =
Expand All @@ -542,7 +542,7 @@ let desu_str_of_record ~quoter ~loc ~is_strict ~error ~path wrap_record labels =
| None -> error (path @ [name])
| Some default ->
let default = [%expr ([%e default] : [%t pld_type])] in
[%expr Result.Ok [%e Ppx_deriving.quote ~quoter default]])
[%expr Ok [%e Ppx_deriving.quote ~quoter default]])
in
[%expr
function
Expand All @@ -557,7 +557,7 @@ let desu_str_of_type ~options ~path ({ ptype_loc = loc } as type_decl) =
let { is_strict; want_exn; _ } = parse_options options in
let quoter = Ppx_deriving.create_quoter () in
let path = path @ [type_decl.ptype_name.txt] in
let error path = [%expr Result.Error [%e str (String.concat "." path)]] in
let error path = [%expr Error [%e str (String.concat "." path)]] in
let top_error = error path in
let polymorphize = Ppx_deriving.poly_fun_of_type_decl type_decl in
let typ = Ppx_deriving.core_type_of_type_decl type_decl in
Expand Down Expand Up @@ -650,7 +650,7 @@ let desu_str_of_type ~options ~path ({ ptype_loc = loc } as type_decl) =
let var_s_exn_args = var_s_exn_args @ [evar "x"] in
let var_s_exn_fun =
let rec loop = function
| [] -> sanitize ~quoter ([%expr match [%e app (evar var_s) var_s_exn_args] with Result.Ok x -> x | Result.Error err -> raise (Failure err)])
| [] -> sanitize ~quoter ([%expr match [%e app (evar var_s) var_s_exn_args] with Ok x -> x | Error err -> raise (Failure err)])
| hd::tl -> lam (pvar hd) (loop tl)
in
loop ((List.mapi (fun i _ -> argn i) ptype_params) @ ["x"])
Expand Down
12 changes: 6 additions & 6 deletions src/ppx_deriving_yojson_runtime.ml
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
include Ppx_deriving_runtime

let (>>=) x f =
match x with Result.Ok x -> f x | (Result.Error _) as x -> x
match x with Ok x -> f x | (Error _) as x -> x

let (>|=) x f =
x >>= fun x -> Result.Ok (f x)
x >>= fun x -> Ok (f x)

let rec map_bind f acc xs =
match xs with
Expand All @@ -13,11 +13,11 @@ let rec map_bind f acc xs =
but do not use [(>>=)] to keep [map_bind] tail-recursive
under js-of-ocaml *)
(match f x with
| ((Result.Error _) as err) -> err
| Result.Ok x -> map_bind f (x :: acc) xs)
| [] -> Result.Ok (List.rev acc)
| ((Error _) as err) -> err
| Ok x -> map_bind f (x :: acc) xs)
| [] -> Ok (List.rev acc)

type 'a error_or = ('a, string) Result.result
type 'a error_or = ('a, string) result

(** [safe_map f l] returns the same value as [List.map f l], but
computes it tail-recursively so that large list lengths don't
Expand Down
7 changes: 1 addition & 6 deletions src/ppx_deriving_yojson_runtime.mli
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
type 'a error_or = ('a, string) Result.result
type 'a error_or = ('a, string) result

val ( >>= ) : 'a error_or -> ('a -> 'b error_or) -> 'b error_or
val ( >|= ) : 'a error_or -> ('a -> 'b) -> 'b error_or
Expand All @@ -17,8 +17,3 @@ module Int32 : (module type of Int32)
module Int64 : (module type of Int64)
module Nativeint : (module type of Nativeint)
module Array : (module type of Array)
module Result : sig
type ('a, 'b) result = ('a, 'b) Result.result =
| Ok of 'a
| Error of 'b
end
8 changes: 5 additions & 3 deletions src_test/dune
Original file line number Diff line number Diff line change
@@ -1,8 +1,10 @@
(executable
(name test_ppx_yojson)
(libraries ounit2 result)
(preprocess (pps ppx_deriving.show ppx_deriving_yojson))
(flags (:standard -w -9-39-27-34-37)))
(libraries ounit2)
(preprocess
(pps ppx_deriving.show ppx_deriving_yojson))
(flags
(:standard -w -9-39-27-34-37)))

(alias
(name runtest)
Expand Down
22 changes: 11 additions & 11 deletions src_test/test_ppx_yojson.ml
Original file line number Diff line number Diff line change
Expand Up @@ -15,19 +15,19 @@ type json =

let show_error_or =
let module M = struct
type 'a error_or = ('a, string) Result.result [@@deriving show]
type 'a error_or = ('a, string) result [@@deriving show]
end in
M.show_error_or

let assert_roundtrip pp_obj to_json of_json obj str =
let json = Yojson.Safe.from_string str in
let cleanup json = Yojson.Safe.(json |> to_string |> from_string) in
assert_equal ~printer:show_json json (cleanup (to_json obj));
assert_equal ~printer:(show_error_or pp_obj) (Result.Ok obj) (of_json json)
assert_equal ~printer:(show_error_or pp_obj) (Ok obj) (of_json json)

let assert_failure pp_obj of_json err str =
let json = Yojson.Safe.from_string str in
assert_equal ~printer:(show_error_or pp_obj) (Result.Error err) (of_json json)
assert_equal ~printer:(show_error_or pp_obj) (Error err) (of_json json)

type u = unit [@@deriving show, yojson]
type i1 = int [@@deriving show, yojson]
Expand Down Expand Up @@ -106,7 +106,7 @@ let test_float _ctxt =
assert_roundtrip pp_f f_to_yojson f_of_yojson
1.0 "1.0";
assert_equal ~printer:(show_error_or pp_f)
(Result.Ok 1.0)
(Ok 1.0)
(f_of_yojson (`Int 1))

let test_bool _ctxt =
Expand Down Expand Up @@ -191,7 +191,7 @@ let test_pvar _ctxt =
assert_roundtrip pp_pvd pvd_to_yojson pvd_of_yojson
(`C 1) "[\"C\", 1]";
assert_equal ~printer:(show_error_or pp_pvd)
(Result.Error "Test_ppx_yojson.pvd")
(Error "Test_ppx_yojson.pvd")
(pvd_of_yojson (`List [`String "D"]))

let test_var _ctxt =
Expand Down Expand Up @@ -228,7 +228,7 @@ let test_key _ctxt =

let test_field_err _ctxt =
assert_equal ~printer:(show_error_or pp_geo)
(Result.Error "Test_ppx_yojson.geo.lat")
(Error "Test_ppx_yojson.geo.lat")
(geo_of_yojson (`Assoc ["Longitude", (`Float 42.0)]))

type id = Yojson.Safe.t [@@deriving yojson]
Expand Down Expand Up @@ -279,9 +279,9 @@ module CustomConversions = struct

module IntMap = Map.Make(struct type t = int let compare = compare end)
type mapEncoding = (int * string) list [@@deriving yojson]
let map_to_yojson m = mapEncoding_to_yojson @@ IntMap.bindings m
let map_of_yojson json =
Result.(match mapEncoding_of_yojson json with
let map_to_yojson m = mapEncoding_to_yojson @@ IntMap.bindings m
let map_of_yojson json =
(match mapEncoding_of_yojson json with
| Ok lst -> Ok (List.fold_left (fun m (k, v) -> IntMap.add k v m) IntMap.empty lst)
| Error s -> Error s)

Expand All @@ -304,7 +304,7 @@ module CustomConversions = struct
assert_roundtrip pp_crecord crecord_to_yojson crecord_of_yojson
IntMap.{ mapping = add 6 "foo" @@ empty }
{|{"mapping":[[6,"foo"]]}|}

let suite = "Custom conversion attributes" >:::
[ "test_record" >:: test_record
; "test_bare" >:: test_bare ]
Expand All @@ -316,7 +316,7 @@ type nostrict = {
[@@deriving show, yojson { strict = false }]
let test_nostrict _ctxt =
assert_equal ~printer:(show_error_or pp_nostrict)
(Result.Ok { nostrict_field = 42 })
(Ok { nostrict_field = 42 })
(nostrict_of_yojson (`Assoc ["nostrict_field", (`Int 42);
"some_other_field", (`Int 43)]))

Expand Down