From b6b30875e486241986429a2c1e4b2c4ee288b70b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Tue, 24 Apr 2018 02:15:20 +0200 Subject: [PATCH] Resto: export `RPC_arg.eq` to the protocol. --- src/lib_protocol_environment/sigs/v1/RPC_arg.mli | 6 ++++++ src/lib_rpc/RPC_arg.ml | 1 + src/lib_rpc/RPC_arg.mli | 1 + .../lib_resto-directory/resto_directory.ml | 8 ++++---- vendors/ocplib-resto/lib_resto/resto.ml | 13 +++++++++---- vendors/ocplib-resto/lib_resto/resto.mli | 6 ++++-- 6 files changed, 25 insertions(+), 10 deletions(-) diff --git a/src/lib_protocol_environment/sigs/v1/RPC_arg.mli b/src/lib_protocol_environment/sigs/v1/RPC_arg.mli index 8920a1419..8658a58c8 100644 --- a/src/lib_protocol_environment/sigs/v1/RPC_arg.mli +++ b/src/lib_protocol_environment/sigs/v1/RPC_arg.mli @@ -26,3 +26,9 @@ val int: int arg val int32: int32 arg val int64: int64 arg val float: float arg +val string: string arg + +val like: 'a arg -> ?descr:string -> string -> 'a arg + +type ('a, 'b) eq = Eq : ('a, 'a) eq +val eq: 'a arg -> 'b arg -> ('a, 'b) eq option diff --git a/src/lib_rpc/RPC_arg.ml b/src/lib_rpc/RPC_arg.ml index 4d4277579..4086bc3a7 100644 --- a/src/lib_rpc/RPC_arg.ml +++ b/src/lib_rpc/RPC_arg.ml @@ -7,4 +7,5 @@ (* *) (**************************************************************************) +type ('i, 'j) eq = ('i, 'j) Resto.eq = Eq : ('a, 'a) eq include Resto.Arg diff --git a/src/lib_rpc/RPC_arg.mli b/src/lib_rpc/RPC_arg.mli index d983931d4..ce744edcd 100644 --- a/src/lib_rpc/RPC_arg.mli +++ b/src/lib_rpc/RPC_arg.mli @@ -7,4 +7,5 @@ (* *) (**************************************************************************) +type ('i, 'j) eq = ('i, 'j) Resto.eq = Eq : ('a, 'a) eq include (module type of struct include Resto.Arg end) diff --git a/vendors/ocplib-resto/lib_resto-directory/resto_directory.ml b/vendors/ocplib-resto/lib_resto-directory/resto_directory.ml index 0ceda685c..26e0a6ee0 100644 --- a/vendors/ocplib-resto/lib_resto-directory/resto_directory.ml +++ b/vendors/ocplib-resto/lib_resto-directory/resto_directory.ml @@ -233,7 +233,7 @@ module Make (Encoding : ENCODING) = struct Some (Suffixes (merge m1 m2)) | Arg (arg1, subt1), Arg (arg2, subt2) -> begin - try let Ty.Eq = Ty.eq arg1.id arg2.id in + try let Eq = Ty.eq arg1.id arg2.id in let subt = merge (Dynamic arg1.descr :: path) subt1 subt2 in Some (Arg (arg1, subt)) with Ty.Not_equal -> @@ -455,7 +455,7 @@ module Make (Encoding : ENCODING) = struct match Ty.eq iarg.id arg.id with | exception Ty.Not_equal -> Lwt.return_none - | Ty.Eq -> + | Eq -> Lwt.return_some (dir : (_ * _) directory :> p directory) end | Empty -> Lwt.return_none @@ -472,7 +472,7 @@ module Make (Encoding : ENCODING) = struct match Ty.eq iarg.id arg.id with | exception Ty.Not_equal -> Lwt.return_none - | Ty.Eq -> + | Eq -> Lwt.return_some (dir : (_ * _) directory :> p directory) end | Empty -> Lwt.return_none @@ -578,7 +578,7 @@ module Make (Encoding : ENCODING) = struct | Static { subdirs = Some (Arg (arg', dir)) ; services } -> begin try - let Ty.Eq = Ty.eq arg.id arg'.id in + let Eq = Ty.eq arg.id arg'.id in (dir :> k directory), services with Ty.Not_equal -> conflict path (CTypes (arg.descr, arg'.descr)) diff --git a/vendors/ocplib-resto/lib_resto/resto.ml b/vendors/ocplib-resto/lib_resto/resto.ml index dfd0b64dc..51a5a57d6 100644 --- a/vendors/ocplib-resto/lib_resto/resto.ml +++ b/vendors/ocplib-resto/lib_resto/resto.ml @@ -28,13 +28,14 @@ let meth_of_string = function module MethMap = Map.Make(struct type t = meth let compare = compare end) module StringMap = Map.Make(String) +type (_, _) eq = Eq : ('a, 'a) eq + module Internal = struct module Ty = struct type 'a witness = .. exception Not_equal - type (_, _) eq = Eq : ('a, 'a) eq module type Ty = sig type t val witness : t witness val eq: 'a witness -> ('a, t) eq @@ -217,6 +218,10 @@ module Arg = struct let string = make ~name:"string" ~destruct:(fun x -> Ok x) ~construct:(fun x -> x) () + let eq a1 a2 = + try Some (Ty.eq a1.id a2.id) + with Internal.Ty.Not_equal -> None + end module Path = struct @@ -329,7 +334,7 @@ module Query = struct | F1 (Single field, fs) -> begin match StringMap.find field.name map with | Parsed (Single field', v) -> - let Ty.Eq = Ty.eq field.ty.id field'.ty.id in + let Eq = Ty.eq field.ty.id field'.ty.id in let v = match v with None -> field.default | Some v -> v in rebuild map fs (f v) | Parsed _ -> assert false @@ -337,7 +342,7 @@ module Query = struct | F1 (Opt field, fs) -> begin match StringMap.find field.name map with | Parsed (Opt field', v) -> - let Ty.Eq = Ty.eq field.ty.id field'.ty.id in + let Eq = Ty.eq field.ty.id field'.ty.id in let v = match v with None -> None | Some v -> v in rebuild map fs (f v) | Parsed _ -> assert false @@ -352,7 +357,7 @@ module Query = struct | F1 (Multi field, fs) -> begin match StringMap.find field.name map with | Parsed (Multi field', v) -> - let Ty.Eq = Ty.eq field.ty.id field'.ty.id in + let Eq = Ty.eq field.ty.id field'.ty.id in let v = match v with None -> [] | Some v -> v in rebuild map fs (f v) | Parsed _ -> assert false diff --git a/vendors/ocplib-resto/lib_resto/resto.mli b/vendors/ocplib-resto/lib_resto/resto.mli index de0c8b91f..c01dd6c9e 100644 --- a/vendors/ocplib-resto/lib_resto/resto.mli +++ b/vendors/ocplib-resto/lib_resto/resto.mli @@ -17,6 +17,8 @@ module MethMap : Map.S with type key = meth module StringMap : Map.S with type 'a t = 'a Map.Make(String).t and type key = string +type (_, _) eq = Eq : ('a, 'a) eq + (** Typed path argument. *) module Arg : sig @@ -44,6 +46,8 @@ module Arg : sig val like: 'a arg -> ?descr:string -> string -> 'a arg + val eq: 'a arg -> 'b arg -> ('a, 'b) eq option + end @@ -181,8 +185,6 @@ module Internal : sig module Ty : sig exception Not_equal - type (_, _) eq = Eq : ('a, 'a) eq - type 'a id val eq : 'a id -> 'b id -> ('a, 'b) eq