Optional oneof

src/compilerlib/pb_codegen_backend.ml

@@ -411,21 +411,6 @@ let compile_message ~(unsigned_tag : bool) (file_options : Pb_option.set)
         }
     in
     [ type_ ]
-  | Tt.Message_oneof_field f :: [] ->
-    let outer_message_names = message_names @ [ message_name ] in
-    let variant =
-      variant_of_oneof ~unsigned_tag ~outer_message_names ~all_types
-        file_options file_name f
-    in
-    [
-      Ot.
-        {
-          module_prefix;
-          spec = Variant variant;
-          type_level_ppx_extension;
-          type_options = message_options;
-        };
-    ]
   | _ ->
     let variants, fields =
       List.fold_left

src/compilerlib/pb_codegen_decode_binary.ml

@@ -169,9 +169,9 @@ let gen_rft_variant sc r_name rf_label { Ot.v_constructors; _ } =
           match vc_field_type with
           | Ot.Vct_nullary ->
             F.line sc "Pbrt.Decoder.empty_nested d;";
-            F.linep sc "v.%s <- %s;" rf_label vc_constructor
+            F.linep sc "v.%s <- Some %s;" rf_label vc_constructor
           | Ot.Vct_non_nullary_constructor field_type ->
-            F.linep sc "v.%s <- %s (%s);" rf_label vc_constructor
+            F.linep sc "v.%s <- Some (%s (%s));" rf_label vc_constructor
               (decode_field_expression field_type pk)))
     v_constructors
 

src/compilerlib/pb_codegen_decode_bs.ml

@@ -94,12 +94,14 @@ let gen_rft_variant sc ~r_name ~rf_label { Ot.v_constructors; _ } =
 
       match vc_field_type with
       | Ot.Vct_nullary ->
-        F.linep sc "| \"%s\" -> v.%s <- %s" json_label rf_label vc_constructor
+        F.linep sc "| \"%s\" -> v.%s <- Some %s" json_label rf_label
+          vc_constructor
       | Ot.Vct_non_nullary_constructor field_type ->
         let value_expression = value_expression ~r_name ~rf_label field_type in
         F.linep sc "| \"%s\" -> " json_label;
         F.linep sc "  let json = Js.Dict.unsafeGet json \"%s\" in" json_label;
-        F.linep sc "  v.%s <- %s (%s)" rf_label vc_constructor value_expression)
+        F.linep sc "  v.%s <- Some (%s (%s))" rf_label vc_constructor
+          value_expression)
     v_constructors
 
 (* Generate decode function for a record *)

src/compilerlib/pb_codegen_decode_yojson.ml

@@ -89,14 +89,14 @@ let gen_rft_variant_field sc ~r_name ~rf_label { Ot.v_constructors; _ } =
 
       match vc_field_type with
       | Ot.Vct_nullary ->
-        F.linep sc "| (\"%s\", _) -> v.%s <- %s" json_label rf_label
+        F.linep sc "| (\"%s\", _) -> v.%s <- Some %s" json_label rf_label
           vc_constructor
       | Ot.Vct_non_nullary_constructor field_type ->
         let match_variable_name, exp =
           field_pattern_match ~r_name ~rf_label field_type
         in
         F.linep sc "| (\"%s\", %s) -> " json_label match_variable_name;
-        F.linep sc "  v.%s <- %s (%s)" rf_label vc_constructor exp)
+        F.linep sc "  v.%s <- Some (%s (%s))" rf_label vc_constructor exp)
     v_constructors
 
 let gen_rft_assoc_field sc ~r_name ~rf_label ~assoc_type ~key_type ~value_type =

src/compilerlib/pb_codegen_default.ml

@@ -69,14 +69,7 @@ let record_field_default_info record_field =
       | Ot.At_hashtable -> "Hashtbl.create 128")
       (* TODO This initial value could be configurable either via
        * the default function or via a protobuf option. *)
-    | Ot.Rft_variant { Ot.v_constructors; _ } ->
-      (match v_constructors with
-      | [] -> assert false
-      | { Ot.vc_constructor; vc_field_type; _ } :: _ ->
-        (match vc_field_type with
-        | Ot.Vct_nullary -> vc_constructor
-        | Ot.Vct_non_nullary_constructor field_type ->
-          sp "%s (%s)" vc_constructor (dfvft field_type None)))
+    | Ot.Rft_variant _ -> "None"
   in
   field_name, default_value, type_string
 

src/compilerlib/pb_codegen_encode_binary.ml

@@ -145,16 +145,17 @@ let gen_rft_variant sc var_name { Ot.v_constructors; _ } =
 
       match vc_field_type with
       | Ot.Vct_nullary ->
-        F.linep sc "| %s ->" vc_constructor;
+        F.linep sc "| Some %s ->" vc_constructor;
         F.sub_scope sc (fun sc ->
             F.line sc "Pbrt.Encoder.empty_nested encoder;";
             gen_encode_field_key sc vc_encoding_number vc_payload_kind false)
       | Ot.Vct_non_nullary_constructor field_type ->
-        F.linep sc "| %s x ->" vc_constructor;
+        F.linep sc "| Some %s x ->" vc_constructor;
         F.sub_scope sc (fun sc ->
             gen_encode_field_type sc ~with_key:true "x" vc_encoding_number
               vc_payload_kind false field_type))
     v_constructors;
+    F.line sc "| None -> ()";
   F.line sc "end;"
 
 let gen_rft_associative sc var_name associative_field =

src/compilerlib/pb_codegen_encode_bs.ml

@@ -162,14 +162,15 @@ let gen_rft_variant sc var_name rf_label { Ot.v_constructors; _ } =
           let json_label =
             Pb_codegen_util.camel_case_of_constructor vc_constructor
           in
-          F.linep sc "| %s v ->" vc_constructor;
+          F.linep sc "| Some (%s v) ->" vc_constructor;
           F.sub_scope sc (fun sc ->
               match vc_field_type with
               | Ot.Vct_nullary ->
                 F.linep sc "Js.Dict.set json \"%s\" Js.Json.null" json_label
               | Ot.Vct_non_nullary_constructor field_type ->
                 gen_field sc var_name json_label field_type vc_payload_kind))
-        v_constructors);
+        v_constructors;
+      F.line sc "| None -> ()");
   F.linep sc "end; (* match v.%s *)" rf_label
 
 let gen_record ?and_ { Ot.r_name; r_fields } sc =

src/compilerlib/pb_codegen_encode_yojson.ml

@@ -133,7 +133,7 @@ let gen_rft_variant sc rf_label { Ot.v_constructors; _ } =
           let json_label =
             Pb_codegen_util.camel_case_of_constructor vc_constructor
           in
-          F.linep sc "| %s v ->" vc_constructor;
+          F.linep sc "| Some (%s v) ->" vc_constructor;
           F.sub_scope sc (fun sc ->
               match vc_field_type with
               | Ot.Vct_nullary ->
@@ -144,7 +144,8 @@ let gen_rft_variant sc rf_label { Ot.v_constructors; _ } =
                  with
                 | None -> F.linep sc "(\"%s\", `Null) :: assoc" json_label
                 | Some exp -> F.linep sc "%s :: assoc " exp)))
-        v_constructors);
+        v_constructors;
+      F.line sc "| None -> assoc");
 
   F.linep sc "in (* match v.%s *)" rf_label
 

src/compilerlib/pb_codegen_pp.ml

@@ -66,7 +66,9 @@ let gen_record ?and_ { Ot.r_name; r_fields } sc =
                  * requirement is indeed comming from the imposed Protobuf format)
                  *)
                 F.line sc
-                @@ sp "Pbrt.Pp.pp_record_field ~first:%b \"%s\" %s fmt %s;"
+                @@ sp
+                     "Pbrt.Pp.pp_record_field ~first:%b \"%s\" \
+                      (Pbrt.Pp.pp_option %s) fmt %s;"
                      first rf_label ("pp_" ^ v_name) var_name
                 (* Rft_variant_field *)
               | Ot.Rft_associative (at, _, (key_type, _), (value_type, _)) ->

src/compilerlib/pb_codegen_util.ml

@@ -68,8 +68,8 @@ let string_of_record_field_type ?module_prefix = function
       (string_of_associative_type Ot.At_hashtable)
   | Ot.Rft_variant { Ot.v_name; _ } ->
     (match module_prefix with
-    | None -> v_name
-    | Some module_prefix -> module_prefix ^ "." ^ v_name)
+    | None -> v_name ^ " option"
+    | Some module_prefix -> module_prefix ^ "." ^ v_name ^ " option")
 
 (** [function_name_of_user_defined prefix user_defined] returns the function
     name of the form `(module'.'?)prefix_(type_name)`.

src/examples/dune

@@ -94,6 +94,18 @@
  (package ocaml-protoc)
  (libraries pbrt pbrt_yojson pbrt_services))
 
+(rule
+ (targets oneof.ml oneof.mli)
+ (deps oneof.proto)
+ (action
+  (run ocaml-protoc --binary --pp --yojson --services --ml_out ./ %{deps})))
+
+(test
+ (name oneof)
+ (modules oneof) ; just check that it compiles
+ (package ocaml-protoc)
+ (libraries pbrt pbrt_yojson pbrt_services))
+
 (include dune.inc)
 
 (rule
@@ -116,4 +128,5 @@
     example04
     example05
     file_server
-    orgchart))))
+    orgchart
+    oneof))))

src/examples/dune.inc

@@ -70,6 +70,16 @@
  (action
   (diff file_server.mli.expected file_server.mli)))
 
+(rule
+ (alias runtest)
+ (action
+  (diff oneof.ml.expected oneof.ml)))
+
+(rule
+ (alias runtest)
+ (action
+  (diff oneof.mli.expected oneof.mli)))
+
 (rule
  (alias runtest)
  (action

src/examples/example03.ml.expected

@@ -2,13 +2,23 @@
 
 type string_some_none = unit
 
-type string_some =
+type string_some_t =
   | None
   | Some of string
 
+and string_some = {
+  t : string_some_t option;
+}
+
 let rec default_string_some_none = ()
 
-let rec default_string_some (): string_some = None
+let rec default_string_some_t (): string_some_t = None
+
+and default_string_some 
+  ?t:((t:string_some_t option) = None)
+  () : string_some  = {
+  t;
+}
 
 [@@@ocaml.warning "-27-30-39"]
 
@@ -20,7 +30,13 @@ let rec pp_string_some_none fmt (v:string_some_none) =
   in
   Pbrt.Pp.pp_brk pp_i fmt ()
 
-let rec pp_string_some fmt (v:string_some) =
+let rec pp_string_some_t fmt (v:string_some_t) =
   match v with
   | None  -> Format.fprintf fmt "None"
   | Some x -> Format.fprintf fmt "@[<hv2>Some(@,%a)@]" Pbrt.Pp.pp_string x
+
+and pp_string_some fmt (v:string_some) = 
+  let pp_i fmt () =
+    Pbrt.Pp.pp_record_field ~first:true "t" (Pbrt.Pp.pp_option pp_string_some_t) fmt v.t;
+  in
+  Pbrt.Pp.pp_brk pp_i fmt ()

src/examples/example03.mli.expected

@@ -9,17 +9,27 @@
 
 type string_some_none = unit
 
-type string_some =
+type string_some_t =
   | None
   | Some of string
 
+and string_some = {
+  t : string_some_t option;
+}
+
 
 (** {2 Basic values} *)
 
 val default_string_some_none : unit
 (** [default_string_some_none ()] is the default value for type [string_some_none] *)
 
-val default_string_some : unit -> string_some
+val default_string_some_t : unit -> string_some_t
+(** [default_string_some_t ()] is the default value for type [string_some_t] *)
+
+val default_string_some : 
+  ?t:string_some_t option ->
+  unit ->
+  string_some
 (** [default_string_some ()] is the default value for type [string_some] *)
 
 
@@ -28,5 +38,8 @@ val default_string_some : unit -> string_some
 val pp_string_some_none : Format.formatter -> string_some_none -> unit 
 (** [pp_string_some_none v] formats v *)
 
+val pp_string_some_t : Format.formatter -> string_some_t -> unit 
+(** [pp_string_some_t v] formats v *)
+
 val pp_string_some : Format.formatter -> string_some -> unit 
 (** [pp_string_some v] formats v *)

src/examples/example04.ml.expected

@@ -7,10 +7,14 @@ type int_list_cons = {
   next : int_list;
 }
 
-and int_list =
+and int_list_t =
   | Cons of int_list_cons
   | Nil
 
+and int_list = {
+  t : int_list_t option;
+}
+
 let rec default_int_list_nil = ()
 
 let rec default_int_list_cons 
@@ -21,7 +25,13 @@ let rec default_int_list_cons
   next;
 }
 
-and default_int_list () : int_list = Cons (default_int_list_cons ())
+and default_int_list_t () : int_list_t = Cons (default_int_list_cons ())
+
+and default_int_list 
+  ?t:((t:int_list_t option) = None)
+  () : int_list  = {
+  t;
+}
 
 [@@@ocaml.warning "-27-30-39"]
 
@@ -40,7 +50,13 @@ let rec pp_int_list_cons fmt (v:int_list_cons) =
   in
   Pbrt.Pp.pp_brk pp_i fmt ()
 
-and pp_int_list fmt (v:int_list) =
+and pp_int_list_t fmt (v:int_list_t) =
   match v with
   | Cons x -> Format.fprintf fmt "@[<hv2>Cons(@,%a)@]" pp_int_list_cons x
   | Nil  -> Format.fprintf fmt "Nil"
+
+and pp_int_list fmt (v:int_list) = 
+  let pp_i fmt () =
+    Pbrt.Pp.pp_record_field ~first:true "t" (Pbrt.Pp.pp_option pp_int_list_t) fmt v.t;
+  in
+  Pbrt.Pp.pp_brk pp_i fmt ()

src/examples/example04.mli.expected

@@ -14,10 +14,14 @@ type int_list_cons = {
   next : int_list;
 }
 
-and int_list =
+and int_list_t =
   | Cons of int_list_cons
   | Nil
 
+and int_list = {
+  t : int_list_t option;
+}
+
 
 (** {2 Basic values} *)
 
@@ -31,7 +35,13 @@ val default_int_list_cons :
   int_list_cons
 (** [default_int_list_cons ()] is the default value for type [int_list_cons] *)
 
-val default_int_list : unit -> int_list
+val default_int_list_t : unit -> int_list_t
+(** [default_int_list_t ()] is the default value for type [int_list_t] *)
+
+val default_int_list : 
+  ?t:int_list_t option ->
+  unit ->
+  int_list
 (** [default_int_list ()] is the default value for type [int_list] *)
 
 
@@ -43,5 +53,8 @@ val pp_int_list_nil : Format.formatter -> int_list_nil -> unit
 val pp_int_list_cons : Format.formatter -> int_list_cons -> unit 
 (** [pp_int_list_cons v] formats v *)
 
+val pp_int_list_t : Format.formatter -> int_list_t -> unit 
+(** [pp_int_list_t v] formats v *)
+
 val pp_int_list : Format.formatter -> int_list -> unit 
 (** [pp_int_list v] formats v *)