Merge pull request #37 from andersfugmann/andersfugmann/single_oneof_…

…fields

Add option 'singleton_oneof_as_option'

Changelog.md

@@ -1,7 +1,11 @@
-## 6.1.1: Unreleased
+## 6.2.0: Unreleased
 - Fix potential nameclash for messages defining extensions
 - Resolve compilation warning on deprecated fields enclosed in a oneof
 - Improve how comments are copied to generated code
+- Add flag 'singleton\_oneof\_as\_option' to map single field
+  onofs to option type (default on). Set to 'false' to keep old
+  behaviour.
+
 
 ## 6.1.0: 2024-04-25
 - Fix name resolution leading to wrongly mapped names

README.md

@@ -117,6 +117,7 @@ can generate the Ocaml code by running
 | fixed\_as\_int       | Map \*fixed\* types to `int`                                    | `fixed_as_int=true`          | false   |
 | singleton\_record    | Messages with only one field will be wrapped in a record        | `singleton_record=true`      | false   |
 | prefix\_output\_with\_package | Emit files prefixed with their package name. This allows multiple protofiles of the same name with different package names to be used | `prefix_output_with_package=true` | false |
+| single\_oneof\_fields\_as\_optional | Oneof declerations only containing one field are mapped to a single optional field | single\_oneof\_fields\_as\_optional=false | true |
 
 Parameters are separated by `;`
 

examples/echo/echo.proto

@@ -7,8 +7,8 @@ message Request {
      Mum = 0;
      World = 1;
   }
-  oneof timestamp {
-    google.protobuf.Timestamp ts = 1;
+  oneof ts {
+    google.protobuf.Timestamp timestamp = 1;
   };
   oneof what {
     who type = 10;

examples/echo/test.ml

@@ -9,16 +9,16 @@ let mk_timestamp () =
 
 
 let mk_request () =
-  Echo.Request.{ timestamp = `Ts (mk_timestamp ()); what = `Type Echo.Request.Who.World }
+  Echo.Request.{ timestamp = Some (mk_timestamp ()); what = `Type Echo.Request.Who.World }
 
 let mk_reply Echo.Request.{ timestamp; what } =
   let at =
     match timestamp with
-      | `Ts {seconds; nanos = _} ->
+      | Some {seconds; nanos = _} ->
           let minutes = seconds / 60 in
           let hours = minutes / 60 in
           Printf.sprintf "%d:%d:%d" (hours mod 24) (minutes mod 60) (seconds mod 60)
-      | `not_set ->
+      | None ->
           "whenever"
   in
 

examples/echo_deriving/echo.proto

@@ -7,9 +7,8 @@ message Request {
      Mum = 0;
      World = 1;
   }
-  oneof timestamp {
-    google.protobuf.Timestamp ts = 1;
-  };
+  google.protobuf.Timestamp timestamp = 1;
+
   oneof what {
     who type = 10;
     string someone = 11;

examples/echo_deriving/test.ml

@@ -9,18 +9,18 @@ let mk_timestamp () =
 
 
 let mk_request () =
-  Echo.Request.{ timestamp = `Ts (mk_timestamp ()); what = `Type Echo.Request.Who.World }
+  Echo.Request.{ timestamp = Some (mk_timestamp ()); what = `Type Echo.Request.Who.World }
 
 
 let mk_reply Echo.Request.{ timestamp; what } =
 
   let at =
     match timestamp with
-      | `Ts {seconds; nanos = _} ->
+      | Some {seconds; nanos = _} ->
           let minutes = seconds / 60 in
           let hours = minutes / 60 in
           Printf.sprintf "%d:%d:%d" (hours mod 24) (minutes mod 60) (seconds mod 60)
-      | `not_set ->
+      | None ->
           "whenever"
   in
 

src/plugin/code.ml

@@ -62,7 +62,6 @@ let map_comments comments =
         |> List.map ~f:(String.replace ~substring:"v}" ~f:(fun _ -> "v\\}"))
         |> remove_trailing_empty_lines
       in
-      (* TODO: Remove indentation *)
       "{v" :: lines @ ["v}"]
   )
   |> List.flatten

src/plugin/emit.ml

@@ -260,7 +260,6 @@ let rec emit_message ~params ~syntax ~scope ~type_db ~comment_db
             |> String.concat ~sep:", "
             |> sprintf "[(%s)]"
           in
-          (* TODO: emit sub_field comments also. *)
           let param_comments =
             List.map ~f:(function
               | (name, (comments, [])) ->

src/plugin/parameters.ml

@@ -9,6 +9,7 @@ type t = {
   debug: bool;
   singleton_record: bool;
   prefix_output_with_package: bool;
+  singleton_oneof_as_option: bool;
 }
 
 let default = {
@@ -20,6 +21,7 @@ let default = {
   debug = false;
   singleton_record = false;
   prefix_output_with_package = false;
+  singleton_oneof_as_option = true;
 }
 
 let parse_option str =
@@ -41,6 +43,7 @@ let parse parameters =
       | `Expr ("singleton_record", (("true"|"false") as v)) -> { param with singleton_record = (bool_of_string v) };
       | `Stmt "debug" -> { param with debug = true}
       | `Expr ("prefix_output_with_package", (("true"|"false") as v)) -> { param with prefix_output_with_package = (bool_of_string v)}
+      | `Expr ("singleton_oneof_as_option", (("true"|"false") as v)) -> { param with singleton_oneof_as_option = (bool_of_string v)}
       | `Stmt "" -> param
       | _ -> failwith ("Unknown parameter: " ^ option)
     )

src/plugin/protoc_gen_ocaml.ml

@@ -34,7 +34,7 @@ let parse_request Plugin.CodeGeneratorRequest.{file_to_generate = files_to_gener
     List.mem ~set:files_to_generate (Option.value_exn name)
   ) proto_files
   in
-  let type_db = Type_db.init ~prefix_module_names:params.prefix_output_with_package proto_files in
+  let type_db = Type_db.init ~params proto_files in
 
   let result =
     List.map ~f:(fun (proto_file : Descriptor.FileDescriptorProto.t) ->

src/plugin/type_db.ml

@@ -47,24 +47,37 @@ let add_scope ~proto_name ~ocaml_name { proto_path; ocaml_path; module_name; oca
   in
   { proto_path; ocaml_path; ocaml_name; module_name }
 
-let element_of_message ~mangle_f descriptorproto =
+let element_of_message ~params ~mangle_f descriptorproto =
   let DescriptorProto.{ field = fields; oneof_decl = oneof_decls; options; extension_range; _ } = descriptorproto in
   let map_type = match options with
     | Some MessageOptions.{ map_entry = Some true; _ } -> Some descriptorproto
     | _ -> None
   in
 
-  (* Need to remove the oneof_decls that we should use as fields *)
-  (* This is somewhat annoying. We should really set single field oneofs as option types. *)
-  (* There is essentially no difference from proto3 optional fields to that. *)
-
-  let plain_fields = List.filter ~f:(function
-    | FieldDescriptorProto.{ proto3_optional = Some v; _ } -> v
-    | FieldDescriptorProto.{ oneof_index; _ } -> Option.is_none oneof_index) fields
+  (* Create a set of oneof index' that should be emitted *)
+  let _, oneofs =
+    List.fold_left ~init:(0, IntSet.empty) ~f:(fun (index, acc) _oneof_decl ->
+      let count =
+        List.fold_left ~init:0 ~f:(fun acc -> function
+          | FieldDescriptorProto.{ proto3_optional = Some true; _ } -> acc
+          | FieldDescriptorProto.{ oneof_index = Some oneof_index; _ } when oneof_index = index -> acc + 1
+          | _ -> acc
+        ) fields
+      in
+      let acc =
+        match count > (if params.Parameters.singleton_oneof_as_option then 1 else 0) with
+        | true -> IntSet.add index acc
+        | false -> acc
+      in
+      (index + 1, acc)
+    ) oneof_decls
   in
-  let oneof_decls =
-    let remove_ids = List.filter_map ~f:(fun FieldDescriptorProto.{ oneof_index; _ } -> oneof_index) plain_fields in
-    List.filteri ~f:(fun i _ -> not (List.mem i ~set:remove_ids)) oneof_decls
+
+  let plain_fields =
+    List.filter ~f:(function
+      | FieldDescriptorProto.{ oneof_index = None; _ } -> true
+      | FieldDescriptorProto.{ oneof_index = Some index; _ } -> not (IntSet.mem index oneofs)
+    ) fields
   in
 
   let field_name_map =
@@ -76,13 +89,17 @@ let element_of_message ~mangle_f descriptorproto =
     in
 
     let plain_field_names = List.filter_map ~f:(fun field -> field.FieldDescriptorProto.name) plain_fields in
-    let oneof_names = List.filter_map ~f:(fun field -> field.OneofDescriptorProto.name) oneof_decls in
+    let oneof_names =
+      List.filter_map ~f:(fun field -> field.OneofDescriptorProto.name) oneof_decls
+      |> List.filteri ~f:(fun i _name -> IntSet.mem i oneofs)
+    in
     (* Extend name mapping. The 'extensions_name' should already have been allocated *)
     Names.create_ocaml_mapping ~name_map ~mangle_f ~name_f:Names.field_name (plain_field_names @ oneof_names)
   in
-  (* Need to exclude oneof's where its a proto3 message. In reality, we should not really care. *)
   let oneofs =
-    List.mapi ~f:(fun i OneofDescriptorProto.{ name; _ } ->
+    List.mapi ~f:(fun i oneof -> i, oneof) oneof_decls
+    |> List.filter ~f:(fun (i, _) -> IntSet.mem i oneofs)
+    |> List.map ~f:(fun (i, OneofDescriptorProto.{ name; _ }) ->
       let name = Option.value_exn ~message:"Oneof field must have a name" name in
       (* Get all the fields *)
       let oneof_fields =
@@ -107,8 +124,8 @@ let element_of_message ~mangle_f descriptorproto =
         ) oneof_fields
       in
       let ocaml_name = StringMap.find name field_name_map in
-      { name; ocaml_name }, Oneof oneofs
-    ) oneof_decls
+      ({ name; ocaml_name }, Oneof oneofs)
+    )
   in
   let plain_fields =
     List.map ~f:(fun FieldDescriptorProto.{ name; type_name; type'; _ } ->
@@ -154,7 +171,7 @@ let element_of_service ~mangle_f ServiceDescriptorProto.{ method'; _ } =
   in
   Service entries
 
-let rec traverse_message ~mangle_f ~scope map services descriptorproto =
+let rec traverse_message ~params ~mangle_f ~scope map services descriptorproto =
   let DescriptorProto.{ nested_type; enum_type; extension = extensions; _ } = descriptorproto in
   (* Scope contains all messages *)
   let name_map =
@@ -164,7 +181,7 @@ let rec traverse_message ~mangle_f ~scope map services descriptorproto =
     Names.create_ocaml_mapping ~mangle_f ~name_f:Names.module_name (message_names @ enum_names @ service_names)
   in
   (* Scope contains this element *)
-  let message_element = element_of_message ~mangle_f descriptorproto in
+  let message_element = element_of_message ~params ~mangle_f descriptorproto in
 
   (* Extension name should not interfere with other module names, but should still be uniq *)
   let extension_names = List.filter_map ~f:(fun e -> e.FieldDescriptorProto.name) extensions in
@@ -197,7 +214,7 @@ let rec traverse_message ~mangle_f ~scope map services descriptorproto =
       let proto_name = Option.value_exn ~message:"All messages must have a name" message.DescriptorProto.name in
       let ocaml_name = StringMap.find proto_name name_map in
       let scope = add_scope ~proto_name ~ocaml_name scope in
-      let map, message_element = traverse_message ~mangle_f ~scope map [] message in
+      let map, message_element = traverse_message ~params ~mangle_f ~scope map [] message in
       StringMap.add ~key:scope.proto_path ~data:(scope, message_element) map
     ) nested_type
   in
@@ -212,7 +229,7 @@ let rec traverse_message ~mangle_f ~scope map services descriptorproto =
   in
   map, message_element
 
-let traverse_file map module_name FileDescriptorProto.{ message_type = messages; package; enum_type = enums; service = services; extension = extensions; options; _ } =
+let traverse_file ~params map module_name FileDescriptorProto.{ message_type = messages; package; enum_type = enums; service = services; extension = extensions; options; _ } =
   let mangle_f = match (Names.has_mangle_option options) with
     | true -> Names.to_snake_case
     | false -> fun x -> x
@@ -236,7 +253,7 @@ let traverse_file map module_name FileDescriptorProto.{ message_type = messages;
   in
   (* Mimic a message. *)
   let message = DescriptorProto.make ~nested_type:messages ~enum_type:enums ~extension:extensions () in
-  let map, _ = traverse_message ~mangle_f map ~scope services message in
+  let map, _ = traverse_message ~params ~mangle_f map ~scope services message in
   map
 
 (** Construct a set of proto_names (types) that are cyclic *)
@@ -302,13 +319,13 @@ let dump { map; cyclic_set = _; file_map } =
     | _ -> ()
   ) map
 
-let init ~prefix_module_names (files : FileDescriptorProto.t list) =
+let init ~params (files : FileDescriptorProto.t list) =
   let map, file_map = List.fold_left ~init:(StringMap.empty, StringMap.empty) ~f:(
     fun (map, file_map) file ->
       let file_name = Option.value_exn ~message:"Files must have a name" file.FileDescriptorProto.name in
-      let module_name = make_module_name ~prefix_module_names ?package:file.package file_name in
+      let module_name = make_module_name ~prefix_module_names:params.Parameters.prefix_output_with_package ?package:file.package file_name in
       let file_map = StringMap.add ~key:file_name ~data:module_name file_map in
-      let map = traverse_file map module_name file in
+      let map = traverse_file ~params map module_name file in
       (map, file_map)
   ) files in
 
@@ -372,14 +389,14 @@ let get_message_oneof_field { map; _ } ~proto_name ~oneof_name ~field_name =
           | { name; constructor_name; _ } when name = field_name -> Some constructor_name
           | _ -> None
         ) oneofs
-        |> Option.value_exn ~message:(sprintf "Field %s not part of oneof %s in message %s"
+        |> Option.value_exn ~message:(sprintf "Field '%s' not part of oneof '%s' in message '%s'"
                                         field_name oneof_name proto_name)
 
-      | Some (Plain _) -> failwith_f "Field %s in message %s is not a oneof field" field_name proto_name
-      | None -> failwith_f "Field %s not found for message %s" oneof_name proto_name
+      | Some (Plain _) -> failwith_f "Field '%s' in message %s is not a oneof field" field_name proto_name
+      | None -> failwith_f "Field '%s' not found for message '%s'" oneof_name proto_name
     in
     name
-  | _ -> failwith_f "%s is not a message" proto_name
+  | _ -> failwith_f "'%s' is not a message" proto_name
 
 
 (** Get the name of an enum *)
@@ -390,8 +407,8 @@ let get_enum_name { map; _ } ~proto_path ?name () =
   in
   match StringMap.find_opt proto_name map with
   | Some ({ ocaml_name; _ }, Enum _) -> ocaml_name
-  | Some (_, element_type) -> failwith_f "%s is not an enum but a %s" proto_name (string_of_element_type element_type)
-  | None -> failwith_f "%s not found" proto_name
+  | Some (_, element_type) -> failwith_f "'%s' is not an enum but a '%s'" proto_name (string_of_element_type element_type)
+  | None -> failwith_f "'%s' not found" proto_name
 
 (** Get the name of an enum value (constructor) for a enum *)
 let get_enum_value { map; _ } ~proto_path ?enum_name enum_value_name =
@@ -400,22 +417,22 @@ let get_enum_value { map; _ } ~proto_path ?enum_name enum_value_name =
     | Some enum_name -> sprintf "%s.%s" proto_path enum_name
   in
   match StringMap.find_opt proto_name map with
-  | None -> failwith_f "Enum %s not found" proto_name
+  | None -> failwith_f "Enum '%s' not found" proto_name
   | Some (_, Enum values) -> begin
       List.find_opt values ~f:(fun { name; _ } -> name = enum_value_name)
       |> function
-      | None -> failwith_f "Enum value %s not found in enum %s" enum_value_name proto_name
+      | None -> failwith_f "Enum value '%s' not found in enum '%s'" enum_value_name proto_name
       | Some { ocaml_name; _ } -> ocaml_name
     end
-  | Some (_, element_type) -> failwith_f "%s(%s):%s is of type %s and not type enum" proto_name (Option.value ~default:"<none>" enum_name) enum_value_name (string_of_element_type element_type)
+  | Some (_, element_type) -> failwith_f "'%s(%s):%s' is of type '%s' and not type enum" proto_name (Option.value ~default:"<none>" enum_name) enum_value_name (string_of_element_type element_type)
 
 (** Get the module name for a service *)
 let get_service { map; _ } ~proto_path name =
   let proto_name = sprintf "%s.%s" proto_path name in
   match StringMap.find_opt proto_name map with
   | Some ({ ocaml_name; _ }, Service _) -> ocaml_name
-  | Some (_, element_type) -> failwith_f "%s is not a service but a %s" proto_name (string_of_element_type element_type)
-  | None -> failwith_f "%s not found" proto_name
+  | Some (_, element_type) -> failwith_f "'%s' is not a service but a '%s'" proto_name (string_of_element_type element_type)
+  | None -> failwith_f "'%s' not found" proto_name
 
 (** Get the ocaml method name for a method in a service *)
 let get_service_method { map; _ } ~proto_path ~service_name method_name =
@@ -428,26 +445,26 @@ let get_service_method { map; _ } ~proto_path ~service_name method_name =
       ) methods
       |> function
       | Some name -> name
-      | None -> failwith_f "method %s not found in service %s" method_name proto_name
+      | None -> failwith_f "method '%s' not found in service '%s'" method_name proto_name
     end
-  | Some (_, element_type) -> failwith_f "%s is not a method but a %s" proto_name (string_of_element_type element_type)
-  | None -> failwith_f "%s not found" proto_name
+  | Some (_, element_type) -> failwith_f "'%s' is not a method but a '%s'" proto_name (string_of_element_type element_type)
+  | None -> failwith_f "'%s' not found" proto_name
 
 let get_module_name { file_map; _ } proto_file =
   match StringMap.find_opt proto_file file_map with
-  | None -> failwith_f "Could not find module name for %s" proto_file
+  | None -> failwith_f "Could not find module name for '%s'" proto_file
   | Some module_name -> module_name
 
 let get_location { map; _ } proto_path =
   match StringMap.find_opt proto_path map with
-  | None -> failwith_f "Unknown proto_path %s" proto_path
+  | None -> failwith_f "Unknown proto_path '%s'" proto_path
   | Some ({ module_name; _}, _) -> module_name
 
 let get_map_type { map; _ } proto_path =
   match StringMap.find_opt proto_path map with
   | Some (_, Message { map_type; _ }) -> map_type
-  | Some (_, element_type) -> failwith_f "%s is not a message but a %s" proto_path (string_of_element_type element_type)
-  | None -> failwith_f "message %s not found" proto_path
+  | Some (_, element_type) -> failwith_f "'%s' is not a message but a '%s'" proto_path (string_of_element_type element_type)
+  | None -> failwith_f "message '%s' not found" proto_path
 
 let get_entry { map; _ } proto_path =
   match StringMap.find_opt proto_path map with
@@ -463,11 +480,11 @@ let get_ocaml_path { map; _ } proto_path =
   match StringMap.find_opt proto_path map with
   | Some ({ ocaml_path = ""; ocaml_name; _ }, _) -> ocaml_name
   | Some ({ ocaml_path; ocaml_name; _ }, _ ) -> sprintf "%s.%s" ocaml_path ocaml_name
-  | None -> failwith_f "type %s not found" proto_path
+  | None -> failwith_f "type '%s' not found" proto_path
 
 let get_extension { map; _ } ~proto_path name =
   let proto_name = sprintf "%s.%s" proto_path name in
   match StringMap.find_opt proto_name map with
   | Some ({ ocaml_name; _ }, Extension) -> ocaml_name
-  | Some (_, element_type) -> failwith_f "%s is not an extension but a %s" proto_name (string_of_element_type element_type)
-  | None -> failwith_f "%s not found" proto_name
+  | Some (_, element_type) -> failwith_f "'%s' is not an extension but a '%s'" proto_name (string_of_element_type element_type)
+  | None -> failwith_f "'%s' not found" proto_name

src/plugin/types.ml

@@ -641,7 +641,12 @@ let make ~params ~syntax ~is_cyclic ~extension_ranges ~scope ~type_db ~comment_d
     split_oneof_decl fields oneof_decls
     |> List.map ~f:(function
       (* proto3 Oneof fields with only one field is mapped as regular field *)
-      | `Oneof (_, [ (FieldDescriptorProto.{ proto3_optional = Some true; _ } as field, map_type) ] )
+      | `Oneof (_, [ field, map_type ] ) when params.singleton_oneof_as_option ->
+        let field = { field with proto3_optional = Some true; oneof_index = None } in
+        c_of_field ~params ~syntax ~scope ~map_type ~type_db ~comment_db field
+      | `Oneof (_, [ (FieldDescriptorProto.{ proto3_optional = Some true; _ } as field, map_type) ] ) ->
+        let field = { field with oneof_index = None } in
+        c_of_field ~params ~syntax ~scope ~map_type ~type_db ~comment_db field
       | `Field ( field, map_type) ->
         c_of_field ~params ~syntax ~scope ~map_type ~type_db ~comment_db field
       | `Oneof (decl, fields) ->