Repository: mransan/ocaml-protoc
Pull request #196 (2023-04-20 15:47:56)

Add support for bytes in JSON encoding
Tested with:
https://github.com/etcd-io/etcd/blob/main/api/mvccpb/kv.proto https://github.com/etcd-io/etcd/blob/main/api/etcdserverpb/rpc.proto

This depends on a newer ocaml-protoc-yojson that supports bytes, encoded as base64: https://github.com/mransan/ocaml-protoc-yojson/pull/3

c-cube: That looks very reasonable :-). Note that I don't have admin rights on the ocaml-protoc-yojson repo.
Lupus: @c-cube PR in JSON runtime library has been merged, I believe this PR is unblocked.

Patch:
diff --git a/src/compilerlib/pb_codegen_backend.ml b/src/compilerlib/pb_codegen_backend.ml
index 06ad007..8705b45 100644
--- a/src/compilerlib/pb_codegen_backend.ml
+++ b/src/compilerlib/pb_codegen_backend.ml
@@ -392,7 +392,14 @@ let compile_message ~(unsigned_tag : bool) (file_options : Pb_option.set)
      OCaml code much easier.
   *)
   match message_body with
-  | [] -> []
+  | [] ->
+    let empty_record = Ot.{ er_name = type_name message_names message_name } in
+
+    let type_ =
+      Ot.
+        { module_prefix; spec = Ot.Unit empty_record; type_level_ppx_extension }
+    in
+    [ type_ ]
   | Tt.Message_oneof_field f :: [] ->
     let outer_message_names = message_names @ [ message_name ] in
     let variant =
diff --git a/src/compilerlib/pb_codegen_decode_binary.ml b/src/compilerlib/pb_codegen_decode_binary.ml
index 3f75320..288f863 100644
--- a/src/compilerlib/pb_codegen_decode_binary.ml
+++ b/src/compilerlib/pb_codegen_decode_binary.ml
@@ -268,6 +268,15 @@ let gen_record ?and_ module_prefix { Ot.r_name; r_fields } sc =
             r_fields);
       F.linep sc "} : %s_types.%s)" module_prefix r_name)
 
+let gen_unit ?and_ { Ot.er_name } sc =
+  F.linep sc "%s decode_%s d =" (Pb_codegen_util.let_decl_of_and and_) er_name;
+  F.scope sc (fun sc ->
+      F.line sc "match Pbrt.Decoder.key d with";
+      F.line sc "| None -> ();";
+      F.line sc "| Some (_, pk) -> ";
+      F.linep sc "  Pbrt.Decoder.unexpected_payload \"%s\" pk"
+        (sp "Unexpected fields in empty message(%s)" er_name))
+
 let gen_variant ?and_ module_prefix { Ot.v_name; v_constructors } sc =
   let process_ctor sc variant_constructor =
     let {
@@ -340,6 +349,9 @@ let gen_struct ?and_ t sc =
     | Ot.Const_variant v ->
       gen_const_variant ?and_ module_prefix v sc;
       true
+    | Ot.Unit u ->
+      gen_unit ?and_ u sc;
+      true
   in
 
   has_encoded
@@ -368,6 +380,9 @@ let gen_sig ?and_ t sc =
     | Ot.Const_variant { Ot.cv_name; _ } ->
       f cv_name;
       true
+    | Ot.Unit { Ot.er_name; _ } ->
+      f er_name;
+      true
   in
 
   has_encoded
diff --git a/src/compilerlib/pb_codegen_decode_yojson.ml b/src/compilerlib/pb_codegen_decode_yojson.ml
index 01e4136..fbb43cb 100644
--- a/src/compilerlib/pb_codegen_decode_yojson.ml
+++ b/src/compilerlib/pb_codegen_decode_yojson.ml
@@ -25,7 +25,8 @@ let field_pattern_match ~r_name ~rf_label field_type =
     in
     ( "json_value",
       sp "Pbrt_yojson.%s json_value \"%s\" \"%s\"" runtime_f r_name rf_label )
-  | Ot.Ft_unit -> assert false
+  | Ot.Ft_unit ->
+    "json_value", sp "Pbrt_yojson.unit json_value \"%s\" \"%s\"" r_name rf_label
   (* TODO Wrapper: add similar one for wrapper type (with different
      runtime functions) *)
   | Ot.Ft_user_defined_type udt ->
@@ -150,6 +151,12 @@ let gen_record ?and_ module_prefix { Ot.r_name; r_fields } sc =
             r_fields);
       F.linep sc "} : %s_types.%s)" module_prefix r_name)
 
+(* Generate decode function for an empty record *)
+let gen_unit ?and_ { Ot.er_name } sc =
+  F.line sc
+  @@ sp "%s decode_%s d =" (Pb_codegen_util.let_decl_of_and and_) er_name;
+  F.line sc (sp "Pbrt_yojson.unit d \"%s\" \"%s\"" er_name "empty record")
+
 (* Generate decode function for a variant type *)
 let gen_variant ?and_ module_prefix { Ot.v_name; v_constructors } sc =
   (* helper function for each constructor case *)
@@ -223,6 +230,9 @@ let gen_struct ?and_ t sc =
     | Ot.Const_variant v ->
       gen_const_variant ?and_ module_prefix v sc;
       true
+    | Ot.Unit u ->
+      gen_unit ?and_ u sc;
+      true
   in
   has_encoded
 
@@ -248,5 +258,8 @@ let gen_sig ?and_ t sc =
   | Ot.Const_variant { Ot.cv_name; _ } ->
     f cv_name;
     true
+  | Ot.Unit { Ot.er_name; _ } ->
+    f er_name;
+    true
 
 let ocamldoc_title = "JSON Decoding"
diff --git a/src/compilerlib/pb_codegen_default.ml b/src/compilerlib/pb_codegen_default.ml
index 0f9c61a..7b4ef51 100644
--- a/src/compilerlib/pb_codegen_default.ml
+++ b/src/compilerlib/pb_codegen_default.ml
@@ -141,6 +141,9 @@ let gen_record ?and_ module_prefix { Ot.r_name; r_fields } sc =
 
   F.line sc "}"
 
+let gen_unit ?and_ { Ot.er_name } sc =
+  F.linep sc "%s default_%s = ()" (let_decl_of_and and_) er_name
+
 let gen_variant ?and_ module_prefix { Ot.v_name; Ot.v_constructors } sc =
   match v_constructors with
   | [] -> failwith "programmatic TODO error"
@@ -183,6 +186,9 @@ let gen_struct ?and_ t sc =
     | Ot.Const_variant v ->
       gen_const_variant v sc;
       true
+    | Ot.Unit u ->
+      gen_unit ?and_ u sc;
+      true
   in
   has_encoded
 
@@ -207,6 +213,12 @@ let gen_sig_record sc module_prefix { Ot.r_name; r_fields } =
   let rn = r_name in
   F.linep sc "(** [default_%s ()] is the default value for type [%s] *)" rn rn
 
+let gen_sig_unit sc { Ot.er_name } =
+  F.linep sc "val default_%s : unit" er_name;
+
+  let rn = er_name in
+  F.linep sc "(** [default_%s ()] is the default value for type [%s] *)" rn rn
+
 let gen_sig ?and_ t sc =
   let _ = and_ in
   let f type_name =
@@ -228,6 +240,9 @@ let gen_sig ?and_ t sc =
     | Ot.Const_variant { Ot.cv_name; _ } ->
       f cv_name;
       true
+    | Ot.Unit u ->
+      gen_sig_unit sc u;
+      true
   in
 
   has_encoded
diff --git a/src/compilerlib/pb_codegen_encode_binary.ml b/src/compilerlib/pb_codegen_encode_binary.ml
index cdcce44..98e13e2 100644
--- a/src/compilerlib/pb_codegen_encode_binary.ml
+++ b/src/compilerlib/pb_codegen_encode_binary.ml
@@ -212,6 +212,13 @@ let gen_record ?and_ module_prefix { Ot.r_name; r_fields } sc =
       F.line sc "()")
 (* encode function *)
 
+let gen_unit ?and_ module_prefix { Ot.er_name } sc =
+  let rn = er_name in
+  F.linep sc "%s encode_%s (v:%s_types.%s) encoder = "
+    (Pb_codegen_util.let_decl_of_and and_)
+    rn module_prefix rn;
+  F.line sc "()"
+
 let gen_variant ?and_ module_prefix variant sc =
   let { Ot.v_name; Ot.v_constructors } = variant in
   let vn = v_name in
@@ -276,6 +283,9 @@ let gen_struct ?and_ t sc =
     | Ot.Const_variant v ->
       gen_const_variant ?and_ module_prefix v sc;
       true
+    | Ot.Unit u ->
+      gen_unit ?and_ module_prefix u sc;
+      true
   in
   has_encoded
 
@@ -300,6 +310,9 @@ let gen_sig ?and_ t sc =
     | Ot.Const_variant { Ot.cv_name; _ } ->
       f cv_name;
       true
+    | Ot.Unit { Ot.er_name; _ } ->
+      f er_name;
+      true
   in
   has_encoded
 
diff --git a/src/compilerlib/pb_codegen_encode_yojson.ml b/src/compilerlib/pb_codegen_encode_yojson.ml
index e2ebda5..3718820 100644
--- a/src/compilerlib/pb_codegen_encode_yojson.ml
+++ b/src/compilerlib/pb_codegen_encode_yojson.ml
@@ -30,7 +30,7 @@ let runtime_function_for_basic_type json_label basic_type pk =
   (* bool *)
   | Ot.Bt_bool, Ot.Pk_varint _ -> "make_bool", None
   (* bytes *)
-  | Ot.Bt_bytes, Ot.Pk_bytes -> unsupported json_label
+  | Ot.Bt_bytes, Ot.Pk_bytes -> "make_bytes", None
   | _ -> unsupported json_label
 
 (* TODO Wrapper: add a runtime_function_for_wrapper_type  which will
@@ -177,6 +177,13 @@ let gen_record ?and_ module_prefix { Ot.r_name; r_fields } sc =
         r_fields (* List.iter *);
       F.line sc "`Assoc assoc")
 
+let gen_unit ?and_ module_prefix { Ot.er_name } sc =
+  let rn = er_name in
+  F.linep sc "%s encode_%s (v:%s_types.%s) = "
+    (Pb_codegen_util.let_decl_of_and and_)
+    rn module_prefix rn;
+  F.line sc (sp "Pbrt_yojson.%s %s" "make_unit" "v")
+
 let gen_variant ?and_ module_prefix { Ot.v_name; v_constructors } sc =
   let process_v_constructor sc v_constructor =
     let { Ot.vc_constructor; Ot.vc_field_type; Ot.vc_payload_kind; _ } =
@@ -233,6 +240,9 @@ let gen_struct ?and_ t sc =
     | Ot.Const_variant v ->
       gen_const_variant ?and_ module_prefix v sc;
       true
+    | Ot.Unit u ->
+      gen_unit ?and_ module_prefix u sc;
+      true
   in
 
   has_encoded
@@ -257,5 +267,8 @@ let gen_sig ?and_ t sc =
   | { Ot.spec = Ot.Const_variant { Ot.cv_name; _ }; _ } ->
     f cv_name;
     true
+  | { Ot.spec = Ot.Unit { Ot.er_name; _ }; _ } ->
+    f er_name;
+    true
 
 let ocamldoc_title = "Protobuf YoJson Encoding"
diff --git a/src/compilerlib/pb_codegen_ocaml_type.ml b/src/compilerlib/pb_codegen_ocaml_type.ml
index 4995e82..41dc55c 100644
--- a/src/compilerlib/pb_codegen_ocaml_type.ml
+++ b/src/compilerlib/pb_codegen_ocaml_type.ml
@@ -139,10 +139,13 @@ and const_variant = {
   cv_constructors: const_variant_constructor list;
 }
 
+and empty_record = { er_name: string }
+
 and type_spec =
   | Record of record
   | Variant of variant
   | Const_variant of const_variant
+  | Unit of empty_record
 
 type type_ = {
   module_prefix: string;
diff --git a/src/compilerlib/pb_codegen_pp.ml b/src/compilerlib/pb_codegen_pp.ml
index 5d97cdc..fb1fd51 100644
--- a/src/compilerlib/pb_codegen_pp.ml
+++ b/src/compilerlib/pb_codegen_pp.ml
@@ -93,6 +93,16 @@ let gen_record ?and_ module_prefix { Ot.r_name; r_fields } sc =
       F.line sc "in";
       F.line sc "Pbrt.Pp.pp_brk pp_i fmt ()")
 
+let gen_unit ?and_ module_prefix { Ot.er_name } sc =
+  F.line sc
+  @@ sp "%s pp_%s fmt (v:%s_types.%s) = " (let_decl_of_and and_) er_name
+       module_prefix er_name;
+  F.scope sc (fun sc ->
+      F.line sc "let pp_i fmt () =";
+      F.scope sc (fun sc -> F.line sc "Pbrt.Pp.pp_unit fmt ()");
+      F.line sc "in";
+      F.line sc "Pbrt.Pp.pp_brk pp_i fmt ()")
+
 let gen_variant ?and_ module_prefix { Ot.v_name; Ot.v_constructors } sc =
   F.line sc
   @@ sp "%s pp_%s fmt (v:%s_types.%s) =" (let_decl_of_and and_) v_name
@@ -133,7 +143,8 @@ let gen_struct ?and_ t sc =
   (match spec with
   | Ot.Record r -> gen_record ?and_ module_prefix r sc
   | Ot.Variant v -> gen_variant ?and_ module_prefix v sc
-  | Ot.Const_variant v -> gen_const_variant ?and_ module_prefix v sc);
+  | Ot.Const_variant v -> gen_const_variant ?and_ module_prefix v sc
+  | Ot.Unit u -> gen_unit ?and_ module_prefix u sc);
   true
 
 let gen_sig ?and_ t sc =
@@ -148,7 +159,8 @@ let gen_sig ?and_ t sc =
   (match spec with
   | Ot.Record { Ot.r_name; _ } -> f r_name
   | Ot.Variant v -> f v.Ot.v_name
-  | Ot.Const_variant { Ot.cv_name; _ } -> f cv_name);
+  | Ot.Const_variant { Ot.cv_name; _ } -> f cv_name
+  | Ot.Unit { Ot.er_name; _ } -> f er_name);
   true
 
 let ocamldoc_title = "Formatters"
diff --git a/src/compilerlib/pb_codegen_types.ml b/src/compilerlib/pb_codegen_types.ml
index 2656a5b..c652158 100644
--- a/src/compilerlib/pb_codegen_types.ml
+++ b/src/compilerlib/pb_codegen_types.ml
@@ -81,6 +81,9 @@ let gen_const_variant ?and_ { Ot.cv_name; cv_constructors } sc =
         (fun { Ot.cvc_name; _ } -> F.linep sc "| %s " cvc_name)
         cv_constructors)
 
+let gen_unit ?and_ { Ot.er_name } sc =
+  F.linep sc "%s %s = unit" (type_decl_of_and and_) er_name
+
 let print_ppx_extension { Ot.type_level_ppx_extension; _ } sc =
   match type_level_ppx_extension with
   | None -> ()
@@ -91,7 +94,8 @@ let gen_struct ?and_ t scope =
   (match spec with
   | Ot.Record r -> gen_record ?and_ r scope
   | Ot.Variant v -> gen_variant ?and_ v scope
-  | Ot.Const_variant v -> gen_const_variant ?and_ v scope);
+  | Ot.Const_variant v -> gen_const_variant ?and_ v scope
+  | Ot.Unit v -> gen_unit ?and_ v scope);
   print_ppx_extension t scope;
   true
 
@@ -100,7 +104,8 @@ let gen_sig ?and_ t scope =
   (match spec with
   | Ot.Record r -> gen_record ?and_ r scope
   | Ot.Variant v -> gen_variant ?and_ v scope
-  | Ot.Const_variant v -> gen_const_variant ?and_ v scope);
+  | Ot.Const_variant v -> gen_const_variant ?and_ v scope
+  | Ot.Unit v -> gen_unit ?and_ v scope);
   print_ppx_extension t scope;
   true
 
diff --git a/src/compilerlib/pb_codegen_util.ml b/src/compilerlib/pb_codegen_util.ml
index 486166f..20814ce 100644
--- a/src/compilerlib/pb_codegen_util.ml
+++ b/src/compilerlib/pb_codegen_util.ml
@@ -162,6 +162,7 @@ let collect_modules_of_type_spec modules = function
   | Ot.Record r -> collect_modules_of_record modules r
   | Ot.Variant v -> collect_modules_of_variant modules v
   | Ot.Const_variant _ -> modules
+  | Ot.Unit _ -> modules
 
 let collect_modules_of_types ocaml_types =
   List.fold_left


Test patch:
diff --git a/src/tests/integration-tests/test27.proto b/src/tests/integration-tests/test27.proto
index f178f8f..1c6d366 100644
--- a/src/tests/integration-tests/test27.proto
+++ b/src/tests/integration-tests/test27.proto
@@ -26,3 +26,5 @@ message Test {
   OneOfIsKeyword one_of_is_keyword = 3;
 }
 
+message Empty {  
+}