Make dir_status more informative in the case Is_component_of_a_group_…

…but_not_the_root so you can immediately tell where the root of the group is.

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>

src/dir_status.ml

@@ -2,6 +2,11 @@ open Stdune
 open Dune_file
 
 module T = struct
+  type is_component_of_a_group_but_not_the_root = {
+    group_root : Path.t;
+    stanzas : Stanza.t list Dir_with_dune.t option;
+  }
+
   type t =
     | Standalone of
         (File_tree.Dir.t * Stanza.t list Dir_with_dune.t option) option
@@ -13,17 +18,22 @@ module T = struct
                     * Stanza.t list Dir_with_dune.t
     (* Directory with [(include_subdirs x)] where [x] is not [no] *)
 
-    | Is_component_of_a_group_but_not_the_root of
-        Stanza.t list Dir_with_dune.t option
+    | Is_component_of_a_group_but_not_the_root of is_component_of_a_group_but_not_the_root
     (* Sub-directory of a [Group_root _] *)
 
   let to_sexp _ = Sexp.Atom "<dir-status is opaque>"
 end
 include T
 
-let is_standalone = function
-  | Standalone _ -> true
-  | _ -> false
+type enclosing_group =
+  | No_group
+  | Group_root of Path.t
+
+let current_group dir = function
+  | Standalone _ -> No_group
+  | Group_root _ -> Group_root dir
+  | Is_component_of_a_group_but_not_the_root { group_root; _ } ->
+    Group_root group_root
 
 let get_include_subdirs stanzas =
   List.fold_left stanzas ~init:None ~f:(fun acc stanza ->
@@ -59,18 +69,23 @@ module DB = struct
 
   let get db ~dir =
     let get ~dir = Memo.exec db.fn dir in
+    let enclosing_group ~dir =
+      match Path.parent dir with
+      | None ->
+        No_group
+      | Some parent_dir ->
+        current_group parent_dir (get ~dir:parent_dir)
+    in
     match
       Option.bind (Path.drop_build_context dir)
         ~f:(File_tree.find_dir db.file_tree)
     with
     | None -> begin
-        match Path.parent dir with
-        | None -> Standalone None
-        | Some dir ->
-          if is_standalone (get ~dir) then
-            Standalone None
-          else
-            Is_component_of_a_group_but_not_the_root None
+        match enclosing_group ~dir  with
+        | No_group -> Standalone None
+        | Group_root group_root ->
+          Is_component_of_a_group_but_not_the_root
+            { stanzas = None; group_root }
       end
     | Some ft_dir ->
       let project_root =
@@ -79,23 +94,32 @@ module DB = struct
         |> Path.of_local in
       match stanzas_in db ~dir with
       | None ->
-        if Path.equal dir project_root ||
-           is_standalone (get ~dir:(Path.parent_exn dir)) then
+        if Path.equal dir project_root  then
           Standalone (Some (ft_dir, None))
         else
-          Is_component_of_a_group_but_not_the_root None
+          (match enclosing_group ~dir with
+           | No_group ->
+             Standalone (Some (ft_dir, None))
+           | Group_root group_root ->
+             Is_component_of_a_group_but_not_the_root
+               { stanzas = None; group_root })
       | Some d ->
         match get_include_subdirs d.data with
         | Some Unqualified ->
           Group_root (ft_dir, d)
         | Some No ->
           Standalone (Some (ft_dir, Some d))
         | None ->
-          if dir <> project_root &&
-             not (is_standalone (get ~dir:(Path.parent_exn dir)))
+          if dir <> project_root
           then begin
-            check_no_module_consumer d.data;
-            Is_component_of_a_group_but_not_the_root (Some d)
+            match enclosing_group ~dir with
+            | Group_root group_root ->
+              (
+                check_no_module_consumer d.data;
+                Is_component_of_a_group_but_not_the_root
+                  { stanzas = (Some d); group_root })
+            | No_group ->
+              Standalone (Some (ft_dir, Some d))
           end else
             Standalone (Some (ft_dir, Some d))
 

src/dir_status.mli

@@ -1,5 +1,10 @@
 open Stdune
 
+type is_component_of_a_group_but_not_the_root = {
+  group_root : Path.t;
+  stanzas : Stanza.t list Dir_with_dune.t option;
+}
+
 type t =
   | Standalone of
       (File_tree.Dir.t * Stanza.t list Dir_with_dune.t option) option
@@ -11,8 +16,7 @@ type t =
                   * Stanza.t list Dir_with_dune.t
   (* Directory with [(include_subdirs x)] where [x] is not [no] *)
 
-  | Is_component_of_a_group_but_not_the_root of
-      Stanza.t list Dir_with_dune.t option
+  | Is_component_of_a_group_but_not_the_root of is_component_of_a_group_but_not_the_root
   (* Sub-directory of a [Group_root _] *)
 
 module DB : sig