Format comments (#123)

* format comments

Signed-off-by: David Vulakh <[email protected]>

* dune build @gen_manpage

Signed-off-by: David Vulakh <[email protected]>

* fix doc comment toggling

Signed-off-by: David Vulakh <[email protected]>

* add more tests of code-like constructs

Signed-off-by: David Vulakh <[email protected]>

* fix code-like constructs

Signed-off-by: David Vulakh <[email protected]>

* add footnote-style lists

added lists for numbers only; letters are likely to be code, I think

Signed-off-by: David Vulakh <[email protected]>

* delete editing artifact

Signed-off-by: David Vulakh <[email protected]>

* fix \[0\] regression

Signed-off-by: David Vulakh <[email protected]>

* fix another footnote-related bug

[1] at start of line specifically

Signed-off-by: David Vulakh <[email protected]>

* recognize flower comments more generously

Signed-off-by: David Vulakh <[email protected]>

---------

Signed-off-by: David Vulakh <[email protected]>

Author: dvulakh

doc/manpage_ocamlformat.mld

@@ -334,6 +334,9 @@ OPTIONS (CODE FORMATTING STYLE)
        --no-parse-toplevel-phrases
            Unset parse-toplevel-phrases.
 
+       --no-preserve-ambiguous-line-comment
+           Unset preserve-ambiguous-line-comment.
+
        --no-space-around-arrays
            Unset space-around-arrays.
 
@@ -401,6 +404,11 @@ OPTIONS (CODE FORMATTING STYLE)
            Parse and format toplevel phrases and their output. The flag is
            unset by default.
 
+       --preserve-ambiguous-line-comment
+           Do not format comments that are one-line long and may contain
+           whitespace-sensitive code (e.g. strings) The flag is unset by
+           default.
+
        --sequence-blank-line={preserve-one|compact}
            Blank line between expressions of a sequence. preserve will keep a
            blank line between two expressions of a sequence if the input

lib/Cmt.ml

@@ -93,36 +93,6 @@ type decoded_kind =
 
 type decoded = {prefix: string; suffix: string; kind: decoded_kind}
 
-(** [~content_offset] indicates at which column the body of the comment
-    starts (1-indexed). [~max_idnent] indicates the maximum amount of
-    indentation to trim. *)
-let unindent_lines ?(max_indent = Stdlib.max_int) ~content_offset first_line
-    tl_lines =
-  let tl_indent =
-    List.fold_left ~init:max_indent
-      ~f:(fun acc s ->
-        Option.value_map ~default:acc ~f:(min acc) (String.indent_of_line s) )
-      tl_lines
-  in
-  (* The indentation of the first line must account for the location of the
-     comment opening. Don't account for the first line if it's empty.
-     [fl_trim] is the number of characters to remove from the first line. *)
-  let fl_trim, fl_indent =
-    match String.indent_of_line first_line with
-    | Some i ->
-        (max 0 (min i (tl_indent - content_offset)), i + content_offset - 1)
-    | None -> (String.length first_line, max_indent)
-  in
-  let min_indent = min tl_indent fl_indent in
-  let first_line = String.drop_prefix first_line fl_trim in
-  first_line
-  :: List.map ~f:(fun s -> String.drop_prefix s min_indent) tl_lines
-
-let unindent_lines ?max_indent ~content_offset txt =
-  match String.split ~on:'\n' txt with
-  | [] -> []
-  | hd :: tl -> unindent_lines ?max_indent ~content_offset hd tl
-
 let is_all_whitespace s = String.for_all s ~f:Char.is_whitespace
 
 let split_asterisk_prefixed =
@@ -147,18 +117,19 @@ let split_asterisk_prefixed =
       Some (fst_line :: List.map tl ~f:drop_prefix)
   | _ -> None
 
+let ambiguous_line line =
+  String.contains line '"' || String.contains line '{'
+  || String.contains line '}'
+
 let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
 
-let decode_comment ~parse_comments_as_doc txt loc =
+let decode_comment ~parse_comments_as_doc ~preserve_ambiguous_line_comments
+    txt loc =
   let txt =
     (* Windows compatibility *)
     let f = function '\r' -> false | _ -> true in
     String.filter txt ~f
   in
-  let opn_offset =
-    let {Lexing.pos_cnum; pos_bol; _} = loc.Location.loc_start in
-    pos_cnum - pos_bol + 1
-  in
   if String.length txt >= 2 then
     match txt.[0] with
     | '$' when not (Char.is_whitespace txt.[1]) -> mk (Verbatim txt)
@@ -173,15 +144,25 @@ let decode_comment ~parse_comments_as_doc txt loc =
     | '=' -> mk (Verbatim txt)
     | _ when is_all_whitespace txt ->
         mk (Verbatim " ") (* Make sure not to format to [(**)]. *)
-    | _ when parse_comments_as_doc -> mk (Doc txt)
-    | _ -> (
+    | c -> (
         let lines =
-          let content_offset = opn_offset + 2 in
-          unindent_lines ~content_offset txt
+          txt |> String.split ~on:'\n'
+          |> function
+          | [] -> [] | hd :: tl -> hd :: List.map ~f:String.lstrip tl
         in
-        match split_asterisk_prefixed lines with
-        | Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines)
-        | None -> mk (Normal txt) )
+        match lines with
+        | [line] when preserve_ambiguous_line_comments && ambiguous_line line
+          ->
+            mk (Verbatim txt)
+        | _ -> (
+          match split_asterisk_prefixed lines with
+          | Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines)
+          | None ->
+              if parse_comments_as_doc then
+                match c with
+                | '_' -> mk ~prefix:"_" (Doc (String.subo ~pos:1 txt))
+                | _ -> mk (Doc txt)
+              else mk (Normal txt) ) )
   else
     match txt with
     (* "(**)" is not parsed as a docstring but as a regular comment
@@ -197,6 +178,9 @@ let decode_docstring _loc = function
   | txt when is_all_whitespace txt -> mk (Verbatim " ")
   | txt -> mk ~prefix:"*" (Doc txt)
 
-let decode ~parse_comments_as_doc = function
-  | Comment {txt; loc} -> decode_comment ~parse_comments_as_doc txt loc
+let decode ~parse_comments_as_doc ~preserve_ambiguous_line_comments =
+  function
+  | Comment {txt; loc} ->
+      decode_comment ~parse_comments_as_doc ~preserve_ambiguous_line_comments
+        txt loc
   | Docstring {txt; loc} -> decode_docstring loc txt

lib/Cmt.mli

@@ -48,4 +48,8 @@ type decoded =
   ; suffix: string  (** Just before the closing. *)
   ; kind: decoded_kind }
 
-val decode : parse_comments_as_doc:bool -> t -> decoded
+val decode :
+     parse_comments_as_doc:bool
+  -> preserve_ambiguous_line_comments:bool
+  -> t
+  -> decoded

lib/Cmts.ml

@@ -611,38 +611,32 @@ end
 
 module Doc = struct
   let fmt ~pro ~epi ~fmt_code conf ~loc txt ~offset =
-    (* Whether the doc starts and ends with an empty line. *)
-    let pre_nl, trail_nl =
-      let lines = String.split ~on:'\n' txt in
-      match lines with
-      | [] | [_] -> (false, false)
-      | h :: _ ->
-          let l = List.last_exn lines in
-          (is_only_whitespaces h, is_only_whitespaces l)
+    let trail_nl =
+      String.split ~on:'\n' txt |> List.last_exn |> is_only_whitespaces
     in
-    let txt = if pre_nl then String.lstrip txt else txt in
-    let txt = if trail_nl then String.rstrip txt else txt in
+    let trail_asterisk = String.is_suffix ~suffix:"*" txt in
+    let txt = String.rstrip txt in
     let parsed = Docstring.parse ~loc ~pro txt in
     (* Disable warnings when parsing of code blocks fails. *)
     let quiet = Conf_t.Elt.make true `Default in
     let conf = {conf with Conf.opr_opts= {conf.Conf.opr_opts with quiet}} in
-    let doc =
-      Fmt_odoc.fmt_parsed conf ~actually_a_doc_comment:false ~fmt_code
-        ~input:txt ~offset parsed
-    in
+    let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:txt ~offset parsed in
     let open Fmt in
-    hvbox 2
-      ( str pro
-      $ fmt_if pre_nl "@;<1000 1>"
-      $ doc
-      $ fmt_if trail_nl "@;<1000 -2>"
-      $ epi )
+    let trailing_space =
+      if trail_asterisk then noop else fmt_or trail_nl "@;<1000 -2>" " "
+    in
+    hvbox 2 (str pro $ doc $ trailing_space $ epi)
 end
 
 let fmt_cmt (conf : Conf.t) cmt ~fmt_code =
   let open Fmt in
   let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
-  let decoded = Cmt.decode ~parse_comments_as_doc cmt in
+  let preserve_ambiguous_line_comments =
+    conf.fmt_opts.preserve_ambiguous_line_comments.v
+  in
+  let decoded =
+    Cmt.decode ~parse_comments_as_doc ~preserve_ambiguous_line_comments cmt
+  in
   (* TODO: Offset should be computed from location. *)
   let offset = 2 + String.length decoded.prefix in
   let pro_str = "(*" ^ decoded.prefix

lib/Conf.ml

@@ -112,6 +112,7 @@ let conventional_profile from =
   ; type_decl= elt `Compact
   ; type_decl_indent= elt 2
   ; wrap_comments= elt false
+  ; preserve_ambiguous_line_comments= elt false
   ; wrap_docstrings= elt true
   ; wrap_fun_args= elt true }
 
@@ -183,6 +184,7 @@ let ocamlformat_profile from =
   ; type_decl= elt `Compact
   ; type_decl_indent= elt 2
   ; wrap_comments= elt false
+  ; preserve_ambiguous_line_comments= elt false
   ; wrap_docstrings= elt true
   ; wrap_fun_args= elt true }
 
@@ -253,6 +255,7 @@ let janestreet_profile from =
   ; type_decl= elt `Sparse
   ; type_decl_indent= elt 2
   ; wrap_comments= elt true
+  ; preserve_ambiguous_line_comments= elt true
   ; wrap_docstrings= elt true
   ; wrap_fun_args= elt false }
 
@@ -1310,6 +1313,19 @@ module Formatting = struct
       (fun conf elt -> update conf ~f:(fun f -> {f with wrap_comments= elt}))
       (fun conf -> conf.fmt_opts.wrap_comments)
 
+  let preserve_ambiguous_line_comments =
+    let doc =
+      "Do not format comments that are one-line long and may contain \
+       whitespace-sensitive code (e.g. strings)"
+    in
+    Decl.flag ~default
+      ~names:["preserve-ambiguous-line-comment"]
+      ~doc ~kind
+      (fun conf elt ->
+        update conf ~f:(fun f ->
+            {f with preserve_ambiguous_line_comments= elt} ) )
+      (fun conf -> conf.fmt_opts.preserve_ambiguous_line_comments)
+
   let wrap_fun_args =
     let doc = "Style for function call." in
     let names = ["wrap-fun-args"] in
@@ -1378,6 +1394,7 @@ module Formatting = struct
       ; elt type_decl
       ; elt type_decl_indent
       ; elt wrap_comments
+      ; elt preserve_ambiguous_line_comments
       ; elt wrap_fun_args
       ; (* removed options *)
         elt align_cases

lib/Conf_t.ml

@@ -120,6 +120,7 @@ type fmt_opts =
   ; type_decl: [`Compact | `Sparse] elt
   ; type_decl_indent: int elt
   ; wrap_comments: bool elt
+  ; preserve_ambiguous_line_comments: bool elt
   ; wrap_docstrings: bool elt
   ; wrap_fun_args: bool elt }
 

lib/Conf_t.mli

@@ -118,6 +118,9 @@ type fmt_opts =
   ; type_decl: [`Compact | `Sparse] elt
   ; type_decl_indent: int elt
   ; wrap_comments: bool elt  (** Wrap comments at margin. *)
+  ; preserve_ambiguous_line_comments: bool elt
+        (** If a comment's contents may contain code whose semantics depend on whitespace, do
+      not wrap it. *)
   ; wrap_docstrings: bool elt
   ; wrap_fun_args: bool elt }
 

lib/Fmt_ast.ml

@@ -424,13 +424,15 @@ let fmt_parsed_docstring c ~loc ?pro ~epi input parsed =
     pos.pos_cnum - pos.pos_bol + 3
   and fmt_code = c.fmt_code in
   let doc =
-    if
-      c.conf.fmt_opts.parse_docstrings.v
-      && String.for_all ~f:Char.is_whitespace input
-    then noop
-    else
-      Fmt_odoc.fmt_parsed c.conf ~actually_a_doc_comment:true ~fmt_code
-        ~offset ~input parsed
+    match input with
+    | "/*" ->
+        (* Special-case the form that toggles odoc: [(**/**)] *) str input
+    | _ ->
+        if
+          c.conf.fmt_opts.parse_docstrings.v
+          && String.for_all ~f:Char.is_whitespace input
+        then noop
+        else Fmt_odoc.fmt_parsed c.conf ~fmt_code ~offset ~input parsed
   in
   let closing_space =
     match parsed with

lib/Fmt_odoc.ml

@@ -74,9 +74,24 @@ let escape_balanced_brackets s =
   in
   insert_ats s "\\" (brackets_to_escape [] [] 0)
 
+let looks_like_number w =
+  let w =
+    match String.chop_suffix w ~suffix:")" with
+    | Some w -> Some (String.chop_prefix_if_exists w ~prefix:"(")
+    | None -> (
+      match String.chop_suffix w ~suffix:"]" with
+      | Some w -> String.chop_prefix w ~prefix:"["
+      | None -> String.chop_suffix w ~suffix:"." )
+  in
+  match w |> Option.map ~f:String.to_list with
+  | Some [c] -> Char.is_alphanum c && not Char.(equal c '0')
+  | Some (leading :: _ as w) ->
+      List.for_all ~f:Char.is_digit w && not Char.(equal leading '0')
+  | Some [] | None -> false
+
 let escape_all s =
   let escapeworthy = function '{' | '}' | '[' | ']' -> true | _ -> false in
-  ensure_escape ~escapeworthy s
+  if looks_like_number s then s else ensure_escape ~escapeworthy s
 
 let split_on_whitespaces =
   String.split_on_chars ~on:['\t'; '\n'; '\011'; '\012'; '\r'; ' ']
@@ -211,17 +226,6 @@ let space_elt c : inline_element with_location =
   let sp = if c.conf.fmt_opts.wrap_docstrings.v then "" else " " in
   Loc.(at (span []) (`Space sp))
 
-let looks_like_number w =
-  let w =
-    match String.chop_suffix w ~suffix:")" with
-    | Some w -> Some (String.chop_prefix_if_exists w ~prefix:"(")
-    | None -> String.chop_suffix w ~suffix:"."
-  in
-  match w |> Option.map ~f:String.to_list with
-  | Some [c] -> Char.is_alphanum c
-  | Some (_ :: _ as w) -> List.for_all ~f:Char.is_digit w
-  | Some [] | None -> false
-
 let non_wrap_space sp = if String.contains sp '\n' then fmt "@\n" else str sp
 
 let rec fmt_inline_elements c elements =
@@ -249,7 +253,10 @@ let rec fmt_inline_elements c elements =
           (non_wrap_space sp)
         $ aux t
     | `Word w :: t ->
-        fmt_if (String.is_prefix ~prefix:"@" w) "\\"
+        fmt_if
+          ( String.is_prefix ~prefix:"@" w
+          && List.mem Odoc_parser.tag_list ~equal:String.equal w )
+          "\\"
         $ str_normalized c w $ aux t
     | `Code_span s :: t -> fmt_code_span s $ aux t
     | `Math_span s :: t -> fmt_math_span s $ aux t
@@ -407,8 +414,7 @@ let beginning_offset (conf : Conf.t) input =
       whitespace_count
   else min whitespace_count 1
 
-let fmt_parsed (conf : Conf.t) ~actually_a_doc_comment ~fmt_code ~input
-    ~offset parsed =
+let fmt_parsed (conf : Conf.t) ~fmt_code ~input ~offset parsed =
   let open Fmt in
   let begin_offset = beginning_offset conf input in
   (* The offset is used to adjust the margin when formatting code blocks. *)
@@ -420,9 +426,7 @@ let fmt_parsed (conf : Conf.t) ~actually_a_doc_comment ~fmt_code ~input
     str (String.make begin_offset ' ') $ fmt_ast conf ~fmt_code parsed
   in
   match parsed with
-  | _ when not (conf.fmt_opts.parse_docstrings.v && actually_a_doc_comment)
-    ->
-      str input
+  | _ when not conf.fmt_opts.parse_docstrings.v -> str input
   | Ok parsed -> fmt_parsed parsed
   | Error msgs ->
       if (not conf.opr_opts.quiet.v) && conf.opr_opts.check_odoc_parsing.v

lib/Fmt_odoc.mli

@@ -22,7 +22,6 @@ val fmt_ast : Conf.t -> fmt_code:fmt_code -> Odoc_parser.Ast.t -> Fmt.t
 
 val fmt_parsed :
      Conf.t
-  -> actually_a_doc_comment:bool
   -> fmt_code:fmt_code
   -> input:string
   -> offset:int