diff --git a/src/dir_status.ml b/src/dir_status.ml index 965bbf46d70..009c02b15e7 100644 --- a/src/dir_status.ml +++ b/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 "" 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,11 +94,15 @@ 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 -> @@ -91,11 +110,16 @@ module DB = struct | 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)) diff --git a/src/dir_status.mli b/src/dir_status.mli index ee2566e0160..2ec45e78923 100644 --- a/src/dir_status.mli +++ b/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