Refactor handling of comments

lib-rpc-server/ocamlformat_rpc.ml

@@ -82,7 +82,8 @@ let run_format conf x =
     (* The formatting functions are ordered in such a way that the ones
        expecting a keyword first (like signatures) are placed before the more
        general ones (like toplevel phrases). Parsing a file as `--impl` with
-       `ocamlformat` processes it as a use file (toplevel phrases) anyway.
+       `ocamlformat` processes it as a use file (toplevel phrases)
+       anyway.
 
        `ocaml-lsp` should use core types, module types and signatures.
        `ocaml-mdx` should use toplevel phrases, expressions and

lib/Cmt.ml

@@ -88,25 +88,104 @@ end
 
 type pos = Before | Within | After
 
-let unindent_lines ~offset first_line tl_lines =
+type decoded_kind =
+  | Verbatim of string
+  | Doc of string
+  | Normal of string
+  | Code of string
+  | Asterisk_prefixed of string list
+
+type decoded = {prefix: string; suffix: string; kind: decoded_kind}
+
+(** [opn_offset] indicates at which column the body of the comment starts. *)
+let unindent_lines ~opn_offset first_line tl_lines =
   let indent_of_line s =
     (* index of first non-whitespace is indentation, None means white line *)
     String.lfindi s ~f:(fun _ c -> not (Char.is_whitespace c))
   in
   (* The indentation of the first line must account for the location of the
-     comment opening *)
-  let fl_spaces = Option.value ~default:0 (indent_of_line first_line) in
-  let fl_indent = fl_spaces + offset in
+     comment opening. Don't account for the first line if it's empty. *)
+  let fl_spaces, fl_indent =
+    match indent_of_line first_line with
+    | Some i -> (i, i + opn_offset)
+    | None -> (String.length first_line, Stdlib.max_int)
+  in
   let min_indent =
     List.fold_left ~init:fl_indent
       ~f:(fun acc s ->
-        Option.value_map ~default:acc ~f:(min acc) (indent_of_line s) )
+        match indent_of_line s with Some i -> min acc i | None -> acc )
       tl_lines
   in
   (* Completely trim the first line *)
   String.drop_prefix first_line fl_spaces
   :: List.map ~f:(fun s -> String.drop_prefix s min_indent) tl_lines
 
-let unindent_lines ~offset = function
+let unindent_lines ~opn_offset txt =
+  match String.split ~on:'\n' txt with
   | [] -> []
-  | hd :: tl -> unindent_lines ~offset hd tl
+  | hd :: tl -> unindent_lines ~opn_offset hd tl
+
+let split_asterisk_prefixed = function
+  | hd :: (_ :: _ as tl)
+    when List.for_all ~f:(String.is_prefix ~prefix:"*") tl ->
+      Some (hd :: List.map tl ~f:(fun s -> String.drop_prefix s 1))
+  | _ -> None
+
+let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
+
+let is_all_whitespace s = String.for_all s ~f:Char.is_whitespace
+
+let decode ~parse_comments_as_doc {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 + 2
+  in
+  if String.length txt >= 2 then
+    match txt.[0] with
+    | '$' when not (Char.is_whitespace txt.[1]) -> mk (Verbatim txt)
+    | '$' ->
+        let opn_offset = opn_offset + 1 in
+        let dollar_suf = Char.equal txt.[String.length txt - 1] '$' in
+        let suffix = if dollar_suf then "$" else "" in
+        let source =
+          let len = String.length txt - if dollar_suf then 2 else 1 in
+          String.sub ~pos:1 ~len txt
+        in
+        let lines = unindent_lines ~opn_offset source in
+        let lines = List.map ~f:String.rstrip lines in
+        let lines = List.drop_while ~f:is_all_whitespace lines in
+        let code = String.concat ~sep:"\n" lines in
+        mk ~prefix:"$" ~suffix (Code code)
+    | '=' -> mk (Verbatim txt)
+    | '*' -> mk ~prefix:"*" (Doc (String.drop_prefix txt 1))
+    | _ when is_all_whitespace txt ->
+        mk (Verbatim " ") (* Make sure not to format to [(**)]. *)
+    | _ when parse_comments_as_doc -> mk (Doc txt)
+    | _ -> (
+        let lines = unindent_lines ~opn_offset txt in
+        (* Don't add a space to the prefix if the first line was only
+           spaces. *)
+        let prefix =
+          if
+            String.starts_with_whitespace txt
+            && not (String.is_empty (List.hd_exn lines))
+          then " "
+          else ""
+        in
+        match split_asterisk_prefixed lines with
+        | Some deprefixed_lines ->
+            mk ~prefix (Asterisk_prefixed deprefixed_lines)
+        | None -> mk ~prefix (Normal (String.concat ~sep:"\n" lines)) )
+  else
+    match txt with
+    (* "(**)" is not parsed as a docstring but as a regular comment
+       containing '*' and would be rewritten as "(***)" *)
+    | "*" when Location.width loc = 4 -> mk (Verbatim "")
+    | ("*" | "$") as txt -> mk (Verbatim txt)
+    | "\n" | " " -> mk (Verbatim " ")
+    | _ -> mk (Normal txt)

lib/Cmt.mli

@@ -37,6 +37,19 @@ module Comparator_no_loc : sig
   include Comparator.S with type t := t
 end
 
-val unindent_lines : offset:int -> string list -> string list
-(** Detect and remove the baseline indentation of a comment or a code block.
-    [offset] is the column number at which the first line starts. *)
+type decoded_kind =
+  | Verbatim of string  (** Original content. *)
+  | Doc of string  (** Original content. *)
+  | Normal of string
+      (** Original content with indentation trimmed. Trailing spaces are not
+          removed. *)
+  | Code of string  (** Source code with indentation removed. *)
+  | Asterisk_prefixed of string list
+      (** Line splitted with asterisks removed. *)
+
+type decoded =
+  { prefix: string  (** Just after the opening. *)
+  ; suffix: string  (** Just before the closing. *)
+  ; kind: decoded_kind }
+
+val decode : parse_comments_as_doc:bool -> t -> decoded