Use Only_packages.get to filter

Signed-off-by: Etienne Millon <[email protected]>
ocaml · Jun 4, 2021 · d32b25b · d32b25b
1 parent 5024b0b
commit d32b25b
Show file tree

Hide file tree

Showing 4 changed files with 96 additions and 113 deletions.
diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml
@@ -2074,14 +2074,6 @@ module Generate_sites_module = struct
        { loc; module_; sourceroot; relocatable; sites; plugins })
 end
 
-module Package_proxy = struct
-  type Stanza.t +=
-    | T of
-        { package : Package.t option
-        ; stanza : Stanza.t
-        }
-end
-
 type Stanza.t +=
   | Library of Library.t
   | Foreign_library of Foreign.Library.t
@@ -2272,7 +2264,6 @@ let stanza_package = function
   | Tests { package = Some package; _ } ->
     Some package
   | Coq_stanza.Theory.T { package = Some package; _ } -> Some package
-  | Package_proxy.T { package; _ } -> package
   | _ -> None
 
 type t =

diff --git a/src/dune_rules/dune_file.mli b/src/dune_rules/dune_file.mli
@@ -405,19 +405,6 @@ module Generate_sites_module : sig
     }
 end
 
-module Package_proxy : sig
-  (** A wrapper to implement the (package) field on a stanza that does not
-      support it. This also helps with dependency cycles since [stanza_package]
-      (used to filter irrelevant stanzas) is part of [Dune_file] and can not
-      depend on all stanzas. *)
-
-  type Stanza.t +=
-    | T of
-        { package : Package.t option
-        ; stanza : Stanza.t
-        }
-end
-
 type Stanza.t +=
   | Library of Library.t
   | Foreign_library of Foreign.Library.t

diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml
@@ -68,90 +68,86 @@ end = struct
   let of_stanza stanza ~sctx ~src_dir ~ctx_dir ~scope ~dir_contents ~expander
       ~files_to_install =
     let dir = ctx_dir in
-    let rec go stanza =
-      match stanza with
-      | Toplevel toplevel ->
-        let+ () = Toplevel_rules.setup ~sctx ~dir ~toplevel in
-        empty_none
-      | Library lib
-        when Lib.DB.available (Scope.libs scope)
-               (Dune_file.Library.best_name lib) ->
-        let+ cctx, merlin =
-          Lib_rules.rules lib ~sctx ~dir ~scope ~dir_contents ~expander
-        in
-        { merlin = Some merlin
-        ; cctx = Some (lib.buildable.loc, cctx)
-        ; js = None
-        ; source_dirs = None
-        }
-      | Foreign_library lib ->
-        let+ () =
-          Lib_rules.foreign_rules lib ~sctx ~dir ~dir_contents ~expander
+    match stanza with
+    | Toplevel toplevel ->
+      let+ () = Toplevel_rules.setup ~sctx ~dir ~toplevel in
+      empty_none
+    | Library lib
+      when Lib.DB.available (Scope.libs scope) (Dune_file.Library.best_name lib)
+      ->
+      let+ cctx, merlin =
+        Lib_rules.rules lib ~sctx ~dir ~scope ~dir_contents ~expander
+      in
+      { merlin = Some merlin
+      ; cctx = Some (lib.buildable.loc, cctx)
+      ; js = None
+      ; source_dirs = None
+      }
+    | Foreign_library lib ->
+      let+ () =
+        Lib_rules.foreign_rules lib ~sctx ~dir ~dir_contents ~expander
+      in
+      empty_none
+    | Executables exes -> (
+      Expander.eval_blang expander exes.enabled_if >>= function
+      | false -> Memo.Build.return empty_none
+      | true ->
+        let* () =
+          Memo.Build.Option.iter exes.install_conf ~f:files_to_install
         in
-        empty_none
-      | Executables exes -> (
-        Expander.eval_blang expander exes.enabled_if >>= function
-        | false -> Memo.Build.return empty_none
-        | true ->
-          let* () =
-            Memo.Build.Option.iter exes.install_conf ~f:files_to_install
-          in
-          let+ cctx, merlin =
-            Exe_rules.rules exes ~sctx ~dir ~scope ~expander ~dir_contents
-          in
-          { merlin = Some merlin
-          ; cctx = Some (exes.buildable.loc, cctx)
-          ; js =
-              Some
-                (List.concat_map exes.names ~f:(fun (_, exe) ->
-                     List.map
-                       [ exe ^ ".bc.js"; exe ^ ".bc.runtime.js" ]
-                       ~f:(Path.Build.relative dir)))
-          ; source_dirs = None
-          })
-      | Alias alias ->
-        let+ () = Simple_rules.alias sctx alias ~dir ~expander in
-        empty_none
-      | Tests tests ->
         let+ cctx, merlin =
-          Test_rules.rules tests ~sctx ~dir ~scope ~expander ~dir_contents
+          Exe_rules.rules exes ~sctx ~dir ~scope ~expander ~dir_contents
         in
         { merlin = Some merlin
-        ; cctx = Some (tests.exes.buildable.loc, cctx)
-        ; js = None
-        ; source_dirs = None
-        }
-      | Copy_files { files = glob; _ } ->
-        let* source_dirs =
-          let loc = String_with_vars.loc glob in
-          let+ src_glob = Expander.No_deps.expand_str expander glob in
-          if Filename.is_relative src_glob then
+        ; cctx = Some (exes.buildable.loc, cctx)
+        ; js =
             Some
-              (Path.Source.relative src_dir src_glob ~error_loc:loc
-              |> Path.Source.parent_exn)
-          else
-            None
-        in
-        Memo.Build.return { merlin = None; cctx = None; js = None; source_dirs }
-      | Install i ->
-        let+ () = files_to_install i in
-        empty_none
-      | Plugin p ->
-        let+ () = Plugin_rules.setup_rules ~sctx ~dir p in
-        empty_none
-      | Cinaps.T cinaps ->
-        let+ () = Cinaps.gen_rules sctx cinaps ~dir ~scope in
-        empty_none
-      | Mdx.T mdx -> (
-        Expander.eval_blang expander (Mdx.enabled_if mdx) >>= function
-        | false -> Memo.Build.return empty_none
-        | true ->
-          let+ () = Mdx.gen_rules ~sctx ~dir ~expander mdx in
-          empty_none)
-      | Package_proxy.T { stanza; _ } -> go stanza
-      | _ -> Memo.Build.return empty_none
-    in
-    go stanza
+              (List.concat_map exes.names ~f:(fun (_, exe) ->
+                   List.map
+                     [ exe ^ ".bc.js"; exe ^ ".bc.runtime.js" ]
+                     ~f:(Path.Build.relative dir)))
+        ; source_dirs = None
+        })
+    | Alias alias ->
+      let+ () = Simple_rules.alias sctx alias ~dir ~expander in
+      empty_none
+    | Tests tests ->
+      let+ cctx, merlin =
+        Test_rules.rules tests ~sctx ~dir ~scope ~expander ~dir_contents
+      in
+      { merlin = Some merlin
+      ; cctx = Some (tests.exes.buildable.loc, cctx)
+      ; js = None
+      ; source_dirs = None
+      }
+    | Copy_files { files = glob; _ } ->
+      let* source_dirs =
+        let loc = String_with_vars.loc glob in
+        let+ src_glob = Expander.No_deps.expand_str expander glob in
+        if Filename.is_relative src_glob then
+          Some
+            (Path.Source.relative src_dir src_glob ~error_loc:loc
+            |> Path.Source.parent_exn)
+        else
+          None
+      in
+      Memo.Build.return { merlin = None; cctx = None; js = None; source_dirs }
+    | Install i ->
+      let+ () = files_to_install i in
+      empty_none
+    | Plugin p ->
+      let+ () = Plugin_rules.setup_rules ~sctx ~dir p in
+      empty_none
+    | Cinaps.T cinaps ->
+      let+ () = Cinaps.gen_rules sctx cinaps ~dir ~scope in
+      empty_none
+    | Mdx.T mdx -> (
+      Expander.eval_blang expander (Mdx.enabled_if mdx) >>= function
+      | false -> Memo.Build.return empty_none
+      | true ->
+        let+ () = Mdx.gen_rules ~sctx ~dir ~expander mdx in
+        empty_none)
+    | _ -> Memo.Build.return empty_none
 
   let of_stanzas stanzas ~cctxs ~sctx ~src_dir ~ctx_dir ~scope ~dir_contents
       ~expander ~files_to_install =

diff --git a/src/dune_rules/mdx.ml b/src/dune_rules/mdx.ml
@@ -127,6 +127,7 @@ type t =
   ; packages : (Loc.t * Package.Name.t) list
   ; preludes : Prelude.t list
   ; enabled_if : Blang.t
+  ; package : Package.t option
   }
 
 let enabled_if t = t.enabled_if
@@ -157,17 +158,13 @@ let decode =
        Stanza_common.Pkg.field_opt ()
          ~check:(Dune_lang.Syntax.since Stanza.syntax (2, 9))
      in
-     (package, { loc; files; packages; preludes; enabled_if }))
+     { loc; files; packages; preludes; enabled_if; package })
 
 let () =
   let open Dune_lang.Decoder in
   let decode = Dune_lang.Syntax.since Stanza.syntax (2, 4) >>> decode in
   Dune_project.Extension.register_simple syntax
-    (return
-       [ ( "mdx"
-         , decode >>| fun (package, x) ->
-           [ Dune_file.Package_proxy.T { package; stanza = T x } ] )
-       ])
+    (return [ ("mdx", decode >>| fun x -> [ T x ]) ])
 
 (** Returns the list of files (in _build) to be passed to mdx for the given
     stanza and context *)
@@ -235,10 +232,22 @@ let gen_rules_for_single_file stanza ~sctx ~dir ~expander ~mdx_prog src =
 (** Generates the rules for a given mdx stanza *)
 let gen_rules t ~sctx ~dir ~expander =
   let open Memo.Build.O in
-  let* files_to_mdx = files_to_mdx t ~sctx ~dir
-  and* mdx_prog =
-    Super_context.resolve_program sctx ~dir ~loc:(Some t.loc)
-      ~hint:"opam install mdx" "ocaml-mdx"
+  let register_rules () =
+    let* files_to_mdx = files_to_mdx t ~sctx ~dir
+    and* mdx_prog =
+      Super_context.resolve_program sctx ~dir ~loc:(Some t.loc)
+        ~hint:"opam install mdx" "ocaml-mdx"
+    in
+    Memo.Build.parallel_iter files_to_mdx
+      ~f:(gen_rules_for_single_file t ~sctx ~dir ~expander ~mdx_prog)
+  in
+  let* only_packages = Only_packages.get () in
+  let do_it =
+    match (only_packages, t.package) with
+    | None, _
+    | Some _, None ->
+      true
+    | Some only, Some stanza_package ->
+      Package.Name.Map.mem only (Package.name stanza_package)
   in
-  Memo.Build.parallel_iter files_to_mdx
-    ~f:(gen_rules_for_single_file t ~sctx ~dir ~expander ~mdx_prog)
+  Memo.Build.if_ do_it register_rules