Support project wide occurrences

ocaml · Jun 5, 2024 · 125f54f · 125f54f
1 parent 3d84dc4
commit 125f54f
Show file tree

Hide file tree

Showing 2 changed files with 34 additions and 8 deletions.
diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml
@@ -436,22 +436,46 @@ let selection_range (state : State.t)
     in
     List.filter_opt ranges
 
-let references (state : State.t)
+let references rpc (state : State.t)
     { ReferenceParams.textDocument = { uri }; position; _ } =
   let doc = Document_store.get state.store uri in
   match Document.kind doc with
   | `Other -> Fiber.return None
   | `Merlin doc ->
-    let+ locs =
+    let* locs, synced =
       Document.Merlin.dispatch_exn
         ~name:"occurrences"
         doc
-        (Occurrences (`Ident_at (Position.logical position), `Buffer))
+        (Occurrences (`Ident_at (Position.logical position), `Project))
+    in
+    let+ () =
+      match synced with
+      | `Out_of_sync _ ->
+        let msg =
+          let message =
+            "The index might be out-of-sync.  If you use Dune you can build \
+             the target `@ocaml-index` to refresh the index."
+          in
+          ShowMessageParams.create ~message ~type_:Warning
+        in
+        task_if_running state.detached ~f:(fun () ->
+            Server.notification rpc (ShowMessage msg))
+      | _ -> Fiber.return ()
     in
     Some
       (List.map locs ~f:(fun loc ->
            let range = Range.of_loc loc in
-           (* using original uri because merlin is looking only in local file *)
+           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 }))
 
 let highlight (state : State.t)
@@ -461,7 +485,7 @@ let highlight (state : State.t)
   match Document.kind doc with
   | `Other -> Fiber.return None
   | `Merlin m ->
-    let+ locs =
+    let+ locs, _synced =
       Document.Merlin.dispatch_exn
         ~name:"occurrences"
         m
@@ -623,7 +647,7 @@ let on_request :
       | Some _ | None -> Hover_req.Default
     in
     later (fun (_ : State.t) () -> Hover_req.handle rpc req mode) ()
-  | TextDocumentReferences req -> later references req
+  | TextDocumentReferences req -> later (references rpc) req
   | TextDocumentCodeLensResolve codeLens -> now codeLens
   | TextDocumentCodeLens req -> (
     match state.configuration.data.codelens with
@@ -653,7 +677,7 @@ let on_request :
         match Document.kind doc with
         | `Other -> Fiber.return None
         | `Merlin doc ->
-          let+ locs =
+          let+ locs, _synced =
             Document.Merlin.dispatch_exn
               ~name:"occurrences"
               doc

diff --git a/ocaml-lsp-server/src/rename.ml b/ocaml-lsp-server/src/rename.ml
@@ -10,7 +10,9 @@ let rename (state : State.t)
     let command =
       Query_protocol.Occurrences (`Ident_at (Position.logical position), `Buffer)
     in
-    let+ locs = Document.Merlin.dispatch_exn ~name:"rename" merlin command in
+    let+ locs, _desync =
+      Document.Merlin.dispatch_exn ~name:"rename" merlin command
+    in
     let version = Document.version doc in
     let source = Document.source doc in
     let edits =