refactor: declare directory targets without loading rules (#9149)

Signed-off-by: Rudi Grinberg <[email protected]>

src/dune_rules/coq/coq_doc.ml

@@ -0,0 +1,27 @@
+open Import
+open Memo.O
+
+let coqdoc_directory ~mode ~obj_dir ~name =
+  Path.Build.relative
+    obj_dir
+    (Coq_lib_name.to_string name
+     ^
+     match mode with
+     | `Html -> ".html"
+     | `Latex -> ".tex")
+;;
+
+let coqdoc_directory_targets ~dir:obj_dir (theory : Coq_stanza.Theory.t) =
+  let+ (_ : Coq_lib.DB.t) =
+    (* We force the creation of the coq_lib db here so that errors there can
+       appear before any errors to do with directory targets from coqdoc. *)
+    let* scope = Scope.DB.find_by_dir obj_dir in
+    Scope.coq_libs scope
+  in
+  let loc = theory.buildable.loc in
+  let name = snd theory.name in
+  Path.Build.Map.of_list_exn
+    [ coqdoc_directory ~mode:`Html ~obj_dir ~name, loc
+    ; coqdoc_directory ~mode:`Latex ~obj_dir ~name, loc
+    ]
+;;

src/dune_rules/coq/coq_doc.mli

@@ -0,0 +1,15 @@
+open Import
+
+(* This code lives in its own module so that it's usable in [Dir_status]
+   without creating dependency cycles *)
+
+val coqdoc_directory
+  :  mode:[< `Html | `Latex ]
+  -> obj_dir:Path.Build.t
+  -> name:Coq_lib_name.t
+  -> Path.Build.t
+
+val coqdoc_directory_targets
+  :  dir:Path.Build.t
+  -> Coq_stanza.Theory.t
+  -> Loc.t Path.Build.Map.t Memo.t

src/dune_rules/coq/coq_rules.ml

@@ -644,31 +644,6 @@ let source_rule ~sctx theories =
      List.concat l)
 ;;
 
-let coqdoc_directory ~mode ~obj_dir ~name =
-  Path.Build.relative
-    obj_dir
-    (Coq_lib_name.to_string name
-     ^
-     match mode with
-     | `Html -> ".html"
-     | `Latex -> ".tex")
-;;
-
-let coqdoc_directory_targets ~dir:obj_dir (theory : Coq_stanza.Theory.t) =
-  let+ (_ : Coq_lib.DB.t) =
-    (* We force the creation of the coq_lib db here so that errors there can
-       appear before any errors to do with directory targets from coqdoc. *)
-    let* scope = Scope.DB.find_by_dir obj_dir in
-    Scope.coq_libs scope
-  in
-  let loc = theory.buildable.loc in
-  let name = snd theory.name in
-  Path.Build.Map.of_list_exn
-    [ coqdoc_directory ~mode:`Html ~obj_dir ~name, loc
-    ; coqdoc_directory ~mode:`Latex ~obj_dir ~name, loc
-    ]
-;;
-
 let setup_coqdoc_rules ~sctx ~dir ~theories_deps (s : Coq_stanza.Theory.t) coq_modules =
   let loc, name = s.buildable.loc, snd s.name in
   let rule =
@@ -691,7 +666,7 @@ let setup_coqdoc_rules ~sctx ~dir ~theories_deps (s : Coq_stanza.Theory.t) coq_m
             ~loc:(Some loc)
             ~hint:"opam install coq"
         in
-        (let doc_dir = coqdoc_directory ~mode ~obj_dir:dir ~name in
+        (let doc_dir = Coq_doc.coqdoc_directory ~mode ~obj_dir:dir ~name in
          let file_flags =
            let globs =
              let open Action_builder.O in
@@ -752,7 +727,7 @@ let setup_coqdoc_rules ~sctx ~dir ~theories_deps (s : Coq_stanza.Theory.t) coq_m
         | `Html -> Alias.make Alias0.doc ~dir
         | `Latex -> Alias.make (Alias.Name.of_string "doc-latex") ~dir
       in
-      coqdoc_directory ~mode ~obj_dir:dir ~name
+      Coq_doc.coqdoc_directory ~mode ~obj_dir:dir ~name
       |> Path.build
       |> Action_builder.path
       |> Rules.Produce.Alias.add_deps alias ~loc

src/dune_rules/coq/coq_rules.mli

@@ -18,11 +18,6 @@ val deps_of
   -> Coq_module.t
   -> unit Dune_engine.Action_builder.t
 
-val coqdoc_directory_targets
-  :  dir:Path.Build.t
-  -> Coq_stanza.Theory.t
-  -> Loc.t Path.Build.Map.t Memo.t
-
 (** ** Rules for Coq stanzas *)
 
 (**coq.theory stanza rules *)

src/dune_rules/dir_contents.ml

@@ -51,14 +51,10 @@ module Standalone_or_root = struct
     ; rules : Rules.t
     }
 
-  type nonrec t =
-    { directory_targets : Loc.t Path.Build.Map.t
-    ; contents : standalone_or_root Memo.Lazy.t
-    }
+  type nonrec t = { contents : standalone_or_root Memo.Lazy.t }
 
   let empty ~dir =
-    { directory_targets = Path.Build.Map.empty
-    ; contents =
+    { contents =
         Memo.Lazy.create (fun () ->
           Memo.return
             { root = empty Standalone ~dir
@@ -68,8 +64,6 @@ module Standalone_or_root = struct
     }
   ;;
 
-  let directory_targets t = t.directory_targets
-
   let root t =
     let+ contents = Memo.Lazy.force t.contents in
     contents.root
@@ -255,34 +249,6 @@ end = struct
     | false -> Load.get sctx ~dir >>= ocaml
   ;;
 
-  let extract_directory_targets ~dir stanzas =
-    List.fold_left stanzas ~init:Path.Build.Map.empty ~f:(fun acc stanza ->
-      match stanza with
-      | Rule { targets = Static { targets = l; _ }; loc = rule_loc; _ } ->
-        List.fold_left l ~init:acc ~f:(fun acc (target, kind) ->
-          let loc = String_with_vars.loc target in
-          match (kind : Targets_spec.Kind.t) with
-          | File -> acc
-          | Directory ->
-            (match String_with_vars.text_only target with
-             | None ->
-               User_error.raise
-                 ~loc
-                 [ Pp.text "Variables are not allowed in directory targets." ]
-             | Some target ->
-               let dir_target = Path.Build.relative ~error_loc:loc dir target in
-               if Path.Build.is_descendant dir_target ~of_:dir
-               then
-                 (* We ignore duplicates here as duplicates are detected and
-                    reported by [Load_rules]. *)
-                 Path.Build.Map.set acc dir_target rule_loc
-               else
-                 (* This will be checked when we interpret the stanza
-                    completely, so just ignore this rule for now. *)
-                 acc))
-      | _ -> acc)
-  ;;
-
   let human_readable_description dir =
     Pp.textf
       "Computing directory contents of %s"
@@ -291,8 +257,7 @@ end = struct
 
   let make_standalone sctx st_dir ~dir (d : Dune_file.t) =
     let human_readable_description () = human_readable_description dir in
-    { Standalone_or_root.directory_targets = extract_directory_targets ~dir d.stanzas
-    ; contents =
+    { Standalone_or_root.contents =
         Memo.lazy_ ~human_readable_description (fun () ->
           let include_subdirs = Loc.none, Include_subdirs.No in
           let ctx = Super_context.context sctx in
@@ -353,21 +318,6 @@ end = struct
     in
     let loc = loc_of_dune_file source_dir in
     let+ components = components in
-    let directory_targets =
-      let dirs =
-        { Dir_status.Group_component.dir
-        ; path_to_group_root = []
-        ; source_dir
-        ; stanzas = dune_file.stanzas
-        }
-        :: components
-      in
-      List.fold_left
-        dirs
-        ~init:Path.Build.Map.empty
-        ~f:(fun acc { Dir_status.Group_component.dir; stanzas; _ } ->
-          Path.Build.Map.superpose acc (extract_directory_targets ~dir stanzas))
-    in
     let contents =
       Memo.lazy_
         ~human_readable_description:(fun () -> human_readable_description dir)
@@ -454,7 +404,7 @@ end = struct
           ; subdirs = Path.Build.Map.of_list_map_exn subdirs ~f:(fun x -> x.dir, x)
           })
     in
-    { Standalone_or_root.directory_targets; contents }
+    { Standalone_or_root.contents }
   ;;
 
   let get0_impl (sctx, dir) : triage Memo.t =
@@ -485,14 +435,14 @@ end = struct
   let get sctx ~dir =
     Memo.exec memo0 (sctx, dir)
     >>= function
-    | Standalone_or_root { directory_targets = _; contents } ->
+    | Standalone_or_root { contents } ->
       let+ { root; rules = _; subdirs = _ } = Memo.Lazy.force contents in
       root
     | Group_part group_root ->
       Memo.exec memo0 (sctx, group_root)
       >>= (function
        | Group_part _ -> assert false
-       | Standalone_or_root { directory_targets = _; contents } ->
+       | Standalone_or_root { contents } ->
          let+ { root; rules = _; subdirs = _ } = Memo.Lazy.force contents in
          root)
   ;;

src/dune_rules/dir_contents.mli

@@ -44,7 +44,6 @@ module Standalone_or_root : sig
   type dir_contents := t
   type t
 
-  val directory_targets : t -> Loc.t Path.Build.Map.t
   val rules : t -> Rules.t Memo.t
   val root : t -> dir_contents Memo.t
   val subdirs : t -> dir_contents list Memo.t

src/dune_rules/dir_status.ml

@@ -88,6 +88,47 @@ let error_no_module_consumer ~loc (qualification : Include_subdirs.qualification
     ]
 ;;
 
+let extract_directory_targets ~dir stanzas =
+  Memo.List.fold_left stanzas ~init:Path.Build.Map.empty ~f:(fun acc stanza ->
+    match stanza with
+    | Rule { targets = Static { targets = l; _ }; loc = rule_loc; _ } ->
+      List.fold_left l ~init:acc ~f:(fun acc (target, kind) ->
+        let loc = String_with_vars.loc target in
+        match (kind : Targets_spec.Kind.t) with
+        | File -> acc
+        | Directory ->
+          (match String_with_vars.text_only target with
+           | None ->
+             User_error.raise
+               ~loc
+               [ Pp.text "Variables are not allowed in directory targets." ]
+           | Some target ->
+             let dir_target = Path.Build.relative ~error_loc:loc dir target in
+             if Path.Build.is_descendant dir_target ~of_:dir
+             then
+               (* We ignore duplicates here as duplicates are detected and
+                  reported by [Load_rules]. *)
+               Path.Build.Map.set acc dir_target rule_loc
+             else
+               (* This will be checked when we interpret the stanza
+                  completely, so just ignore this rule for now. *)
+               acc))
+      |> Memo.return
+    | Coq_stanza.Theory.T m ->
+      (* It's unfortunate that we need to pull in the coq rules here. But
+         we don't have a generic mechanism for this yet. *)
+      Coq_doc.coqdoc_directory_targets ~dir m
+      >>| Path.Build.Map.union acc ~f:(fun path loc1 loc2 ->
+        User_error.raise
+          ~loc:loc1
+          [ Pp.textf
+              "The following both define the same directory target: %s"
+              (Path.Build.to_string path)
+          ; Pp.enumerate ~f:Loc.pp_file_colon_line [ loc1; loc2 ]
+          ])
+    | _ -> Memo.return acc)
+;;
+
 module rec DB : sig
   val get : dir:Path.Build.t -> t Memo.t
 end = struct
@@ -199,3 +240,19 @@ end = struct
     fun ~dir -> Memo.exec memo dir
   ;;
 end
+
+let directory_targets ~dir =
+  DB.get ~dir
+  >>= function
+  | Standalone (_, dune_file) -> extract_directory_targets ~dir dune_file.stanzas
+  | Group_root { components; dune_file; _ } ->
+    let f ~dir stanzas acc =
+      extract_directory_targets ~dir stanzas >>| Path.Build.Map.superpose acc
+    in
+    let* init = f ~dir dune_file.stanzas Path.Build.Map.empty in
+    components
+    >>= Memo.List.fold_left ~init ~f:(fun acc { Group_component.dir; stanzas; _ } ->
+      f ~dir stanzas acc)
+  | Generated | Source_only _ | Is_component_of_a_group_but_not_the_root _ ->
+    Memo.return Path.Build.Map.empty
+;;

src/dune_rules/dir_status.mli

@@ -40,3 +40,5 @@ type t =
 module DB : sig
   val get : dir:Path.Build.t -> t Memo.t
 end
+
+val directory_targets : dir:Path.Build.t -> Loc.t Path.Build.Map.t Memo.t

src/dune_rules/gen_rules.ml

@@ -299,26 +299,6 @@ let gen_rules_for_stanzas
   cctxs
 ;;
 
-let collect_directory_targets ~init ~dir =
-  Only_packages.stanzas_in_dir dir
-  >>= function
-  | None -> Memo.return init
-  | Some d ->
-    Memo.List.fold_left d.stanzas ~init ~f:(fun acc stanza ->
-      match stanza with
-      | Coq_stanza.Theory.T m ->
-        Coq_rules.coqdoc_directory_targets ~dir m
-        >>| Path.Build.Map.union acc ~f:(fun path loc1 loc2 ->
-          User_error.raise
-            ~loc:loc1
-            [ Pp.textf
-                "The following both define the same directory target: %s"
-                (Path.Build.to_string path)
-            ; Pp.enumerate ~f:Loc.pp_file_colon_line [ loc1; loc2 ]
-            ])
-      | _ -> Memo.return acc)
-;;
-
 let gen_rules sctx dir_contents cctxs ~source_dir ~dir
   : (Loc.t * Compilation_context.t) list Memo.t
   =
@@ -469,10 +449,7 @@ let gen_rules_standalone_or_root sctx standalone_or_root ~dir ~source_dir =
     Rules.union rules rules'
   in
   let+ rules =
-    let+ directory_targets =
-      let init = Dir_contents.Standalone_or_root.directory_targets standalone_or_root in
-      collect_directory_targets ~dir ~init
-    in
+    let+ directory_targets = Dir_status.directory_targets ~dir in
     Gen_rules.rules_for ~dir ~allowed_subdirs:Filename.Set.empty rules ~directory_targets
   in
   Gen_rules.rules_here rules