Data_encoding: use inline record for case field
This commit is contained in:
parent
47f8bbbe68
commit
09a039bfea
@ -64,7 +64,7 @@ let rec length : type x. x Encoding.t -> x -> int =
|
||||
length_case cases
|
||||
| Mu (`Dynamic, _name, self) ->
|
||||
length (self e) value
|
||||
| Obj (Opt (`Dynamic, _, e)) -> begin
|
||||
| Obj (Opt { kind = `Dynamic ; encoding = e }) -> begin
|
||||
match value with
|
||||
| None -> 1
|
||||
| Some value -> 1 + length e value
|
||||
@ -87,7 +87,7 @@ let rec length : type x. x Encoding.t -> x -> int =
|
||||
| Tups (`Variable, e1, e2) ->
|
||||
let (v1, v2) = value in
|
||||
length e1 v1 + length e2 v2
|
||||
| Obj (Opt (`Variable, _, e)) -> begin
|
||||
| Obj (Opt { kind = `Variable ; encoding = e }) -> begin
|
||||
match value with
|
||||
| None -> 0
|
||||
| Some value -> length e value
|
||||
@ -106,8 +106,8 @@ let rec length : type x. x Encoding.t -> x -> int =
|
||||
| Mu (`Variable, _name, self) ->
|
||||
length (self e) value
|
||||
(* Recursive*)
|
||||
| Obj (Req (_, e)) -> length e value
|
||||
| Obj (Dft (_, e, _)) -> length e value
|
||||
| Obj (Req { encoding = e }) -> length e value
|
||||
| Obj (Dft { encoding = e }) -> length e value
|
||||
| Tup e -> length e value
|
||||
| Conv { encoding = e ; proj } ->
|
||||
length e (proj value)
|
||||
|
@ -190,15 +190,15 @@ let rec read_rec : type ret. ret Encoding.t -> state -> ret
|
||||
let l = read_list e state in
|
||||
Array.of_list l
|
||||
| List e -> read_list e state
|
||||
| (Obj (Req (_, e))) -> read_rec e state
|
||||
| (Obj (Dft (_, e, _))) -> read_rec e state
|
||||
| (Obj (Opt (`Dynamic, _, e))) ->
|
||||
| (Obj (Req { encoding = e })) -> read_rec e state
|
||||
| (Obj (Dft { encoding = e })) -> read_rec e state
|
||||
| (Obj (Opt { kind = `Dynamic ; encoding = e })) ->
|
||||
let present = Atom.bool state in
|
||||
if not present then
|
||||
None
|
||||
else
|
||||
Some (read_rec e state)
|
||||
| (Obj (Opt (`Variable, _, e))) ->
|
||||
| (Obj (Opt { kind = `Variable ; encoding = e })) ->
|
||||
if state.remaining_bytes = 0 then
|
||||
None
|
||||
else
|
||||
|
@ -252,16 +252,16 @@ let rec read_rec
|
||||
read_list e state @@ fun (l, state) ->
|
||||
k (Array.of_list l, state)
|
||||
| List e -> read_list e state k
|
||||
| (Obj (Req (_, e))) -> read_rec e state k
|
||||
| (Obj (Dft (_, e, _))) -> read_rec e state k
|
||||
| (Obj (Opt (`Dynamic, _, e))) ->
|
||||
| (Obj (Req { encoding = e })) -> read_rec e state k
|
||||
| (Obj (Dft { encoding = e })) -> read_rec e state k
|
||||
| (Obj (Opt { kind = `Dynamic ; encoding = e })) ->
|
||||
Atom.bool resume state @@ fun (present, state) ->
|
||||
if not present then
|
||||
k (None, state)
|
||||
else
|
||||
read_rec e state @@ fun (v, state) ->
|
||||
k (Some v, state)
|
||||
| (Obj (Opt (`Variable, _, e))) ->
|
||||
| (Obj (Opt { kind = `Variable ; encoding = e })) ->
|
||||
let size = remaining_bytes state in
|
||||
if size = 0 then
|
||||
k (None, state)
|
||||
|
@ -226,18 +226,18 @@ let rec write_rec : type a. a Encoding.t -> state -> a -> unit =
|
||||
Array.iter (write_rec e state) value
|
||||
| List e ->
|
||||
List.iter (write_rec e state) value
|
||||
| Obj (Req (_, e)) -> write_rec e state value
|
||||
| Obj (Opt (`Dynamic, _, e)) -> begin
|
||||
| Obj (Req { encoding = e }) -> write_rec e state value
|
||||
| Obj (Opt { kind = `Dynamic ; encoding = e }) -> begin
|
||||
match value with
|
||||
| None -> Atom.bool state false
|
||||
| Some value -> Atom.bool state true ; write_rec e state value
|
||||
end
|
||||
| Obj (Opt (`Variable, _, e)) -> begin
|
||||
| Obj (Opt { kind = `Variable ; encoding = e }) -> begin
|
||||
match value with
|
||||
| None -> ()
|
||||
| Some value -> write_rec e state value
|
||||
end
|
||||
| Obj (Dft (_, e, _)) -> write_rec e state value
|
||||
| Obj (Dft { encoding = e }) -> write_rec e state value
|
||||
| Objs (_, e1, e2) ->
|
||||
let (v1, v2) = value in
|
||||
write_rec e1 state v1 ;
|
||||
|
@ -114,9 +114,17 @@ type 'a desc =
|
||||
| Delayed : (unit -> 'a t) -> 'a desc
|
||||
|
||||
and _ field =
|
||||
| Req : string * 'a t -> 'a field
|
||||
| Opt : Kind.enum * string * 'a t -> 'a option field
|
||||
| Dft : string * 'a t * 'a -> 'a field
|
||||
| Req : { name: string ;
|
||||
encoding: 'a t ;
|
||||
} -> 'a field
|
||||
| Opt : { name: string ;
|
||||
kind: Kind.enum ;
|
||||
encoding: 'a t ;
|
||||
} -> 'a option field
|
||||
| Dft : { name: string ;
|
||||
encoding: 'a t ;
|
||||
default: 'a ;
|
||||
} -> 'a field
|
||||
|
||||
and 'a case =
|
||||
| Case : { name : string option ;
|
||||
@ -157,7 +165,7 @@ let rec classify : type a. a t -> Kind.t = fun e ->
|
||||
| String kind -> (kind :> Kind.t)
|
||||
| String_enum (_, cases) ->
|
||||
`Fixed Binary_size.(integer_to_size @@ enum_size cases)
|
||||
| Obj (Opt (kind, _, _)) -> (kind :> Kind.t)
|
||||
| Obj (Opt { kind }) -> (kind :> Kind.t)
|
||||
| Objs (kind, _, _) -> kind
|
||||
| Tups (kind, _, _) -> kind
|
||||
| Union (kind, _, _) -> (kind :> Kind.t)
|
||||
@ -167,8 +175,8 @@ let rec classify : type a. a t -> Kind.t = fun e ->
|
||||
| Array _ -> `Variable
|
||||
| List _ -> `Variable
|
||||
(* Recursive *)
|
||||
| Obj (Req (_, encoding)) -> classify encoding
|
||||
| Obj (Dft (_, encoding, _)) -> classify encoding
|
||||
| Obj (Req { encoding }) -> classify encoding
|
||||
| Obj (Dft { encoding }) -> classify encoding
|
||||
| Tup encoding -> classify encoding
|
||||
| Conv { encoding } -> classify encoding
|
||||
| Describe { encoding } -> classify encoding
|
||||
@ -224,9 +232,9 @@ let rec is_zeroable: type t. t encoding -> bool = fun e ->
|
||||
| Array _ -> true (* 0-element array *)
|
||||
| List _ -> true (* 0-element list *)
|
||||
(* represented as whatever is inside: truth mostly propagates *)
|
||||
| Obj (Req (_, e)) -> is_zeroable e (* represented as-is *)
|
||||
| Obj (Opt (`Variable, _, _)) -> true (* optional field ommited *)
|
||||
| Obj (Dft (_, e, _)) -> is_zeroable e (* represented as-is *)
|
||||
| Obj (Req { encoding = e }) -> is_zeroable e (* represented as-is *)
|
||||
| Obj (Opt { kind = `Variable }) -> true (* optional field ommited *)
|
||||
| Obj (Dft { encoding = e }) -> is_zeroable e (* represented as-is *)
|
||||
| Obj _ -> false
|
||||
| Objs (_, e1, e2) -> is_zeroable e1 && is_zeroable e2
|
||||
| Tup e -> is_zeroable e
|
||||
@ -331,17 +339,21 @@ let describe ?title ?description encoding =
|
||||
let def name encoding = make @@ Def { name ; encoding }
|
||||
|
||||
let req ?title ?description n t =
|
||||
Req (n, describe ?title ?description t)
|
||||
Req { name = n ; encoding = describe ?title ?description t }
|
||||
let opt ?title ?description n encoding =
|
||||
let kind =
|
||||
match classify encoding with
|
||||
| `Variable -> `Variable
|
||||
| `Fixed _ | `Dynamic -> `Dynamic in
|
||||
Opt (kind, n, make @@ Describe { title ; description ; encoding })
|
||||
Opt { name = n ; kind ;
|
||||
encoding = make @@ Describe { title ; description ; encoding } }
|
||||
let varopt ?title ?description n encoding =
|
||||
Opt (`Variable, n, make @@ Describe { title ; description ; encoding })
|
||||
Opt { name = n ; kind = `Variable ;
|
||||
encoding = make @@ Describe { title ; description ; encoding } }
|
||||
let dft ?title ?description n t d =
|
||||
Dft (n, describe ?title ?description t, d)
|
||||
Dft { name = n ;
|
||||
encoding = describe ?title ?description t ;
|
||||
default = d }
|
||||
|
||||
let raw_splitted ~json ~binary =
|
||||
make @@ Splitted { encoding = binary ;
|
||||
|
@ -72,9 +72,17 @@ type 'a desc =
|
||||
| Delayed : (unit -> 'a t) -> 'a desc
|
||||
|
||||
and _ field =
|
||||
| Req : string * 'a t -> 'a field
|
||||
| Opt : Kind.enum * string * 'a t -> 'a option field
|
||||
| Dft : string * 'a t * 'a -> 'a field
|
||||
| Req : { name: string ;
|
||||
encoding: 'a t ;
|
||||
} -> 'a field
|
||||
| Opt : { name: string ;
|
||||
kind: Kind.enum ;
|
||||
encoding: 'a t ;
|
||||
} -> 'a option field
|
||||
| Dft : { name: string ;
|
||||
encoding: 'a t ;
|
||||
default: 'a ;
|
||||
} -> 'a field
|
||||
|
||||
and 'a case =
|
||||
| Case : { name : string option ;
|
||||
|
@ -225,9 +225,9 @@ and field_json
|
||||
: type a. a Encoding.field -> a Json_encoding.field =
|
||||
let open Json_encoding in
|
||||
function
|
||||
| Encoding.Req (name, e) -> req name (get_json e)
|
||||
| Encoding.Opt (_, name, e) -> opt name (get_json e)
|
||||
| Encoding.Dft (name, e, d) -> dft name (get_json e) d
|
||||
| Encoding.Req { name ; encoding = e } -> req name (get_json e)
|
||||
| Encoding.Opt { name ; encoding = e } -> opt name (get_json e)
|
||||
| Encoding.Dft { name ; encoding = e ; default = d} -> dft name (get_json e) d
|
||||
|
||||
and case_json : type a. a Encoding.case -> a Json_encoding.case =
|
||||
let open Json_encoding in
|
||||
|
Loading…
Reference in New Issue
Block a user