Reanalyze: support rewatch monorepos via root .sourcedirs.json cmt_scan

analysis/reanalyze/src/Paths.ml

@@ -205,3 +205,72 @@ let readSourceDirs ~configSources =
       Log_.item "Types for cross-references will not be found.\n");
     dirs := readDirsFromConfig ~configSources);
   !dirs
+
+type cmt_scan_entry = {
+  build_root: string;
+  scan_dirs: string list;
+  also_scan_build_root: bool;
+}
+(** Read explicit `.cmt/.cmti` scan plan from `.sourcedirs.json`.
+
+    This is a v2 extension produced by `rewatch` to support monorepos without requiring
+    reanalyze-side package resolution.
+
+    The scan plan is a list of build roots (usually `<pkg>/lib/bs`) relative to the project root,
+    plus a list of subdirectories (relative to that build root) to scan for `.cmt/.cmti`.
+
+    If missing, returns the empty list and callers should fall back to legacy behavior. *)
+
+let readCmtScan () =
+  let sourceDirsFile =
+    ["lib"; "bs"; ".sourcedirs.json"]
+    |> List.fold_left Filename.concat runConfig.bsbProjectRoot
+  in
+  let entries = ref [] in
+  let read_entry (json : Ext_json_types.t) =
+    match json with
+    | Ext_json_types.Obj {map} -> (
+      let build_root =
+        match StringMap.find_opt map "build_root" with
+        | Some (Ext_json_types.Str {str}) -> Some str
+        | _ -> None
+      in
+      let scan_dirs =
+        match StringMap.find_opt map "scan_dirs" with
+        | Some (Ext_json_types.Arr {content = arr}) ->
+          arr |> Array.to_list
+          |> List.filter_map (fun x ->
+                 match x with
+                 | Ext_json_types.Str {str} -> Some str
+                 | _ -> None)
+        | _ -> []
+      in
+      let also_scan_build_root =
+        match StringMap.find_opt map "also_scan_build_root" with
+        | Some (Ext_json_types.True _) -> true
+        | Some (Ext_json_types.False _) -> false
+        | _ -> false
+      in
+      match build_root with
+      | Some build_root ->
+        entries := {build_root; scan_dirs; also_scan_build_root} :: !entries
+      | None -> ())
+    | _ -> ()
+  in
+  let read_cmt_scan (json : Ext_json_types.t) =
+    match json with
+    | Ext_json_types.Obj {map} -> (
+      match StringMap.find_opt map "cmt_scan" with
+      | Some (Ext_json_types.Arr {content = arr}) ->
+        arr |> Array.iter read_entry
+      | _ -> ())
+    | _ -> ()
+  in
+  if sourceDirsFile |> Sys.file_exists then (
+    let jsonOpt = sourceDirsFile |> Ext_json_parse.parse_json_from_file in
+    match jsonOpt with
+    | exception _ -> []
+    | json ->
+      read_cmt_scan json;
+      !entries |> List.rev)
+  else []

analysis/reanalyze/src/Reanalyze.ml

@@ -102,28 +102,61 @@ let collectCmtFilePaths ~cmtRoot : string list =
     walkSubDirs ""
   | None ->
     Lazy.force Paths.setReScriptProjectRoot;
-    let lib_bs = runConfig.projectRoot +++ ("lib" +++ "bs") in
-    let sourceDirs =
-      Paths.readSourceDirs ~configSources:None |> List.sort String.compare
-    in
-    sourceDirs
-    |> List.iter (fun sourceDir ->
-           let libBsSourceDir = Filename.concat lib_bs sourceDir in
-           let files =
-             match Sys.readdir libBsSourceDir |> Array.to_list with
-             | files -> files
-             | exception Sys_error _ -> []
-           in
-           let cmtFiles =
-             files
-             |> List.filter (fun x ->
-                    Filename.check_suffix x ".cmt"
-                    || Filename.check_suffix x ".cmti")
-           in
-           cmtFiles |> List.sort String.compare
-           |> List.iter (fun cmtFile ->
-                  let cmtFilePath = Filename.concat libBsSourceDir cmtFile in
-                  paths := cmtFilePath :: !paths)));
+    (* Prefer explicit scan plan emitted by rewatch (v2 `.sourcedirs.json`).
+       This supports monorepos without reanalyze-side package resolution. *)
+    let scan_plan = Paths.readCmtScan () in
+    if scan_plan <> [] then
+      let seen = Hashtbl.create 256 in
+      let add_dir (absDir : string) =
+        let files =
+          match Sys.readdir absDir |> Array.to_list with
+          | files -> files
+          | exception Sys_error _ -> []
+        in
+        files
+        |> List.filter (fun x ->
+               Filename.check_suffix x ".cmt" || Filename.check_suffix x ".cmti")
+        |> List.sort String.compare
+        |> List.iter (fun f ->
+               let p = Filename.concat absDir f in
+               if not (Hashtbl.mem seen p) then (
+                 Hashtbl.add seen p ();
+                 paths := p :: !paths))
+      in
+      scan_plan
+      |> List.iter (fun (entry : Paths.cmt_scan_entry) ->
+             let build_root_abs =
+               Filename.concat runConfig.projectRoot entry.build_root
+             in
+             (* Scan configured subdirs. *)
+             entry.scan_dirs
+             |> List.iter (fun d -> add_dir (Filename.concat build_root_abs d));
+             (* Optionally scan build root itself for namespace/mlmap `.cmt`s. *)
+             if entry.also_scan_build_root then add_dir build_root_abs)
+    else
+      (* Legacy behavior: scan `<projectRoot>/lib/bs/<sourceDir>` based on source dirs. *)
+      let lib_bs = runConfig.projectRoot +++ ("lib" +++ "bs") in
+      let sourceDirs =
+        Paths.readSourceDirs ~configSources:None |> List.sort String.compare
+      in
+      sourceDirs
+      |> List.iter (fun sourceDir ->
+             let libBsSourceDir = Filename.concat lib_bs sourceDir in
+             let files =
+               match Sys.readdir libBsSourceDir |> Array.to_list with
+               | files -> files
+               | exception Sys_error _ -> []
+             in
+             let cmtFiles =
+               files
+               |> List.filter (fun x ->
+                      Filename.check_suffix x ".cmt"
+                      || Filename.check_suffix x ".cmti")
+             in
+             cmtFiles |> List.sort String.compare
+             |> List.iter (fun cmtFile ->
+                    let cmtFilePath = Filename.concat libBsSourceDir cmtFile in
+                    paths := cmtFilePath :: !paths)));
   !paths |> List.rev
 
 (** Process files sequentially *)