Fix the formatter's line endings on Windows and in CRLF files

.github/workflows/ci.yml

@@ -167,7 +167,7 @@ jobs:
 
       - name: "Syntax: Run tests"
         env:
-          ROUNDTRIP_TEST: ${{ runner.os == 'Windows' && '0' || '1' }}
+          ROUNDTRIP_TEST: 1
         run: ./scripts/test_syntax.sh
         shell: bash
 

analysis/src/commands.ml

@@ -300,6 +300,13 @@ let format ~source ~kind_file =
     Lsp.Types.TextEdit.create ~newText:text ~range
   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 result =
     match kind_file with
     | Files.Res -> (
@@ -309,16 +316,19 @@ let format ~source ~kind_file =
       match List.length diagnostics > 0 with
       | true -> Error "Document has syntax errors"
       | false ->
-        Ok (Res_printer.print_implementation ~comments structure |> create_range)
-      )
+        Ok
+          (Res_printer.print_implementation ~comments structure
+          |> restore_line_endings |> create_range))
     | Resi -> (
       let {Res_driver.parsetree = signature; comments; diagnostics} =
         Res_driver.parsing_engine.parse_interface_from_source ~source
       in
       match List.length diagnostics > 0 with
       | true -> Error "Document has syntax errors"
       | false ->
-        Ok (Res_printer.print_interface ~comments signature |> create_range))
+        Ok
+          (Res_printer.print_interface ~comments signature
+          |> restore_line_endings |> create_range))
     | Other -> Error "Failed to format, file not supported"
   in
 

changes/format-line-endings.fix.md

@@ -0,0 +1 @@
+- Make the formatter keep each file's line endings. On Windows it no longer rewrites LF files with CRLF or reports them in `rescript format --check`, and formatting a CRLF file no longer adds a carriage return inside multi-line comments, template literals and raw JS on every run.

changes/windows-format-tests.internal.md

@@ -0,0 +1 @@
+- Run the syntax roundtrip tests and the OCaml and ReScript format checks on Windows CI.

compiler/bsc/rescript_compiler_driver.ml

@@ -176,7 +176,7 @@ let format_file input =
       input
   in
   match !((Clflags.current ()).output_name) with
-  | None -> Compiler_request_output.write_stdout formatted
+  | None -> Compiler_request_output.write_stdout_binary formatted
   | Some fname -> Ext_io.write_file fname formatted
 
 let set_color_option option =

compiler/ext/compiler_request_output.ml

@@ -5,6 +5,9 @@ type sink = {
   prefix: string;
   buffer: Buffer.t;
   mutable file: (string * out_channel) option;
+  mutable exact: bool;
+      (* The buffer holds the final bytes: once binary output is written, text
+         is converted as it is written instead of when it is read. *)
 }
 
 type streams = {
@@ -55,8 +58,30 @@ let write_sink sink text position length =
   | Some (_, channel) ->
     output_string channel
       (text_mode_input ~win32:Sys.win32 (String.sub text position length))
+  | None when sink.exact ->
+    Buffer.add_string sink.buffer
+      (text_mode_line_endings ~win32:Sys.win32
+         (String.sub text position length))
   | None -> Buffer.add_substring sink.buffer text position length
 
+let write_sink_binary sink text =
+  match sink.file with
+  | Some (_, channel) ->
+    flush channel;
+    set_binary_mode_out channel true;
+    output_string channel text;
+    flush channel;
+    set_binary_mode_out channel false
+  | None ->
+    if not sink.exact then (
+      let converted =
+        text_mode_line_endings ~win32:Sys.win32 (Buffer.contents sink.buffer)
+      in
+      Buffer.clear sink.buffer;
+      Buffer.add_string sink.buffer converted;
+      sink.exact <- true);
+    Buffer.add_string sink.buffer text
+
 let sink_channel sink =
   match sink.file with
   | Some (_, channel) -> channel
@@ -65,15 +90,22 @@ let sink_channel sink =
       Filename.open_temp_file ~mode:[Open_text] sink.prefix ".log"
     in
     (* Output written so far goes first. The channel is in text mode, so it
-       already converts line endings. *)
-    output_string channel
-      (text_mode_input ~win32:Sys.win32 (Buffer.contents sink.buffer));
+       already converts line endings, unless the buffer holds final bytes. *)
+    if sink.exact then (
+      set_binary_mode_out channel true;
+      output_string channel (Buffer.contents sink.buffer);
+      flush channel;
+      set_binary_mode_out channel false)
+    else
+      output_string channel
+        (text_mode_input ~win32:Sys.win32 (Buffer.contents sink.buffer));
     Buffer.clear sink.buffer;
     sink.file <- Some (path, channel);
     channel
 
 let sink_contents sink =
   match sink.file with
+  | None when sink.exact -> Buffer.contents sink.buffer
   | None ->
     text_mode_line_endings ~win32:Sys.win32 (Buffer.contents sink.buffer)
   | Some (path, channel) ->
@@ -115,6 +147,16 @@ let write_stdout text =
   | Some streams -> write_sink streams.stdout text 0 (String.length text)
   | None -> output_string Stdlib.stdout text
 
+let write_stdout_binary text =
+  match current () with
+  | Some streams -> write_sink_binary streams.stdout text
+  | None ->
+    flush Stdlib.stdout;
+    set_binary_mode_out Stdlib.stdout true;
+    output_string Stdlib.stdout text;
+    flush Stdlib.stdout;
+    set_binary_mode_out Stdlib.stdout false
+
 let write_stderr text =
   match current () with
   | Some streams -> write_sink streams.stderr text 0 (String.length text)
@@ -134,7 +176,9 @@ let print_stderr text =
 exception Failed of {error: exn; stdout: string; stderr: string}
 
 let with_capture action =
-  let sink prefix = {prefix; buffer = Buffer.create 256; file = None} in
+  let sink prefix =
+    {prefix; buffer = Buffer.create 256; file = None; exact = false}
+  in
   let stdout = sink "rescript-compiler-stdout-" in
   let stderr = sink "rescript-compiler-stderr-" in
   let streams =

compiler/ext/compiler_request_output.mli

@@ -6,6 +6,11 @@ val is_active : unit -> bool
 val stdout_formatter : unit -> Format.formatter
 val stderr_formatter : unit -> Format.formatter
 val write_stdout : string -> unit
+
+val write_stdout_binary : string -> unit
+(** Write [text] as is, without the CRLF line endings that a text-mode channel
+    writes on Windows. *)
+
 val write_stderr : string -> unit
 val print_stdout : string -> unit
 val print_stderr : string -> unit

compiler/syntax/cli/res_cli.ml

@@ -61,17 +61,13 @@ end = struct
 end
 
 module Cli_arg_processor = struct
-  type backend = Parser : 'diagnostics Res_driver.parsing_engine -> backend
-  [@@unboxed]
-
   let process_file ~is_interface ~width ~recover ~target ~jsx_version
       ~jsx_module ~test_ast_conversion filename =
     let len = String.length filename in
     let process_interface =
       is_interface
       || (len > 0 && (String.get [@doesNotRaise]) filename (len - 1) = 'i')
     in
-    let parsing_engine = Parser Res_driver.parsing_engine in
     let print_engine =
       match target with
       | "ml" -> Res_driver_ml_printer.print_engine
@@ -87,18 +83,23 @@ module Cli_arg_processor = struct
         exit 1
     in
 
-    let (Parser backend) = parsing_engine 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;
 
     (* Special case for tokens - bypass parsing entirely *)
     if target = "tokens" then
       print_engine.print_implementation ~width ~filename ~comments:[] []
     else if process_interface then
-      let parse_result = backend.parse_interface ~filename in
+      let parse_result =
+        Res_driver.parse_interface_from_source ~display_filename:filename
+          ~source:(load_source ())
+      in
       if parse_result.invalid then (
-        backend.string_of_diagnostics ~source:parse_result.source
-          ~filename:parse_result.filename parse_result.diagnostics;
+        Res_diagnostics.print_report parse_result.diagnostics
+          parse_result.source;
         if recover then
           print_engine.print_interface ~width ~filename
             ~comments:parse_result.comments parse_result.parsetree
@@ -120,10 +121,13 @@ module Cli_arg_processor = struct
         print_engine.print_interface ~width ~filename
           ~comments:parse_result.comments parsetree
     else
-      let parse_result = backend.parse_implementation ~filename in
+      let parse_result =
+        Res_driver.parse_implementation_from_source ~display_filename:filename
+          ~source:(load_source ())
+      in
       if parse_result.invalid then (
-        backend.string_of_diagnostics ~source:parse_result.source
-          ~filename:parse_result.filename parse_result.diagnostics;
+        Res_diagnostics.print_report parse_result.diagnostics
+          parse_result.source;
         if recover then
           print_engine.print_implementation ~width ~filename
             ~comments:parse_result.comments parse_result.parsetree

compiler/syntax/src/res_driver.ml

@@ -155,11 +155,11 @@ let print_engine =
   {
     print_implementation =
       (fun ~width ~filename:_ ~comments structure ->
-        Compiler_request_output.write_stdout
+        Compiler_request_output.write_stdout_binary
           (Res_printer.print_implementation ~width structure ~comments));
     print_interface =
       (fun ~width ~filename:_ ~comments signature ->
-        Compiler_request_output.write_stdout
+        Compiler_request_output.write_stdout_binary
           (Res_printer.print_interface ~width signature ~comments));
   }
 

compiler/syntax/src/res_line_endings.ml

@@ -0,0 +1,31 @@
+let uses_crlf 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

compiler/syntax/src/res_line_endings.mli

@@ -0,0 +1,17 @@
+(* 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

compiler/syntax/src/res_multi_printer.ml

@@ -1,15 +1,18 @@
 (* print res files to res syntax *)
-let print_res ~ignore_parse_errors ~is_interface ~filename =
+let print_res ~ignore_parse_errors ~is_interface ~filename source =
   if is_interface then (
-    let parse_result = Res_driver.parsing_engine.parse_interface ~filename in
+    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
       ~comments:parse_result.comments parse_result.parsetree)
   else
     let parse_result =
-      Res_driver.parsing_engine.parse_implementation ~filename
+      Res_driver.parse_implementation_from_source ~display_filename:filename
+        ~source
     in
     if parse_result.invalid then (
       Res_diagnostics.print_report parse_result.diagnostics parse_result.source;
@@ -24,7 +27,8 @@ let print ?(ignore_parse_errors = false) input =
     let len = String.length input in
     len > 0 && String.unsafe_get input (len - 1) = 'i'
   in
-  print_res ~ignore_parse_errors ~is_interface ~filename:input
+  Res_line_endings.preserve (Ext_io.load_file input)
+    (print_res ~ignore_parse_errors ~is_interface ~filename:input)
 [@@raises Res_driver.Already_reported]
 
 (* suppress unused optional arg *)

rewatch/tests/format/05-format-line-endings.sh

@@ -0,0 +1,45 @@
+#!/bin/bash
+cd $(dirname $0)
+source "../utils.sh"
+cd ../../testrepo
+
+bold "Test: It should keep each file's line endings"
+
+dir=format-line-endings
+mkdir -p $dir
+trap 'rm -rf "$dir"' EXIT
+
+# Formatted source with lines inside a comment and a template literal, which
+# used to get CR CR LF line endings when formatted with CRLF ones
+formatted='/* a\n multi-line comment */\nlet s = `line 1\nline 2`\n'
+printf "$formatted" > $dir/Lf.res
+printf "$formatted" | sed 's/$/\r/' > $dir/Crlf.res
+printf 'let  x  =  1\n' > $dir/UnformattedLf.res
+printf 'let  x  =  1\r\n' > $dir/UnformattedCrlf.res
+
+if ! check_output=$(rewatch format --check $dir/Lf.res $dir/Crlf.res 2>&1); then
+  error "Formatted LF and CRLF files failed the format check"
+  echo "$check_output"
+  exit 1
+fi
+
+cp $dir/Lf.res $dir/Lf.expected
+cp $dir/Crlf.res $dir/Crlf.expected
+printf 'let x = 1\n' > $dir/UnformattedLf.expected
+printf 'let x = 1\r\n' > $dir/UnformattedCrlf.expected
+
+if ! format_output=$(rewatch format $dir/*.res 2>&1); then
+  error "Error formatting LF and CRLF files"
+  echo "$format_output"
+  exit 1
+fi
+
+for file in Lf Crlf UnformattedLf UnformattedCrlf; do
+  if ! cmp -s $dir/$file.res $dir/$file.expected; then
+    error "Formatting $file.res changed its line endings"
+    od -c $dir/$file.res | head -10
+    exit 1
+  fi
+done
+
+success "LF and CRLF files keep their line endings"

rewatch/tests/suite.sh

@@ -120,6 +120,7 @@ fi
 ./format/02-format-single-file.sh &&
 ./format/03-format-stdin.sh &&
 ./format/04-format-current-project.sh &&
+./format/05-format-line-endings.sh &&
 
 # Clean tests
 ./clean/01-clean-single-project.sh &&

scripts/format.sh

@@ -8,8 +8,10 @@ echo Formatting OCaml code...
 opam exec -- dune build @fmt --auto-promote
 
 echo Formatting ReScript code...
-files=$(find packages tests -type f \( -name "*.res" -o -name "*.resi" \) ! -name "syntaxErrors*" ! -name "generated_mocha_test.res" ! -path "tests/build_tests/super_errors/fixtures/break_keyword_binding.res" ! -path "tests/tools_tests/*/NoMigration.res*" ! -path "tests/build_tests/super_errors_multi/fixtures/Iface_not_compiled/*" ! -path "tests/syntax_tests*" ! -path "tests/analysis_tests/tests*" ! -path "*/node_modules/*")
-./cli/rescript.js format $files
+# xargs passes the files in batches that fit the platform's command-line
+# length limit, which is only 32K characters on Windows.
+find packages tests -type f \( -name "*.res" -o -name "*.resi" \) ! -name "syntaxErrors*" ! -name "generated_mocha_test.res" ! -path "tests/build_tests/super_errors/fixtures/break_keyword_binding.res" ! -path "tests/tools_tests/*/NoMigration.res*" ! -path "tests/build_tests/super_errors_multi/fixtures/Iface_not_compiled/*" ! -path "tests/syntax_tests*" ! -path "tests/analysis_tests/tests*" ! -path "*/node_modules/*" -print0 \
+  | xargs -0 node ./cli/rescript.js format
 
 echo Formatting JS code...
 yarn format