fix(lsp): Add test harness, update named arg code action title, fix c…

…ode action trigger points, do not print LSP warnings (#2134)

compiler/src/language_server/code_action.re

@@ -58,8 +58,8 @@ let explicit_type_annotation = (range, uri, type_str) => {
 
 let named_arg_label = (range, uri, arg_label) => {
   ResponseResult.{
-    title: "Used named argument label",
-    kind: "name-argument-label",
+    title: "Use argument label",
+    kind: "use-argument-label",
     edit: {
       document_changes: [
         {
@@ -79,23 +79,22 @@ let send_code_actions =
   Protocol.response(~id, ResponseResult.to_yojson(Some(code_actions)));
 };
 
-let process_explicit_type_annotation = (uri, results: list(Sourcetree.node)) => {
+let rec process_explicit_type_annotation =
+        (uri, results: list(Sourcetree.node)) => {
   switch (results) {
-  | [Pattern({pattern})]
   | [
-      Pattern({pattern: {pat_desc: TPatAlias({pat_desc: TPatAny}, _, _)}}),
-      Pattern({pattern}),
+      Pattern({pattern: {pat_extra: [], pat_desc: TPatVar(_)} as pattern}),
       ..._,
-    ]
-      when pattern.pat_extra == [] =>
+    ] =>
     let loc = {...pattern.pat_loc, loc_start: pattern.pat_loc.loc_end};
     let type_str = Printtyp.string_of_type_scheme(pattern.pat_type);
     Some(explicit_type_annotation(Utils.loc_to_range(loc), uri, type_str));
+  | [_, ...rest] => process_explicit_type_annotation(uri, rest)
   | _ => None
   };
 };
 
-let process_named_arg_label = (uri, results: list(Sourcetree.node)) => {
+let rec process_named_arg_label = (uri, results: list(Sourcetree.node)) => {
   switch (results) {
   | [Argument({arg_label, label_specified, loc}), ..._] when !label_specified =>
     let loc = {...loc, loc_end: loc.loc_start};
@@ -107,6 +106,7 @@ let process_named_arg_label = (uri, results: list(Sourcetree.node)) => {
       | Default({txt}) => txt
       };
     Some(named_arg_label(Utils.loc_to_range(loc), uri, arg_label));
+  | [_, ...rest] => process_named_arg_label(uri, rest)
   | _ => None
   };
 };

compiler/src/language_server/code_file.re

@@ -53,12 +53,16 @@ let compile_source = (uri, source) => {
   Trace.log("Compiling " ++ filename);
 
   switch (
-    Compile.compile_string(
-      ~is_root_file=true,
-      ~hook=stop_after_typed_well_formed,
-      ~name=filename,
-      source,
-    )
+    Config.preserve_config(() => {
+      // Warnings will be reported in diagnostics so no need to print them
+      Config.print_warnings := false;
+      Compile.compile_string(
+        ~is_root_file=true,
+        ~hook=stop_after_typed_well_formed,
+        ~name=filename,
+        source,
+      );
+    })
   ) {
   | exception exn =>
     switch (Grain_parsing.Location.error_of_exn(exn)) {

compiler/src/language_server/log.re

@@ -0,0 +1,22 @@
+[@deriving (enum, yojson)]
+type message_type =
+  | [@value 1] Error
+  | Warning
+  | Info
+  | Log
+  | Debug;
+
+[@deriving yojson]
+type t = {
+  [@key "type"]
+  type_: int,
+  message: string,
+};
+
+let log = (~message_type=Info, message) => {
+  let type_ = message_type_to_enum(message_type);
+  Protocol.notification(
+    ~method="window/logMessage",
+    to_yojson({message, type_}),
+  );
+};

compiler/src/language_server/utils.re

@@ -1,11 +1,11 @@
 open Grain_utils;
 open Grain_diagnostics;
 let uri_to_filename = (uri: Uri.t): string => {
-  Uri.path(uri);
+  Uri.path(uri) |> Str.replace_first(Str.regexp("^/\\(.\\):"), "\\1:");
 };
 
 let filename_to_uri = (filename: string): Uri.t => {
-  Uri.of_string(filename);
+  Uri.make(~scheme="file", ~host="", ~path=filename, ());
 };
 
 let loc_to_range = (pos: Grain_parsing.Location.t): Protocol.range => {

compiler/test/runner.re

@@ -95,7 +95,7 @@ let extract_anf = ({cstate_desc}) =>
 let compile_string_to_final_anf = (name, s) =>
   extract_anf(compile_string(~hook=stop_after_optimization, ~name, s));
 
-let open_process = args => {
+let open_process = (~stdin_input=?, args) => {
   // We need to run the tests in powershell on Windows to have the correct environment
   let program = Sys.win32 ? "powershell.exe" : "/usr/bin/env";
 
@@ -112,6 +112,13 @@ let open_process = args => {
       Unix.environment(),
     );
 
+  switch (stdin_input) {
+  | None => ()
+  | Some(input) =>
+    output_string(stdin, input);
+    flush(stdin);
+  };
+
   let current_time = Unix.time();
 
   let out_eof = ref(false);
@@ -200,6 +207,14 @@ let doc = (file, arguments) => {
   (out ++ err, code);
 };
 
+let lsp = stdin_input => {
+  let cmd = [|"grain", "lsp"|];
+
+  let (code, out, err) = open_process(~stdin_input, cmd);
+
+  (out ++ err, code);
+};
+
 let module_header = "module Test; ";
 
 let makeSnapshotRunner =
@@ -534,3 +549,155 @@ let makeGrainDocErrorRunner = (test, name, filename, expected, arguments) => {
     },
   );
 };
+
+let lsp_request = json => {
+  let str = Yojson.Safe.to_string(json);
+  let request_len = String.length(str);
+  "Content-Length: " ++ string_of_int(request_len) ++ "\r\n" ++ str ++ "\r\n";
+};
+
+let lsp_expected_response = json => {
+  let str = Yojson.Safe.to_string(json);
+  let request_len = String.length(str);
+  "Content-Length: " ++ string_of_int(request_len) ++ "\r\n\r\n" ++ str;
+};
+
+let lsp_input = (method, params) => {
+  `Assoc([
+    ("jsonrpc", `String("2.0")),
+    ("id", `Int(1)),
+    ("method", `String(method)),
+    ("params", params),
+  ]);
+};
+
+let lsp_notification = (method, params) => {
+  `Assoc([
+    ("jsonrpc", `String("2.0")),
+    ("method", `String(method)),
+    ("params", params),
+  ]);
+};
+
+let lsp_success_response = result => {
+  `Assoc([
+    ("jsonrpc", `String("2.0")),
+    ("id", `Int(1)),
+    ("result", result),
+    ("error", `Null),
+  ]);
+};
+
+let lsp_setup_teardown_requests = (code_uri, code) => {
+  let init_request =
+    lsp_input(
+      "initialize",
+      Yojson.Safe.from_string(
+        {|{"processId":1,"clientInfo":null,"locale":null,"rootUri":null,"trace":"off"}|},
+      ),
+    );
+
+  let open_request =
+    lsp_input(
+      "textDocument/didOpen",
+      `Assoc([
+        (
+          "textDocument",
+          `Assoc([
+            ("uri", `String(code_uri)),
+            ("languageId", `String("grain")),
+            ("version", `Int(1)),
+            ("text", `String(code)),
+          ]),
+        ),
+      ]),
+    );
+
+  let shutdown_request =
+    Yojson.Safe.from_string({|{"jsonrpc":"2.0","id":1,"method":"shutdown"}|});
+
+  let exit_request =
+    Yojson.Safe.from_string({|{"jsonrpc":"2.0","id":1,"method":"exit"}|});
+
+  (
+    lsp_request(init_request) ++ lsp_request(open_request),
+    lsp_request(shutdown_request) ++ lsp_request(exit_request),
+  );
+};
+
+let assert_lsp_responses =
+    (expect, expected_open_diagnostics, ~expected_output=?, result) => {
+  let expected_init_response =
+    lsp_expected_response(
+      lsp_success_response(
+        Yojson.Safe.from_string(
+          {|{"capabilities":{"documentFormattingProvider":true,"textDocumentSync":1,"hoverProvider":true,"definitionProvider":{"linkSupport":true},"typeDefinitionProvider":true,"referencesProvider":false,"documentSymbolProvider":false,"codeActionProvider":true,"codeLensProvider":{"resolveProvider":true},"documentHighlightProvider":false,"documentRangeFormattingProvider":false,"renameProvider":false,"inlayHintProvider":{"resolveProvider":false}}}|},
+        ),
+      ),
+    );
+  let expected_open_response =
+    lsp_expected_response(
+      lsp_notification(
+        "textDocument/publishDiagnostics",
+        expected_open_diagnostics,
+      ),
+    );
+  let expected_begin_response =
+    expected_init_response ++ expected_open_response;
+
+  let expected_exit_response =
+    lsp_expected_response(lsp_success_response(`Null));
+
+  let expected =
+    switch (expected_output) {
+    | None => expected_begin_response ++ expected_exit_response
+    | Some(expected_output) =>
+      let expected_response =
+        lsp_expected_response(lsp_success_response(expected_output));
+      expected_begin_response ++ expected_response ++ expected_exit_response;
+    };
+
+  expect.string(result).toEqual(expected);
+};
+
+let makeLspRunner =
+    (test, name, code_uri, code, request_params, expected_output) => {
+  test(
+    name,
+    ({expect}) => {
+      let (setup_request, teardown_request) =
+        lsp_setup_teardown_requests(code_uri, code);
+
+      let (result, code) =
+        lsp(
+          setup_request ++ lsp_request(request_params) ++ teardown_request,
+        );
+
+      assert_lsp_responses(
+        expect,
+        `Assoc([("uri", `String(code_uri)), ("diagnostics", `List([]))]),
+        ~expected_output,
+        result,
+      );
+
+      expect.int(code).toBe(0);
+    },
+  );
+};
+
+let makeLspDiagnosticsRunner =
+    (test, name, code_uri, code, expected_diagnostics) => {
+  test(
+    name,
+    ({expect}) => {
+      let (setup_request, teardown_request) =
+        lsp_setup_teardown_requests(code_uri, code);
+
+      let (result, code) = lsp(setup_request ++ teardown_request);
+
+      assert_lsp_responses(expect, expected_diagnostics, result);
+
+      expect.int(code).toBe(0);
+    },
+  );
+};

compiler/test/suites/dune

@@ -1,5 +1,5 @@
 (library
  (name Grain_tests_suites)
  (public_name grain-tests.suites)
- (libraries grain grain-tests.framework)
+ (libraries grain grain-tests.framework uri)
  (modules (:standard)))