From dba52c2bc83adb266f38f21cc9064f92b12af0ea Mon Sep 17 00:00:00 2001
From: Liam Stevenson <lstevenson@janestreet.com>
Date: Tue, 4 Mar 2025 10:56:32 -0500
Subject: [PATCH] Adapt to additionnal occurrences staleness information
 (#1488)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* Use new occurrences api

* Update ci to use Merlin branch

* Update pin now that the merlin PR is merged

* Filter stale occurrences when renaming

* Also filter-out stale occurrences for references and prepare-rename

---------

Co-authored-by: Ulysse Gérard <thevoodoos@gmail.com>
---
 .github/workflows/build-and-test.yml     |  2 +-
 ocaml-lsp-server/src/ocaml_lsp_server.ml | 46 +++++++++++++-----------
 ocaml-lsp-server/src/rename.ml           | 10 +++++-
 3 files changed, 36 insertions(+), 22 deletions(-)

diff --git a/.github/workflows/build-and-test.yml b/.github/workflows/build-and-test.yml
index d32d6b253..61b15b91e 100644
--- a/.github/workflows/build-and-test.yml
+++ b/.github/workflows/build-and-test.yml
@@ -49,7 +49,7 @@ jobs:
 
       # Remove this pin once a compatible version of Merlin has been released
       - name: Pin dev Merlin
-        run: opam --cli=2.1 pin --with-version=5.4-503 https://github.com/liam923/merlin.git#rename-holes
+        run: opam --cli=2.1 pin --with-version=5.4-503 https://github.com/ocaml/merlin.git#main
 
       - name: Build and install dependencies
         run: opam install .
diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml
index 4d2fe1b0a..d07db779b 100644
--- a/ocaml-lsp-server/src/ocaml_lsp_server.ml
+++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml
@@ -424,7 +424,7 @@ let references
   match Document.kind doc with
   | `Other -> Fiber.return None
   | `Merlin doc ->
-    let* locs, synced =
+    let* occurrences, synced =
       Document.Merlin.dispatch_exn
         ~name:"occurrences"
         doc
@@ -445,20 +445,22 @@ let references
       | _ -> Fiber.return ()
     in
     Some
-      (List.map locs ~f:(fun loc ->
-         let range = Range.of_loc loc in
-         let uri =
-           match loc.loc_start.pos_fname with
-           | "" -> uri
-           | path -> Uri.of_path path
-         in
-         Log.log ~section:"debug" (fun () ->
-           Log.msg
-             "merlin returned fname %a"
-             [ "pos_fname", `String loc.loc_start.pos_fname
-             ; "uri", `String (Uri.to_string uri)
-             ]);
-         { Location.uri; range }))
+      (List.filter_map occurrences ~f:(function
+         | { loc = _; is_stale = true } -> None
+         | { loc; is_stale = false } ->
+           let range = Range.of_loc loc in
+           let uri =
+             match loc.loc_start.pos_fname with
+             | "" -> uri
+             | path -> Uri.of_path path
+           in
+           Log.log ~section:"debug" (fun () ->
+             Log.msg
+               "merlin returned fname %a"
+               [ "pos_fname", `String loc.loc_start.pos_fname
+               ; "uri", `String (Uri.to_string uri)
+               ]);
+           Some { Location.uri; range }))
 ;;
 
 let highlight
@@ -470,14 +472,15 @@ let highlight
   match Document.kind doc with
   | `Other -> Fiber.return None
   | `Merlin m ->
-    let+ locs, _synced =
+    let+ occurrences, _synced =
       Document.Merlin.dispatch_exn
         ~name:"occurrences"
         m
         (Occurrences (`Ident_at (Position.logical position), `Buffer))
     in
     let lsp_locs =
-      List.filter_map locs ~f:(fun loc ->
+      List.filter_map occurrences ~f:(fun (occurrence : Query_protocol.occurrence) ->
+        let loc = occurrence.loc in
         let range = Range.of_loc loc in
         (* filter out multi-line ranges, since those are very noisy and happen
            a lot with certain PPXs *)
@@ -660,16 +663,19 @@ let on_request
          match Document.kind doc with
          | `Other -> Fiber.return None
          | `Merlin doc ->
-           let+ locs, _synced =
+           let+ occurrences, _synced =
              Document.Merlin.dispatch_exn
                ~name:"occurrences"
                doc
                (Occurrences (`Ident_at (Position.logical position), `Buffer))
            in
            let loc =
-             List.find_opt locs ~f:(fun loc ->
+             List.find_map occurrences ~f:(fun (occurrence : Query_protocol.occurrence) ->
+               let loc = occurrence.loc in
                let range = Range.of_loc loc in
-               Position.compare_inclusion position range = `Inside)
+               match occurrence.is_stale, Position.compare_inclusion position range with
+               | false, `Inside -> Some loc
+               | true, _ | _, `Outside _ -> None)
            in
            Option.map loc ~f:Range.of_loc)
       ()
diff --git a/ocaml-lsp-server/src/rename.ml b/ocaml-lsp-server/src/rename.ml
index 6563ea9da..2f3815069 100644
--- a/ocaml-lsp-server/src/rename.ml
+++ b/ocaml-lsp-server/src/rename.ml
@@ -10,7 +10,15 @@ let rename (state : State.t) { RenameParams.textDocument = { uri }; position; ne
     let command =
       Query_protocol.Occurrences (`Ident_at (Position.logical position), `Renaming)
     in
-    let+ locs, _desync = Document.Merlin.dispatch_exn ~name:"rename" merlin command in
+    let+ occurrences, _desync =
+      Document.Merlin.dispatch_exn ~name:"rename" merlin command
+    in
+    let locs =
+      List.filter_map occurrences ~f:(fun (occurrence : Query_protocol.occurrence) ->
+        match occurrence.is_stale with
+        | true -> None
+        | false -> Some occurrence.loc)
+    in
     let version = Document.version doc in
     let uri = Document.uri doc in
     let edits =