balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Resto: export RPC_arg.eq to the protocol.

Browse Source
This commit is contained in:
Grégoire Henry 2018-04-24 02:15:20 +02:00 committed by Benjamin Canou
parent 1460aba927
commit b6b30875e4
6 changed files with 25 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/lib_protocol_environment/sigs/v1/RPC_arg.mli
View File

@ -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

1
src/lib_rpc/RPC_arg.ml
View File

@ -7,4 +7,5 @@
(* *)
(**************************************************************************)
type ('i, 'j) eq = ('i, 'j) Resto.eq = Eq : ('a, 'a) eq
include Resto.Arg

1
src/lib_rpc/RPC_arg.mli
View File

@ -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)

8
vendors/ocplib-resto/lib_resto-directory/resto_directory.ml vendored
View File

@ -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))

13
vendors/ocplib-resto/lib_resto/resto.ml vendored
View File

@ -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

6
vendors/ocplib-resto/lib_resto/resto.mli vendored
View File

@ -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