fix: --ignore-promoted-rules should work on internal rules

Internal promotion rules such as generating opam files weren't being
ignored under --ignored-promoted-rules.

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

<!-- ps-id: af82808a-164d-4f37-aefc-155d2b6b4eca -->

Author: rgrinberg

doc/changes/8518.md

@@ -0,0 +1,2 @@
+- Ignore internal promote rules when `--ignore-promoted-rules` is set (#8518,
+  fix #8417, @rgrinberg)

src/dune_rules/dune_file.ml

@@ -2463,21 +2463,12 @@ type t =
   ; stanzas : Stanzas.t
   }
 
-let is_promoted_rule =
-  let is_promoted_mode version = function
-    | Rule.Mode.Promote { only = None; lifetime; _ } ->
-      if version >= (3, 5)
-      then (
-        match lifetime with
-        | Unlimited -> true
-        | Until_clean -> false)
-      else true
-    | _ -> false
-  in
-  fun version rule ->
-    match rule with
-    | Rule { mode; _ } | Menhir_stanza.T { mode; _ } -> is_promoted_mode version mode
-    | _ -> false
+let is_promoted_rule version rule =
+  match rule with
+  | Rule { mode; _ } | Menhir_stanza.T { mode; _ } ->
+    let until_clean = if version >= (3, 5) then `Keep else `Ignore in
+    Rule_mode_decoder.is_ignored mode ~until_clean
+  | _ -> false
 ;;
 
 let parse sexps ~dir ~file ~project =

src/dune_rules/rule_mode_decoder.ml

@@ -99,3 +99,15 @@ end
 
 let decode = sum mode_decoders
 let field = field "mode" decode ~default:Rule.Mode.Standard
+
+let is_ignored (mode : Rule.Mode.t) ~until_clean =
+  !Clflags.ignore_promoted_rules
+  &&
+  match mode with
+  | Promote { only = None; lifetime = Unlimited; _ } -> true
+  | Promote { only = None; lifetime = Until_clean; _ } ->
+    (match until_clean with
+     | `Ignore -> true
+     | `Keep -> false)
+  | _ -> false
+;;

src/dune_rules/rule_mode_decoder.mli

@@ -15,3 +15,4 @@ end
 
 val decode : Rule.Mode.t Dune_lang.Decoder.t
 val field : Rule.Mode.t Dune_lang.Decoder.fields_parser
+val is_ignored : Rule.Mode.t -> until_clean:[ `Ignore | `Keep ] -> bool

src/dune_rules/simple_rules.ml

@@ -134,9 +134,7 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) =
       else action
     in
     (match rule_kind ~rule ~action with
-     | No_alias ->
-       let+ targets = add_user_rule sctx ~dir ~rule ~action ~expander in
-       Some targets
+     | No_alias -> add_user_rule sctx ~dir ~rule ~action ~expander
      | Aliases_with_targets (aliases, alias_target) ->
        let* () =
          let aliases = List.map ~f:(Alias.make ~dir) aliases in
@@ -145,8 +143,7 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) =
              alias
              (Action_builder.path (Path.build alias_target)))
        in
-       let+ targets = add_user_rule sctx ~dir ~rule ~action ~expander in
-       Some targets
+       add_user_rule sctx ~dir ~rule ~action ~expander
      | Aliases_only aliases ->
        let aliases = List.map ~f:(Alias.make ~dir) aliases in
        let* action = interpret_and_add_locks ~expander rule.locks action.build in

src/dune_rules/super_context.ml

@@ -255,24 +255,31 @@ let extend_action t ~dir build =
 ;;
 
 let make_rule t ?mode ?loc ~dir { Action_builder.With_targets.build; targets } =
-  let build = extend_action t build ~dir in
-  Rule.make
-    ?mode
-    ~info:(Rule.Info.of_loc_opt loc)
-    ~context:(Some (Context.build_context (Env_tree.context t)))
-    ~targets
-    build
+  match mode with
+  | Some mode when Rule_mode_decoder.is_ignored mode ~until_clean:`Keep -> None
+  | _ ->
+    let build = extend_action t build ~dir in
+    Some
+      (Rule.make
+         ?mode
+         ~info:(Rule.Info.of_loc_opt loc)
+         ~context:(Some (Context.build_context (Env_tree.context t)))
+         ~targets
+         build)
 ;;
 
 let add_rule t ?mode ?loc ~dir build =
-  let rule = make_rule t ?mode ?loc ~dir build in
-  Rules.Produce.rule rule
+  match make_rule t ?mode ?loc ~dir build with
+  | None -> Memo.return ()
+  | Some rule -> Rules.Produce.rule rule
 ;;
 
 let add_rule_get_targets t ?mode ?loc ~dir build =
-  let rule = make_rule t ?mode ?loc ~dir build in
-  let+ () = Rules.Produce.rule rule in
-  rule.targets
+  match make_rule t ?mode ?loc ~dir build with
+  | None -> Memo.return None
+  | Some rule ->
+    let+ () = Rules.Produce.rule rule in
+    Some rule.targets
 ;;
 
 let add_rules t ?loc ~dir builds = Memo.parallel_iter builds ~f:(add_rule ?loc t ~dir)

src/dune_rules/super_context.mli

@@ -69,7 +69,7 @@ val add_rule_get_targets
   -> ?loc:Loc.t
   -> dir:Path.Build.t
   -> Action.Full.t Action_builder.With_targets.t
-  -> Targets.Validated.t Memo.t
+  -> Targets.Validated.t option Memo.t
 
 val add_rules
   :  t

test/blackbox-tests/test-cases/ignore-promoted-rules-internal-rules.t renamed to test/blackbox-tests/test-cases/ignore-promoted-internal-rules.t

@@ -19,4 +19,4 @@ This should not modify the file now
 
   $ dune build --ignore-promoted-rules foo.opam
   $ grep extra foo.opam
-  [1]
+  foobar_extra