Add alias field to rules

CHANGES.md

@@ -1,3 +1,9 @@
+2.1.0 (unreleased)
+----------------
+
+- Introduce `alias` and `package` fields to the `rule` stanza. This is the
+  preferred way of attaching rules to aliases. (#2744, @rgrinberg)
+
 2.0.0 (unreleased)
 ------------------
 

doc/dune-files.rst

@@ -795,6 +795,12 @@ See the :ref:`user-actions` section for more details.
 - ``(locks (<lock-names>))`` specify that the action must be run while
   holding the following locks. See the :ref:`locks` section for more details.
 
+- ``(alias <alias-name>)`` specify the alias this rule belongs to. Building this
+  alias means building the targets of this rule.
+
+- ``(package <package>)`` specify the package this rule belongs to. This rule
+  will be unavailable when installing other packages in release mode.
+
 Note that contrary to makefiles or other build systems, user rules currently
 don't support patterns, such as a rule to produce ``%.y`` from ``%.x`` for any
 given ``%``. This might be supported in the future.

src/dune/config.ml

@@ -31,6 +31,8 @@ let inside_emacs = Option.is_some (Env.get Env.initial "INSIDE_EMACS")
 
 let inside_dune = Option.is_some (Env.get Env.initial "INSIDE_DUNE")
 
+let () = Dune_lang.Syntax.inside_dune := inside_dune
+
 let inside_ci = Option.is_some (Env.get Env.initial "CI")
 
 let show_full_command_on_error () =

src/dune/dune_file.ml

@@ -1707,6 +1707,8 @@ module Rule = struct
     ; locks : String_with_vars.t list
     ; loc : Loc.t
     ; enabled_if : Blang.t
+    ; alias : Alias.Name.t option
+    ; package : Package.t option
     }
 
   type action_or_field =
@@ -1754,6 +1756,8 @@ module Rule = struct
     ; locks = []
     ; loc
     ; enabled_if = Blang.true_
+    ; alias = None
+    ; package = None
     }
 
   let long_form =
@@ -1788,8 +1792,15 @@ module Rule = struct
           | false, Some mode -> Ok mode
           | true, None -> Ok Fallback
           | false, None -> Ok Standard)
-    and+ enabled_if = enabled_if ~since:(Some (1, 4)) in
-    { targets; deps; action; mode; locks; loc; enabled_if }
+    and+ enabled_if = enabled_if ~since:(Some (1, 4))
+    and+ package =
+      field_o "package"
+        (Dune_lang.Syntax.since Stanza.syntax (2, 1) >>> Pkg.decode)
+    and+ alias =
+      field_o "alias"
+        (Dune_lang.Syntax.since Stanza.syntax (2, 1) >>> Alias.Name.decode)
+    in
+    { targets; deps; action; mode; locks; loc; enabled_if; alias; package }
 
   let decode =
     peek_exn
@@ -1860,6 +1871,8 @@ module Rule = struct
         ; locks = []
         ; loc
         ; enabled_if
+        ; alias = None
+        ; package = None
         })
 
   let ocamlyacc_to_rule loc { modules; mode; enabled_if } =
@@ -1884,6 +1897,8 @@ module Rule = struct
         ; locks = []
         ; loc
         ; enabled_if
+        ; alias = None
+        ; package = None
         })
 end
 
@@ -2385,6 +2400,7 @@ end
 let stanza_package = function
   | Library { public = Some { package; _ }; _ }
   | Alias { package = Some package; _ }
+  | Rule { package = Some package; _ }
   | Install { package; _ }
   | Executables { install_conf = Some { package; _ }; _ }
   | Documentation { package; _ }

src/dune/dune_file.mli

@@ -368,6 +368,8 @@ module Rule : sig
     ; locks : String_with_vars.t list
     ; loc : Loc.t
     ; enabled_if : Blang.t
+    ; alias : Alias.Name.t option
+    ; package : Package.t option
     }
 end
 

src/dune/simple_rules.ml

@@ -4,6 +4,22 @@ open Dune_file
 open! No_io
 module SC = Super_context
 
+module Alias_rules = struct
+  let stamp ~deps ~action ~extra_bindings =
+    ( "user-alias"
+    , Bindings.map ~f:Dep_conf.remove_locs deps
+    , Option.map ~f:Action_unexpanded.remove_locs action
+    , Option.map extra_bindings ~f:Pform.Map.to_stamp )
+
+  let add sctx ~alias ~stamp ~loc ?(locks = []) build =
+    let dir = Alias.dir alias in
+    SC.add_alias_action sctx alias ~dir ~loc ~locks ~stamp build
+
+  let add_empty sctx ~loc ~alias ~stamp =
+    let action = Build.return (Action.Progn []) in
+    add sctx ~loc ~alias ~stamp action
+end
+
 let interpret_locks ~expander = List.map ~f:(Expander.expand_path expander)
 
 let dep_bindings ~extra_bindings deps =
@@ -35,10 +51,42 @@ let check_filename =
       Path.as_in_build_dir_exn p
     | Dir p -> not_in_dir ~error_loc (Path.to_string p)
 
+type rule_kind =
+  | Alias_only of Alias.Name.t
+  | Alias_with_targets of Alias.Name.t * Path.Build.t
+  | No_alias
+
+let rule_kind ~(rule : Rule.t) ~action =
+  match rule.alias with
+  | None -> No_alias
+  | Some alias -> (
+    match Build.targets action |> Path.Build.Set.choose with
+    | None -> Alias_only alias
+    | Some target -> Alias_with_targets (alias, target) )
+
+let add_user_rule sctx ~dir ~(rule : Rule.t) ~action ~expander =
+  SC.add_rule_get_targets
+    sctx
+    (* user rules may have extra requirements, in which case they will be
+       specified as a part of rule.deps, which will be correctly taken care of
+       by the build description *)
+    ~sandbox:Sandbox_config.no_special_requirements ~dir ~mode:rule.mode
+    ~loc:rule.loc
+    ~locks:(interpret_locks ~expander rule.locks)
+    action
+
 let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) =
   match Expander.eval_blang expander rule.enabled_if with
-  | false -> Path.Build.Set.empty
-  | true ->
+  | false ->
+    Option.iter rule.alias ~f:(fun name ->
+        let alias = Alias.make ~dir name in
+        let action = Some (snd rule.action) in
+        let stamp =
+          Alias_rules.stamp ~deps:rule.deps ~action ~extra_bindings
+        in
+        Alias_rules.add_empty sctx ~alias ~loc:(Some rule.loc) ~stamp);
+    Path.Build.Set.empty
+  | true -> (
     let targets : Expander.Targets.t =
       match rule.targets with
       | Infer -> Infer
@@ -57,17 +105,28 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) =
     in
     let bindings = dep_bindings ~extra_bindings rule.deps in
     let expander = Expander.add_bindings expander ~bindings in
-    SC.add_rule_get_targets
-      sctx
-      (* user rules may have extra requirements, in which case they will be
-         specified as a part of rule.deps, which will be correctly taken care
-         of by the build description *)
-      ~sandbox:Sandbox_config.no_special_requirements ~dir ~mode:rule.mode
-      ~loc:rule.loc
-      ~locks:(interpret_locks ~expander rule.locks)
-      ( SC.Deps.interpret_named sctx ~expander rule.deps
+    let action =
+      SC.Deps.interpret_named sctx ~expander rule.deps
       |> SC.Action.run sctx (snd rule.action) ~loc:(fst rule.action) ~expander
-           ~dep_kind:Required ~targets ~targets_dir:dir )
+           ~dep_kind:Required ~targets ~targets_dir:dir
+    in
+    match rule_kind ~rule ~action with
+    | No_alias -> add_user_rule sctx ~dir ~rule ~action ~expander
+    | Alias_with_targets (alias, alias_target) ->
+      let () =
+        let alias = Alias.make alias ~dir in
+        Path.Set.singleton (Path.build alias_target)
+        |> Rules.Produce.Alias.add_deps alias
+      in
+      add_user_rule sctx ~dir ~rule ~action ~expander
+    | Alias_only name ->
+      let alias = Alias.make ~dir name in
+      let stamp =
+        let action = Some (snd rule.action) in
+        Alias_rules.stamp ~deps:rule.deps ~extra_bindings ~action
+      in
+      Alias_rules.add sctx ~alias ~stamp ~loc:(Some rule.loc) action;
+      Path.Build.Set.empty )
 
 let copy_files sctx ~dir ~expander ~src_dir (def : Copy_files.t) =
   let loc = String_with_vars.loc def.glob in
@@ -114,39 +173,29 @@ let copy_files sctx ~dir ~expander ~src_dir (def : Copy_files.t) =
            ~src:file_src ~dst:file_dst);
       Path.build file_dst)
 
-let add_alias sctx ~dir ~name ~stamp ~loc ?(locks = []) build =
-  let alias = Alias.make name ~dir in
-  SC.add_alias_action sctx alias ~dir ~loc ~locks ~stamp build
-
 let alias sctx ?extra_bindings ~dir ~expander (alias_conf : Alias_conf.t) =
+  let alias = Alias.make ~dir alias_conf.name in
   let stamp =
-    ( "user-alias"
-    , Bindings.map ~f:Dep_conf.remove_locs alias_conf.deps
-    , Option.map
-        ~f:(fun (_loc, a) -> Action_unexpanded.remove_locs a)
-        alias_conf.action
-    , Option.map extra_bindings ~f:Pform.Map.to_stamp )
+    let action = Option.map ~f:snd alias_conf.action in
+    Alias_rules.stamp ~deps:alias_conf.deps ~extra_bindings ~action
   in
   let loc = Some alias_conf.loc in
-  let locks, action =
-    match Expander.eval_blang expander alias_conf.enabled_if with
-    | false -> (None, Build.return (Action.Progn []))
-    | true ->
-      let locks = interpret_locks ~expander alias_conf.locks in
-      let action =
-        SC.Deps.interpret_named sctx ~expander alias_conf.deps
-        |>
-        match alias_conf.action with
-        | None ->
-          fun x ->
-            let open Build.O in
-            Build.ignore x >>> Build.progn []
-        | Some (loc, action) ->
-          let bindings = dep_bindings ~extra_bindings alias_conf.deps in
-          let expander = Expander.add_bindings expander ~bindings in
-          SC.Action.run sctx action ~loc ~expander ~dep_kind:Required
-            ~targets:(Forbidden "aliases") ~targets_dir:dir
-      in
-      (Some locks, action)
-  in
-  add_alias sctx ~loc ~dir ~name:alias_conf.name ~stamp ?locks action
+  match Expander.eval_blang expander alias_conf.enabled_if with
+  | false -> Alias_rules.add_empty sctx ~loc ~alias ~stamp
+  | true ->
+    let locks = interpret_locks ~expander alias_conf.locks in
+    let action =
+      SC.Deps.interpret_named sctx ~expander alias_conf.deps
+      |>
+      match alias_conf.action with
+      | None ->
+        fun x ->
+          let open Build.O in
+          Build.ignore x >>> Build.progn []
+      | Some (loc, action) ->
+        let bindings = dep_bindings ~extra_bindings alias_conf.deps in
+        let expander = Expander.add_bindings expander ~bindings in
+        SC.Action.run sctx action ~loc ~expander ~dep_kind:Required
+          ~targets:(Forbidden "aliases") ~targets_dir:dir
+    in
+    Alias_rules.add sctx ~loc ~stamp ~locks action ~alias

src/dune/super_context.ml

@@ -244,20 +244,18 @@ let chdir_to_build_context_root t build =
       | Chdir _ -> action
       | _ -> Chdir (Path.build t.context.build_dir, action))
 
-let add_rule t ?sandbox ?mode ?locks ?loc ~dir build =
+let make_rule t ?sandbox ?mode ?locks ?loc ~dir build =
   let build = chdir_to_build_context_root t build in
   let env = Env.external_ t.env_context ~dir in
-  Rules.Produce.rule
-    (Rule.make ?sandbox ?mode ?locks ~info:(Rule.Info.of_loc_opt loc)
-       ~context:(Some t.context) ~env:(Some env) build)
+  Rule.make ?sandbox ?mode ?locks ~info:(Rule.Info.of_loc_opt loc)
+    ~context:(Some t.context) ~env:(Some env) build
+
+let add_rule t ?sandbox ?mode ?locks ?loc ~dir build =
+  let rule = make_rule t ?sandbox ?mode ?locks ?loc ~dir build in
+  Rules.Produce.rule rule
 
 let add_rule_get_targets t ?sandbox ?mode ?locks ?loc ~dir build =
-  let build = chdir_to_build_context_root t build in
-  let env = Env.external_ t.env_context ~dir in
-  let rule =
-    Rule.make ?sandbox ?mode ?locks ~info:(Rule.Info.of_loc_opt loc)
-      ~context:(Some t.context) ~env:(Some env) build
-  in
+  let rule = make_rule t ?sandbox ?mode ?locks ?loc ~dir build in
   Rules.Produce.rule rule;
   rule.targets
 

src/dune/test_rules.ml

@@ -59,6 +59,8 @@ let rules (t : Dune_file.Tests.t) ~sctx ~dir ~scope ~expander ~dir_contents =
           ; locks = t.locks
           ; loc
           ; enabled_if = t.enabled_if
+          ; alias = None
+          ; package = t.package
           }
         in
         add_alias ~loc ~action:(Diff diff) ~locks:t.locks;

src/dune_lang/syntax.ml

@@ -43,6 +43,8 @@ module Version = struct
     parser_major = data_major && parser_minor >= data_minor
 end
 
+let inside_dune = ref false
+
 module Supported_versions = struct
   type t = int Int.Map.t
 
@@ -54,7 +56,7 @@ module Supported_versions = struct
 
   let is_supported t (major, minor) =
     match Int.Map.find t major with
-    | Some minor' -> minor' >= minor
+    | Some minor' -> minor' >= minor || !inside_dune
     | None -> false
 
   let supported_ranges t =

src/dune_lang/syntax.mli

@@ -101,3 +101,5 @@ val set : t -> Version.t -> ('a, 'k) Decoder.parser -> ('a, 'k) Decoder.parser
 val get_exn : t -> (Version.t, 'k) Decoder.parser
 
 val key : t -> Version.t Univ_map.Key.t
+
+val inside_dune : bool ref

test/blackbox-tests/dune.inc

@@ -877,6 +877,14 @@
    test-cases/github2629
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name github2681)
+ (deps (package dune) (source_tree test-cases/github2681))
+ (action
+  (chdir
+   test-cases/github2681
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name github534)
  (deps (package dune) (source_tree test-cases/github534))
@@ -1985,6 +1993,7 @@
   (alias github25)
   (alias github2584)
   (alias github2629)
+  (alias github2681)
   (alias github534)
   (alias github568)
   (alias github597)
@@ -2205,6 +2214,7 @@
   (alias github25)
   (alias github2584)
   (alias github2629)
+  (alias github2681)
   (alias github534)
   (alias github568)
   (alias github597)

test/blackbox-tests/test-cases/github2681/run.t

@@ -0,0 +1,28 @@
+A rule may have an alias field. This denotes that the action of the rule is a
+dependency of the alias.
+  $ mkdir simple && cd simple
+  $ cat > dune-project <<EOF
+  > (lang dune 2.1)
+  > EOF
+  $ cat > dune <<EOF
+  > (rule
+  >  (action (with-stdout-to foo (echo "hello world")))
+  >  (alias bar))
+  > EOF
+  $ dune build @bar --display short
+  $ cat _build/default/foo
+  hello world
+  $ cd ..
+
+A rule may now have an empty set of targets if it has an alias field
+  $ mkdir no-targets && cd no-targets
+  $ cat > dune-project <<EOF
+  > (lang dune 2.1)
+  > EOF
+  $ cat > dune <<EOF
+  > (rule
+  >  (action (echo "hello world"))
+  >  (alias bar))
+  > EOF
+  $ dune build @bar --display short
+  hello world