Merge pull request #1259 from rgrinberg/build-default-alias-dir-target

When the target is a directory use the default alias in it

CHANGES.md

@@ -67,6 +67,9 @@ next
 
 - Do not print diffs by default when running inside dune (#1260, @diml)
 
+- Interpret `$ dune build dir` as building the default alias in `dir`. (#1259,
+  @rgrinberg)
+
 1.1.1 (08/08/2018)
 ------------------
 

bin/alias.ml

@@ -0,0 +1,60 @@
+open Stdune
+
+let die = Dune.Import.die
+
+type t =
+  { name : string
+  ; recursive : bool
+  ; dir : Path.t
+  ; contexts : Dune.Context.t list
+  }
+
+let to_log_string { name ; recursive; dir ; contexts = _ } =
+  sprintf "- %s alias %s%s/%s"
+    (if recursive then "recursive " else "")
+    (if recursive then "@@" else "@")
+    (Path.to_string_maybe_quoted dir)
+    name
+
+let in_dir ~name ~recursive ~contexts dir =
+  Util.check_path contexts dir;
+  match Path.extract_build_context dir with
+  | None ->
+    { dir
+    ; recursive
+    ; name
+    ; contexts
+    }
+  | Some ("install", _) ->
+    die "Invalid alias: %s.\n\
+         There are no aliases in %s."
+      (Path.to_string_maybe_quoted Path.(relative build_dir "install"))
+      (Path.to_string_maybe_quoted dir)
+  | Some (ctx, dir) ->
+    { dir
+    ; recursive
+    ; name
+    ; contexts =
+        [List.find_exn contexts ~f:(fun c -> Dune.Context.name c = ctx)]
+    }
+
+let of_string common s ~contexts =
+  if not (String.is_prefix s ~prefix:"@") then
+    None
+  else
+    let pos, recursive =
+      if String.length s >= 2 && s.[1] = '@' then
+        (2, false)
+      else
+        (1, true)
+    in
+    let s = String.drop s pos in
+    let path = Path.relative Path.root (Common.prefix_target common s) in
+    if Path.is_root path then
+      die "@@ on the command line must be followed by a valid alias name"
+    else if not (Path.is_managed path) then
+      die "@@ on the command line must be followed by a relative path"
+    else
+      let dir = Path.parent_exn path in
+      let name = Path.basename path in
+      Some (in_dir ~name ~recursive ~contexts dir)

bin/alias.mli

@@ -0,0 +1,19 @@
+open Stdune
+
+type t = private
+  { name : string
+  ; recursive : bool
+  ; dir : Path.t
+  ; contexts : Dune.Context.t list
+  }
+
+val in_dir
+  :  name:string
+  -> recursive:bool
+  -> contexts:Dune.Context.t list
+  -> Path.t
+  -> t
+
+val of_string : Common.t -> string -> contexts:Dune.Context.t list -> t option
+
+val to_log_string : t -> string

bin/main.ml

@@ -584,11 +584,10 @@ let runtest =
         | dir -> sprintf "@%s/runtest" dir));
     let log = Log.create common in
     let targets (setup : Main.setup) =
-      let check_path = Util.check_path setup.contexts in
       List.map dirs ~f:(fun dir ->
         let dir = Path.(relative root) (Common.prefix_target common dir) in
-        check_path dir;
-        Target.Alias_rec (Path.relative dir "runtest"))
+        Target.Alias (Alias.in_dir ~name:"runtest" ~recursive:true
+                        ~contexts:setup.contexts dir))
     in
     run_build_command ~log ~common ~targets
   in

bin/target.ml

@@ -10,39 +10,31 @@ let hint = Dune.Import.hint
 
 type t =
   | File      of Path.t
-  | Alias     of Path.t
-  | Alias_rec of Path.t
+  | Alias     of Alias.t
 
 type resolve_input =
   | Path of Path.t
   | String of string
 
 let request (setup : Dune.Main.setup) targets =
   let open Build.O in
-  let contexts = List.map setup.contexts ~f:(fun c -> c.Context.name) in
   List.fold_left targets ~init:(Build.return ()) ~f:(fun acc target ->
     acc >>>
     match target with
     | File path -> Build.path path
-    | Alias path ->
-      let contexts, dir, name = Util.parse_alias path ~contexts in
-      Build_system.Alias.dep_multi_contexts ~dir ~name
-        ~file_tree:setup.file_tree ~contexts
-    | Alias_rec path ->
-      let contexts, dir, name = Util.parse_alias path ~contexts in
-      Build_system.Alias.dep_rec_multi_contexts ~dir ~name
-        ~file_tree:setup.file_tree ~contexts)
+    | Alias { Alias. name; recursive; dir; contexts } ->
+      let contexts = List.map ~f:Dune.Context.name contexts in
+      (if recursive then
+         Build_system.Alias.dep_rec_multi_contexts
+       else
+         Build_system.Alias.dep_multi_contexts)
+        ~dir ~name ~file_tree:setup.file_tree ~contexts)
 
 let log_targets ~log targets =
   List.iter targets ~f:(function
     | File path ->
       Log.info log @@ "- " ^ (Path.to_string path)
-    | Alias path ->
-      Log.info log @@ "- alias " ^
-                      (Path.to_string_maybe_quoted path)
-    | Alias_rec path ->
-      Log.info log @@ "- recursive alias " ^
-                      (Path.to_string_maybe_quoted path));
+    | Alias a -> Log.info log (Alias.to_log_string a));
   flush stdout
 
 let target_hint (setup : Dune.Main.setup) path =
@@ -59,8 +51,8 @@ let target_hint (setup : Dune.Main.setup) path =
         | Some (_, path) -> path)
   in
   let candidates =
-    (* Only suggest hints for the basename, otherwise it's slow when there are lots of
-       files *)
+    (* Only suggest hints for the basename, otherwise it's slow when there are
+       lots of files *)
     List.filter_map candidates ~f:(fun path ->
       if Path.equal (Path.parent_exn path) sub_dir then
         Some (Path.to_string path)
@@ -70,13 +62,15 @@ let target_hint (setup : Dune.Main.setup) path =
   let candidates = String.Set.of_list candidates |> String.Set.to_list in
   hint (Path.to_string path) candidates
 
-
 let resolve_path path ~(setup : Dune.Main.setup) =
   Util.check_path setup.contexts path;
   let can't_build path =
     Error (path, target_hint setup path);
   in
-  if not (Path.is_managed path) then
+  if Dune.File_tree.dir_exists setup.file_tree path then
+    Ok [ Alias (Alias.in_dir ~name:"default" ~recursive:true
+                  ~contexts:setup.contexts path) ]
+  else if not (Path.is_managed path) then
     Ok [File path]
   else if Path.is_in_build_dir path then begin
     if Build_system.is_target setup.build_system path then
@@ -96,26 +90,11 @@ let resolve_path path ~(setup : Dune.Main.setup) =
     | l  -> Ok l
 
 let resolve_target common ~(setup : Dune.Main.setup) s =
-  if String.is_prefix s ~prefix:"@" then begin
-    let pos, is_rec =
-      if String.length s >= 2 && s.[1] = '@' then
-        (2, false)
-      else
-        (1, true)
-    in
-    let s = String.drop s pos in
-    let path = Path.relative Path.root (Common.prefix_target common s) in
-    Util.check_path setup.contexts path;
-    if Path.is_root path then
-      die "@@ on the command line must be followed by a valid alias name"
-    else if not (Path.is_managed path) then
-      die "@@ on the command line must be followed by a relative path"
-    else
-      Ok [if is_rec then Alias_rec path else Alias path]
-  end else begin
+  match Alias.of_string common s ~contexts:setup.contexts with
+  | Some a -> Ok [Alias a]
+  | None ->
     let path = Path.relative Path.root (Common.prefix_target common s) in
     resolve_path path ~setup
-  end
 
 let resolve_targets_mixed ~log common (setup : Dune.Main.setup) user_targets =
   match user_targets with

bin/target.mli

@@ -2,8 +2,7 @@ open Stdune
 
 type t =
   | File      of Path.t
-  | Alias     of Path.t
-  | Alias_rec of Path.t
+  | Alias     of Alias.t
 
 val request
   :  Dune.Main.setup

bin/util.ml

@@ -2,18 +2,6 @@ open! Stdune
 open Dune
 open Import
 
-let parse_alias path ~contexts =
-  let dir = Path.parent_exn path in
-  let name = Path.basename path in
-  match Path.extract_build_context dir with
-  | None -> (contexts, dir, name)
-  | Some ("install", _) ->
-    die "Invalid alias: %s.\n\
-         There are no aliases in %s."
-      (Path.to_string_maybe_quoted Path.(relative build_dir "install"))
-      (Path.to_string_maybe_quoted path)
-  | Some (ctx, dir) -> ([ctx], dir, name)
-
 let check_path contexts =
   let contexts =
     String.Set.of_list (List.map contexts ~f:(fun c -> c.Context.name))

bin/util.mli

@@ -1,11 +1,6 @@
 open Stdune
 open Dune
 
-val parse_alias
-  :  Path.t
-  -> contexts:string list
-  -> string list * Path.t * string
-
 val check_path : Context.t list -> Path.t -> unit
 
 val find_root : unit -> string * string list

doc/usage.rst

@@ -154,6 +154,19 @@ definition is assumed:
 Which means that by default ``dune build`` will build everything that
 is installable.
 
+When using a directory as a target, it will be interpreted as building the
+default target in the directory. The directory must exist in the source tree.
+
+.. code::
+
+   dune build dir
+
+Is equivalent to:
+
+.. code::
+
+   dune build @@dir/default
+
 Finding external libraries
 ==========================
 

src/context.ml

@@ -585,3 +585,5 @@ let cc_g (ctx : t) =
     ["-g"]
   else
     []
+
+let name t = t.name

src/context.mli

@@ -155,3 +155,5 @@ val best_mode : t -> Mode.t
 
 (** [\["-g"\]] if [!Clflags.g] and [\[\]] otherwise *)
 val cc_g : t -> string list
+
+val name : t -> string

test/blackbox-tests/dune.inc

@@ -804,6 +804,14 @@
    test-cases/syntax-versioning
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name target-dir-alias)
+ (deps (package dune) (source_tree test-cases/target-dir-alias))
+ (action
+  (chdir
+   test-cases/target-dir-alias
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name tests-stanza)
  (deps (package dune) (source_tree test-cases/tests-stanza))
@@ -983,6 +991,7 @@
   (alias shadow-bindings)
   (alias subst)
   (alias syntax-versioning)
+  (alias target-dir-alias)
   (alias tests-stanza)
   (alias tests-stanza-action)
   (alias too-many-parens)
@@ -1081,6 +1090,7 @@
   (alias shadow-bindings)
   (alias subst)
   (alias syntax-versioning)
+  (alias target-dir-alias)
   (alias tests-stanza)
   (alias tests-stanza-action)
   (alias too-many-parens)

test/blackbox-tests/test-cases/target-dir-alias/dir-target-works/dune-project

@@ -0,0 +1 @@
+(lang dune 1.2)

test/blackbox-tests/test-cases/target-dir-alias/dir-target-works/foo/dune

@@ -0,0 +1,3 @@
+(alias
+ (name default)
+ (action (echo "default target works")))

test/blackbox-tests/test-cases/target-dir-alias/run.t

@@ -0,0 +1,5 @@
+Building a directory results in the default target being built
+
+  $ dune build foo --root dir-target-works
+  Entering directory 'dir-target-works'
+  default target works