feat: expand variables in (promote (into ..))

Signed-off-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>

Author: anmonteiro

src/dune_lang/dune_lang.ml

@@ -58,6 +58,7 @@ module Menhir_env = Menhir_env
 module Dune_env = Dune_env
 module Js_of_ocaml = Js_of_ocaml
 module Menhir = Menhir
+module Rule_mode = Rule_mode
 module Rule_mode_decoder = Rule_mode_decoder
 module Mode_conf = Mode_conf
 module Oxcaml = Oxcaml

src/dune_lang/rule_mode.ml

@@ -0,0 +1,26 @@
+open Import
+module Rule = Dune_engine.Rule
+
+module Promote = struct
+  module Into = struct
+    type t =
+      { loc : Loc.t
+      ; dir : String_with_vars.t
+      }
+  end
+
+  type t =
+    { lifetime : Rule.Promote.Lifetime.t
+    ; into : Into.t option
+    ; only : Filename.t Predicate.t option
+    }
+end
+
+type t =
+  | Standard
+  | Fallback (** Only use this rule if the source files don't exist. *)
+  | Promote of Promote.t (** Silently promote the targets to the source tree. *)
+  | Ignore_source_files
+  (** Just ignore the source files entirely. This is for cases where the
+      targets are promoted only in a specific context, such as for
+      .install files. *)

src/dune_lang/rule_mode.mli

@@ -0,0 +1,25 @@
+open Import
+
+module Promote : sig
+  module Into : sig
+    type t =
+      { loc : Loc.t
+      ; dir : String_with_vars.t
+      }
+  end
+
+  type t =
+    { lifetime : Dune_engine.Rule.Promote.Lifetime.t
+    ; into : Into.t option
+    ; only : Filename.t Predicate.t option
+    }
+end
+
+type t =
+  | Standard
+  | Fallback (** Only use this rule if the source files don't exist. *)
+  | Promote of Promote.t (** Silently promote the targets to the source tree. *)
+  | Ignore_source_files
+  (** Just ignore the source files entirely. This is for cases where the
+      targets are promoted only in a specific context, such as for
+      .install files. *)

src/dune_lang/rule_mode_decoder.ml

@@ -4,11 +4,11 @@ module Rule = Dune_engine.Rule
 
 module Promote = struct
   let into_decode =
-    let+ loc, dir = located relative_file in
-    { Rule.Promote.Into.loc; dir }
+    let+ loc, dir = located String_with_vars.decode in
+    { Rule_mode.Promote.Into.loc; dir }
   ;;
 
-  let decode : Rule.Promote.t Decoder.t =
+  let decode : Rule_mode.Promote.t Decoder.t =
     fields
       (let+ until_clean =
          field_b "until-clean" ~check:(Syntax.since Stanza.syntax (1, 10))
@@ -20,27 +20,27 @@ module Promote = struct
          Option.map only ~f:(fun only ->
            Predicate.create (Predicate_lang.Glob.test only ~standard:Predicate_lang.true_))
        in
-       { Rule.Promote.lifetime = (if until_clean then Until_clean else Unlimited)
+       { Rule_mode.Promote.lifetime = (if until_clean then Until_clean else Unlimited)
        ; into
        ; only
        })
   ;;
 end
 
 let mode_decoders =
-  [ "standard", return Rule.Mode.Standard
-  ; "fallback", return Rule.Mode.Fallback
+  [ "standard", return Rule_mode.Standard
+  ; "fallback", return Rule_mode.Fallback
   ; ( "promote"
     , let+ p = Promote.decode in
-      Rule.Mode.Promote p )
+      Rule_mode.Promote p )
   ; ( "promote-until-clean"
     , let+ () =
         Syntax.deleted_in
           Stanza.syntax
           (3, 0)
           ~extra_info:"Use the (promote (until-clean)) syntax instead."
       in
-      Rule.Mode.Promote { lifetime = Until_clean; into = None; only = None } )
+      Rule_mode.Promote { lifetime = Until_clean; into = None; only = None } )
   ; ( "promote-into"
     , let+ () = Syntax.since Stanza.syntax (1, 8)
       and+ () =
@@ -49,7 +49,7 @@ let mode_decoders =
           (3, 0)
           ~extra_info:"Use the (promote (into <dir>)) syntax instead."
       and+ into = Promote.into_decode in
-      Rule.Mode.Promote { lifetime = Unlimited; into = Some into; only = None } )
+      Rule_mode.Promote { lifetime = Unlimited; into = Some into; only = None } )
   ; ( "promote-until-clean-into"
     , let+ () = Syntax.since Stanza.syntax (1, 8)
       and+ () =
@@ -58,9 +58,9 @@ let mode_decoders =
           (3, 0)
           ~extra_info:"Use the (promote (until-clean) (into <dir>)) syntax instead."
       and+ into = Promote.into_decode in
-      Rule.Mode.Promote { lifetime = Until_clean; into = Some into; only = None } )
+      Rule_mode.Promote { lifetime = Until_clean; into = Some into; only = None } )
   ]
 ;;
 
 let decode = sum mode_decoders
-let field = field "mode" decode ~default:Rule.Mode.Standard
+let field = field "mode" decode ~default:Rule_mode.Standard

src/dune_lang/rule_mode_decoder.mli

@@ -1,10 +1,9 @@
 open Import
-module Rule := Dune_engine.Rule
 
 module Promote : sig
-  val decode : Rule.Promote.t Decoder.t
-  val into_decode : Rule.Promote.Into.t Decoder.t
+  val decode : Rule_mode.Promote.t Decoder.t
+  val into_decode : Rule_mode.Promote.Into.t Decoder.t
 end
 
-val decode : Rule.Mode.t Decoder.t
-val field : Rule.Mode.t Decoder.fields_parser
+val decode : Rule_mode.t Decoder.t
+val field : Rule_mode.t Decoder.fields_parser

src/dune_lang/stanzas/copy_files.ml

@@ -9,7 +9,7 @@ type origin =
 type t =
   { add_line_directive : bool
   ; alias : Alias_name.t option
-  ; mode : Rule.Mode.t
+  ; mode : Rule_mode.t
   ; enabled_if : Blang.t
   ; files : String_with_vars.t
   ; only_sources : Blang.t
@@ -32,7 +32,7 @@ let decode_only_sources =
 let long_form =
   let check = Syntax.since Stanza.syntax (2, 7) in
   let+ alias = field_o "alias" (check >>> Alias.decode)
-  and+ mode = field "mode" ~default:Rule.Mode.Standard (check >>> Rule_mode_decoder.decode)
+  and+ mode = field "mode" ~default:Rule_mode.Standard (check >>> Rule_mode_decoder.decode)
   and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (2, 8)) ()
   and+ files = field "files" (check >>> String_with_vars.decode)
   and+ only_sources =

src/dune_lang/stanzas/copy_files.mli

@@ -7,7 +7,7 @@ type origin =
 type t =
   { add_line_directive : bool
   ; alias : Alias_name.t option
-  ; mode : Dune_engine.Rule.Mode.t
+  ; mode : Rule_mode.t
   ; enabled_if : Blang.t
   ; files : String_with_vars.t
   ; only_sources : Blang.t

src/dune_rules/dune_file.ml

@@ -60,7 +60,7 @@ module Mask = struct
 
   let is_promoted_rule =
     let is_promoted_mode version = function
-      | Rule.Mode.Promote { only = None; lifetime; _ } ->
+      | Rule_mode.Promote { only = None; lifetime; _ } ->
         if version >= (3, 5)
         then (
           match lifetime with

src/dune_rules/exe.ml

@@ -233,16 +233,17 @@ let link_exe
           ; Dyn link_args
           ]
     >>| Action.Full.add_sandbox sandbox
+  and* mode =
+    let sctx = Compilation_context.super_context cctx in
+    let* expander = Super_context.expander sctx ~dir in
+    let rule_mode =
+      match promote with
+      | None -> Rule_mode.Standard
+      | Some p -> Promote p
+    in
+    Rule_mode_expand.expand_path ~expander ~dir rule_mode
   in
-  Super_context.add_rule
-    sctx
-    ~loc
-    ~dir
-    ~mode:
-      (match promote with
-       | None -> Standard
-       | Some p -> Promote p)
-    action_with_targets
+  Super_context.add_rule sctx ~loc ~dir ~mode action_with_targets
 ;;
 
 let link_js

src/dune_rules/exe.mli

@@ -63,7 +63,7 @@ val link_many
   -> ?sandbox:Sandbox_config.t
   -> programs:Program.t list
   -> linkages:Linkage.t list
-  -> promote:Rule.Promote.t option
+  -> promote:Rule_mode.Promote.t option
   -> Compilation_context.t
   -> dep_graphs Memo.t
 
@@ -74,7 +74,7 @@ val build_and_link
   -> ?sandbox:Sandbox_config.t
   -> program:Program.t
   -> linkages:Linkage.t list
-  -> promote:Rule.Promote.t option
+  -> promote:Rule_mode.Promote.t option
   -> Compilation_context.t
   -> dep_graphs Memo.t
 
@@ -85,7 +85,7 @@ val build_and_link_many
   -> ?sandbox:Sandbox_config.t
   -> programs:Program.t list
   -> linkages:Linkage.t list
-  -> promote:Rule.Promote.t option
+  -> promote:Rule_mode.Promote.t option
   -> Compilation_context.t
   -> dep_graphs Memo.t