Add custom request ocamllsp/typedHoles

ocaml-lsp-server/docs/ocamllsp/typedHoles-spec.md

@@ -0,0 +1,53 @@
+# Typed Holes Request
+
+## Description
+
+### A note on stability: 
+
+OCaml-LSP does not guarantee stability for this custom request, meaning the core 
+contributors may change or remove this custom request, as they see necessary.
+
+### What typed holes are
+
+Merlin has a concept of "typed holes" that are syntactically represented as `_`. Files
+that incorporate typed holes are not considered valid OCaml, but Merlin and OCaml-LSP
+support them. One example when such typed holes can occur is when on "destructs" a value,
+e.g., destructing `(Some 1)` will generate code `match Some 1 with Some _ -> _ | None ->
+_`. While the first underscore is a valid "match-all"/wildcard pattern, the rest of
+underscores are typed holes.
+
+### Why this custom request needed
+
+It is reasonable that user wants to jump around such typed holes to be able to edit them.
+This custom request allows clients to know where these holes are and enable jumping around
+them.
+
+## Client capability
+
+nothing that should be noted
+
+## Server capability
+
+property name: `handleTypedHoles`
+
+property type: `boolean`
+
+## Request
+
+- method: `ocamllsp/typedHoles`
+- params:
+
+```json
+{
+  "uri": DocumentUri,
+}
+```
+
+## Response
+
+- result: `Range[]`
+  - empty array if no holes found in the file at the given `URI`
+- error: code and message set in case an exception happens during the
+  `ocamllsp/typedHoles` request.
+  - in case of any errors in finding holes in the file, the handler throws an exception,
+    which is returned from the language server.

ocaml-lsp-server/src/custom_requests/req_typed_holes.ml

@@ -0,0 +1,62 @@
+open Import
+
+let capability = ("handleTypedHoles", `Bool true)
+
+let meth = "ocamllsp/typedHoles"
+
+module Request_params = struct
+  type t = Uri.t
+
+  (* Request params must have the form as in the given string. *)
+  let expected_params = `Assoc [ ("uri", `String "<DocumentUri>") ]
+
+  let t_of_structured_json params : t option =
+    match params with
+    | `Assoc [ ("uri", uri) ] ->
+      let uri = Uri.t_of_yojson uri in
+      Some uri
+    | _ -> None
+
+  let parse_exn (params : Jsonrpc.Message.Structured.t option) : t =
+    let raise_invalid_params ?data ~message () =
+      Jsonrpc.Response.Error.raise
+      @@ Jsonrpc.Response.Error.make ?data
+           ~code:Jsonrpc.Response.Error.Code.InvalidParams ~message ()
+    in
+    match params with
+    | None ->
+      raise_invalid_params ~message:"Expected params but received none" ()
+    | Some params -> (
+      match t_of_structured_json params with
+      | Some uri -> uri
+      | None ->
+        let error_json =
+          `Assoc
+            [ ("params_expected", expected_params)
+            ; ("params_received", (params :> Json.t))
+            ]
+        in
+        raise_invalid_params ~message:"Unxpected parameter format"
+          ~data:error_json ())
+end
+
+let on_request ~(params : Jsonrpc.Message.Structured.t option) (state : State.t)
+    =
+  let uri = Request_params.parse_exn params in
+  let store = state.store in
+  let doc = Document_store.get_opt store uri in
+  match doc with
+  | None ->
+    Jsonrpc.Response.Error.raise
+    @@ Jsonrpc.Response.Error.make
+         ~code:Jsonrpc.Response.Error.Code.InvalidParams
+         ~message:
+           (Printf.sprintf "Document %s wasn't found in the document store"
+              (Uri.to_string uri))
+         ()
+  | Some doc ->
+    let open Fiber.O in
+    let+ holes = Document.dispatch_exn doc Holes in
+    Json.yojson_of_list
+      (fun (loc, _type) -> loc |> Range.of_loc |> Range.yojson_of_t)
+      holes

ocaml-lsp-server/src/custom_requests/req_typed_holes.mli

@@ -0,0 +1,8 @@
+open Import
+
+val capability : string * Json.t
+
+val meth : string
+
+val on_request :
+  params:Jsonrpc.Message.Structured.t option -> State.t -> Json.t Fiber.t

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -52,6 +52,7 @@ let initialize_info : InitializeResult.t =
               [ ("interfaceSpecificLangId", `Bool true)
               ; Req_switch_impl_intf.capability
               ; Req_infer_intf.capability
+              ; Req_typed_holes.capability
               ] )
         ]
     in
@@ -824,6 +825,7 @@ let on_request :
     match
       [ (Req_switch_impl_intf.meth, Req_switch_impl_intf.on_request)
       ; (Req_infer_intf.meth, Req_infer_intf.on_request)
+      ; (Req_typed_holes.meth, Req_typed_holes.on_request)
       ]
       |> List.assoc_opt meth
     with

ocaml-lsp-server/test/e2e/__tests__/ocamllsp-typedHoles.ts

@@ -0,0 +1,115 @@
+import outdent from "outdent";
+import * as LanguageServer from "../src/LanguageServer";
+
+import * as Types from "vscode-languageserver-types";
+
+describe("ocamllsp/typedHoles", () => {
+  let languageServer = null;
+
+  async function openDocument(source: string) {
+    await languageServer.sendNotification("textDocument/didOpen", {
+      textDocument: Types.TextDocumentItem.create(
+        "file:///test.ml",
+        "ocaml",
+        0,
+        source,
+      ),
+    });
+  }
+
+  async function sendTypedHolesReq() {
+    return languageServer.sendRequest("ocamllsp/typedHoles", {
+      uri: "file:///test.ml",
+    });
+  }
+
+  beforeEach(async () => {
+    languageServer = await LanguageServer.startAndInitialize();
+  });
+
+  afterEach(async () => {
+    await LanguageServer.exit(languageServer);
+    languageServer = null;
+  });
+
+  it("empty when no holes in file", async () => {
+    await openDocument(
+      outdent`
+let u = 1
+`,
+    );
+
+    let r = await sendTypedHolesReq();
+    expect(r).toMatchInlineSnapshot(`Array []`);
+  });
+
+  it("one hole", async () => {
+    await openDocument(
+      outdent`
+let k = match () with () -> _
+`,
+    );
+
+    let r = await sendTypedHolesReq();
+    expect(r).toMatchInlineSnapshot(`
+      Array [
+        Object {
+          "end": Object {
+            "character": 29,
+            "line": 0,
+          },
+          "start": Object {
+            "character": 28,
+            "line": 0,
+          },
+        },
+      ]
+    `);
+  });
+
+  it("several holes", async () => {
+    await openDocument(
+      outdent`
+let u =
+  let i = match Some 1 with None -> _ | Some -> _ in
+  let b = match () with () -> _ in
+  ()
+      `,
+    );
+    let r = await sendTypedHolesReq();
+    expect(r).toMatchInlineSnapshot(`
+      Array [
+        Object {
+          "end": Object {
+            "character": 31,
+            "line": 2,
+          },
+          "start": Object {
+            "character": 30,
+            "line": 2,
+          },
+        },
+        Object {
+          "end": Object {
+            "character": 37,
+            "line": 1,
+          },
+          "start": Object {
+            "character": 36,
+            "line": 1,
+          },
+        },
+        Object {
+          "end": Object {
+            "character": 49,
+            "line": 1,
+          },
+          "start": Object {
+            "character": 48,
+            "line": 1,
+          },
+        },
+      ]
+    `);
+  });
+});