Add glob_files_rec (#4176)

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>

Author: jeremiedimino

CHANGES.md

@@ -12,6 +12,8 @@ Unreleased
 
 - Allow `%{version:pkg}` to work for external packages (#4104, @kit-ty-kate)
 
+- Add `(glob_files_rec <dir>/<glob>)` for globbing files recursively (#4176, @jeremiedimino)
+
 2.8.2 (21/01/2021)
 ------------------
 

src/dune_rules/dep_conf.ml

@@ -7,7 +7,10 @@ type t =
   | File of String_with_vars.t
   | Alias of String_with_vars.t
   | Alias_rec of String_with_vars.t
-  | Glob_files of String_with_vars.t
+  | Glob_files of
+      { glob : String_with_vars.t
+      ; recursive : bool
+      }
   | Source_tree of String_with_vars.t
   | Package of String_with_vars.t
   | Universe
@@ -18,7 +21,8 @@ let remove_locs = function
   | File sw -> File (String_with_vars.remove_locs sw)
   | Alias sw -> Alias (String_with_vars.remove_locs sw)
   | Alias_rec sw -> Alias_rec (String_with_vars.remove_locs sw)
-  | Glob_files sw -> Glob_files (String_with_vars.remove_locs sw)
+  | Glob_files g ->
+    Glob_files { g with glob = String_with_vars.remove_locs g.glob }
   | Source_tree sw -> Source_tree (String_with_vars.remove_locs sw)
   | Package sw -> Package (String_with_vars.remove_locs sw)
   | Universe -> Universe
@@ -46,7 +50,12 @@ let decode =
       [ ("file", sw >>| fun x -> File x)
       ; ("alias", sw >>| fun x -> Alias x)
       ; ("alias_rec", sw >>| fun x -> Alias_rec x)
-      ; ("glob_files", sw >>| fun x -> Glob_files x)
+      ; ( "glob_files"
+        , sw >>| fun x -> Glob_files { glob = x; recursive = false } )
+      ; ( "glob_files_rec"
+        , let+ () = Dune_lang.Syntax.since Stanza.syntax (2, 9)
+          and+ x = sw in
+          Glob_files { glob = x; recursive = true } )
       ; ("package", sw >>| fun x -> Package x)
       ; ("universe", return Universe)
       ; ( "files_recursively_in"
@@ -76,9 +85,13 @@ let encode = function
   | Alias_rec t ->
     List
       [ Dune_lang.unsafe_atom_of_string "alias_rec"; String_with_vars.encode t ]
-  | Glob_files t ->
+  | Glob_files { glob = t; recursive } ->
     List
-      [ Dune_lang.unsafe_atom_of_string "glob_files"
+      [ Dune_lang.unsafe_atom_of_string
+          ( if recursive then
+            "glob_files_rec"
+          else
+            "glob_files" )
       ; String_with_vars.encode t
       ]
   | Source_tree t ->

src/dune_rules/dep_conf.mli

@@ -6,7 +6,10 @@ type t =
   | File of String_with_vars.t
   | Alias of String_with_vars.t
   | Alias_rec of String_with_vars.t
-  | Glob_files of String_with_vars.t
+  | Glob_files of
+      { glob : String_with_vars.t
+      ; recursive : bool
+      }
   | Source_tree of String_with_vars.t
   | Package of String_with_vars.t
   | Universe

src/dune_rules/dep_conf_eval.ml

@@ -8,6 +8,15 @@ let make_alias expander s =
   Expander.Or_exn.expand_path expander s
   |> Result.map ~f:(Alias.of_user_written_path ~loc)
 
+let fold_source_dirs dir ~init ~f =
+  let prefix_with, dir = Path.extract_build_context_dir_exn dir in
+  match File_tree.find_dir dir with
+  | None -> init
+  | Some dir ->
+    File_tree.Dir.fold dir ~init ~traverse:Sub_dirs.Status.Set.all
+      ~f:(fun dir acc ->
+        f (Path.append_source prefix_with (File_tree.Dir.path dir)) acc)
+
 let dep expander = function
   | File s ->
     Expander.Or_exn.expand_path expander s
@@ -26,16 +35,28 @@ let dep expander = function
              Build_system.Alias.dep_rec ~loc:(String_with_vars.loc s) a
            in
            [])
-  | Glob_files s ->
+  | Glob_files { glob = s; recursive } ->
     let loc = String_with_vars.loc s in
     let path = Expander.Or_exn.expand_path expander s in
     Result.map path ~f:(fun path ->
         let pred =
           Glob.of_string_exn loc (Path.basename path) |> Glob.to_pred
         in
         let dir = Path.parent_exn path in
-        Action_builder.map ~f:Path.Set.to_list
-          (File_selector.create ~dir pred |> Action_builder.paths_matching ~loc))
+        let add_dir dir acc =
+          let+ paths =
+            Action_builder.paths_matching ~loc (File_selector.create ~dir pred)
+          and+ acc = acc in
+          Path.Set.fold paths ~init:acc ~f:(fun p acc -> p :: acc)
+        in
+        let+ files =
+          let init = Action_builder.return [] in
+          if recursive then
+            fold_source_dirs dir ~init ~f:add_dir
+          else
+            add_dir dir init
+        in
+        List.rev files)
   | Source_tree s ->
     let path = Expander.Or_exn.expand_path expander s in
     Result.map path ~f:(fun path ->

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

@@ -0,0 +1,73 @@
+Tests for (glob_files_rec <dir>/<glob>). This feature is not meat to
+be release as it. We plan to replace it by recursive globs for 3.0.0.
+
+  $ cat > dune-project <<EOF
+  > (lang dune 2.9)
+  > EOF
+
+  $ cat > dune <<EOF
+  > (rule
+  >  (alias x)
+  >  (deps (glob_files_rec foo/*.txt))
+  >  (action (bash "for i in %{deps}; do printf \"\$i\\n\"; done")))
+  > EOF
+
+  $ mkdir -p foo/a/b1/c
+  $ mkdir -p foo/a/b2/c
+  $ mkdir -p foo/a/b3/c
+
+  $ touch foo/x.txt
+  $ touch foo/a/x.txt
+  $ touch foo/a/b1/c/x.txt
+  $ touch foo/a/b1/c/y.txt
+Leave a/b2/c empty to make sure we don't choke on empty dirs.
+  $ touch foo/a/b3/x.txt
+  $ touch foo/a/b3/x.other
+
+  $ dune build @x
+          bash alias x
+  foo/x.txt
+  foo/a/x.txt
+  foo/a/b1/c/x.txt
+  foo/a/b1/c/y.txt
+  foo/a/b3/x.txt
+
+  $ find . -name \*.txt | dune_cmd count-lines
+  10
+  $ dune build @x --force 2>&1 | dune_cmd count-lines
+  6
+
+Check that generated files are taken into account
+-------------------------------------------------
+
+  $ cat > foo/dune <<EOF
+  > (rule
+  >  (target gen.txt)
+  >  (action (with-stdout-to %{target} (echo ""))))
+  > EOF
+
+  $ dune build @x --force 2>&1 | grep gen.txt
+  foo/gen.txt
+
+Check that generated directories are ignored
+--------------------------------------------
+
+  $ cat > dune <<EOF
+  > (library
+  >  (name foo))
+  > 
+  > (rule
+  >  (alias x)
+  >  (deps (glob_files_rec *.cmi))
+  >  (action (bash "for i in %{deps}; do echo \$i; done")))
+  > EOF
+
+  $ touch foo/foo.ml
+
+  $ dune build
+
+  $ find _build -name \*.cmi
+  _build/default/.foo.objs/byte/foo.cmi
+
+  $ dune build @x
+

test/blackbox-tests/utils/dune_cmd.ml

@@ -162,6 +162,37 @@ module Sanitizer = struct
   let () = register name of_args run
 end
 
+module Count_lines = struct
+  type t =
+    | Stdin
+    | File of Path.t
+
+  let name = "count-lines"
+
+  let count_lines ic =
+    let rec loop n =
+      match input_line ic with
+      | exception End_of_file -> n
+      | _line -> loop (n + 1)
+    in
+    loop 0
+
+  let of_args = function
+    | [] -> Stdin
+    | [ file ] -> File (Path.of_filename_relative_to_initial_cwd file)
+    | _ -> raise (Arg.Bad "Usage: dune_arg count-lines <file>")
+
+  let run t =
+    let n =
+      match t with
+      | Stdin -> count_lines stdin
+      | File p -> Io.with_file_in p ~binary:false ~f:count_lines
+    in
+    Printf.printf "%d\n%!" n
+
+  let () = register name of_args run
+end
+
 let () =
   let name, args =
     match Array.to_list Sys.argv with