From 1464507998c53c395b4460592a4ba7ec73bbd782 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Louis=20Roch=C3=A9=20=28Ahrefs=29?= <louis.roche@ahrefs.com>
Date: Sat, 4 Dec 2021 00:39:24 +0800
Subject: [PATCH] feature: increase verbosity on subsequent hover

---
 ocaml-lsp-server/src/ocaml_lsp_server.ml      | 33 ++++++++++++++--
 ocaml-lsp-server/src/state.ml                 |  7 ++++
 ocaml-lsp-server/src/state.mli                |  6 +++
 .../e2e/__tests__/textDocument-hover.test.ts  | 39 +++++++++++++++++++
 4 files changed, 82 insertions(+), 3 deletions(-)

diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml
index 2d794e101..2d3975ec4 100644
--- a/ocaml-lsp-server/src/ocaml_lsp_server.ml
+++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml
@@ -509,9 +509,23 @@ let query_doc doc pos =
     Some s
   | _ -> None
 
-let query_type doc pos =
+let query_type ?(verbosity = 0) doc pos =
   let command = Query_protocol.Type_enclosing (None, pos, None) in
-  let+ res = Document.dispatch_exn doc command in
+  let+ res =
+    Document.with_pipeline_exn doc (fun pipeline ->
+        let pipeline =
+          match verbosity with
+          | 0 -> pipeline
+          | verbosity ->
+            let source = Document.source doc in
+            let config = Mpipeline.final_config pipeline in
+            let config =
+              { config with query = { config.query with verbosity } }
+            in
+            Mpipeline.make config source
+        in
+        Query_commands.dispatch pipeline command)
+  in
   match res with
   | []
   | (_, `Index _, _) :: _ ->
@@ -525,8 +539,21 @@ let hover server (state : State.t)
     Document_store.get store uri
   in
   let pos = Position.logical position in
+  let verbosity =
+    match state.hover_history with
+    | [] -> 0
+    | { uri = h_uri; position = h_pos } :: _ as hist ->
+      if Uri.equal uri h_uri && Ordering.is_eq (Position.compare position h_pos)
+      then
+        List.length hist
+      else (
+        state.hover_history <- [];
+        0
+      )
+  in
+  state.hover_history <- { uri; position } :: state.hover_history;
   (* TODO we shouldn't acquiring the merlin thread twice per request *)
-  let* query_type = query_type doc pos in
+  let* query_type = query_type ~verbosity doc pos in
   match query_type with
   | None -> Fiber.return None
   | Some (loc, typ) ->
diff --git a/ocaml-lsp-server/src/state.ml b/ocaml-lsp-server/src/state.ml
index 940add239..a3fda7b53 100644
--- a/ocaml-lsp-server/src/state.ml
+++ b/ocaml-lsp-server/src/state.ml
@@ -8,6 +8,11 @@ type init =
       ; dune : Dune.t
       }
 
+type hover_history =
+  { uri : Uri.t
+  ; position : Position.t
+  }
+
 type t =
   { store : Document_store.t
   ; merlin : Scheduler.thread
@@ -20,6 +25,7 @@ type t =
   ; ocamlformat_rpc : Ocamlformat_rpc.t
   ; diagnostics : Diagnostics.t
   ; symbols_thread : Scheduler.thread Lazy_fiber.t
+  ; mutable hover_history : hover_history list
   }
 
 let create ~store ~merlin ~detached ~configuration ~ocamlformat ~ocamlformat_rpc
@@ -35,6 +41,7 @@ let create ~store ~merlin ~detached ~configuration ~ocamlformat ~ocamlformat_rpc
   ; ocamlformat_rpc
   ; diagnostics
   ; symbols_thread
+  ; hover_history = []
   }
 
 let initialize_params (state : t) =
diff --git a/ocaml-lsp-server/src/state.mli b/ocaml-lsp-server/src/state.mli
index 9717d25f7..4693cb9ea 100644
--- a/ocaml-lsp-server/src/state.mli
+++ b/ocaml-lsp-server/src/state.mli
@@ -8,6 +8,11 @@ type init =
       ; dune : Dune.t
       }
 
+type hover_history =
+  { uri : Uri.t
+  ; position : Position.t
+  }
+
 type t =
   { store : Document_store.t
   ; merlin : Scheduler.thread
@@ -20,6 +25,7 @@ type t =
   ; ocamlformat_rpc : Ocamlformat_rpc.t
   ; diagnostics : Diagnostics.t
   ; symbols_thread : Scheduler.thread Lazy_fiber.t
+  ; mutable hover_history : hover_history list
   }
 
 val create :
diff --git a/ocaml-lsp-server/test/e2e/__tests__/textDocument-hover.test.ts b/ocaml-lsp-server/test/e2e/__tests__/textDocument-hover.test.ts
index 0652ec7ba..90949ed7a 100644
--- a/ocaml-lsp-server/test/e2e/__tests__/textDocument-hover.test.ts
+++ b/ocaml-lsp-server/test/e2e/__tests__/textDocument-hover.test.ts
@@ -245,6 +245,45 @@ describe("textDocument/hover", () => {
     });
   });
 
+  it("returns type inferred under cursor with increased verbosity", async () => {
+    languageServer = await LanguageServer.startAndInitialize();
+    await languageServer.sendNotification("textDocument/didOpen", {
+      textDocument: Types.TextDocumentItem.create(
+        "file:///test.ml",
+        "ocaml",
+        0,
+        outdent`
+        type t = int
+        let x : t = 1
+        `
+      ),
+    });
+
+    let result0 = await languageServer.sendRequest("textDocument/hover", {
+      textDocument: Types.TextDocumentIdentifier.create("file:///test.ml"),
+      position: Types.Position.create(1, 4),
+    });
+    let result1 = await languageServer.sendRequest("textDocument/hover", {
+      textDocument: Types.TextDocumentIdentifier.create("file:///test.ml"),
+      position: Types.Position.create(1, 4),
+    });
+
+    expect(result0).toMatchObject({
+      contents: { kind: "plaintext", value: "t" },
+      range: {
+        end: { character: 5, line: 1 },
+        start: { character: 4, line: 1 },
+      },
+    });
+    expect(result1).toMatchObject({
+      contents: { kind: "plaintext", value: "int" },
+      range: {
+        end: { character: 5, line: 1 },
+        start: { character: 4, line: 1 },
+      },
+    });
+  });
+
   it("regression test for #343", async () => {
     languageServer = await LanguageServer.startAndInitialize({
       capabilities: {