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

Data_encoding: add names to union cases

Browse Source
This commit is contained in:
Milo Davis 2018-03-10 10:27:40 -05:00 committed by Grégoire Henry
parent de006f4be3
commit f5cc599ae6
3 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/lib_data_encoding/data_encoding.ml
View File

@ -174,7 +174,8 @@ and _ field =
| Dft : string * 'a t * 'a -> 'a field | Dft : string * 'a t * 'a -> 'a field
and 'a case = and 'a case =
| Case : { encoding : 'a t ; | Case : { name : string option ;
encoding : 'a t ;
proj : ('t -> 'a option) ; proj : ('t -> 'a option) ;
inj : ('a -> 't) ; inj : ('a -> 't) ;
tag : case_tag } -> 't case tag : case_tag } -> 't case
@ -326,8 +327,9 @@ module Json = struct
make @@ make @@
Union (kind, tag, Union (kind, tag,
List.map List.map
(fun (Case { encoding ; proj = proj' ; inj = inj' ; tag }) -> (fun (Case { name ; encoding ; proj = proj' ; inj = inj' ; tag }) ->
Case { encoding ; Case { encoding ;
name ;
proj = (fun x -> proj' (proj x)); proj = (fun x -> proj' (proj x));
inj = (fun x -> inj (inj' x)) ; inj = (fun x -> inj (inj' x)) ;
tag }) tag })
@ -352,8 +354,9 @@ module Json = struct
make @@ make @@
Union (`Dynamic (* ignored *), tag, Union (`Dynamic (* ignored *), tag,
List.map List.map
(fun (Case { encoding = e2 ; proj ; inj ; tag }) -> (fun (Case { name ; encoding = e2 ; proj ; inj ; tag }) ->
Case { encoding = lift_union_in_pair b p e1 e2 ; Case { encoding = lift_union_in_pair b p e1 e2 ;
name ;
proj = (fun (x, y) -> proj = (fun (x, y) ->
match proj y with match proj y with
| None -> None | None -> None
@ -365,8 +368,9 @@ module Json = struct
make @@ make @@
Union (`Dynamic (* ignored *), tag, Union (`Dynamic (* ignored *), tag,
List.map List.map
(fun (Case { encoding = e1 ; proj ; inj ; tag }) -> (fun (Case { name ; encoding = e1 ; proj ; inj ; tag }) ->
Case { encoding = lift_union_in_pair b p e1 e2 ; Case { encoding = lift_union_in_pair b p e1 e2 ;
name ;
proj = (fun (x, y) -> proj = (fun (x, y) ->
match proj x with match proj x with
| None -> None | None -> None
@ -821,14 +825,16 @@ module Encoding = struct
List.map (fun (Case { encoding }) -> classify encoding) cases in List.map (fun (Case { encoding }) -> classify encoding) cases in
let kind = Kind.merge_list tag_size kinds in let kind = Kind.merge_list tag_size kinds in
make @@ Union (kind, tag_size, cases) make @@ Union (kind, tag_size, cases)
let case tag encoding proj inj = Case { encoding ; proj ; inj ; tag } let case ?name tag encoding proj inj = Case { name ; encoding ; proj ; inj ; tag }
let option ty = let option ty =
union union
~tag_size:`Uint8 ~tag_size:`Uint8
[ case (Tag 1) ty [ case (Tag 1) ty
~name:"Some"
(fun x -> x) (fun x -> x)
(fun x -> Some x) ; (fun x -> Some x) ;
case (Tag 0) empty case (Tag 0) empty
~name:"None"
(function None -> Some () | Some _ -> None) (function None -> Some () | Some _ -> None)
(fun () -> None) ; (fun () -> None) ;
] ]

4
src/lib_data_encoding/data_encoding.mli
View File

@ -357,8 +357,10 @@ type case_tag = Tag of int | Json_only
An optional tag gives a name to a case and should be used to maintain An optional tag gives a name to a case and should be used to maintain
compatibility. compatibility.
If no tag is specified, tags are assigned by the union combinator. *) An optional name for the case can be provided,
which is used in the binary documentation. *)
val case : val case :
?name:string ->
case_tag -> case_tag ->
'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case

2
src/lib_protocol_environment/sigs/v1/data_encoding.mli
View File

@ -164,7 +164,7 @@ type case_tag = Tag of int | Json_only
type 't case type 't case
val case : val case :
case_tag -> 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case ?name:string -> case_tag -> 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case
val union : val union :
?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding