Keep line breaks inside literals when formatting

analysis/src/commands.ml

@@ -301,11 +301,7 @@ let format ~source ~kind_file =
   in
 
   (* Keep a CRLF document's line endings, rather than return mixed ones *)
-  let restore_line_endings text =
-    if Res_line_endings.uses_crlf source then Res_line_endings.to_crlf text
-    else text
-  in
-  let source = Res_line_endings.to_lf source in
+  let newline = Res_line_endings.newline source in
 
   let result =
     match kind_file with
@@ -317,8 +313,8 @@ let format ~source ~kind_file =
       | true -> Error "Document has syntax errors"
       | false ->
         Ok
-          (Res_printer.print_implementation ~comments structure
-          |> restore_line_endings |> create_range))
+          (Res_printer.print_implementation ~newline ~comments structure
+          |> create_range))
     | Resi -> (
       let {Res_driver.parsetree = signature; comments; diagnostics} =
         Res_driver.parsing_engine.parse_interface_from_source ~source
@@ -327,8 +323,8 @@ let format ~source ~kind_file =
       | true -> Error "Document has syntax errors"
       | false ->
         Ok
-          (Res_printer.print_interface ~comments signature
-          |> restore_line_endings |> create_range))
+          (Res_printer.print_interface ~newline ~comments signature
+          |> create_range))
     | Other -> Error "Failed to format, file not supported"
   in
 

changes/format-literal-line-breaks.fix.md

@@ -0,0 +1 @@
+- Make `bsc -format` keep the line breaks inside string, template and character literals and polymorphic variant names as written, and format comments with `\r\r\n` stably.

compiler/syntax/cli/res_cli.ml

@@ -68,13 +68,18 @@ module Cli_arg_processor = struct
       is_interface
       || (len > 0 && (String.get [@doesNotRaise]) filename (len - 1) = 'i')
     in
+    let source = lazy (Ext_io.load_file filename) in
+    let load_source () = Lazy.force source in
     let print_engine =
       match target with
       | "ml" -> Res_driver_ml_printer.print_engine
       | "ast" -> Res_ast_debugger.print_engine
       | "comments" -> Res_ast_debugger.comments_print_engine
       | "tokens" -> Res_token_debugger.token_print_engine
-      | "res" -> Res_driver.print_engine
+      | "res" ->
+        (* Keep the line endings of a CRLF file, like bsc -format *)
+        Res_driver.print_engine
+          ~newline:(Res_line_endings.newline (load_source ()))
       | "doc" -> Res_ast_debugger.doc_print_engine
       | target ->
         print_endline
@@ -83,9 +88,6 @@ module Cli_arg_processor = struct
         exit 1
     in
 
-    (* Read sources with LF line endings, so a CRLF file prints like an LF one,
-       also inside comments, template literals and raw JS. *)
-    let load_source () = Res_line_endings.to_lf (Ext_io.load_file filename) in
     (* Color the Format tags (e.g. @{<error>...@}) of printed diagnostics *)
     Misc.Color.setup None;
 

compiler/syntax/src/res_doc.ml

@@ -203,7 +203,7 @@ let fits w stack =
   in
   calculate_all stack
 
-let to_string ~width doc =
+let to_string ?(newline = "\n") ~width doc =
   propagate_forced_breaks doc;
   let buffer = Mini_buffer.create 1000 in
 
@@ -234,7 +234,7 @@ let to_string ~width doc =
               Mini_buffer.add_char buffer '\n';
               process ~pos:0 [] rest)
             else (
-              Mini_buffer.flush_newline buffer;
+              Mini_buffer.flush_newline buffer ~newline;
               Mini_buffer.add_string buffer
                 (String.make ind ' ' [@doesNotRaise]);
               process ~pos:ind [] rest)
@@ -249,7 +249,7 @@ let to_string ~width doc =
               Mini_buffer.add_string buffer " ";
               pos + 1
             | Hard ->
-              Mini_buffer.flush_newline buffer;
+              Mini_buffer.flush_newline buffer ~newline;
               0
             | Literal ->
               Mini_buffer.add_char buffer '\n';

compiler/syntax/src/res_doc.mli

@@ -57,7 +57,11 @@ val has_pending_line_suffix : t -> bool
     count as flat. Text after [doc] on the same line would precede the
     comment. *)
 
-val to_string : width:int -> t -> string
+val to_string : ?newline:string -> width:int -> t -> string
+(** [to_string ~newline ~width doc] writes the line breaks of [doc] as
+    [newline] (default LF). A [literal_line] is part of a literal's contents
+    and stays LF. *)
+
 val debug : t -> unit
 
 val is_nil : t -> bool

compiler/syntax/src/res_driver.ml

@@ -151,16 +151,16 @@ let parse_interface_from_source ~display_filename ~source =
     comments = List.rev engine.comments;
   }
 
-let print_engine =
+let print_engine ~newline =
   {
     print_implementation =
       (fun ~width ~filename:_ ~comments structure ->
         Compiler_request_output.write_stdout_binary
-          (Res_printer.print_implementation ~width structure ~comments));
+          (Res_printer.print_implementation ~width ~newline structure ~comments));
     print_interface =
       (fun ~width ~filename:_ ~comments signature ->
         Compiler_request_output.write_stdout_binary
-          (Res_printer.print_interface ~width signature ~comments));
+          (Res_printer.print_interface ~width ~newline signature ~comments));
   }
 
 exception Already_reported

compiler/syntax/src/res_driver.mli

@@ -49,7 +49,8 @@ type print_engine = {
 
 val parsing_engine : Res_diagnostics.t list parsing_engine
 
-val print_engine : print_engine
+(* Prints ReScript with line breaks written as [newline] *)
+val print_engine : newline:string -> print_engine
 
 exception Already_reported
 

compiler/syntax/src/res_line_endings.ml

@@ -1,31 +1,4 @@
-let uses_crlf source =
+let newline source =
   match String.index_opt source '\n' with
-  | Some index -> index > 0 && source.[index - 1] = '\r'
-  | None -> false
-
-let to_lf source =
-  if not (String.contains source '\r') then source
-  else
-    let length = String.length source in
-    let converted = Buffer.create length in
-    String.iteri
-      (fun index character ->
-        if
-          not
-            (character = '\r' && index + 1 < length && source.[index + 1] = '\n')
-        then Buffer.add_char converted character)
-      source;
-    Buffer.contents converted
-
-let to_crlf text =
-  let converted = Buffer.create (String.length text) in
-  String.iter
-    (fun character ->
-      if character = '\n' then Buffer.add_char converted '\r';
-      Buffer.add_char converted character)
-    text;
-  Buffer.contents converted
-
-let preserve source print =
-  let printed = print (to_lf source) in
-  if uses_crlf source then to_crlf printed else printed
+  | Some index when index > 0 && source.[index - 1] = '\r' -> "\r\n"
+  | _ -> "\n"

compiler/syntax/src/res_line_endings.mli

@@ -1,17 +1,8 @@
-(* The printer emits LF line endings, but the scanner keeps a CRLF source's CRs
-   inside comments, template literals and raw JS. Printed as is, those lines
-   end in CR LF next to plain LF lines, and an editor or a text-mode channel
-   that turns each LF into CRLF makes them CR CR LF. *)
-
-(* Whether the first line break of [source] is CRLF *)
-val uses_crlf : string -> bool
-
-(* Replaces each CRLF with LF. A lone CR stays. *)
-val to_lf : string -> string
-
-(* Replaces each LF with CRLF. *)
-val to_crlf : string -> string
-
-(* [preserve source print] prints [source] with LF line endings and gives the
-   result CRLF line endings when [source] uses them. *)
-val preserve : string -> (string -> string) -> string
+(* The printer writes its own line breaks with the newline it is given, and
+   copies comments and literals with their bytes unchanged. Formatting a file
+   with the newline of its source keeps a CRLF file CRLF without touching the
+   line breaks inside its string literals, which are part of the program. *)
+
+(* The newline of [source]: CRLF when its first line break is CRLF, LF
+   otherwise *)
+val newline : string -> string

compiler/syntax/src/res_minibuffer.ml

@@ -38,10 +38,10 @@ let add_string b s =
   b.position <- new_position
 
 (* adds newline and trims all preceding whitespace *)
-let flush_newline b =
+let flush_newline b ~newline =
   let position = ref b.position in
   while Bytes.unsafe_get b.buffer (!position - 1) = ' ' && !position >= 0 do
     position := !position - 1
   done;
   b.position <- !position;
-  add_char b '\n'
+  add_string b newline

compiler/syntax/src/res_minibuffer.mli

@@ -3,4 +3,4 @@ val add_char : t -> char -> unit
 val add_string : t -> string -> unit
 val contents : t -> string
 val create : int -> t
-val flush_newline : t -> unit
+val flush_newline : t -> newline:string -> unit

compiler/syntax/src/res_multi_printer.ml

@@ -1,13 +1,14 @@
 (* print res files to res syntax *)
 let print_res ~ignore_parse_errors ~is_interface ~filename source =
+  let newline = Res_line_endings.newline source in
   if is_interface then (
     let parse_result =
       Res_driver.parse_interface_from_source ~display_filename:filename ~source
     in
     if parse_result.invalid then (
       Res_diagnostics.print_report parse_result.diagnostics parse_result.source;
       if not ignore_parse_errors then raise_notrace Res_driver.Already_reported);
-    Res_printer.print_interface ~width:Res_printer.default_print_width
+    Res_printer.print_interface ~width:Res_printer.default_print_width ~newline
       ~comments:parse_result.comments parse_result.parsetree)
   else
     let parse_result =
@@ -18,7 +19,7 @@ let print_res ~ignore_parse_errors ~is_interface ~filename source =
       Res_diagnostics.print_report parse_result.diagnostics parse_result.source;
       if not ignore_parse_errors then raise_notrace Res_driver.Already_reported);
     Res_printer.print_implementation ~width:Res_printer.default_print_width
-      ~comments:parse_result.comments parse_result.parsetree
+      ~newline ~comments:parse_result.comments parse_result.parsetree
 [@@raises Res_driver.Already_reported]
 
 (* print the given file named input to from "language" to res, general interface exposed by the compiler *)
@@ -27,8 +28,8 @@ let print ?(ignore_parse_errors = false) input =
     let len = String.length input in
     len > 0 && String.unsafe_get input (len - 1) = 'i'
   in
-  Res_line_endings.preserve (Ext_io.load_file input)
-    (print_res ~ignore_parse_errors ~is_interface ~filename:input)
+  print_res ~ignore_parse_errors ~is_interface ~filename:input
+    (Ext_io.load_file input)
 [@@raises Res_driver.Already_reported]
 
 (* suppress unused optional arg *)

compiler/syntax/src/res_printer.ml

@@ -181,6 +181,14 @@ let print_multiline_comment_content txt =
     Doc.concat
       [Doc.text "/* "; Doc.text (Comment.trim_spaces line); Doc.text " */"]
   | first :: rest ->
+    (* The printer writes the line break, so drop the CRs of a CRLF one *)
+    let first =
+      let len = ref (String.length first) in
+      while !len > 0 && String.unsafe_get first (!len - 1) = '\r' do
+        decr len
+      done;
+      String.sub first 0 !len [@doesNotRaise]
+    in
     let first_line = Comment.trim_spaces first in
     Doc.concat
       [
@@ -6448,12 +6456,12 @@ let interface_doc (s : Parsetree.signature) ~comments =
   Comment_table.walk_signature s cmt_tbl comments;
   print_signature ~state:(State.init ()) s cmt_tbl
 
-let print_implementation ?(width = default_print_width)
+let print_implementation ?(width = default_print_width) ?(newline = "\n")
     (s : Parsetree.structure) ~comments =
-  Doc.to_string ~width (implementation_doc s ~comments) ^ "\n"
+  Doc.to_string ~newline ~width (implementation_doc s ~comments) ^ newline
 
-let print_interface ?(width = default_print_width) (s : Parsetree.signature)
-    ~comments =
-  Doc.to_string ~width (interface_doc s ~comments) ^ "\n"
+let print_interface ?(width = default_print_width) ?(newline = "\n")
+    (s : Parsetree.signature) ~comments =
+  Doc.to_string ~newline ~width (interface_doc s ~comments) ^ newline
 
 let print_structure s t = print_structure ~state:(State.init ()) s t

compiler/syntax/src/res_printer.mli

@@ -25,9 +25,17 @@ val interface_doc :
   Parsetree.signature -> comments:Res_comment.t list -> Res_doc.t
 
 val print_implementation :
-  ?width:int -> Parsetree.structure -> comments:Res_comment.t list -> string
+  ?width:int ->
+  ?newline:string ->
+  Parsetree.structure ->
+  comments:Res_comment.t list ->
+  string
 val print_interface :
-  ?width:int -> Parsetree.signature -> comments:Res_comment.t list -> string
+  ?width:int ->
+  ?newline:string ->
+  Parsetree.signature ->
+  comments:Res_comment.t list ->
+  string
 
 val print_ident_like :
   ?allow_uident:bool -> ?allow_hyphen:bool -> string -> Res_doc.t

tests/syntax_tests/res_test.ml

@@ -25,11 +25,17 @@ let x: int
 |})
 
 (* Formatting keeps a file's line endings, also inside comments, template
-   literals and raw JS, and formatting the result again changes nothing *)
+   literals and raw JS, and formatting the result again changes nothing. The
+   line breaks inside literals are part of the program and keep their bytes,
+   whatever the file's line endings, and so do the ones inside comments. *)
 let () =
+  let to_crlf text = String.concat "\r\n" (String.split_on_char '\n' text) in
   let lf =
     "/* a\n\
     \ multi-line comment */\n\
+     /* a comment\n\
+    \ * with stars\n\
+    \ */\n\
      let s = `line 1\n\
      line 2`\n\
      let r = %raw(`\n\
@@ -53,7 +59,20 @@ let () =
       let formatted = format source in
       assert (formatted = source);
       assert (format formatted = formatted))
-    [lf; Res_line_endings.to_crlf lf]
+    [
+      lf;
+      to_crlf lf;
+      "let x = 1\r\nlet s = \"a\nb\"\r\n";
+      "let x = 1\nlet s = \"a\r\nb\"\n";
+      "let x = 1\r\nlet t = `a\nb`\r\nlet c = '\n'\r\nlet p = #\"a\nb\"\r\n";
+      "let x = 1\nlet t = `a\r\nb`\nlet c = '\r'\nlet p = #\"a\r\nb\"\n";
+      "let x = 1\n/* a\r\r\nb\nc */\nlet y = 2\n";
+      "let x = 1\r\n/* a\nb\r\nc */\r\nlet y = 2\r\n";
+    ];
+  (* The printer writes the line breaks of a comment it reindents *)
+  let formatted = format "let x = 1\n/* a\r\r\n b */\nlet y = 2\n" in
+  assert (formatted = "let x = 1\n/* a\n b */\nlet y = 2\n");
+  assert (format (to_crlf formatted) = to_crlf formatted)
 
 let () = print_endline "✅ multi printer api tests"