Merge pull request #206 from Lupus/option-parsing-improvements

Option parsing improvements

src/compilerlib/pb_parsing_parse_tree.ml

@@ -66,9 +66,13 @@ type map_field = {
   map_options: Pb_option.set;
 }
 
+type oneof_body_content =
+  | Oneof_field of oneof_field
+  | Oneof_option of Pb_option.t
+
 type oneof = {
   oneof_name: string;
-  oneof_fields: oneof_field list;
+  oneof_body: oneof_body_content list;
 }
 (** oneof entity *)
 
@@ -211,11 +215,17 @@ let pp_map_field ppf map_field =
     map_field.map_key_type Pb_field_type.pp_unresolved_t
     map_field.map_value_type Pb_option.pp_set map_field.map_options
 
+let pp_oneof_body_content ppf = function
+  | Oneof_field field -> pp_oneof_field ppf field
+  | Oneof_option option -> Pb_option.pp_t ppf option
+
 let pp_oneof ppf oneof =
-  fprintf ppf "{@[<2>@,oneof_name = %S;@,oneof_fields = [@[<v>%a@]];@,}@]"
-    oneof.oneof_name
-    (pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ";@,") pp_oneof_field)
-    oneof.oneof_fields
+  fprintf ppf "{@[<v 2>%s = %S;@,%s = [@[<v>%a@]];@,@]}" "oneof_name"
+    oneof.oneof_name "oneof_body"
+    (pp_print_list
+       ~pp_sep:(fun ppf () -> fprintf ppf ";@,")
+       pp_oneof_body_content)
+    oneof.oneof_body
 
 let pp_enum_value ppf enum_value =
   fprintf ppf "{@[<v 2>@,enum_value_name = %S;@,enum_value_int = %d;@,}@]"

src/compilerlib/pb_parsing_parser.mly

@@ -116,7 +116,9 @@ reserved_        : reserved      T_eof {$1}
 
 /* (* Main protobuf symbol *) */
 
-proto_           : proto         T_eof {$1}
+proto_ :
+  | proto T_eof {$1}
+  | T_eof {Pb_parsing_util.proto ()}
 
 proto:
   | syntax proto_content {Pb_parsing_util.proto ~syntax:$1 ~proto:$2 ()}
@@ -267,7 +269,7 @@ extension_range :
 
 oneof :
   | T_one_of field_name T_lbrace oneof_field_list rbrace {
-    Pb_parsing_util.oneof ~fields:$4 $2
+    Pb_parsing_util.oneof ~oneof_body:$4 $2
   }
   | T_one_of T_lbrace oneof_field_list rbrace {
     Pb_exception.missing_one_of_name $1
@@ -284,6 +286,7 @@ oneof_field :
   | T_ident field_name T_equal T_int semicolon {
     Pb_parsing_util.oneof_field ~type_:(snd $1) ~number:$4 $2
   }
+  | option     { Pb_parsing_util.oneof_option $1 }
 
 map :
   | T_map T_less T_ident T_comma T_ident T_greater field_name T_equal T_int semicolon {
@@ -354,6 +357,7 @@ field_option_list :
 field_option :
   | T_ident T_equal constant               { (snd $1, $3) }
   | T_lparen T_ident T_rparen T_equal constant { (snd $2, $5)}
+  | T_lparen T_ident T_rparen T_ident T_equal constant { ((snd $2) ^ (snd $4), $6)}
 
 option_identifier_item :
   | T_ident                   {snd $1}

src/compilerlib/pb_parsing_util.ml

@@ -55,15 +55,17 @@ let map_field ?options:(map_options = Pb_option.empty) ~number ~key_type
   }
 
 let oneof_field ?(options = Pb_option.empty) ~number ~type_ name =
-  {
-    Pt.field_name = name;
-    Pt.field_number = number;
-    Pt.field_type = Pb_field_type.parse type_;
-    Pt.field_options = options;
-    Pt.field_label = ();
-  }
+  Pt.Oneof_field
+    {
+      Pt.field_name = name;
+      Pt.field_number = number;
+      Pt.field_type = Pb_field_type.parse type_;
+      Pt.field_options = options;
+      Pt.field_label = ();
+    }
 
-let oneof ~fields name = { Pt.oneof_name = name; Pt.oneof_fields = fields }
+let oneof_option option_ = Pt.Oneof_option option_
+let oneof ?(oneof_body = []) name = { Pt.oneof_name = name; Pt.oneof_body }
 let message_counter = ref 0
 
 let enum_value ~int_value name =

src/compilerlib/pb_parsing_util.mli

@@ -53,9 +53,10 @@ val oneof_field :
   number:int ->
   type_:string ->
   string ->
-  Pt.oneof_field
+  Pt.oneof_body_content
 
-val oneof : fields:Pt.oneof_field list -> string -> Pt.oneof
+val oneof_option : Pb_option.t -> Pt.oneof_body_content
+val oneof : ?oneof_body:Pt.oneof_body_content list -> string -> Pt.oneof
 val message_body_field : Pt.message_field -> Pt.message_body_content
 val message_body_map_field : Pt.map_field -> Pt.message_body_content
 val message_body_oneof_field : Pt.oneof -> Pt.message_body_content

src/compilerlib/pb_typing_resolution.ml

@@ -293,9 +293,10 @@ let resolve_type t type_ =
         (function
           | Tt.Message_field field -> Tt.Message_field (resolve_field field)
           | Tt.Message_oneof_field oneof ->
-            let { Tt.oneof_name; oneof_fields } = oneof in
+            let { Tt.oneof_name; oneof_fields; oneof_options } = oneof in
             let oneof_fields = List.map resolve_field oneof_fields in
-            Tt.Message_oneof_field { Tt.oneof_name; oneof_fields }
+            Tt.Message_oneof_field
+              { Tt.oneof_name; oneof_fields; oneof_options }
           | Tt.Message_map_field map ->
             let {
               Tt.map_name;

src/compilerlib/pb_typing_type_tree.ml

@@ -58,6 +58,7 @@ type 'a map_field = {
 type 'a oneof = {
   oneof_name: string;
   oneof_fields: 'a oneof_field list;
+  oneof_options: Pb_option.set;
 }
 (** Oneof definition *)
 

src/compilerlib/pb_typing_validation.ml

@@ -58,9 +58,23 @@ let compile_map_p1 map_parsed =
   Tt.{ map_name; map_number; map_key_type; map_value_type; map_options }
 
 let compile_oneof_p1 oneof_parsed =
-  let { Pt.oneof_name; Pt.oneof_fields } = oneof_parsed in
-
-  { Tt.oneof_name; Tt.oneof_fields = List.map compile_field_p1 oneof_fields }
+  let init =
+    {
+      Tt.oneof_name = oneof_parsed.Pt.oneof_name;
+      Tt.oneof_fields = [];
+      Tt.oneof_options = Pb_option.empty;
+    }
+  in
+  List.fold_left
+    (fun acc -> function
+      | Pt.Oneof_field f ->
+        { acc with Tt.oneof_fields = compile_field_p1 f :: acc.Tt.oneof_fields }
+      | Pt.Oneof_option (name, value) ->
+        {
+          acc with
+          Tt.oneof_options = Pb_option.add acc.Tt.oneof_options name value;
+        })
+    init oneof_parsed.Pt.oneof_body
 
 let not_found f : bool =
   try