try modifying and reusing the existing Code_frame module for snapshot printing

Author: zth

analysis/src/Commands.ml

@@ -381,6 +381,7 @@ let test ~path ~debug =
           | "com" ->
             let currentFile = createCurrentFile () in
             if !Cfg.useRevampedCompletion then (
+              Code_frame.setup (Some Misc.Color.Never);
               let source = Files.readFile currentFile in
               let completions =
                 completionRevamped ~debug ~path ~pos:(line, col) ~currentFile
@@ -391,16 +392,10 @@ let test ~path ~debug =
               | Some (completable, completionsText), Some text -> (
                 match SharedTypes.CompletableRevamped.try_loc completable with
                 | Some loc ->
-                  let range =
-                    CodeFence.
-                      {
-                        start = loc.Location.loc_start.pos_cnum;
-                        finish = loc.Warnings.loc_end.pos_cnum;
-                      }
-                  in
                   Printf.printf "Found Completable: %s\n\n"
                     (SharedTypes.CompletableRevamped.toString completable);
-                  CodeFence.format_code_snippet_cropped text (Some range) 3
+                  Code_frame.print ~is_warning:true ~draw_underline:true
+                    ~src:text ~start_pos:loc.loc_start ~end_pos:loc.loc_end
                   |> print_endline;
                   print_endline completionsText
                 | None -> ())

compiler/ml/code_frame.ml

@@ -104,7 +104,7 @@ end
 
 let setup = Color.setup
 
-type gutter = Number of int | Elided
+type gutter = Number of int | Elided | UnderlinedRow
 type highlighted_string = {s: string; start: int; end_: int}
 type line = {gutter: gutter; content: highlighted_string list}
 
@@ -116,7 +116,7 @@ type line = {gutter: gutter; content: highlighted_string list}
   - center snippet when it's heavily indented
   - ellide intermediate lines when the reported range is huge
 *)
-let print ~is_warning ~src ~(start_pos : Lexing.position)
+let print ~is_warning ~draw_underline ~src ~(start_pos : Lexing.position)
     ~(end_pos : Lexing.position) =
   let indent = 2 in
   let highlight_line_start_line = start_pos.pos_lnum in
@@ -175,7 +175,8 @@ let print ~is_warning ~src ~(start_pos : Lexing.position)
                |> break_long_line line_width
                |> List.mapi (fun i line ->
                       match gutter with
-                      | Elided -> {s = line; start = 0; end_ = 0}
+                      | Elided | UnderlinedRow ->
+                        {s = line; start = 0; end_ = 0}
                       | Number line_number ->
                         let highlight_line_start_offset =
                           start_pos.pos_cnum - start_pos.pos_bol
@@ -207,7 +208,41 @@ let print ~is_warning ~src ~(start_pos : Lexing.position)
                         in
                         {s = line; start; end_})
            in
-           {gutter; content = new_content})
+           if draw_underline then
+             let has_highlight =
+               List.exists (fun {start; end_} -> start < end_) new_content
+             in
+             if has_highlight then
+               let underline_content =
+                 List.map
+                   (fun {start; end_} ->
+                     if start < end_ then
+                       let overline_char = "‾" in
+                       let underline_length = end_ - start in
+                       let underline =
+                         String.concat ""
+                           (List.init underline_length (fun _ -> overline_char))
+                       in
+                       [
+                         {
+                           s = String.make start ' ' ^ underline;
+                           start = 0;
+                           end_ = 0;
+                         };
+                       ]
+                     else [{s = ""; start = 0; end_ = 0}])
+                   new_content
+               in
+               [
+                 {gutter; content = new_content};
+                 {
+                   gutter = UnderlinedRow;
+                   content = List.flatten underline_content;
+                 };
+               ]
+             else [{gutter; content = new_content}]
+           else [{gutter; content = new_content}])
+    |> List.flatten
   in
   let buf = Buffer.create 100 in
   let open Color in
@@ -275,5 +310,11 @@ let print ~is_warning ~src ~(start_pos : Lexing.position)
                            else NoColor
                          in
                          add_ch c ch);
+                  add_ch NoColor '\n')
+         | UnderlinedRow ->
+           content
+           |> List.iter (fun line ->
+                  draw_gutter NoColor "";
+                  line.s |> String.iter (fun ch -> add_ch NoColor ch);
                   add_ch NoColor '\n'));
   Buffer.contents buf

compiler/ml/location.ml

@@ -140,8 +140,9 @@ let print ?(src = None) ~message_kind intro ppf (loc : t) =
          branch might not be reached (aka no inline file content display) so
          we don't wanna end up with two line breaks in the the consequent *)
       fprintf ppf "@,%s"
-        (Code_frame.print ~is_warning:(message_kind = `warning) ~src
-           ~start_pos:loc.loc_start ~end_pos:loc.loc_end)
+        (Code_frame.print ~draw_underline:false
+           ~is_warning:(message_kind = `warning) ~src ~start_pos:loc.loc_start
+           ~end_pos:loc.loc_end)
     with
     (* this might happen if the file is e.g. "", "_none_" or any of the fake file name placeholders.
        we've already printed the location above, so nothing more to do here. *)

tests/analysis_new_tests/tests/test_files/__snapshots__/RecordFieldCompletions.res_Record_field_completion_in_nested_record.snap

@@ -1,10 +1,10 @@
 Found Completable: Cexpression
 
-1 + // Record field completion in nested record
-2 + let x = TestTypeDefs.nestedTestRecord.
-            ----------------------------- 
-3 + //                                    ^com
-4 + 
+  1 │ // Record field completion in nested record
+  2 │ let x = TestTypeDefs.nestedTestRecord.
+    │         ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
+  3 │ //                                    ^com
+  4 │ 
 
 [{
     "label": "test",

tests/analysis_new_tests/tests/test_files/__snapshots__/RecordFieldCompletions.res_Record_field_completion_in_nested_record_another_level.snap

@@ -1,10 +1,10 @@
 Found Completable: Cexpression
 
-1 + // Record field completion in nested record, another level
-2 + let x = TestTypeDefs.nestedTestRecord.nested.
-            ------------------------------------ 
-3 + //                                           ^com
-4 + 
+  1 │ // Record field completion in nested record, another level
+  2 │ let x = TestTypeDefs.nestedTestRecord.nested.
+    │         ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
+  3 │ //                                           ^com
+  4 │ 
 
 [{
     "label": "name",

tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_array.snap

@@ -1,13 +1,11 @@
 Found Completable: Cpattern
 
-1 + // Empty case, array
-2 + let someStringArr = ["hello"]
-3 + 
-4 + let x = switch someStringArr {
-                   -------------  
-5 +   | 
-6 + //  ^com
-7 + }
+  2 │ let someStringArr = ["hello"]
+  3 │ 
+  4 │ let x = switch someStringArr {
+    │                ‾‾‾‾‾‾‾‾‾‾‾‾‾
+  5 │   | 
+  6 │ //  ^com
 
 [{
     "label": "[]",

tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_bool.snap

@@ -1,11 +1,10 @@
 Found Completable: Cpattern
 
-1 + // Empty case, bool
-2 + let x = switch true {
-                   ----  
-3 +   | 
-4 + //  ^com
-5 + }
+  1 │ // Empty case, bool
+  2 │ let x = switch true {
+    │                ‾‾‾‾
+  3 │   | 
+  4 │ //  ^com
 
 [{
     "label": "true",

tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_record.snap

@@ -1,11 +1,10 @@
 Found Completable: Cpattern
 
-1 + // Empty case, record
-2 + let x = switch TestTypeDefs.nestedTestRecord {
-                   -----------------------------  
-3 +   | 
-4 + //  ^com
-5 + }
+  1 │ // Empty case, record
+  2 │ let x = switch TestTypeDefs.nestedTestRecord {
+    │                ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
+  3 │   | 
+  4 │ //  ^com
 
 [{
     "label": "{}",

tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_string.snap

@@ -1,12 +1,11 @@
 Found Completable: Cpattern
 
-1 + // Empty case, string
-2 + let str = "hello"
-3 + let x = switch str {
-                   ---  
-4 +   | 
-5 + //  ^com
-6 + }
+  1 │ // Empty case, string
+  2 │ let str = "hello"
+  3 │ let x = switch str {
+    │                ‾‾‾
+  4 │   | 
+  5 │ //  ^com
 
 [{
     "label": "\"\"",