From f5cc599ae601e1b75d10e9b27d46c3888ec25b11 Mon Sep 17 00:00:00 2001
From: Milo Davis <davis.mil@husky.neu.edu>
Date: Sat, 10 Mar 2018 10:27:40 -0500
Subject: [PATCH] Data_encoding: add names to union cases

---
 src/lib_data_encoding/data_encoding.ml           | 16 +++++++++++-----
 src/lib_data_encoding/data_encoding.mli          |  4 +++-
 .../sigs/v1/data_encoding.mli                    |  2 +-
 3 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/src/lib_data_encoding/data_encoding.ml b/src/lib_data_encoding/data_encoding.ml
index 6288985b0..3540920ac 100644
--- a/src/lib_data_encoding/data_encoding.ml
+++ b/src/lib_data_encoding/data_encoding.ml
@@ -174,7 +174,8 @@ and _ field =
   | Dft : string * 'a t * 'a -> 'a field
 
 and 'a case =
-  | Case : { encoding : 'a t ;
+  | Case : { name : string option ;
+             encoding : 'a t ;
              proj : ('t -> 'a option) ;
              inj : ('a -> 't) ;
              tag : case_tag } -> 't case
@@ -326,8 +327,9 @@ module Json = struct
             make @@
             Union (kind, tag,
                    List.map
-                     (fun (Case { encoding ; proj = proj' ; inj = inj' ; tag }) ->
+                     (fun (Case { name ; encoding ; proj = proj' ; inj = inj' ; tag }) ->
                         Case { encoding ;
+                               name ;
                                proj = (fun x -> proj' (proj x));
                                inj = (fun x -> inj (inj' x)) ;
                                tag })
@@ -352,8 +354,9 @@ module Json = struct
           make @@
           Union (`Dynamic (* ignored *), tag,
                  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 ;
+                             name ;
                              proj = (fun (x, y) ->
                                  match proj y with
                                  | None -> None
@@ -365,8 +368,9 @@ module Json = struct
           make @@
           Union (`Dynamic (* ignored *), tag,
                  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 ;
+                             name ;
                              proj = (fun (x, y) ->
                                  match proj x with
                                  | None -> None
@@ -821,14 +825,16 @@ module Encoding = struct
       List.map (fun (Case { encoding }) -> classify encoding) cases in
     let kind = Kind.merge_list tag_size kinds in
     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 =
     union
       ~tag_size:`Uint8
       [ case (Tag 1) ty
+          ~name:"Some"
           (fun x -> x)
           (fun x -> Some x) ;
         case (Tag 0) empty
+          ~name:"None"
           (function None -> Some () | Some _ -> None)
           (fun () -> None) ;
       ]
diff --git a/src/lib_data_encoding/data_encoding.mli b/src/lib_data_encoding/data_encoding.mli
index 00ba32d90..12e2840df 100644
--- a/src/lib_data_encoding/data_encoding.mli
+++ b/src/lib_data_encoding/data_encoding.mli
@@ -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
     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 :
+  ?name:string ->
   case_tag ->
   'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case
 
diff --git a/src/lib_protocol_environment/sigs/v1/data_encoding.mli b/src/lib_protocol_environment/sigs/v1/data_encoding.mli
index 0fa19af88..d621c12a4 100644
--- a/src/lib_protocol_environment/sigs/v1/data_encoding.mli
+++ b/src/lib_protocol_environment/sigs/v1/data_encoding.mli
@@ -164,7 +164,7 @@ type case_tag = Tag of int | Json_only
 
 type 't 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 :
   ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding