diff --git a/src/compilerlib/dune b/src/compilerlib/dune index 65a23289..7bab48c5 100644 --- a/src/compilerlib/dune +++ b/src/compilerlib/dune @@ -5,15 +5,17 @@ (library (name ocaml_protoc_compiler_lib) (public_name ocaml-protoc.compiler-lib) - (synopsis "Compiler library for ocaml-protoc, to turn .proto files into OCaml code") + (synopsis + "Compiler library for ocaml-protoc, to turn .proto files into OCaml code") (wrapped true) - (modules pb_codegen_all pb_codegen_backend pb_codegen_decode_binary pb_codegen_decode_bs - pb_codegen_decode_yojson pb_codegen_default pb_codegen_make pb_codegen_encode_binary - pb_codegen_encode_bs pb_codegen_encode_yojson pb_codegen_formatting - pb_codegen_ocaml_type pb_codegen_pp pb_codegen_plugin pb_codegen_types pb_codegen_services - pb_codegen_util pb_exception pb_field_type pb_location pb_logger pb_option - pb_parsing pb_parsing_lexer pb_parsing_parser pb_parsing_parse_tree - pb_parsing_util pb_typing_graph pb_typing pb_typing_recursion - pb_typing_resolution pb_typing_type_tree pb_typing_util - pb_typing_validation pb_util pb_format_util) + (modules pb_codegen_all pb_codegen_backend pb_codegen_decode_binary + pb_codegen_decode_bs pb_codegen_decode_yojson pb_codegen_default + pb_codegen_make pb_codegen_encode_binary pb_codegen_encode_bs + pb_codegen_encode_yojson pb_codegen_formatting pb_codegen_ocaml_type_dump + pb_codegen_ocaml_type pb_codegen_pp pb_codegen_plugin pb_codegen_types + pb_codegen_services pb_codegen_util pb_exception pb_field_type pb_location + pb_logger pb_option pb_parsing pb_parsing_lexer pb_parsing_parser + pb_parsing_parse_tree pb_parsing_util pb_typing_graph pb_typing + pb_typing_recursion pb_typing_resolution pb_typing_type_tree + pb_typing_util pb_typing_validation pb_util pb_format_util) (libraries stdlib-shims)) diff --git a/src/compilerlib/pb_codegen_backend.ml b/src/compilerlib/pb_codegen_backend.ml index 9609e820..14194ced 100644 --- a/src/compilerlib/pb_codegen_backend.ml +++ b/src/compilerlib/pb_codegen_backend.ml @@ -382,7 +382,7 @@ let compile_message ~(unsigned_tag : bool) (file_options : Pb_option.set) (* TODO maybe module_ should be resolved before `compile_message` since it is common with compile_enum *) - let { Tt.message_name; Tt.message_body; _ } = message in + let { Tt.message_name; Tt.message_body; Tt.message_options; _ } = message in let { Tt.message_names; _ } = scope in @@ -403,7 +403,12 @@ let compile_message ~(unsigned_tag : bool) (file_options : Pb_option.set) let type_ = Ot. - { module_prefix; spec = Ot.Unit empty_record; type_level_ppx_extension } + { + module_prefix; + spec = Ot.Unit empty_record; + type_level_ppx_extension; + type_options = message_options; + } in [ type_ ] | Tt.Message_oneof_field f :: [] -> @@ -412,7 +417,15 @@ let compile_message ~(unsigned_tag : bool) (file_options : Pb_option.set) 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 } ] + [ + Ot. + { + module_prefix; + spec = Variant variant; + type_level_ppx_extension; + type_options = message_options; + }; + ] | _ -> let variants, fields = List.fold_left @@ -485,6 +498,7 @@ let compile_message ~(unsigned_tag : bool) (file_options : Pb_option.set) rf_label = label_name_of_field_name field_name; rf_field_type = record_field_type; rf_mutable = mutable_; + rf_options = field.field_options; } in @@ -508,6 +522,7 @@ let compile_message ~(unsigned_tag : bool) (file_options : Pb_option.set) * parser all the way down to here. *) rf_field_type = Rft_variant variant; + rf_options = field.oneof_options; } in @@ -518,6 +533,7 @@ let compile_message ~(unsigned_tag : bool) (file_options : Pb_option.set) module_prefix; spec = Variant variant; type_level_ppx_extension; + type_options = Pb_option.empty; } in t :: variants @@ -583,6 +599,7 @@ let compile_message ~(unsigned_tag : bool) (file_options : Pb_option.set) rf_label = label_name_of_field_name map_name; rf_field_type = record_field_type; rf_mutable = is_mutable ~field_name:map_name map_options; + rf_options = map_options; } in @@ -601,23 +618,30 @@ let compile_message ~(unsigned_tag : bool) (file_options : Pb_option.set) in let type_ = - Ot.{ module_prefix; spec = Record record; type_level_ppx_extension } + Ot. + { + module_prefix; + spec = Record record; + type_level_ppx_extension; + type_options = message_options; + } in List.rev (type_ :: variants) let compile_enum file_options file_name scope enum = - let { Tt.enum_name; enum_values; _ } = enum in + let { Tt.enum_name; enum_values; enum_options; _ } = enum in let module_prefix = module_prefix_of_file_name file_name in let { Tt.message_names; Tt.packages = _ } = scope in let cv_constructors = List.map - (fun { Tt.enum_value_name; Tt.enum_value_int } -> + (fun { Tt.enum_value_name; Tt.enum_value_int; Tt.enum_value_options } -> { Ot.cvc_name = constructor_name enum_value_name; Ot.cvc_binary_value = enum_value_int; Ot.cvc_string_value = enum_value_name; + Ot.cvc_options = enum_value_options; }) enum_values in @@ -635,6 +659,7 @@ let compile_enum file_options file_name scope enum = Const_variant { cv_name = type_name message_names enum_name; cv_constructors }; type_level_ppx_extension; + type_options = enum_options; } let compile_rpc ~(file_name : string) ~all_types diff --git a/src/compilerlib/pb_codegen_ocaml_type.ml b/src/compilerlib/pb_codegen_ocaml_type.ml index 6d883975..69328d4b 100644 --- a/src/compilerlib/pb_codegen_ocaml_type.ml +++ b/src/compilerlib/pb_codegen_ocaml_type.ml @@ -121,6 +121,7 @@ and record_field = { rf_label: string; rf_field_type: record_field_type; rf_mutable: bool; + rf_options: Pb_option.set; } and record = { @@ -132,6 +133,7 @@ and const_variant_constructor = { cvc_name: string; cvc_binary_value: int; cvc_string_value: string; + cvc_options: Pb_option.set; } and const_variant = { @@ -154,6 +156,7 @@ type type_ = { generated module and it is based on the `.proto` filename. *) spec: type_spec; type_level_ppx_extension: string option; + type_options: Pb_option.set; } (** RPC argument or return type. We require message types in RPC. *) diff --git a/src/compilerlib/pb_codegen_ocaml_type_dump.ml b/src/compilerlib/pb_codegen_ocaml_type_dump.ml new file mode 100644 index 00000000..e12afdab --- /dev/null +++ b/src/compilerlib/pb_codegen_ocaml_type_dump.ml @@ -0,0 +1,249 @@ +(* + The MIT License (MIT) + + Copyright (c) 2016 Maxime Ransan + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in all + copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE + SOFTWARE. + +*) +module Ot = Pb_codegen_ocaml_type +module F = Pb_codegen_formatting + +(** OCaml type representation dumping plugin *) + +module PP = struct + open Ot + + (* Helper function to convert payload_kind to string *) + let string_of_payload_kind pk = + match pk with + | Pk_varint zigzag -> Printf.sprintf "Pk_varint (zigzag: %b)" zigzag + | Pk_bits32 -> "Pk_bits32" + | Pk_bits64 -> "Pk_bits64" + | Pk_bytes -> "Pk_bytes" + + (* Helper function to convert basic_type to string *) + let string_of_basic_type bt = + match bt with + | Bt_string -> "Bt_string" + | Bt_float -> "Bt_float" + | Bt_int -> "Bt_int" + | Bt_int32 -> "Bt_int32" + | Bt_uint32 -> "Bt_uint32" + | Bt_int64 -> "Bt_int64" + | Bt_uint64 -> "Bt_uint64" + | Bt_bytes -> "Bt_bytes" + | Bt_bool -> "Bt_bool" + + (* Helper function to convert repeated_type to string *) + let string_of_repeated_type rt = + match rt with + | Rt_list -> "Rt_list" + | Rt_repeated_field -> "Rt_repeated_field" + + (* Helper function to convert associative_type to string *) + let string_of_associative_type at = + match at with + | At_list -> "At_list" + | At_hashtable -> "At_hashtable" + + (* Helper function to convert constant to string *) + let string_of_constant constant = + match constant with + | Pb_option.Constant_string s -> + Printf.sprintf "Constant_string %S" (String.escaped s) + | Constant_bool b -> Printf.sprintf "Constant_bool %b" b + | Constant_int i -> Printf.sprintf "Constant_int %d" i + | Constant_float f -> Printf.sprintf "Constant_float %f" f + | Constant_literal s -> + Printf.sprintf "Constant_literal %S" (String.escaped s) + + (* Helper function to convert value to string *) + let rec string_of_value value = + match value with + | Pb_option.Scalar_value c -> string_of_constant c + | Message_literal ml -> string_of_message_literal ml + | List_literal ll -> string_of_list_literal ll + + (* Helper function to convert message_literal to string *) + and string_of_message_literal ml = + "{" + ^ String.concat ", " + (List.map + (fun (k, v) -> Printf.sprintf "%S: %s" k (string_of_value v)) + ml) + ^ "}" + + (* Helper function to convert list_literal to string *) + and string_of_list_literal ll = + "[" ^ String.concat ", " (List.map string_of_value ll) ^ "]" + + (* Function to convert options (message_literal) to string *) + let string_of_options options = string_of_message_literal options + + (* Helper function to convert default_value to string *) + let string_of_default_value dv = + match dv with + | None -> "None" + | Some value -> string_of_constant value + + (* Recursive function to print a record field type *) + let rec print_record_field_type sc rf_type = + match rf_type with + | Rft_nolabel (ftype, enc_num, pk) -> + F.linep sc + " Rft_nolabel (Field Type: %s, Encoding: %d, Payload Kind: %s)" + (string_of_field_type ftype) + enc_num + (string_of_payload_kind pk) + | Rft_required (ftype, enc_num, pk, dv) -> + F.linep sc + " Rft_required (Field Type: %s, Encoding: %d, Payload Kind: %s, \ + Default Value: %s)" + (string_of_field_type ftype) + enc_num + (string_of_payload_kind pk) + (string_of_default_value dv) + | Rft_optional (ftype, enc_num, pk, dv) -> + F.linep sc + " Rft_optional (Field Type: %s, Encoding: %d, Payload Kind: %s, \ + Default Value: %s)" + (string_of_field_type ftype) + enc_num + (string_of_payload_kind pk) + (string_of_default_value dv) + | Rft_repeated (rt, ftype, enc_num, pk, packed) -> + F.linep sc + " Rft_repeated (Repeated Type: %s, Field Type: %s, Encoding: %d, \ + Payload Kind: %s, Packed: %b)" + (string_of_repeated_type rt) + (string_of_field_type ftype) + enc_num + (string_of_payload_kind pk) + packed + | Rft_associative (at, enc_num, (bt, pk1), (ftype, pk2)) -> + F.linep sc + " Rft_associative (Associative Type: %s, Encoding: %d, Basic Type: \ + %s, Payload Kind1: %s, Field Type: %s, Payload Kind2: %s)" + (string_of_associative_type at) + enc_num (string_of_basic_type bt) + (string_of_payload_kind pk1) + (string_of_field_type ftype) + (string_of_payload_kind pk2) + | Rft_variant v -> F.linep sc " Rft_variant: %s" v.v_name + + (* Helper function to convert field_type to string *) + and string_of_field_type ft = + match ft with + | Ft_unit -> "Ft_unit" + | Ft_basic_type bt -> "Ft_basic_type: " ^ string_of_basic_type bt + | Ft_user_defined_type udt -> "Ft_user_defined_type: " ^ udt.udt_type_name + | Ft_wrapper_type wt -> + Printf.sprintf "Ft_wrapper_type: Basic Type: %s, Payload Kind: %s" + (string_of_basic_type wt.wt_type) + (string_of_payload_kind wt.wt_pk) + + (* Recursive function to print a variant *) + let rec print_variant sc variant = + F.linep sc "Variant: %s" variant.v_name; + List.iter (print_variant_constructor sc) variant.v_constructors + + (* Recursive function to print a variant constructor *) + and print_variant_constructor sc vc = + F.linep sc " Constructor: %s" vc.vc_constructor; + F.linep sc " Field Type: %s\n" + (string_of_variant_constructor_type vc.vc_field_type); + F.linep sc " Encoding Number: %d, Payload Kind: %s" vc.vc_encoding_number + (string_of_payload_kind vc.vc_payload_kind) + + (* Helper function to convert variant_constructor_type to string *) + and string_of_variant_constructor_type vct = + match vct with + | Vct_nullary -> "Vct_nullary" + | Vct_non_nullary_constructor ft -> + "Vct_non_nullary_constructor: " ^ string_of_field_type ft + + (* Recursive function to print a record *) + let rec print_record sc record = + F.linep sc "Record: %s" record.r_name; + List.iter (print_record_field sc) record.r_fields + + (* Recursive function to print a record field *) + and print_record_field sc record_field = + F.linep sc "- Field: %s" record_field.rf_label; + print_record_field_type sc record_field.rf_field_type; + F.linep sc " Field options: %s" (string_of_options record_field.rf_options) + + (* Recursive function to print a const_variant *) + let rec print_const_variant sc const_variant = + F.linep sc "Const Variant: %s" const_variant.cv_name; + List.iter (print_const_variant_constructor sc) const_variant.cv_constructors + + (* Recursive function to print a const_variant constructor *) + and print_const_variant_constructor sc cvc = + F.linep sc " Constructor: %s" cvc.cvc_name; + F.linep sc " Binary Value: %d, String Value: %s" cvc.cvc_binary_value + cvc.cvc_string_value; + F.linep sc " Options: %s" (string_of_options cvc.cvc_options) + + (* Recursive function to print the type_spec *) + let print_type_spec sc type_spec = + match type_spec with + | Record record -> print_record sc record + | Variant variant -> print_variant sc variant + | Const_variant const_variant -> print_const_variant sc const_variant + | Unit empty_record -> F.linep sc "Empty Record: %s" empty_record.er_name + + (* Entry point to start printing *) + let print_type sc type_ = + F.linep sc "Module Prefix: %s" type_.module_prefix; + print_type_spec sc type_.spec; + F.linep sc "Options: %s" (string_of_options type_.type_options); + match type_.type_level_ppx_extension with + | Some ext -> F.linep sc "PPX Extension: %s" ext + | None -> () +end + +let gen_struct ?and_ t sc = + (match and_ with + | Some _ -> () + | None -> + F.line sc "(* ----------------------------------------------------- *)"); + F.line sc "(*"; + F.sub_scope sc (fun sc -> PP.print_type sc t); + F.line sc "*)"; + true + +let gen_sig ?and_ t sc = + ignore and_; + ignore t; + ignore sc; + true + +let ocamldoc_title = "Dump of internal representation for generated OCaml types" +let requires_mutable_records = false + +let plugin : Pb_codegen_plugin.t = + let module P = struct + let gen_sig = gen_sig + let gen_struct = gen_struct + let ocamldoc_title = ocamldoc_title + let requires_mutable_records = requires_mutable_records + end in + (module P) diff --git a/src/compilerlib/pb_codegen_ocaml_type_dump.mli b/src/compilerlib/pb_codegen_ocaml_type_dump.mli new file mode 100644 index 00000000..8ca03531 --- /dev/null +++ b/src/compilerlib/pb_codegen_ocaml_type_dump.mli @@ -0,0 +1,5 @@ +(** Plugin that dumps a representation of the parsed proto in comments *) + +include Pb_codegen_plugin.S + +val plugin : Pb_codegen_plugin.t diff --git a/src/compilerlib/pb_codegen_types.ml b/src/compilerlib/pb_codegen_types.ml index cf94d196..345e288c 100644 --- a/src/compilerlib/pb_codegen_types.ml +++ b/src/compilerlib/pb_codegen_types.ml @@ -49,7 +49,7 @@ let gen_record ?and_ { Ot.r_name; r_fields } sc = F.linep sc "%s %s = {" (type_decl_of_and and_) r_name; F.sub_scope sc (fun sc -> List.iter - (fun { Ot.rf_label; rf_field_type; rf_mutable } -> + (fun { Ot.rf_label; rf_field_type; rf_mutable; rf_options = _ } -> let prefix = field_prefix rf_mutable in let type_ = Pb_codegen_util.string_of_record_field_type rf_field_type diff --git a/src/compilerlib/pb_option.mli b/src/compilerlib/pb_option.mli index f282d6a9..ee9c5afc 100644 --- a/src/compilerlib/pb_option.mli +++ b/src/compilerlib/pb_option.mli @@ -23,7 +23,7 @@ type option_name = string type t = option_name * value -type set +type set = t list (** Collection of options Can be used for field/message or file options *) diff --git a/src/compilerlib/pb_parsing_parse_tree.ml b/src/compilerlib/pb_parsing_parse_tree.ml index ba9f39ef..5ee3ebc5 100644 --- a/src/compilerlib/pb_parsing_parse_tree.ml +++ b/src/compilerlib/pb_parsing_parse_tree.ml @@ -79,6 +79,7 @@ type oneof = { type enum_value = { enum_value_name: string; enum_value_int: int; + enum_value_options: Pb_option.set; } type enum_body_content = diff --git a/src/compilerlib/pb_parsing_parser.mly b/src/compilerlib/pb_parsing_parser.mly index 4737f190..f130effa 100644 --- a/src/compilerlib/pb_parsing_parser.mly +++ b/src/compilerlib/pb_parsing_parser.mly @@ -398,7 +398,7 @@ enum_body_content : enum_value : | T_ident T_equal T_int semicolon { Pb_parsing_util.enum_value ~int_value:$3 (snd $1) } - | T_ident T_equal T_int field_options semicolon { Pb_parsing_util.enum_value ~int_value:$3 (snd $1) } + | T_ident T_equal T_int field_options semicolon { Pb_parsing_util.enum_value ~int_value:$3 ~options:$4 (snd $1) } | T_ident T_equal T_int { Pb_exception.missing_semicolon_for_enum_value (snd $1) (fst $1) } diff --git a/src/compilerlib/pb_parsing_util.ml b/src/compilerlib/pb_parsing_util.ml index f211488e..3ed8463e 100644 --- a/src/compilerlib/pb_parsing_util.ml +++ b/src/compilerlib/pb_parsing_util.ml @@ -68,8 +68,14 @@ 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 = - Pt.(Enum_value { enum_value_name = name; enum_value_int = int_value }) +let enum_value ~int_value ?(options = Pb_option.empty) name = + Pt.( + Enum_value + { + enum_value_name = name; + enum_value_int = int_value; + enum_value_options = options; + }) let enum_option option_ = Pt.Enum_option option_ diff --git a/src/compilerlib/pb_parsing_util.mli b/src/compilerlib/pb_parsing_util.mli index 2f3bb84f..f9bfdaa3 100644 --- a/src/compilerlib/pb_parsing_util.mli +++ b/src/compilerlib/pb_parsing_util.mli @@ -60,7 +60,10 @@ 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 -val enum_value : int_value:int -> string -> Pt.enum_body_content + +val enum_value : + int_value:int -> ?options:Pb_option.set -> string -> Pt.enum_body_content + val enum_option : Pb_option.t -> Pt.enum_body_content val enum : ?enum_body:Pt.enum_body_content list -> string -> Pt.enum val extension_range_single_number : int -> Pt.extension_range diff --git a/src/compilerlib/pb_typing_type_tree.ml b/src/compilerlib/pb_typing_type_tree.ml index 000cb294..189edbef 100644 --- a/src/compilerlib/pb_typing_type_tree.ml +++ b/src/compilerlib/pb_typing_type_tree.ml @@ -88,6 +88,7 @@ and 'a message = { type enum_value = { enum_value_name: string; enum_value_int: int; + enum_value_options: Pb_option.set; } type enum = { diff --git a/src/compilerlib/pb_typing_validation.ml b/src/compilerlib/pb_typing_validation.ml index 805f5cf1..1810b2c3 100644 --- a/src/compilerlib/pb_typing_validation.ml +++ b/src/compilerlib/pb_typing_validation.ml @@ -118,8 +118,9 @@ let compile_enum_p1 ?(parent_options = Pb_option.empty) file_name file_options let enum_values = Pb_util.List.filter_map (function - | Pt.Enum_value { Pt.enum_value_name; enum_value_int } -> - Some Tt.{ enum_value_name; enum_value_int } + | Pt.Enum_value + { Pt.enum_value_name; enum_value_int; enum_value_options } -> + Some Tt.{ enum_value_name; enum_value_int; enum_value_options } | _ -> None) enum_body in diff --git a/src/ocaml-protoc/ocaml_protoc_cmdline.ml b/src/ocaml-protoc/ocaml_protoc_cmdline.ml index 52f3894a..1f0a5e2a 100644 --- a/src/ocaml-protoc/ocaml_protoc_cmdline.ml +++ b/src/ocaml-protoc/ocaml_protoc_cmdline.ml @@ -110,6 +110,8 @@ module Cmdline = struct yojson: bool ref; (** whether yojson encoding is enabled *) bs: bool ref; (** whether BuckleScript encoding is enabled *) pp: bool ref; (** whether pretty printing is enabled *) + dump_type_repr: bool ref; + (** whether comments with debug ocaml type representation are added *) services: bool ref; (** whether services code generation is enabled *) make: bool ref; (** whether to generate "make" functions *) mutable cmd_line_file_options: File_options.t; @@ -129,6 +131,7 @@ module Cmdline = struct yojson = ref false; bs = ref false; pp = ref false; + dump_type_repr = ref false; services = ref false; make = ref false; cmd_line_file_options = File_options.make (); @@ -141,6 +144,10 @@ module Cmdline = struct "--bs", Arg.Set t.bs, " generate BuckleScript encoding"; "--binary", Arg.Set t.binary, " generate binary encoding"; "--pp", Arg.Set t.pp, " generate pretty print functions"; + ( "--dump_type_repr", + Arg.Set t.dump_type_repr, + " generate comments with internal representation on generated OCaml \ + types (useful for debugging ocaml-protoc itself)" ); ( "--services", Arg.Set t.services, " generate code for services (requires json+binary)" ); @@ -162,7 +169,9 @@ module Cmdline = struct let anon_fun t proto_file_name = t.proto_file_name <- proto_file_name let validate t = - if (not !(t.yojson)) && (not !(t.binary)) && (not !(t.pp)) && not !(t.bs) + if + (not !(t.yojson)) && (not !(t.binary)) && (not !(t.pp)) && (not !(t.bs)) + && not !(t.dump_type_repr) then ( t.binary := true; t.pp := true diff --git a/src/ocaml-protoc/ocaml_protoc_generation.ml b/src/ocaml-protoc/ocaml_protoc_generation.ml index d95d0233..a1cc999b 100644 --- a/src/ocaml-protoc/ocaml_protoc_generation.ml +++ b/src/ocaml-protoc/ocaml_protoc_generation.ml @@ -56,6 +56,10 @@ let generate_code ocaml_types ~proto_file_options cmdline : unit = let plugins : Pb_codegen_plugin.t list = List.flatten [ + (if !(cmdline.Cmdline.dump_type_repr) then + [ Pb_codegen_ocaml_type_dump.plugin ] + else + []); (if !(cmdline.Cmdline.pp) then [ Pb_codegen_pp.plugin ] else diff --git a/src/tests/expectation/dune b/src/tests/expectation/dune index 35425c4e..bbcc4c9f 100644 --- a/src/tests/expectation/dune +++ b/src/tests/expectation/dune @@ -3,3 +3,14 @@ (libraries pbrt ocaml-protoc.compiler-lib) (package ocaml-protoc) (flags :standard -open Ocaml_protoc_compiler_lib)) + +(rule + (targets option_processing.ml option_processing.mli) + (deps option_processing.proto) + (action + (run ocaml-protoc --dump_type_repr --ml_out ./ %{deps}))) + +(rule + (alias runtest) + (action + (diff option_processing.ml.expected option_processing.ml))) diff --git a/src/tests/expectation/option_processing.ml.expected b/src/tests/expectation/option_processing.ml.expected new file mode 100644 index 00000000..d36a0f95 --- /dev/null +++ b/src/tests/expectation/option_processing.ml.expected @@ -0,0 +1,128 @@ +[@@@ocaml.warning "-27-30-39"] + +type payment_system = + | Cash + | Credit_card + | Debit_card + | App + +type person_location = { + lat : float; + lng : float; +} + +type person_id = + | X of string + | Y of int32 + +and person = { + id : int64; + email : string; + name : string; + home : person_location option; + picture : bytes; + id : person_id; +} + +let rec default_payment_system () = (Cash:payment_system) + +let rec default_person_location + ?lat:((lat:float) = 0.) + ?lng:((lng:float) = 0.) + () : person_location = { + lat; + lng; +} + +let rec default_person_id () : person_id = X ("") + +and default_person + ?id:((id:int64) = 0L) + ?email:((email:string) = "") + ?name:((name:string) = "") + ?home:((home:person_location option) = None) + ?picture:((picture:bytes) = Bytes.create 0) + ?id:((id:person_id) = X ("")) + () : person = { + id; + email; + name; + home; + picture; + id; +} + +[@@@ocaml.warning "-27-30-39"] + +(** {2 Dump of internal representation for generated OCaml types} *) + +(* ----------------------------------------------------- *) +(* + Module Prefix: Option_processing + Const Variant: payment_system + Constructor: Cash + Binary Value: 0, String Value: CASH + Options: {"label": Constant_string "Cash"} + Constructor: Credit_card + Binary Value: 1, String Value: CREDIT_CARD + Options: {"label": Constant_string "Credit Card"} + Constructor: Debit_card + Binary Value: 2, String Value: DEBIT_CARD + Options: {"label": Constant_string "Debit Card"} + Constructor: App + Binary Value: 3, String Value: APP + Options: {"label": Constant_string "Mobile App"} + Options: {"label": Constant_string "Payment method"} +*) + +(* ----------------------------------------------------- *) +(* + Module Prefix: Option_processing + Record: person_location + - Field: lat + Rft_nolabel (Field Type: Ft_basic_type: Bt_float, Encoding: 1, Payload Kind: Pk_bits64) + Field options: {"validate.rules.double": {"gte": Constant_int -90, "lte": Constant_int 90}} + - Field: lng + Rft_nolabel (Field Type: Ft_basic_type: Bt_float, Encoding: 2, Payload Kind: Pk_bits64) + Field options: {"validate.rules.double": {"gte": Constant_int -180, "lte": Constant_int 180}} + Options: {"validate.disabled": Constant_bool true} +*) + +(* ----------------------------------------------------- *) +(* + Module Prefix: Option_processing + Variant: person_id + Constructor: X + Field Type: Vct_non_nullary_constructor: Ft_basic_type: Bt_string + + Encoding Number: 6, Payload Kind: Pk_bytes + Constructor: Y + Field Type: Vct_non_nullary_constructor: Ft_basic_type: Bt_int32 + + Encoding Number: 7, Payload Kind: Pk_varint (zigzag: false) + Options: {} +*) + +(* + Module Prefix: Option_processing + Record: person + - Field: id + Rft_nolabel (Field Type: Ft_basic_type: Bt_int64, Encoding: 1, Payload Kind: Pk_varint (zigzag: false)) + Field options: {"validate.rules.uint64.gt": Constant_int 999} + - Field: email + Rft_nolabel (Field Type: Ft_basic_type: Bt_string, Encoding: 2, Payload Kind: Pk_bytes) + Field options: {"validate.rules.string.email": Constant_bool true} + - Field: name + Rft_nolabel (Field Type: Ft_basic_type: Bt_string, Encoding: 3, Payload Kind: Pk_bytes) + Field options: {"validate.rules.string": {"pattern": Constant_string "^[^[0-9]A-Za-z]+( [^[0-9]A-Za-z]+)*$", "max_bytes": Constant_int 256}} + - Field: home + Rft_optional (Field Type: Ft_user_defined_type: person_location, Encoding: 4, Payload Kind: Pk_bytes, Default Value: None) + Field options: {"validate.rules.message.required": Constant_bool true} + - Field: picture + Rft_nolabel (Field Type: Ft_basic_type: Bt_bytes, Encoding: 5, Payload Kind: Pk_bytes) + Field options: {"validate.rules.bytes": {"not_in": [Constant_string "foo", Constant_string "bar", Constant_string "baz"]}} + - Field: id + Rft_variant: person_id + Field options: {"validate.required": Constant_bool true} + Options: {"validate.disabled": Constant_bool true} +*) diff --git a/src/tests/expectation/option_processing.proto b/src/tests/expectation/option_processing.proto new file mode 100644 index 00000000..15f96445 --- /dev/null +++ b/src/tests/expectation/option_processing.proto @@ -0,0 +1,41 @@ +syntax = "proto3"; + +package examplepb; + +enum PAYMENT_SYSTEM { + option (label) = "Payment method"; + // FIXME: Enum constructor options are currently not propagated to OCaml types + CASH = 0 [(label) = "Cash"]; + CREDIT_CARD = 1 [(label) = "Credit Card"]; + DEBIT_CARD = 2 [(label) = "Debit Card"]; + APP = 3 [(label) = "Mobile App"]; +} + +message Person { + option (validate.disabled) = true; + + uint64 id = 1 [(validate.rules).uint64.gt = 999]; + + string email = 2 [(validate.rules).string.email = true]; + + string name = 3 [(validate.rules).string = { + pattern: "^[^[0-9]A-Za-z]+( [^[0-9]A-Za-z]+)*$", + max_bytes: 256, + }]; + + Location home = 4 [(validate.rules).message.required = true]; + + message Location { + double lat = 1 [(validate.rules).double = {gte: -90, lte: 90}]; + double lng = 2 [(validate.rules).double = {gte: -180, lte: 180}]; + } + + bytes picture = 5 [(validate.rules).bytes = {not_in: ["foo", "bar", "baz"]}]; + + oneof id { + option (validate.required) = true; + + string x = 6; + int32 y = 7; + } +}