Skip to content

Commit 6436dc9

Browse files
author
Guillaume Petiot
authored
Make the formatting mode of comments more explicit (ocaml-ppx#1745)
1 parent a572aee commit 6436dc9

File tree

1 file changed

+119
-127
lines changed

1 file changed

+119
-127
lines changed

Diff for: ‎lib/Cmt.ml

+119-127
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,8 @@ module T = struct
1818

1919
let txt t = t.txt
2020

21+
let create txt loc = {txt; loc}
22+
2123
let compare =
2224
Comparable.lexicographic
2325
[ Comparable.lift String.compare ~f:txt
@@ -29,148 +31,138 @@ end
2931

3032
include T
3133
include Comparator.Make (T)
34+
open Fmt
3235

33-
let create txt loc = {txt; loc}
36+
type pos = Before | Within | After
3437

35-
let split_asterisk_prefixed {txt; loc= {Location.loc_start; _}} =
36-
let len = Position.column loc_start + 3 in
37-
let pat =
38-
String.Search_pattern.create
39-
(String.init len ~f:(function
40-
| 0 -> '\n'
41-
| n when n < len - 1 -> ' '
42-
| _ -> '*' ) )
43-
in
44-
let rec split_asterisk_prefixed_ pos =
45-
match String.Search_pattern.index pat ~pos ~in_:txt with
46-
| Some 0 -> "" :: split_asterisk_prefixed_ len
47-
| Some idx ->
48-
String.sub txt ~pos ~len:(idx - pos)
49-
:: split_asterisk_prefixed_ (idx + len)
50-
| _ ->
51-
let drop = function ' ' | '\t' -> true | _ -> false in
52-
let line = String.rstrip ~drop (String.drop_prefix txt pos) in
53-
if String.is_empty line then [" "]
54-
else if Char.equal line.[String.length line - 1] '\n' then
55-
[String.drop_suffix line 1; ""]
56-
else if Char.is_whitespace txt.[String.length txt - 1] then
57-
[line ^ " "]
58-
else [line]
59-
in
60-
split_asterisk_prefixed_ 0
38+
module Asterisk_prefixed = struct
39+
let split {txt; loc= {Location.loc_start; _}} =
40+
let len = Position.column loc_start + 3 in
41+
let pat =
42+
String.Search_pattern.create
43+
(String.init len ~f:(function
44+
| 0 -> '\n'
45+
| n when n < len - 1 -> ' '
46+
| _ -> '*' ) )
47+
in
48+
let rec split_ pos =
49+
match String.Search_pattern.index pat ~pos ~in_:txt with
50+
| Some 0 -> "" :: split_ len
51+
| Some idx -> String.sub txt ~pos ~len:(idx - pos) :: split_ (idx + len)
52+
| _ ->
53+
let drop = function ' ' | '\t' -> true | _ -> false in
54+
let line = String.rstrip ~drop (String.drop_prefix txt pos) in
55+
if String.is_empty line then [" "]
56+
else if Char.equal line.[String.length line - 1] '\n' then
57+
[String.drop_suffix line 1; ""]
58+
else if Char.is_whitespace txt.[String.length txt - 1] then
59+
[line ^ " "]
60+
else [line]
61+
in
62+
split_ 0
6163

62-
let unindent_lines ~opn_pos first_line tl_lines =
63-
let indent_of_line s =
64-
(* index of first non-whitespace is indentation, None means white line *)
65-
String.lfindi s ~f:(fun _ c -> not (Char.is_whitespace c))
66-
in
67-
(* The indentation of the first line must account for the location of the
68-
comment opening *)
69-
let fl_spaces = Option.value ~default:0 (indent_of_line first_line) in
70-
let fl_offset = opn_pos.Lexing.pos_cnum - opn_pos.pos_bol + 2 in
71-
let fl_indent = fl_spaces + fl_offset in
72-
let min_indent =
73-
List.fold_left ~init:fl_indent
74-
~f:(fun acc s ->
75-
Option.value_map ~default:acc ~f:(min acc) (indent_of_line s) )
76-
tl_lines
77-
in
78-
(* Completely trim the first line *)
79-
String.drop_prefix first_line fl_spaces
80-
:: List.map ~f:(fun s -> String.drop_prefix s min_indent) tl_lines
64+
let fmt lines =
65+
vbox 1
66+
( fmt "(*"
67+
$ list_fl lines (fun ~first:_ ~last line ->
68+
match line with
69+
| "" when last -> fmt ")"
70+
| _ -> str line $ fmt_or last "*)" "@,*" ) )
71+
end
8172

82-
let fmt_multiline_cmt ?epi ~opn_pos ~starts_with_sp first_line tl_lines =
83-
let open Fmt in
84-
let is_white_line s = String.for_all s ~f:Char.is_whitespace in
85-
let unindented = unindent_lines ~opn_pos first_line tl_lines in
86-
let fmt_line ~first ~last:_ s =
87-
let sep, sp =
88-
if is_white_line s then (str "\n", noop)
89-
else (fmt "@;<1000 0>", fmt_if starts_with_sp " ")
73+
module Unwrapped = struct
74+
let unindent_lines ~opn_pos first_line tl_lines =
75+
let indent_of_line s =
76+
(* index of first non-whitespace is indentation, None means white
77+
line *)
78+
String.lfindi s ~f:(fun _ c -> not (Char.is_whitespace c))
9079
in
91-
fmt_if_k (not first) sep $ sp $ str (String.rstrip s)
92-
in
93-
vbox 0 ~name:"multiline" (list_fl unindented fmt_line $ fmt_opt epi)
80+
(* The indentation of the first line must account for the location of the
81+
comment opening *)
82+
let fl_spaces = Option.value ~default:0 (indent_of_line first_line) in
83+
let fl_offset = opn_pos.Lexing.pos_cnum - opn_pos.pos_bol + 2 in
84+
let fl_indent = fl_spaces + fl_offset in
85+
let min_indent =
86+
List.fold_left ~init:fl_indent
87+
~f:(fun acc s ->
88+
Option.value_map ~default:acc ~f:(min acc) (indent_of_line s) )
89+
tl_lines
90+
in
91+
(* Completely trim the first line *)
92+
String.drop_prefix first_line fl_spaces
93+
:: List.map ~f:(fun s -> String.drop_prefix s min_indent) tl_lines
9494

95-
type pos = Before | Within | After
95+
let fmt_multiline_cmt ?epi ~opn_pos ~starts_with_sp first_line tl_lines =
96+
let is_white_line s = String.for_all s ~f:Char.is_whitespace in
97+
let unindented = unindent_lines ~opn_pos first_line tl_lines in
98+
let fmt_line ~first ~last:_ s =
99+
let sep, sp =
100+
if is_white_line s then (str "\n", noop)
101+
else (fmt "@;<1000 0>", fmt_if starts_with_sp " ")
102+
in
103+
fmt_if_k (not first) sep $ sp $ str (String.rstrip s)
104+
in
105+
vbox 0 ~name:"multiline" (list_fl unindented fmt_line $ fmt_opt epi)
96106

97-
let fmt cmt ~wrap:wrap_comments ~ocp_indent_compat ~fmt_code pos =
98-
let open Fmt in
99-
let fmt_asterisk_prefixed_lines lines =
100-
vbox 1
101-
( fmt "(*"
102-
$ list_pn lines (fun ~prev:_ line ~next ->
103-
match (line, next) with
104-
| "", None -> fmt ")"
105-
| _, None -> str line $ fmt "*)"
106-
| _, Some _ -> str line $ fmt "@,*" ) )
107-
in
108-
let fmt_unwrapped_cmt {txt= s; loc} =
107+
let fmt ~ocp_indent_compat {txt= s; loc} pos =
109108
let is_sp = function ' ' | '\t' -> true | _ -> false in
110-
let epi =
111-
(* Preserve position of closing but strip empty lines at the end *)
112-
match String.rfindi s ~f:(fun _ c -> not (is_sp c)) with
113-
| Some i when Char.( = ) s.[i] '\n' ->
114-
break 1000 (-2) (* Break before closing *)
115-
| Some i when i < String.length s - 1 ->
116-
str " " (* Preserve a space at the end *)
117-
| _ -> noop
118-
in
119-
let stripped = String.rstrip s in
120-
match String.split_lines stripped with
109+
match String.split_lines (String.rstrip s) with
121110
| first_line :: (_ :: _ as tl) when not (String.is_empty first_line) ->
122111
if ocp_indent_compat then
123112
(* Not adding artificial breaks and keeping the comment contents
124113
verbatim will not interfere with ocp-indent. *)
125114
match pos with
126-
| Before -> wrap "(*" "*)" (str s)
127-
| Within -> wrap "(*" "*)" (str s)
128-
| After -> break_unless_newline 1000 0 $ wrap "(*" "*)" (str s)
115+
| Before -> wrap "(*" "*)" @@ str s
116+
| Within -> wrap "(*" "*)" @@ str s
117+
| After -> break_unless_newline 1000 0 $ wrap "(*" "*)" @@ str s
129118
else
119+
let epi =
120+
(* Preserve position of closing but strip empty lines at the
121+
end *)
122+
match String.rfindi s ~f:(fun _ c -> not (is_sp c)) with
123+
| Some i when Char.( = ) s.[i] '\n' ->
124+
break 1000 (-2) (* Break before closing *)
125+
| Some i when i < String.length s - 1 ->
126+
str " " (* Preserve a space at the end *)
127+
| _ -> noop
128+
in
130129
(* Preserve the first level of indentation *)
131130
let starts_with_sp = is_sp first_line.[0] in
132131
wrap "(*" "*)"
133-
(fmt_multiline_cmt ~opn_pos:loc.loc_start ~epi ~starts_with_sp
134-
first_line tl )
135-
| _ -> wrap "(*" "*)" (str s)
136-
in
137-
let fmt_non_code ?(wrap_comments = wrap_comments) cmt =
138-
if not wrap_comments then
139-
match split_asterisk_prefixed cmt with
140-
| [""] | [_] | [_; ""] -> fmt_unwrapped_cmt cmt
141-
| asterisk_prefixed_lines ->
142-
fmt_asterisk_prefixed_lines asterisk_prefixed_lines
143-
else
144-
match split_asterisk_prefixed cmt with
145-
| [] -> assert false
146-
| [""] -> assert false
147-
| [""; ""] -> str "(* *)"
148-
| [text] -> str "(*" $ fill_text text ~epi:"*)"
149-
| [text; ""] -> str "(*" $ fill_text text ~epi:" *)"
150-
| asterisk_prefixed_lines ->
151-
fmt_asterisk_prefixed_lines asterisk_prefixed_lines
152-
in
153-
let fmt_code ({txt= str; _} as cmt) =
154-
let dollar_last = Char.equal str.[String.length str - 1] '$' in
155-
let len = String.length str - if dollar_last then 2 else 1 in
156-
let source = String.sub ~pos:1 ~len str in
157-
match fmt_code source with
158-
| Ok formatted ->
159-
let cls : Fmt.s = if dollar_last then "$*)" else "*)" in
160-
hvbox 2 ~name:"code"
161-
(wrap "(*$" cls
162-
( fmt "@;" $ formatted
163-
$ fmt_if (String.length str > 2) "@;<1 -2>" ) )
164-
| Error () -> fmt_non_code ~wrap_comments:false cmt
132+
@@ fmt_multiline_cmt ~opn_pos:loc.loc_start ~epi ~starts_with_sp
133+
first_line tl
134+
| _ -> wrap "(*" "*)" @@ str s
135+
end
136+
137+
let fmt cmt ~wrap:wrap_comments ~ocp_indent_compat ~fmt_code pos =
138+
let mode =
139+
match cmt.txt with
140+
| "" -> impossible "not produced by parser"
141+
(* "(**)" is not parsed as a docstring but as a regular comment
142+
containing '*' and would be rewritten as "(***)" *)
143+
| "*" when Location.width cmt.loc = 4 -> `Verbatim "(**)"
144+
| "*" -> `Verbatim "(***)"
145+
| "$" -> `Verbatim "(*$*)"
146+
| str when Char.equal str.[0] '$' -> (
147+
let dollar_suf = Char.equal str.[String.length str - 1] '$' in
148+
let cls : Fmt.s = if dollar_suf then "$*)" else "*)" in
149+
let len = String.length str - if dollar_suf then 2 else 1 in
150+
let source = String.sub ~pos:1 ~len str in
151+
match fmt_code source with
152+
| Ok formatted -> `Code (formatted, cls)
153+
| Error () -> `Unwrapped cmt )
154+
| _ -> (
155+
match Asterisk_prefixed.split cmt with
156+
| [] | [""] -> impossible "not produced by split_asterisk_prefixed"
157+
| [""; ""] -> `Verbatim "(* *)"
158+
| [text] when wrap_comments -> `Wrapped (text, "*)")
159+
| [text; ""] when wrap_comments -> `Wrapped (text, " *)")
160+
| [_] | [_; ""] -> `Unwrapped cmt
161+
| lines -> `Asterisk_prefixed lines )
165162
in
166-
match cmt.txt with
167-
| "*" ->
168-
if
169-
(* "(**)" is not parsed as a docstring but as a regular comment
170-
containing '*' and would be rewritten as "(***)" *)
171-
Location.width cmt.loc = 4
172-
then str "(**)"
173-
else str "(***)"
174-
| "" | "$" -> fmt_non_code cmt
175-
| str when Char.equal str.[0] '$' -> fmt_code cmt
176-
| _ -> fmt_non_code cmt
163+
match mode with
164+
| `Verbatim x -> str x
165+
| `Code (x, cls) -> hvbox 2 @@ wrap "(*$@;" cls (x $ fmt "@;<1 -2>")
166+
| `Wrapped (x, epi) -> str "(*" $ fill_text x ~epi
167+
| `Unwrapped x -> Unwrapped.fmt ~ocp_indent_compat x pos
168+
| `Asterisk_prefixed x -> Asterisk_prefixed.fmt x

0 commit comments

Comments
 (0)