Skip to content

Commit 270ec34

Browse files
andersfugmannandersfugmann
authored
Merge pull request #43 from andersfugmann/andersfugmann/parse_markdown
Improve handling of comments in proto files
2 parents 51d6940 + b74e7a2 commit 270ec34

11 files changed

Lines changed: 3884 additions & 1304 deletions

File tree

‎Changelog.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@
55
- Add flag 'singleton\_oneof\_as\_option' to map single field
66
onofs to option type (default on). Set to 'false' to keep old
77
behaviour.
8+
- Improve copying of comments from .proto files into ocaml code using
9+
omd to parse markdown
810

911

1012
## 6.1.0: 2024-04-25

‎ocaml-protoc-plugin.opam‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,6 @@ build: [
1414

1515
depends: [
1616
"conf-protoc" {>= "1.0.0"}
17-
"conf-pkg-config"
1817
"conf-protoc-dev" {with-test}
1918
"conf-c++" {with-test}
2019
"dune" {>= "3.12"}
@@ -24,6 +23,7 @@ depends: [
2423
"ppx_deriving" {with-test}
2524
"bisect_ppx" {with-test}
2625
"odoc" {with-doc}
26+
"omd"
2727
"conf-pkg-config" {build}
2828
"dune-configurator" {with-test}
2929
"yojson" {with-test}

‎src/plugin/code.ml‎

Lines changed: 64 additions & 124 deletions
Original file line numberDiff line numberDiff line change
@@ -2,102 +2,67 @@ open !StdLabels
22
open !MoreLabels
33
open !Utils
44

5+
type indent = [ `Begin | `End | `EndBegin | `None | `Raw ]
6+
57
type t = {
6-
mutable indent : string;
7-
mutable code : string list;
8+
mutable indent : int;
9+
mutable code : (indent * string) list;
810
}
911

10-
let init () = {indent = ""; code = []}
11-
let incr t = t.indent <- " " ^ t.indent
12+
let init () = {indent = 0; code = []}
13+
let incr t = t.indent <- t.indent + 1
1214
let decr t =
13-
match String.length t.indent >= 2 with
14-
| true ->
15-
t.indent <- String.sub ~pos:0 ~len:(String.length t.indent - 2) t.indent
16-
| false -> failwith "Cannot decr indentation level at this point"
17-
18-
(** Merge groups when the list groups ends with a line that starts with a '-' *)
19-
let rec merge_list_groups = function
20-
| (false, l1) :: (true, l2) :: xs ->
21-
begin match List.rev l1 with
22-
| s :: _ when String.starts_with_regex ~regex:"[ ]*- " s ->
23-
(false, l1 @ l2) :: merge_list_groups xs
24-
| _ -> (false, l1) :: (true, l2) :: merge_list_groups xs
25-
end
26-
| x :: xs ->
27-
x :: merge_list_groups xs
28-
| [] -> []
29-
30-
let remove_trailing_empty_lines lines =
31-
lines
32-
|> List.rev
33-
|> List.drop_while ~f:((=) "")
34-
|> List.rev
35-
36-
let escape_comment s =
37-
String.to_seq s
38-
|> Seq.map (function
39-
| '{' | '}' | '[' | ']' | '@' | '\\' as ch -> Printf.sprintf "\\%c" ch
40-
| ch -> Printf.sprintf "%c" ch
41-
)
42-
|> List.of_seq
43-
|> String.concat ~sep:""
44-
45-
46-
let map_comments comments =
47-
comments
48-
|> String.concat ~sep:"\n\n"
49-
|> String.split_on_char ~sep:'\n'
50-
|> List.map ~f:(String.trim_end ~chars:" \n\t")
51-
|> List.group ~f:(fun s -> String.starts_with ~prefix:" " s && not (String.starts_with_regex ~regex:"[ ]*- " s))
52-
|> merge_list_groups
53-
|> List.map ~f:(function
54-
| (false, lines) ->
55-
lines
56-
|> List.map ~f:String.trim
57-
|> remove_trailing_empty_lines
58-
|> List.map ~f:escape_comment
59-
| (true, lines) ->
60-
let lines =
61-
lines
62-
|> List.map ~f:(String.replace ~substring:"v}" ~f:(fun _ -> "v\\}"))
63-
|> remove_trailing_empty_lines
64-
in
65-
"{v" :: lines @ ["v}"]
66-
)
67-
|> List.flatten
68-
|> List.rev
69-
|> List.drop_while ~f:(fun x -> x = "")
70-
|> List.rev
15+
match t.indent = 0 with
16+
| true -> failwith "Cannot decr indentation level at this point"
17+
| false -> t.indent <- t.indent - 1
7118

7219
let emit t indent fmt =
73-
let prepend s =
74-
String.split_on_char ~sep:'\n' s
75-
|> List.iter ~f:(fun line ->
76-
(* Replace tabs with indent *)
77-
let line =
78-
"" :: String.split_on_char ~sep:'\t' line
79-
|> String.concat ~sep:t.indent
80-
in
81-
t.code <- (String.trim_end ~chars:" " line) :: t.code);
82-
in
20+
(* Verify indentation level *)
21+
(match indent with
22+
| `Begin -> incr t
23+
| `End -> decr t
24+
| `EndBegin -> decr t; incr t
25+
| `None -> ()
26+
| `Raw -> ()
27+
);
28+
8329
let emit s =
84-
match indent with
85-
| `Begin ->
86-
prepend s;
87-
incr t
88-
| `None ->
89-
prepend s
90-
| `End ->
91-
decr t;
92-
prepend s
93-
| `EndBegin ->
94-
decr t;
95-
prepend s;
96-
incr t
30+
String.split_on_char ~sep:'\n' s
31+
|> List.iter ~f:(fun s -> t.code <- (indent, String.trim_end ~chars:" \t" s) :: t.code)
9732
in
9833
Printf.ksprintf emit fmt
9934

100-
let append t code = List.iter ~f:(emit t `None "%s") (code.code |> List.rev)
35+
let contents t =
36+
let append buffer indent s =
37+
(match String.length s > 0 with
38+
| true ->
39+
List.iter ~f:(Buffer.add_string buffer) indent;
40+
Buffer.add_string buffer s
41+
| false -> ()
42+
);
43+
Buffer.add_string buffer "\n";
44+
buffer
45+
in
46+
47+
let rec print buffer indent = function
48+
| (`None, s) :: lines -> print (append buffer indent s) indent lines
49+
| (`Begin, s) :: lines -> print (append buffer indent s) (" " :: indent) lines
50+
| (`EndBegin, s) :: lines ->
51+
let indent' = List.tl indent in
52+
print (append buffer indent' s) indent lines
53+
| (`End, s) :: lines ->
54+
let indent = List.tl indent in
55+
print (append buffer indent s) indent lines
56+
| (`Raw, s) :: lines ->
57+
print (append buffer [] s) indent lines
58+
| [] ->
59+
Buffer.contents buffer
60+
in
61+
print (Buffer.create 256) [] (List.rev t.code)
62+
63+
let append t code =
64+
(* Same as rev_append no??? *)
65+
List.iter ~f:(fun l -> t.code <- l :: t.code) (code.code |> List.rev)
10166

10267
let append_deprecaton_if ~deprecated level str =
10368
match deprecated with
@@ -110,68 +75,43 @@ let append_deprecaton_if ~deprecated level str =
11075
in
11176
Printf.sprintf "%s[%socaml.alert protobuf \"Marked as deprecated in the .proto file\"]" str level
11277

113-
let append_comments ~comments str =
114-
let comment_str =
115-
map_comments comments
116-
|> String.concat ~sep:"\n"
117-
|> String.trim
118-
in
119-
match List.is_empty comments with
120-
| true -> str
121-
| false ->
122-
Printf.sprintf "%s(** %s *)" str comment_str
123-
12478
let emit_deprecation ?(deprecated=true) t level =
12579
if deprecated then
12680
emit t `None "%s" (append_deprecaton_if ~deprecated:true level "")
12781

12882
let emit_comment ~(position:[`Leading | `Trailing]) t = function
129-
| [] -> ()
130-
| comments ->
83+
| None -> ()
84+
| Some comments ->
13185
if position = `Leading then emit t `None "";
132-
let comments = map_comments comments in
133-
let () =
134-
match comments with
135-
| [ comment ] -> emit t `None "(** %s *)" (String.trim comment)
136-
| comments ->
137-
emit t `Begin "(**";
138-
List.iter ~f:(emit t `None "%s") comments;
139-
emit t `End "*)";
140-
in
86+
let comment_string = Comment_db.to_ocaml_doc comments in
87+
emit t `Begin "(**";
88+
emit t `Raw "%s" comment_string;
89+
emit t `End "*)";
14190
if position = `Trailing then emit t `None "";
14291
()
14392

144-
let contents t =
145-
List.map ~f:(Printf.sprintf "%s") (List.rev t.code)
146-
|> String.concat ~sep:"\n"
147-
14893
(** Emit comment for muliple fields / constructors *)
14994
let emit_field_doc t
15095
~(position:[`Leading | `Trailing])
15196
?(format:('a -> 'b, unit, string, unit) format4="[%s]")
15297
?(header="")
153-
?(comments=[])
98+
?(comments)
15499
param_comments =
155100

156101
(* Remove parameters with no comments *)
157-
let param_comments =
158-
List.filter ~f:(fun (_, comments) -> not (List.is_empty comments)) param_comments
159-
in
102+
let has_header = String.length header > 0 in
160103

161-
let comments = map_comments comments in
162-
match List.exists ~f:(fun s -> String.length s > 0) comments, String.length header > 0, not (List.is_empty param_comments) with
163-
| false, _, false -> ()
164-
| has_comments, has_header, _ ->
104+
match comments, List.is_empty param_comments with
105+
| None, true -> ()
106+
| _ ->
165107
if position = `Leading then emit t `None "";
166108
emit t `Begin "(**";
167-
168-
if has_comments then List.iter ~f:(emit t `None "%s") comments;
109+
Option.iter ~f:(fun comments -> emit t `Raw "%s" (Comment_db.to_ocaml_doc comments)) comments;
169110
if has_header then emit t `None "%s" header;
170111
List.iter ~f:(fun (param, comments) ->
171-
let comments = map_comments comments in
172112
emit t `None "";
173113
emit t `Begin format param;
174-
List.iter ~f:(emit t `None "%s") comments;
114+
emit t `Raw "%s" (Comment_db.to_ocaml_doc comments);
175115
emit t `End "";
176116
) param_comments;
177117

‎src/plugin/comment_db.ml‎

Lines changed: 63 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -60,13 +60,65 @@ let _string_of_path path =
6060
|> String.concat ~sep:"; "
6161
|> Printf.sprintf "[ %s ]"
6262

63-
type comment = string option
64-
type comments = { leading: comment; trailing: comment; detatched: string list }
63+
type comment = Omd.doc
6564

6665
module Code_info_map = Map.Make(struct type t = path let compare = compare end)
67-
type code_info_map = comments Code_info_map.t
66+
type code_info_map = comment Code_info_map.t
67+
68+
type t = comment StringMap.t
69+
70+
let parse_comments leading trailing detatched =
71+
72+
let remove_comment_prefix =
73+
let comment_regex = "^[ \t]*//[ ]?" |> Str.regexp in
74+
Str.replace_first comment_regex ""
75+
in
76+
77+
let replace_emph =
78+
let emph_regex = {|[[]\([^]]*\)[]][[][]]|} |> Str.regexp in
79+
Str.global_replace emph_regex "_\\1_"
80+
in
81+
let fix_comment doc =
82+
let rec inner state = function
83+
| l :: ls when String.trim l = "" -> l :: inner state ls (* Ignore empty lines *)
84+
| l :: ls when String.starts_with_regex ~regex:"[ ]*- " l -> begin
85+
match state with
86+
| `In_list -> l :: inner state ls
87+
| `In_code true -> (" " ^ l) :: inner state ls
88+
| `In_code false -> l :: inner state ls
89+
| `Plain -> "" :: inner `In_list (l :: ls)
90+
end
91+
| l :: ls when String.starts_with ~prefix:" " l -> begin
92+
match state with
93+
| `In_list -> l :: inner state ls
94+
| `In_code true -> (" " ^ l) :: inner state ls
95+
| `In_code false -> l :: inner state ls
96+
| `Plain -> "" :: inner (`In_code (String.starts_with ~prefix:" " l |> not)) (l :: ls)
97+
end
98+
| l :: ls -> begin
99+
match state with
100+
| `In_code _ -> "" :: inner `Plain (l :: ls)
101+
| _ -> l :: inner `Plain ls
102+
end
103+
| [] -> []
104+
in
105+
106+
doc
107+
|> replace_emph
108+
|> String.split_on_char ~sep:'\n'
109+
|> List.map ~f:remove_comment_prefix
110+
|> inner `Plain
111+
|> String.concat ~sep:"\n"
112+
in
113+
114+
let comment =
115+
leading :: (List.map ~f:Option.some detatched) @ [trailing]
116+
|> List.filter_map ~f:(fun i -> i)
117+
|> String.concat ~sep:"\n"
118+
in
119+
120+
fix_comment comment |> Omd.of_string
68121

69-
type t = comments StringMap.t
70122

71123
let make_code_info_map: SourceCodeInfo.t option -> code_info_map = fun source_code_info ->
72124
let source_code_info = Option.value ~default:[] source_code_info in
@@ -85,7 +137,7 @@ let make_code_info_map: SourceCodeInfo.t option -> code_info_map = fun source_co
85137
| SourceCodeInfo.Location.{ leading_comments = None; trailing_comments = None; leading_detached_comments = []; _ } -> db
86138
| SourceCodeInfo.Location.{ leading_comments = leading; trailing_comments = trailing; leading_detached_comments = detatched; _ } ->
87139
let path = map_location ~context:File location.SourceCodeInfo.Location.path in
88-
let element = { leading; trailing; detatched } in
140+
let element = parse_comments leading trailing detatched in
89141
Code_info_map.add ~key:path ~data:element db
90142
) source_code_info
91143
in
@@ -174,7 +226,7 @@ let init: FileDescriptorProto.t -> t = fun filedescriptor ->
174226

175227
(** Accessors *)
176228

177-
let get_comments: element_type:element -> proto_path:string -> ?name:string -> t -> string list =
229+
let get_comments: element_type:element -> proto_path:string -> ?name:string -> t -> comment option =
178230
fun ~element_type ~proto_path ?name t ->
179231
let key =
180232
let key = Printf.sprintf "%s:%s" (string_of_element element_type) proto_path in
@@ -183,13 +235,6 @@ let get_comments: element_type:element -> proto_path:string -> ?name:string -> t
183235
| None -> key
184236
in
185237
StringMap.find_opt key t
186-
|> Option.map ~f:( fun { leading; trailing; _} -> [leading; trailing])
187-
(*|> (fun x -> match x with
188-
| None -> Printf.eprintf "Not Found: %s\n" key; x
189-
| Some _ -> Printf.eprintf "Found: %s\n" key; x)
190-
*)
191-
|> Option.value ~default:[]
192-
|> List.filter_map ~f:(fun x -> x)
193238

194239

195240
let get_message_comments = get_comments ~element_type:Message
@@ -202,3 +247,8 @@ let get_method_comments = get_comments ~element_type:Method
202247
let get_extension_comments = get_comments ~element_type:Extension
203248
let get_file_comments = get_comments ~element_type:File ~proto_path:"." ?name:None
204249
let get_option_comments = get_comments ~element_type:Option
250+
251+
let to_ocaml_doc comments =
252+
comments
253+
|> Omd.to_html
254+
|> Printf.sprintf "{%%html:\n%s%%}"

0 commit comments

Comments
 (0)