Merge pull request #54 from issuu/andersfugmann/fix_mangle

Fix name mangling, as reported in #52

src/plugin/emit.ml

@@ -54,10 +54,14 @@ let emit_enum_type ~scope ~params
   Code.emit implementation `End "";
   {module_name; signature; implementation}
 
-let emit_service_type scope ServiceDescriptorProto.{ name; method' = methods; _ } =
+let emit_service_type ~options scope ServiceDescriptorProto.{ name; method' = methods; _ } =
   let emit_method t local_scope scope service_name MethodDescriptorProto.{ name; input_type; output_type; _} =
     let name = Option.value_exn name in
-    let uncapitalized_name = String.uncapitalize_ascii name |> Scope.Local.get_unique_name local_scope in
+    let mangle_f = match Scope.has_mangle_option options with
+      | false -> fun id -> id
+      | true -> Names.to_snake_case
+    in
+    let uncapitalized_name = mangle_f name |> String.uncapitalize_ascii |> Scope.Local.get_unique_name local_scope in
     (* To keep symmetry, only ensure that lowercased names are unique
        so that the upper case names are aswell.  We should remove this
        mapping if/when we deprecate the old API *)
@@ -233,11 +237,11 @@ let rec emit_message ~params ~syntax scope
   in
   {module_name; signature; implementation}
 
-let rec wrap_packages ~params ~syntax scope message_type services = function
+let rec wrap_packages ~params ~syntax ~options scope message_type services = function
   | [] ->
     let {module_name = _; implementation; _} = emit_message ~params ~syntax scope message_type in
     List.iter ~f:(fun service ->
-        Code.append implementation (emit_service_type scope service)
+        Code.append implementation (emit_service_type ~options scope service)
       ) services;
     implementation
 
@@ -246,15 +250,15 @@ let rec wrap_packages ~params ~syntax scope message_type services = function
     let package_name = Scope.get_name scope package in
     let scope = Scope.push scope package in
     Code.emit implementation `Begin "module %s = struct" package_name;
-    Code.append implementation (wrap_packages ~params ~syntax scope message_type services packages);
+    Code.append implementation (wrap_packages ~params ~syntax ~options scope message_type services packages);
     Code.emit implementation `End "end";
     implementation
 
 let parse_proto_file ~params scope
     FileDescriptorProto.{ name; package; dependency = dependencies; public_dependency = _;
                           weak_dependency = _; message_type = message_types;
                           enum_type = enum_types; service = services; extension;
-                          options = _; source_code_info = _; syntax; }
+                          options; source_code_info = _; syntax; }
   =
   let name = Option.value_exn ~message:"All files must have a name" name |> String.map ~f:(function '-' -> '_' | c -> c) in
   let syntax = match syntax with
@@ -302,7 +306,7 @@ let parse_proto_file ~params scope
       Code.emit implementation `End "end";
       Code.emit implementation `None "(**/**)";
   in
-  wrap_packages ~params ~syntax scope message_type services (Option.value_map ~default:[] ~f:(String.split_on_char ~sep:'.') package)
+  wrap_packages ~params ~syntax ~options scope message_type services (Option.value_map ~default:[] ~f:(String.split_on_char ~sep:'.') package)
   |> Code.append implementation;
 
 

src/plugin/names.ml

@@ -1,5 +1,7 @@
 open StdLabels
 
+type char_type = Lower | Upper | Neither
+
 (** Taken from: https://caml.inria.fr/pub/docs/manual-ocaml/lex.html *)
 let is_reserved = function
   | "and" | "as" | "assert" | "asr" | "begin" | "class" | "constraint" | "do" | "done"
@@ -23,12 +25,12 @@ let to_snake_case ident =
     Bytes.to_string bytes
   in
   let char_case = function
-    | 'a' .. 'z' -> `Lower
-    | 'A' .. 'Z' -> `upper
-    | _ -> `Neither
+    | 'a' .. 'z' -> Lower
+    | 'A' .. 'Z' -> Upper
+    | _ -> Neither
   in
-  let is_lower c = char_case c = `Lower in
-  let is_upper c = char_case c = `Upper in
+  let is_lower c = char_case c = Lower in
+  let is_upper c = char_case c = Upper in
 
   let rec to_snake_case = function
     | c1 :: c2 :: cs when is_lower c1 && is_upper c2 ->

src/plugin/scope.ml

@@ -45,6 +45,14 @@ let module_name_of_proto file =
   |> String.capitalize_ascii
   |> String.map ~f:(function '-' -> '_' | c -> c)
 
+let has_mangle_option options =
+  Option.map ~f:Spec.Options.Ocaml_options.get options
+  |> function
+  | Some (Ok (Some v)) -> v
+  | Some (Ok None) -> false
+  | None -> false
+  | Some (Error _e) -> failwith "Could not parse ocaml-protoc-plugin options with id 1074"
+
 module Type_tree = struct
   type t = { name: string; types: t list; depends: string list; fields: string list * string list list; enum_names: string list; service_names: string list }
   type file = { module_name: string; types: t list }
@@ -275,19 +283,11 @@ module Type_tree = struct
     let map = StringMap.singleton "" { ocaml_name = ""; module_name; cyclic = false } in
     traverse_types map "" types
 
-  let option_mangle_names FileDescriptorProto.{ options; _ } =
-    Option.map ~f:Spec.Options.Ocaml_options.get options
-    |> function
-    | Some (Ok (Some v)) -> v
-    | Some (Ok None) -> false
-    | None -> false
-    | Some (Error _e) -> failwith "Could not parse ocaml-protoc-plugin options with id 1074"
-
   let create_db (files : FileDescriptorProto.t list)=
     let inner proto_file =
       let map = map_file proto_file in
       let cyclic_map = create_cyclic_map map in
-      let file_db = create_file_db ~mangle:(option_mangle_names proto_file) cyclic_map map in
+      let file_db = create_file_db ~mangle:(has_mangle_option proto_file.options) cyclic_map map in
       file_db
     in
     List.map ~f:inner files

src/plugin/scope.mli

@@ -35,3 +35,6 @@ val get_package_name : t -> string option
 
 (** Tell if the type pointed to by the current scope is part of a cycle. *)
 val is_cyclic: t -> bool
+
+(** Test is the options specify name mangling *)
+val has_mangle_option: Spec.Descriptor.Google.Protobuf.FileOptions.t option -> bool

test/mangle_names.proto

@@ -25,3 +25,12 @@ message camel_case_name {
   };
   uint32 xid_zero = 11;
 }
+
+message RequestOne { }
+message ResponseOne { }
+
+service StringOfInt {
+  rpc CallOne (RequestOne) returns (ResponseOne);
+  rpc Call_one (RequestOne) returns (ResponseOne);
+  rpc callOne (RequestOne) returns (ResponseOne);
+}

test/mangle_names_test.ml

@@ -0,0 +1,7 @@
+module A = Mangle_names.Camel_case_name
+module B = Mangle_names.Camel_case_name'
+module C = Mangle_names.Request_one
+module D = Mangle_names.Response_one
+module E = Mangle_names.String_of_int.Call_one
+module F = Mangle_names.String_of_int.Call_one'
+module G = Mangle_names.String_of_int.Call_one''