package ocaml-protoc
Pure OCaml compiler for .proto files
Install
Dune Dependency
Authors
Maintainers
Sources
ocaml-protoc-3.1.tbz
sha256=4bd16bb119f5c55a9d5e906173d8611cb7664a0c926f108077eb05f1ceb7de03
sha512=01266efcc926dd7042e9eddc874b0c41c65688b36ec3e30756a69e09d6cc57eaa8d4a043015b668a2e61cc45cac7efa51cdbad06757a98a55ff53416af98c44d
doc/src/ocaml-protoc.compiler-lib/pb_codegen_pp.ml.html
Source file pb_codegen_pp.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
module Ot = Pb_codegen_ocaml_type module F = Pb_codegen_formatting module L = Pb_logger open Pb_codegen_util let gen_field field_type = match field_type with | Ot.Ft_user_defined_type udt -> let function_prefix = "pp" in function_name_of_user_defined ~function_prefix udt | Ot.Ft_wrapper_type { Ot.wt_type; _ } -> sp "Pbrt.Pp.pp_wrapper_%s" (string_of_basic_type ~for_pp:true wt_type) | _ -> sp "Pbrt.Pp.pp_%s" (string_of_field_type ~for_pp:true field_type) let gen_record ?and_ { Ot.r_name; r_fields } sc = L.log "gen_pp, record_name: %s\n" r_name; F.line sc @@ sp "%s pp_%s fmt (v:%s) = " (let_decl_of_and and_) r_name r_name; F.sub_scope sc (fun sc -> F.line sc "let pp_i fmt () ="; F.sub_scope sc (fun sc -> List.iteri (fun i record_field -> let first = i = 0 in let { Ot.rf_label; rf_field_type; _ } = record_field in let var_name = sp "v.%s" rf_label in match rf_field_type with | Ot.Rft_nolabel (field_type, _, _) | Ot.Rft_required (field_type, _, _, _) -> let field_string_of = gen_field field_type in F.line sc @@ sp "Pbrt.Pp.pp_record_field ~first:%b \"%s\" %s fmt %s;" first rf_label field_string_of var_name (* Rft_required *) | Ot.Rft_optional (field_type, _, _, _) -> let field_string_of = gen_field field_type in F.line sc @@ sp "Pbrt.Pp.pp_record_field ~first:%b \"%s\" \ (Pbrt.Pp.pp_option %s) fmt %s;" first rf_label field_string_of var_name (* Rft_optional *) | Ot.Rft_repeated (rt, field_type, _, _, _) -> let field_string_of = gen_field field_type in (match rt with | Ot.Rt_list -> F.line sc @@ sp "Pbrt.Pp.pp_record_field ~first:%b \"%s\" \ (Pbrt.Pp.pp_list %s) fmt %s;" first rf_label field_string_of var_name | Ot.Rt_repeated_field -> F.line sc @@ sp "Pbrt.Pp.pp_record_field ~first:%b \"%s\" \ (Pbrt.Pp.pp_list %s) fmt (Pbrt.Repeated_field.to_list \ %s);" first rf_label field_string_of var_name) (* Rft_repeated_field *) | Ot.Rft_variant { Ot.v_name; v_constructors = _ } -> (* constructors are ignored because the pretty printing is completely * delegated to the pretty print function associated with that variant. * This is indeed different from the [decode]/[encode] functions which * requires `inlining` the decoding/encoding logic within the record (This * requirement is indeed comming from the imposed Protobuf format) *) F.line sc @@ sp "Pbrt.Pp.pp_record_field ~first:%b \"%s\" %s fmt %s;" first rf_label ("pp_" ^ v_name) var_name (* Rft_variant_field *) | Ot.Rft_associative (at, _, (key_type, _), (value_type, _)) -> let pp_runtime_function = match at with | Ot.At_list -> "pp_associative_list" | Ot.At_hashtable -> "pp_hastable" in let pp_key = gen_field (Ot.Ft_basic_type key_type) in let pp_value = gen_field value_type in F.line sc @@ sp "Pbrt.Pp.pp_record_field ~first:%b \"%s\" (Pbrt.Pp.%s %s \ %s) fmt %s;" first rf_label pp_runtime_function pp_key pp_value var_name (* Associative_list *)) r_fields); F.line sc "in"; F.line sc "Pbrt.Pp.pp_brk pp_i fmt ()") let gen_unit ?and_ { Ot.er_name } sc : unit = F.line sc @@ sp "%s pp_%s fmt (v:%s) = " (let_decl_of_and and_) er_name er_name; F.sub_scope sc (fun sc -> F.line sc "let pp_i fmt () ="; F.sub_scope sc (fun sc -> F.line sc "Pbrt.Pp.pp_unit fmt ()"); F.line sc "in"; F.line sc "Pbrt.Pp.pp_brk pp_i fmt ()") let gen_variant ?and_ { Ot.v_name; Ot.v_constructors } sc = F.line sc @@ sp "%s pp_%s fmt (v:%s) =" (let_decl_of_and and_) v_name v_name; F.sub_scope sc (fun sc -> F.line sc "match v with"; List.iter (fun { Ot.vc_constructor; vc_field_type; _ } -> match vc_field_type with | Ot.Vct_nullary -> F.line sc @@ sp "| %s -> Format.fprintf fmt \"%s\"" vc_constructor vc_constructor | Ot.Vct_non_nullary_constructor field_type -> let field_string_of = gen_field field_type in F.line sc @@ sp "| %s x -> Format.fprintf fmt \"@[<hv2>%s(@,%%a)@]\" %s x" vc_constructor vc_constructor field_string_of) v_constructors) let gen_const_variant ?and_ { Ot.cv_name; cv_constructors } sc = F.line sc @@ sp "%s pp_%s fmt (v:%s) =" (let_decl_of_and and_) cv_name cv_name; F.sub_scope sc (fun sc -> F.line sc "match v with"; List.iter (fun { Ot.cvc_name; _ } -> F.line sc @@ sp "| %s -> Format.fprintf fmt \"%s\"" cvc_name cvc_name) cv_constructors) let gen_struct ?and_ t sc = let { Ot.spec; _ } = t in (match spec with | Ot.Record r -> gen_record ?and_ r sc | Ot.Variant v -> gen_variant ?and_ v sc | Ot.Const_variant v -> gen_const_variant ?and_ v sc | Ot.Unit u -> gen_unit ?and_ u sc); true let gen_sig ?and_ t sc = let _ = and_ in let { Ot.spec; _ } = t in let f type_name = F.line sc @@ sp "val pp_%s : Format.formatter -> %s -> unit " type_name type_name; F.line sc @@ sp "(** [pp_%s v] formats v *)" type_name in (match spec with | Ot.Record { Ot.r_name; _ } -> f r_name | Ot.Variant v -> f v.Ot.v_name | Ot.Const_variant { Ot.cv_name; _ } -> f cv_name | Ot.Unit { Ot.er_name; _ } -> f er_name); true let ocamldoc_title = "Formatters" 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)
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>