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

Resto: minor simplification (remove RPC_service.map)

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-11 19:28:51 +01:00
parent f2b7897572
commit c9822abab7
13 changed files with 54 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/lib_protocol_environment_sigs/v1/RPC_path.mli
View File

@ -28,9 +28,3 @@ val add_final_args:
('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a list) path
val (/:*):
('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a list) path
val prefix:
('prefix, 'a) path -> ('a, 'params) path -> ('prefix, 'params) path
val map:
('a -> 'b) -> ('b -> 'a) -> ('prefix, 'a) path -> ('prefix, 'b) path

13
src/lib_protocol_environment_sigs/v1/RPC_service.mli
View File

@ -43,19 +43,6 @@ val error_encoding:
('meth, 'prefix, 'params, 'query, 'input, 'output) service ->
unit Data_encoding.t
val prefix:
('prefix, 'inner_prefix) RPC_path.t ->
('meth, 'inner_prefix, 'params, 'query,
'input, 'output) service ->
('meth, 'prefix, 'params,
'query, 'input, 'output) service
val map:
('a -> 'b) ->
('b -> 'a) ->
('meth, 'pr, 'a, 'q, 'i, 'o) service ->
('meth, 'pr, 'b, 'q, 'i, 'o) service
val get_service:
?description: string ->
query: 'query RPC_query.t ->

2
vendors/ocplib-resto/lib_ezresto-directory/test/ezDirectory.ml vendored
View File

@ -26,7 +26,7 @@ let dir =
(fun i j () () -> Lwt.return (`Ok (float_of_int i+.j)))
let dir =
register dir alternate_add_service'
(fun (i,j) () () -> Lwt.return (`Ok (i+j)))
(fun (((), i),j) () () -> Lwt.return (`Ok (i+ int_of_float j)))
let dir =
register_describe_directory_service
dir describe_service

2
vendors/ocplib-resto/lib_ezresto-directory/test/ezResto_test.ml vendored
View File

@ -48,7 +48,7 @@ module Test(Request : sig
assert (test repeat_service ((), 3) (`A []) (`A (repeat 3 (`A [])))) ;
assert (test add_service ((), 2) 3 5) ;
assert (test alternate_add_service (((), 1), 2.5) () 3.5) ;
assert (test alternate_add_service' (1, 2) () 3) ;
assert (test alternate_add_service' (((), 1), 2.) () 3) ;
()
end

5
vendors/ocplib-resto/lib_ezresto-directory/test/ezServices.ml vendored
View File

@ -41,10 +41,7 @@ let alternate_add_service' =
~input:Json_encoding.null
~output:Json_encoding.int
~error:Json_encoding.empty
Path.(map
(fun (((),i),f) -> (i,int_of_float f))
(fun (i,f) -> (((),i),float_of_int f))
(root / "bar" /: Arg.int /: Arg.float / "add"))
Path.(root / "bar" /: Arg.int /: Arg.float / "add")
let minus_service r =
post_service

1
vendors/ocplib-resto/lib_ezresto/ezResto.ml vendored
View File

@ -23,7 +23,6 @@ module Path = struct
let add_arg = Path.add_arg
let (/) = add_suffix
let (/:) = add_arg
let map = Path.map
end
module Query = Query
type ('meth, 'params, 'query, 'input, 'output, 'error) service =

2
vendors/ocplib-resto/lib_ezresto/ezResto.mli vendored
View File

@ -49,8 +49,6 @@ module Path : sig
val add_arg: 'params path -> 'a Arg.arg -> ('params * 'a) path
val (/:): 'params path -> 'a Arg.arg -> ('params * 'a) path
val map: ('a -> 'b) -> ('b -> 'a) -> 'a path -> 'b path
end
module Query : sig

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

@ -181,7 +181,7 @@ module Make (Encoding : ENCODING) = struct
: type p pr. (pr, p) Path.path -> p directory -> pr directory
= fun path dir ->
let rec prefix
: type k pr. (pr, k) Resto.Internal.rpath -> k directory -> pr directory
: type k pr. (pr, k) Resto.Internal.path -> k directory -> pr directory
= fun path dir ->
match path with
| Root -> dir
@ -195,9 +195,7 @@ module Make (Encoding : ENCODING) = struct
services = MethMap.empty })
| DynamicTail _ ->
invalid_arg "RestoDirectory.prefix" in
match Resto.Internal.to_path path with
| Path path -> prefix path dir
| MappedPath (path, map, _) -> prefix path (map_directory map dir)
prefix (Resto.Internal.to_path path) dir
let conflict steps kind = raise (Conflict (steps, kind))
@ -431,7 +429,7 @@ module Make (Encoding : ENCODING) = struct
let rec transparent_resolve
: type pr p.
pr directory -> (pr, p) rpath -> p -> p directory option Lwt.t
pr directory -> (pr, p) path -> p -> p directory option Lwt.t
= fun dir path rargs ->
match path with
| Root -> Lwt.return_some dir
@ -488,16 +486,7 @@ module Make (Encoding : ENCODING) = struct
params -> query -> input -> (output, error) Answer.t Lwt.t =
fun dir service params query body ->
let service = Service.Internal.to_service service in
begin
match service.path with
| Service.Internal.Path p ->
transparent_resolve dir p params
| Service.Internal.MappedPath (p, _, f) -> begin
transparent_resolve dir p (f params) >>= function
| None -> Lwt.return_none
| Some dir -> Lwt.return_some (map f dir)
end
end >>= function
transparent_resolve dir service.path params >>= function
| None -> Lwt.return (`Not_found None)
| Some (Static { services ; _ }) -> begin
try
@ -522,7 +511,7 @@ module Make (Encoding : ENCODING) = struct
let rec describe_rpath
: type a b. Description.path_item list ->
(a, b) rpath -> Description.path_item list
(a, b) path -> Description.path_item list
= fun acc path ->
match path with
| Root -> acc
@ -538,7 +527,7 @@ module Make (Encoding : ENCODING) = struct
****************************************************************************)
let rec step_of_path
: type p rk. (rk, p) rpath -> step list -> step list
: type p rk. (rk, p) path -> step list -> step list
= fun path acc ->
match path with
| Root -> acc
@ -551,7 +540,7 @@ module Make (Encoding : ENCODING) = struct
let rec insert
: type k rk.
(rk, k) rpath -> rk directory -> k directory * (k directory -> rk directory)
(rk, k) path -> rk directory -> k directory * (k directory -> rk directory)
= fun path dir ->
match path with
| Root -> dir, (fun x -> x)
@ -629,7 +618,7 @@ module Make (Encoding : ENCODING) = struct
fun root s handler ->
let s = Service.Internal.to_service s in
let register
: type k. (pr, k) rpath -> (k -> q -> i -> (o, e) Answer.t Lwt.t) ->
: type k. (pr, k) path -> (k -> q -> i -> (o, e) Answer.t Lwt.t) ->
pr directory =
fun path handler ->
let dir, insert = insert path root in
@ -662,9 +651,7 @@ module Make (Encoding : ENCODING) = struct
| Static _ -> conflict path (CService s.meth)
| Dynamic _ -> conflict path CBuilder
| DynamicTail _ -> conflict path CTail in
match s.path with
| Path p -> register p handler
| MappedPath (p, map, _) -> register p (fun p i -> handler (map p) i)
register s.path handler
let register =
(register
@ -681,7 +668,7 @@ module Make (Encoding : ENCODING) = struct
fun ?descr root path builder ->
let path = Resto.Internal.to_path path in
let register
: type k. (pr, k) rpath -> (k -> k directory Lwt.t) -> pr directory =
: type k. (pr, k) path -> (k -> k directory Lwt.t) -> pr directory =
fun path builder ->
let dir, insert = insert path root in
match dir with
@ -692,11 +679,7 @@ module Make (Encoding : ENCODING) = struct
| Static ({ subdirs = Some _ ; _ }) -> conflict path CDir
| Dynamic _ -> conflict path CBuilder
| DynamicTail _ -> conflict path CTail in
match path with
| Path p -> register p builder
| MappedPath (p, map, _) ->
register p
(fun args -> builder (map args) >|= map_directory map)
register path builder
let register_describe_directory_service
: type pr.

2
vendors/ocplib-resto/lib_resto-directory/test/directory.ml vendored
View File

@ -28,7 +28,7 @@ let dir =
(fun i j () () -> Lwt.return (`Ok (float_of_int i+.j)))
let dir =
register dir alternate_add_service'
(fun (i,j) () () -> Lwt.return (`Ok (i+j)))
(fun (((),i),j) () () -> Lwt.return (`Ok (i+ int_of_float j)))
let dir =
register dir dummy_service
(fun ((((((((),_a), _b), _c), _d), _e), _f), _g) () () -> Lwt.return (`Ok ()))

2
vendors/ocplib-resto/lib_resto-directory/test/resto_test.ml vendored
View File

@ -69,7 +69,7 @@ module Test(Request : sig
assert (test add_service ((), 2) 3 5) ;
assert (test alternate_add_service (((), 1), 2.5) () 3.5) ;
assert (test real_minus_service1 (((), 2.5), 1) () 1.5) ;
assert (test alternate_add_service' (1, 2) () 3) ;
assert (test alternate_add_service' (((), 1), 2.) () 3) ;
()
end

5
vendors/ocplib-resto/lib_resto-directory/test/services.ml vendored
View File

@ -43,10 +43,7 @@ let alternate_add_service' =
~input:Json_encoding.null
~output:Json_encoding.int
~error:Json_encoding.empty
Path.(map
(fun (((),i),f) -> (i,int_of_float f))
(fun (i,f) -> (((),i),float_of_int f))
(root / "bar" /: Arg.int /: Arg.float / "add"))
Path.(root / "bar" /: Arg.int /: Arg.float / "add")
let minus_service =
post_service

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

@ -69,57 +69,35 @@ module Internal = struct
let from_arg x = x
let to_arg x = x
type (_,_) rpath =
| Root : ('rkey, 'rkey) rpath
| Static : ('rkey, 'key) rpath * string -> ('rkey, 'key) rpath
| Dynamic : ('rkey, 'key) rpath * 'a arg -> ('rkey, 'key * 'a) rpath
| DynamicTail : ('rkey, 'key) rpath * 'a arg -> ('rkey, 'key * 'a list) rpath
type (_,_) path =
| Path: ('prefix, 'params) rpath -> ('prefix, 'params) path
| MappedPath:
('prefix, 'key) rpath * ('key -> 'params) * ('params -> 'key) ->
('prefix, 'params) path
| Root : ('rkey, 'rkey) path
| Static : ('rkey, 'key) path * string -> ('rkey, 'key) path
| Dynamic : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a) path
| DynamicTail : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a list) path
let rec rsubst0 : type a b. (a, a) rpath -> (b, b) rpath = function
let rec subst0 : type a b. (a, a) path -> (b, b) path = function
| Root -> Root
| Static (rpath, name) -> Static (rsubst0 rpath, name)
| Dynamic (rpath, arg) -> assert false (* impossible *)
| DynamicTail (rpath, arg) -> assert false (* impossible *)
| Static (path, name) -> Static (subst0 path, name)
| Dynamic (path, arg) -> assert false (* impossible *)
| DynamicTail (path, arg) -> assert false (* impossible *)
let subst0 = function
| Path rpath -> Path (rsubst0 rpath)
| MappedPath _ -> invalid_arg "Resto.Path.subst0"
let rec rsubst1 : type a b c. (a, a * c) rpath -> (b, b * c) rpath = function
let rec subst1 : type a b c. (a, a * c) path -> (b, b * c) path = function
| Root -> assert false (* impossible *)
| Static (rpath, name) -> Static (rsubst1 rpath, name)
| Dynamic (rpath, arg) -> Dynamic (rsubst0 rpath, arg)
| DynamicTail (rpath, arg) -> DynamicTail (rsubst0 rpath, arg)
| Static (path, name) -> Static (subst1 path, name)
| Dynamic (path, arg) -> Dynamic (subst0 path, arg)
| DynamicTail (path, arg) -> DynamicTail (subst0 path, arg)
let subst1 = function
| Path rpath -> Path (rsubst1 rpath)
| MappedPath _ -> invalid_arg "Resto.Path.subst1"
let rec rsubst2 : type a b c d. (a, (a * c) * d) rpath -> (b, (b * c) * d) rpath = function
let rec subst2 : type a b c d. (a, (a * c) * d) path -> (b, (b * c) * d) path = function
| Root -> assert false (* impossible *)
| Static (rpath, name) -> Static (rsubst2 rpath, name)
| Dynamic (rpath, arg) -> Dynamic (rsubst1 rpath, arg)
| DynamicTail (rpath, arg) -> DynamicTail (rsubst1 rpath, arg)
| Static (path, name) -> Static (subst2 path, name)
| Dynamic (path, arg) -> Dynamic (subst1 path, arg)
| DynamicTail (path, arg) -> DynamicTail (subst1 path, arg)
let subst2 = function
| Path rpath -> Path (rsubst2 rpath)
| MappedPath _ -> invalid_arg "Resto.Path.subst2"
let rec rsubst3 : type a b c d e. (a, ((a * c) * d) * e) rpath -> (b, ((b * c) * d) * e) rpath = function
let rec subst3 : type a b c d e. (a, ((a * c) * d) * e) path -> (b, ((b * c) * d) * e) path = function
| Root -> assert false (* impossible *)
| Static (rpath, name) -> Static (rsubst3 rpath, name)
| Dynamic (rpath, arg) -> Dynamic (rsubst2 rpath, arg)
| DynamicTail (rpath, arg) -> DynamicTail (rsubst2 rpath, arg)
let subst3 = function
| Path rpath -> Path (rsubst3 rpath)
| MappedPath _ -> invalid_arg "Resto.Path.subst3"
| Static (path, name) -> Static (subst3 path, name)
| Dynamic (path, arg) -> Dynamic (subst2 path, arg)
| DynamicTail (path, arg) -> DynamicTail (subst2 path, arg)
let from_path x = x
let to_path x = x
@ -245,52 +223,33 @@ module Path = struct
type ('a, 'b) t = ('a, 'b) Internal.path
type ('a, 'b) path = ('a, 'b) Internal.path
type ('a, 'b) rpath = ('a, 'b) Internal.rpath
type 'prefix context = ('prefix, 'prefix) path
let root = Path Root
let open_root = Path Root
let root = Root
let open_root = Root
let add_suffix (type p pr) (path : (p, pr) path) name =
match path with
| Path (DynamicTail _) -> invalid_arg "Resto.Path.add_suffix"
| MappedPath (DynamicTail _, _, _) -> invalid_arg "Resto.Path.add_suffix"
| Path path -> Path (Static (path, name))
| MappedPath (path, map, rmap) ->
MappedPath (Static (path, name), map, rmap)
| DynamicTail _ -> invalid_arg "Resto.Path.add_suffix"
| path -> Static (path, name)
let add_arg (type p pr) (path : (p, pr) path) arg =
match path with
| Path (DynamicTail _) -> invalid_arg "Resto.Path.add_arg"
| MappedPath (DynamicTail _, _, _) -> invalid_arg "Resto.Path.add_arg"
| Path path -> Path (Dynamic (path, arg))
| MappedPath (path, map, rmap) ->
MappedPath (Dynamic (path, arg),
(fun (x, y) -> (map x, y)),
(fun (x, y) -> (rmap x, y)))
| DynamicTail _ -> invalid_arg "Resto.Path.add_arg"
| path -> Dynamic (path, arg)
let add_final_args (type p pr) (path : (p, pr) path) arg =
match path with
| Path (DynamicTail _) -> invalid_arg "Resto.Path.add_final_arg"
| MappedPath (DynamicTail _, _, _) -> invalid_arg "Resto.Path.add_final_arg"
| Path path -> Path (DynamicTail (path, arg))
| MappedPath (path, map, rmap) ->
MappedPath (DynamicTail (path, arg),
(fun (x, y) -> (map x, y)),
(fun (x, y) -> (rmap x, y)))
let map map rmap = function
| Path p -> MappedPath (p, map, rmap)
| MappedPath (p, map', rmap') ->
MappedPath (p, (fun x -> map (map' x)), (fun x -> rmap' (rmap x)))
| DynamicTail _ -> invalid_arg "Resto.Path.add_final_arg"
| path -> DynamicTail (path, arg)
let prefix
: type p pr a. (pr, a) path -> (a, p) path -> (pr, p) path
= fun p1 p2 ->
let rec prefix
: type pr a k.
(pr, a) path -> (a, k) rpath -> (pr, k) path
(pr, a) path -> (a, k) path -> (pr, k) path
= fun p1 p2 ->
match p2 with
| Root -> p1
@ -299,12 +258,8 @@ module Path = struct
| DynamicTail (path, arg) -> add_final_args (prefix p1 path) arg
in
match p1 with
| Path (DynamicTail _) -> invalid_arg "Resto.Path.prefix"
| MappedPath (DynamicTail _, _, _) -> invalid_arg "Resto.Path.prefix"
| _ ->
match p2 with
| Path p2 -> prefix p1 p2
| MappedPath (p2, m, rm) -> map m rm (prefix p1 p2)
| DynamicTail _ -> invalid_arg "Resto.Path.prefix"
| _ -> prefix p1 p2
let (/) = add_suffix
let (/:) = add_arg
@ -658,10 +613,6 @@ module MakeService(Encoding : ENCODING) = struct
let subst2 s = { s with path = Internal.subst2 s.path }
let subst3 s = { s with path = Internal.subst3 s.path }
let map f g (s : (_,_,_,_,_,_,_) service) =
{ s with path = Path.map f g s.path }
let meth = fun { meth } -> meth
let query
@ -711,7 +662,7 @@ module MakeService(Encoding : ENCODING) = struct
: type pr p. (pr, p) path -> p -> string list
= fun path args ->
let rec forge_request_args
: type k. (pr, k) rpath -> k -> string list -> string list
: type k. (pr, k) path -> k -> string list -> string list
= fun path args acc ->
match path, args with
| Root, _ ->
@ -723,9 +674,7 @@ module MakeService(Encoding : ENCODING) = struct
| DynamicTail (path, arg), (args, xs) ->
forge_request_args path args
(List.fold_right (fun x acc -> arg.construct x :: acc) xs acc) in
match path with
| Path path -> forge_request_args path args []
| MappedPath (path, _, rmap) -> forge_request_args path (rmap args) []
forge_request_args path args []
let forge_request_query
: type q. q query -> q -> (string * string) list

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

@ -75,9 +75,6 @@ module Path : sig
val prefix:
('prefix, 'a) path -> ('a, 'params) path -> ('prefix, 'params) path
val map:
('a -> 'b) -> ('b -> 'a) -> ('prefix, 'a) path -> ('prefix, 'b) path
end
(** Service directory description *)
@ -192,17 +189,11 @@ module Internal : sig
val from_arg : 'a arg -> 'a Arg.t
val to_arg : 'a Arg.t -> 'a arg
type (_, _) rpath =
| Root : ('rkey, 'rkey) rpath
| Static : ('rkey, 'key) rpath * string -> ('rkey, 'key) rpath
| Dynamic : ('rkey, 'key) rpath * 'a arg -> ('rkey, 'key * 'a) rpath
| DynamicTail : ('rkey, 'key) rpath * 'a arg -> ('rkey, 'key * 'a list) rpath
type (_, _) path =
| Path: ('prefix, 'params) rpath -> ('prefix, 'params) path
| MappedPath:
('prefix, 'key) rpath * ('key -> 'params) * ('params -> 'key) ->
('prefix, 'params) path
| Root : ('rkey, 'rkey) path
| Static : ('rkey, 'key) path * string -> ('rkey, 'key) path
| Dynamic : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a) path
| DynamicTail : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a list) path
val from_path : ('a, 'b) path -> ('a, 'b) Path.t
val to_path : ('a, 'b) Path.t -> ('a, 'b) path
@ -338,12 +329,6 @@ module MakeService(Encoding : ENCODING) : sig
('meth, 'prefix, 'params,
'query, 'input, 'output, 'error) service
val map:
('a -> 'b) ->
('b -> 'a) ->
('meth, 'pr, 'a, 'q, 'i, 'o, 'e) service ->
('meth, 'pr, 'b, 'q, 'i, 'o, 'e) service
val subst0:
([< meth ] as 'm, 'p, 'p, 'q, 'i, 'o, 'e) service ->
('m, 'p2, 'p2, 'q, 'i, 'o, 'e) service