PoC: emit code actions from the compiler that the editor tooling can use

jscomp/bsc/rescript_compiler_main.ml

@@ -273,6 +273,9 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
     "-bs-ast", unit_call(fun _ ->  Js_config.binary_ast := true; Js_config.syntax_only := true),
     "*internal* Generate binary .mli_ast and ml_ast and stop";
 
+    "-code-action-data", unit_call(fun _ ->  Js_config.code_action_data := true),
+    "*internal* Emit code action data";
+
     "-bs-syntax-only", set Js_config.syntax_only,
     "*internal* Only check syntax";
 

jscomp/common/js_config.ml

@@ -57,6 +57,7 @@ let all_module_aliases = ref false
 let no_stdlib = ref false
 let no_export = ref false
 let as_ppx = ref false
+let code_action_data = ref false
 
 let int_of_jsx_version = function
   | Jsx_v3 -> 3

jscomp/common/js_config.mli

@@ -112,3 +112,5 @@ val as_pp : bool ref
 val self_stack : string Stack.t
 
 val modules : bool ref
+
+val code_action_data : bool ref

jscomp/ml/code_action_data.ml

@@ -0,0 +1,61 @@
+type code_action_type = WrapWith of {left: string; right: string}
+type code_action_style = Regular | QuickFix
+type code_action = {
+  style: code_action_style;
+  type_: code_action_type;
+  title: string;
+}
+
+let code_action_data = ref []
+let add_code_action (data : code_action) =
+  code_action_data := data :: !code_action_data
+let get_code_action_data () = !code_action_data
+
+let escape text =
+  let ln = String.length text in
+  let buf = Buffer.create ln in
+  let rec loop i =
+    if i < ln then (
+      (match text.[i] with
+      | '\012' -> Buffer.add_string buf "\\f"
+      | '\\' -> Buffer.add_string buf "\\\\"
+      | '"' -> Buffer.add_string buf "\\\""
+      | '\n' -> Buffer.add_string buf "\\n"
+      | '\b' -> Buffer.add_string buf "\\b"
+      | '\r' -> Buffer.add_string buf "\\r"
+      | '\t' -> Buffer.add_string buf "\\t"
+      | c -> Buffer.add_char buf c);
+      loop (i + 1))
+  in
+  loop 0;
+  Buffer.contents buf
+
+let loc_to_json loc =
+  Printf.sprintf
+    "{\"start\": {\"line\": %s, \"col\": %s},\"end\": {\"line\": %s, \"col\": \
+     %s}}"
+    (loc.Location.loc_start.pos_lnum |> string_of_int)
+    (loc.loc_start.pos_cnum |> string_of_int)
+    (loc.loc_end.pos_lnum |> string_of_int)
+    (loc.loc_end.pos_cnum |> string_of_int)
+
+let code_action_type_to_json = function
+  | WrapWith {left; right} ->
+    Printf.sprintf "\"type\": \"wrapWith\", \"wrapLeft\": \"%s\", \"wrapRight\": \"%s\""
+      (escape left) (escape right)
+
+let emit_code_actions_data loc ppf =
+  match !code_action_data with
+  | [] -> ()
+  | code_actions ->
+    Format.fprintf ppf "@\n=== CODE ACTIONS ===@\n";
+    code_actions
+    |> List.iter (fun data ->
+           Format.fprintf ppf
+             "{\"title\": \"%s\", \"kind\": \"%s\" \"loc\": %s, %s}"
+             (escape data.title)
+             (match data.style with
+             | Regular -> "regular"
+             | QuickFix -> "quickfix")
+             (loc_to_json loc)
+             (code_action_type_to_json data.type_))

jscomp/ml/code_action_data.mli

@@ -0,0 +1,12 @@
+type code_action_type = WrapWith of {left: string; right: string}
+type code_action_style = Regular | QuickFix
+type code_action = {
+    style: code_action_style;
+    type_: code_action_type;
+    title: string;
+}
+
+val add_code_action: code_action -> unit
+val get_code_action_data: unit -> code_action list
+
+val emit_code_actions_data: Location.t -> Format.formatter -> unit

jscomp/ml/typecore.ml

@@ -636,6 +636,14 @@ let simple_conversions = [
 let print_simple_conversion ppf (actual, expected) =
   try (
     let converter = List.assoc (actual, expected) simple_conversions in
+    Code_action_data.add_code_action {
+      Code_action_data.style = QuickFix; 
+      type_ = WrapWith {
+        left = converter ^ "("; 
+        right = ")"
+      };
+      title = Printf.sprintf "Convert %s to %s" actual expected
+    };
     fprintf ppf "@,@,@[<v 2>You can convert @{<info>%s@} to @{<info>%s@} with @{<info>%s@}.@]" actual expected converter
   ) with | Not_found -> ()
 
@@ -4045,14 +4053,14 @@ let report_error env ppf = function
 let super_report_error_no_wrap_printing_env = report_error
 
 
-let report_error env ppf err =
-  Printtyp.wrap_printing_env env (fun () -> report_error env ppf err)
+let report_error loc env ppf err =
+  Printtyp.wrap_printing_env env (fun () -> report_error env ppf err; Code_action_data.emit_code_actions_data loc ppf;)
 
 let () =
   Location.register_error_of_exn
     (function
       | Error (loc, env, err) ->
-        Some (Location.error_of_printer loc (report_error env) err)
+        Some (Location.error_of_printer loc (report_error loc env) err)
       | Error_forward err ->
         Some err
       | _ ->

jscomp/ml/typecore.mli

@@ -114,7 +114,7 @@ exception Error_forward of Location.error
 val super_report_error_no_wrap_printing_env: Env.t -> formatter -> error -> unit
 
 
-val report_error: Env.t -> formatter -> error -> unit
+val report_error: Location.t -> Env.t -> formatter -> error -> unit
  (* Deprecated.  Use Location.{error_of_exn, report_error}. *)
 
 (* Forward declaration, to be filled in by Typemod.type_module *)