Data_encoding: move internal function internally

This commit is contained in:
Raphaël Proust 2018-05-03 15:18:10 +08:00
parent 34d4e9ec5d
commit 194d3f9120
3 changed files with 12 additions and 15 deletions

View File

@ -7,6 +7,15 @@
(* *)
(**************************************************************************)
let apply_and_get_first_some ?(error=Encoding.No_case_matched) fs v =
let rec loop = function
| [] -> raise error
| f :: fs ->
match f v with
| Some l -> l
| None -> loop fs in
loop fs
type 'l writer = {
write: 'a. 'a Encoding.t -> 'a -> MBytes.t -> int -> int ;
}
@ -55,7 +64,7 @@ let rec length : type x. x Encoding.t -> x -> int = fun e ->
let case_length (Case { encoding = e ; proj }) =
let length v = tag_size + length e v in
fun v -> Option.map ~f:length (proj v) in
apply (List.map case_length cases)
apply_and_get_first_some (List.map case_length cases)
| Mu (`Dynamic, _name, self) ->
fun v -> length (self e) v
| Obj (Opt (`Dynamic, _, e)) ->
@ -102,7 +111,7 @@ let rec length : type x. x Encoding.t -> x -> int = fun e ->
| Some v -> Some (length v)) :: acc)
tl in
let cases, json_only = case_lengths false [] cases in
apply
apply_and_get_first_some
~error:(if json_only
then Failure "No case matched, but JSON only cases were present in union"
else No_case_matched)
@ -232,7 +241,7 @@ module Writer = struct
match proj v with
| None -> None
| Some v -> Some (write v)) in
apply (TzList.filter_map writes_case cases)
apply_and_get_first_some (TzList.filter_map writes_case cases)
end

View File

@ -17,16 +17,6 @@ exception Int_out_of_range of int * int * int
exception Float_out_of_range of float * float * float
exception Parse_error of string
(*TODO: provide a more specialised function that doesn't need as many closures*)
let apply ?(error=No_case_matched) fs v =
let rec loop = function
| [] -> raise error
| f :: fs ->
match f v with
| Some l -> l
| None -> loop fs in
loop fs
module Kind = struct

View File

@ -50,8 +50,6 @@
* predicates, etc.) *)
(* TODO: move the doc into the packing module *)
val apply: ?error:exn -> ('a -> 'b option) list -> 'a -> 'b
module Kind: sig
type t = [ `Fixed of int | `Dynamic | `Variable ]