fix: merlin_config when nested dune-{project,workspace} files exist

Author: actionshrimp

ocaml-lsp-server/src/merlin_config.ml

@@ -255,38 +255,45 @@ let find_project_context start_dir =
      need to keep track of this folder because [dune ocaml-merlin] might be
      started from a folder that is a parent of the [workdir]. Thus we cannot
      always use that starting folder as the workdir. *)
-  let map_workdir dir = function
-    | Some dir -> Some dir
-    | None ->
-      (* XXX what's ["dune-file"]? *)
-      let fnames = List.map ~f:(Filename.concat dir) [ "dune"; "dune-file" ] in
-      if List.exists ~f:file_exists fnames then
-        Some dir
-      else
-        None
+  let rec outermost ~dir search_files =
+    let cur_match =
+      search_files
+      |> List.find_map ~f:(fun f ->
+             let fname = Filename.concat dir f in
+             if file_exists fname then
+               Some (dir, fname)
+             else
+               None)
+    in
+    let parent = Filename.dirname dir in
+    if parent = dir then
+      cur_match
+    else
+      match outermost ~dir:parent search_files with
+      | Some outer -> Some outer
+      | None -> cur_match
   in
 
-  let rec loop workdir dir =
-    match
-      List.find_map [ "dune-project"; "dune-workspace" ] ~f:(fun f ->
-          let fname = Filename.concat dir f in
-          if file_exists fname then
-            let workdir = Option.value ~default:dir workdir in
-            Some ({ workdir; process_dir = dir }, fname)
-          else
-            None)
-    with
-    | Some s -> Some s
+  let rec innermost ~dir search_files =
+    let cur_match =
+      search_files
+      |> List.find_opt ~f:(fun f -> file_exists (Filename.concat dir f))
+    in
+    match cur_match with
+    | Some dir -> Some dir
     | None ->
       let parent = Filename.dirname dir in
-      if parent <> dir then
-        (* Was this directory the workdir ? *)
-        let workdir = map_workdir dir workdir in
-        loop workdir parent
-      else
+      if parent = dir then
         None
+      else
+        innermost ~dir:parent search_files
   in
-  loop None start_dir
+  let workdir = innermost ~dir:start_dir [ "dune" ] in
+  match outermost ~dir:start_dir [ "dune-workspace"; "dune-project" ] with
+  | Some (dir, f) ->
+    let workdir = workdir |> Option.value ~default:dir in
+    Some ({ workdir; process_dir = dir }, f)
+  | _ -> None
 
 let get_external_config db (t : Mconfig.t) path =
   let path = Misc.canonicalize_filename path in

ocaml-lsp-server/test/e2e/__tests__/declaration_files/dune

@@ -1,2 +1,3 @@
 (library
- (name declaration_files))
+ (name declaration_files)
+ (libraries inner))

ocaml-lsp-server/test/e2e/__tests__/declaration_files/inner/dune

@@ -0,0 +1,2 @@
+(library
+ (name inner))

ocaml-lsp-server/test/e2e/__tests__/declaration_files/inner/dune-workspace

@@ -0,0 +1 @@
+(lang dune 2.5)

ocaml-lsp-server/test/e2e/__tests__/declaration_files/inner/inner_lib.ml

@@ -0,0 +1 @@
+let x = 2

ocaml-lsp-server/test/e2e/__tests__/declaration_files/inner/inner_lib.mli

@@ -0,0 +1 @@
+val x : int

ocaml-lsp-server/test/e2e/__tests__/declaration_files/inner/inner_main.ml

@@ -0,0 +1 @@
+let y = Inner_lib.x

ocaml-lsp-server/test/e2e/__tests__/declaration_files/main.ml

@@ -1 +1,3 @@
 let y = Lib.x
+
+let z = Inner.Inner_lib.x

ocaml-lsp-server/test/e2e/__tests__/textDocument-declaration.test.ts

@@ -10,16 +10,21 @@ describe("textDocument/declaration", () => {
 
   let testWorkspacePath = path.join(__dirname, "declaration_files/");
 
+  let outerDuneProjectPath = path.join(__dirname, "../../../../dune-project");
+
+
   let createPathForFile = (filename: string) =>
     path.join(testWorkspacePath, filename);
 
   beforeEach(async () => {
+    await fs.rename(outerDuneProjectPath, outerDuneProjectPath + ".bak");
     languageServer = await LanguageServer.startAndInitialize();
   });
 
   afterEach(async () => {
     await LanguageServer.exit(languageServer);
     languageServer = null;
+    await fs.rename(outerDuneProjectPath + ".bak", outerDuneProjectPath);
   });
 
   async function openDocument(filepath) {
@@ -57,5 +62,35 @@ describe("textDocument/declaration", () => {
       start: { character: 0, line: 0 },
     });
     expect(result[0].uri).toEqualUri(testUri(createPathForFile("lib.mli")));
+
+    let resultFromInner = await queryDeclaration(
+      createPathForFile("main.ml"),
+      Types.Position.create(2, 25),
+    );
+
+    expect(resultFromInner.length).toBe(1);
+    expect(resultFromInner[0].range).toMatchObject({
+      end: { character: 0, line: 0 },
+      start: { character: 0, line: 0 },
+    });
+    expect(resultFromInner[0].uri).toEqualUri(testUri(createPathForFile("inner/inner_lib.mli")));
+  });
+
+  it("returns location of a declaration in an inner project", async () => {
+    child_process.execSync("dune build", { cwd: testWorkspacePath });
+
+    await openDocument(createPathForFile("inner/inner_main.ml"));
+
+    let result = await queryDeclaration(
+      createPathForFile("inner/inner_main.ml"),
+      Types.Position.create(0, 13),
+    );
+
+    expect(result.length).toBe(1);
+    expect(result[0].range).toMatchObject({
+      end: { character: 0, line: 0 },
+      start: { character: 0, line: 0 },
+    });
+    expect(result[0].uri).toEqualUri(testUri(createPathForFile("inner/inner_lib.mli")));
   });
 });