fix: factor out build only subdir common functions

Signed-off-by: Antonio Nuno Monteiro <[email protected]>

src/dune_engine/build_config.ml

@@ -12,8 +12,17 @@ module Context_or_install = struct
 end
 
 module Rules = struct
+  module Build_only_sub_dirs = struct
+    type t = Subdir_set.t Path.Build.Map.t
+
+    let union a b =
+      Path.Build.Map.union a b ~f:(fun _ a b -> Some (Subdir_set.union a b))
+
+    let singleton ~dir sub_dirs = Path.Build.Map.singleton dir sub_dirs
+  end
+
   type t =
-    { build_dir_only_sub_dirs : Subdir_set.t Path.Build.Map.t
+    { build_dir_only_sub_dirs : Build_only_sub_dirs.t
     ; directory_targets : Loc.t Path.Build.Map.t
     ; rules : Rules.t Memo.t
     }
@@ -26,8 +35,8 @@ module Rules = struct
 
   let combine_exn r { build_dir_only_sub_dirs; directory_targets; rules } =
     { build_dir_only_sub_dirs =
-        Path.Build.Map.union r.build_dir_only_sub_dirs build_dir_only_sub_dirs
-          ~f:(fun _ a b -> Some (Subdir_set.union a b))
+        Build_only_sub_dirs.union r.build_dir_only_sub_dirs
+          build_dir_only_sub_dirs
     ; directory_targets =
         Path.Build.Map.union_exn r.directory_targets directory_targets
     ; rules =

src/dune_engine/build_config.mli

@@ -14,13 +14,23 @@ end
 
 module Rules : sig
   (** Rules for a given directory. This type is structured so that all generated
-      sub-directories (either directory targets or internal generated
+      sub-directories (either directory targets or internally generated
       directories such as [.ppx]) are known immediately, while the actual build
       rules are computed in a second stage. The staging is to avoid computation
       cycles created during the computation of the rules. *)
 
+  module Build_only_sub_dirs : sig
+    (** The set of either directory targets or internally generated directories,
+        indexed by their parent build directory. *)
+    type t = Subdir_set.t Path.Build.Map.t
+
+    val union : t -> t -> t
+
+    val singleton : dir:Path.Build.t -> Subdir_set.t -> t
+  end
+
   type t =
-    { build_dir_only_sub_dirs : Subdir_set.t Path.Build.Map.t
+    { build_dir_only_sub_dirs : Build_only_sub_dirs.t
           (** Sub-directories that don't exist in the source tree but exists in
               the build directory. This is for internal directories such as
               [.dune] or [.ppx]. *)

src/dune_engine/load_rules.ml

@@ -508,8 +508,8 @@ end = struct
 
     let combine_exn r { build_dir_only_sub_dirs; directory_targets; rules } =
       { build_dir_only_sub_dirs =
-          Path.Build.Map.union r.build_dir_only_sub_dirs build_dir_only_sub_dirs
-            ~f:(fun _ a b -> Some (Subdir_set.union a b))
+          Build_config.Rules.Build_only_sub_dirs.union r.build_dir_only_sub_dirs
+            build_dir_only_sub_dirs
       ; directory_targets =
           Path.Build.Map.union_exn r.directory_targets directory_targets
       ; rules =

src/dune_rules/gen_rules.ml

@@ -375,7 +375,8 @@ let has_rules ~dir subdirs f =
   let rules = Rules.collect_unit f in
   Memo.return
     (Build_config.Rules
-       { build_dir_only_sub_dirs = Path.Build.Map.singleton dir subdirs
+       { build_dir_only_sub_dirs =
+           Build_config.Rules.Build_only_sub_dirs.singleton ~dir subdirs
        ; directory_targets = Path.Build.Map.empty
        ; rules
        })
@@ -412,6 +413,14 @@ let rec under_melange_emit_target ~dir =
       | None -> under_melange_emit_target ~dir:parent
       | Some stanza -> Memo.return @@ Some { stanza_dir = parent; stanza }))
 
+let rules_for ~dir rules =
+  { Build_config.Rules.build_dir_only_sub_dirs =
+      Build_config.Rules.Build_only_sub_dirs.singleton ~dir
+        (Subdir_set.These (automatic_subdirs (Path.Build.explode dir)))
+  ; directory_targets = Path.Build.Map.empty
+  ; rules
+  }
+
 let melange_emit_rules sctx { stanza_dir; stanza } =
   let rules =
     Rules.collect_unit (fun () ->
@@ -420,12 +429,7 @@ let melange_emit_rules sctx { stanza_dir; stanza } =
         Melange_rules.setup_emit_js_rules ~dir_contents ~dir:stanza_dir ~scope
           ~sctx stanza)
   in
-  { Build_config.Rules.build_dir_only_sub_dirs =
-      Path.Build.Map.singleton stanza_dir
-        (Subdir_set.These (automatic_subdirs (Path.Build.explode stanza_dir)))
-  ; directory_targets = Path.Build.Map.empty
-  ; rules
-  }
+  rules_for ~dir:stanza_dir rules
 
 let gen_melange_emit_rules sctx ~dir ({ stanza_dir; stanza } as for_melange) =
   match
@@ -465,15 +469,9 @@ let gen_melange_emit_rules sctx ~dir ({ stanza_dir; stanza } as for_melange) =
                (Path.Source.to_string parent_melange_emit_dir)
            ]))
 
-let empty_rules ~dir =
-  { Build_config.Rules.build_dir_only_sub_dirs =
-      Path.Build.Map.singleton dir
-        (Subdir_set.These (automatic_subdirs (Path.Build.explode dir)))
-  ; directory_targets = Path.Build.Map.empty
-  ; rules = Memo.return Rules.empty
-  }
-
-let gen_melange_emit_rules_or_empty_redirect sctx ~dir = function
+let gen_melange_emit_rules_or_empty_redirect sctx ~dir under_melange_emit =
+  let empty_rules ~dir = rules_for ~dir (Memo.return Rules.empty) in
+  match under_melange_emit with
   | None -> Memo.return Build_config.(Redirect_to_parent (empty_rules ~dir))
   | Some for_melange -> (
     let+ melange_rules = gen_melange_emit_rules sctx ~dir for_melange in
@@ -577,7 +575,7 @@ let gen_rules ~sctx ~dir components : Build_config.gen_rules_result Memo.t =
         let automatic_subdirs = automatic_subdirs components in
         let build_config subdirs =
           { Build_config.Rules.build_dir_only_sub_dirs =
-              Path.Build.Map.singleton dir subdirs
+              Build_config.Rules.Build_only_sub_dirs.singleton ~dir subdirs
           ; directory_targets
           ; rules
           }
@@ -625,7 +623,8 @@ let gen_rules ctx_or_install ~dir components =
         let+ subdirs, rules = Install_rules.symlink_rules sctx ~dir in
         let directory_targets = Rules.directory_targets rules in
         Build_config.Rules
-          { build_dir_only_sub_dirs = Path.Build.Map.singleton dir subdirs
+          { build_dir_only_sub_dirs =
+              Build_config.Rules.Build_only_sub_dirs.singleton ~dir subdirs
           ; directory_targets
           ; rules = Memo.return rules
           })