Add (files) stanza (#12879)

Signed-off-by: Nicolás Ojeda Bär <n.oje.bar@gmail.com>

Author: nojb

doc/changes/added/12879.md

@@ -0,0 +1,2 @@
+- Added `(files)` stanza, similar to `(dirs)` to control which files are visible
+  to Dune on a per-directory basis. (#12879, @nojb)

doc/reference/dune/files.rst

@@ -0,0 +1,19 @@
+files
+-----
+
+.. versionadded:: 3.21
+
+The ``files`` stanza allows restricting which files Dune should consider in the
+current directory. Its syntax mirrors the :doc:`/reference/predicate-language`
+used by the ``dirs`` stanza and supports ``:standard`` (which expands to all
+files), globs, and set operations.
+
+This is useful in mixed build setups where external tools such as ``make``
+produce artifacts that Dune should ignore.
+
+Examples:
+
+.. code:: dune
+
+   (files :standard \ *.cm*)   ;; ignore bytecode/native artifacts
+   (files *.ml *.mli)          ;; only keep OCaml sources

doc/reference/dune/index.rst

@@ -56,6 +56,7 @@ The following pages describe the available stanzas and their meanings.
       dynamic_include
       env
       dirs
+      files
       data_only_dirs
       ignored_subdirs
       include_subdirs

src/source/dune_file.ml

@@ -41,40 +41,62 @@ let dyn_of_kind = function
 
 module Dir_map = struct
   module Per_dir = struct
+    let no_dupes =
+      Option.merge ~f:(fun (loc, _) (loc2, _) ->
+        let main_message = Pp.text "This stanza was already specified at:" in
+        let annots =
+          let main = User_message.make ~loc [ main_message ] in
+          let related =
+            [ User_message.make ~loc:loc2 [ Pp.text "Already defined here" ] ]
+          in
+          User_message.Annots.singleton
+            Compound_user_error.annot
+            [ Compound_user_error.make ~main ~related ]
+        in
+        User_error.raise
+          ~loc
+          ~annots
+          [ main_message; Pp.verbatim (Loc.to_file_colon_line loc2) ])
+    ;;
+
+    module Files = struct
+      type t = (Loc.t * Predicate_lang.Glob.t) option
+
+      let default = None
+
+      let eval t ~files =
+        match t with
+        | None -> files
+        | Some (_, glob) ->
+          Filename.Set.filter files ~f:(fun filename ->
+            Predicate_lang.Glob.test glob ~standard:Predicate_lang.true_ filename)
+      ;;
+    end
+
     type t =
       { sexps : Dune_lang.Ast.t list
       ; subdir_status : Source_dir_status.Spec.input
+      ; files : Files.t
       }
 
-    let to_dyn { sexps; subdir_status = _ } =
+    let to_dyn { sexps; subdir_status = _; files = _ } =
       let open Dyn in
       record
         [ "sexps", list Dune_lang.to_dyn (List.map ~f:Dune_lang.Ast.remove_locs sexps) ]
     ;;
 
     let empty =
-      { sexps = []; subdir_status = Source_dir_status.Map.init ~f:(fun _ -> None) }
+      { sexps = []
+      ; subdir_status = Source_dir_status.Map.init ~f:(fun _ -> None)
+      ; files = None
+      }
     ;;
 
     let merge d1 d2 =
       { sexps = d1.sexps @ d2.sexps
       ; subdir_status =
-          Source_dir_status.Map.merge d1.subdir_status d2.subdir_status ~f:(fun l r ->
-            Option.merge l r ~f:(fun (loc, _) (loc2, _) ->
-              let main_message = Pp.text "This stanza stanza was already specified at:" in
-              let annots =
-                let main = User_message.make ~loc [ main_message ] in
-                let related =
-                  [ User_message.make ~loc:loc2 [ Pp.text "Already defined here" ] ]
-                in
-                User_message.Annots.singleton
-                  Compound_user_error.annot
-                  [ Compound_user_error.make ~main ~related ]
-              in
-              User_error.raise
-                ~loc
-                ~annots
-                [ main_message; Pp.verbatim (Loc.to_file_colon_line loc2) ]))
+          Source_dir_status.Map.merge d1.subdir_status d2.subdir_status ~f:no_dupes
+      ; files = no_dupes d1.files d2.files
       }
     ;;
   end
@@ -113,12 +135,15 @@ module Dir_map = struct
   let merge_all = List.fold_left ~f:merge ~init:empty
 end
 
+module Files = Dir_map.Per_dir.Files
+
 module Ast = struct
   type t =
     | Ignored_sub_dirs of Loc.t * Predicate_lang.Glob.t
     | Data_only_dirs of Loc.t * Predicate_lang.Glob.t
     | Vendored_dirs of Loc.t * Predicate_lang.Glob.Element.t Predicate_lang.t
     | Dirs of Loc.t * Predicate_lang.Glob.t
+    | Files of Loc.t * Predicate_lang.Glob.t
     | Subdir of Path.Local.t * t list
     | Include of
         { loc : Loc.t
@@ -212,6 +237,15 @@ module Ast = struct
     Dirs (loc, dirs)
   ;;
 
+  let files =
+    let+ loc, files =
+      Dune_lang.Syntax.since Stanza.syntax (3, 21)
+      >>> Predicate_lang.Glob.decode
+      |> located
+    in
+    Files (loc, files)
+  ;;
+
   let data_only_dirs =
     let+ loc, glob =
       located
@@ -257,6 +291,7 @@ module Ast = struct
     @@
     let+ subdirs = multi_field "subdir" (subdir ~inside_include)
     and+ dirs = field_o "dirs" dirs
+    and+ files = field_o "files" files
     and+ ignored_sub_dirs =
       multi_field "ignored_subdirs" (ignored_sub_dirs ~inside_subdir)
     and+ vendored_dirs = field_o "vendored_dirs" vendored_dirs
@@ -266,6 +301,7 @@ module Ast = struct
     let ast =
       List.concat
         [ Option.to_list dirs
+        ; Option.to_list files
         ; Option.to_list vendored_dirs
         ; subdirs
         ; ignored_sub_dirs
@@ -281,7 +317,7 @@ module Ast = struct
   let statically_evaluated_stanzas =
     (* This list must be kept in sync with [decode]
        [include] is excluded b/c it's also a normal stanza *)
-    [ "data_only_dirs"; "vendored_dirs"; "ignored_sub_dirs"; "subdir"; "dirs" ]
+    [ "data_only_dirs"; "vendored_dirs"; "ignored_sub_dirs"; "subdir"; "dirs"; "files" ]
   ;;
 
   let decode ~inside_subdir ~inside_include =
@@ -340,6 +376,7 @@ module Group = struct
     ; data_only_dirs : (Loc.t * Predicate_lang.Glob.t) option
     ; vendored_dirs : (Loc.t * Predicate_lang.Glob.Element.t Predicate_lang.t) option
     ; dirs : (Loc.t * Predicate_lang.Glob.t) option
+    ; files : (Loc.t * Predicate_lang.Glob.t) option
     ; leftovers : Dune_lang.Ast.t list
     ; subdirs : (Path.Local.t * Ast.t list) list
     }
@@ -349,6 +386,7 @@ module Group = struct
     ; data_only_dirs = None
     ; vendored_dirs = None
     ; dirs = None
+    ; files = None
     ; subdirs = []
     ; leftovers = []
     }
@@ -385,6 +423,7 @@ module Group = struct
     | Vendored_dirs (loc, glob) ->
       { t with vendored_dirs = Some (no_dupes "vendored_dirs" loc t.vendored_dirs glob) }
     | Dirs (loc, glob) -> { t with dirs = Some (no_dupes "dirs" loc t.dirs glob) }
+    | Files (loc, glob) -> { t with files = Some (no_dupes "files" loc t.files glob) }
     | Subdir (path, stanzas) -> { t with subdirs = (path, stanzas) :: t.subdirs }
     | Leftovers stanzas -> { t with leftovers = List.rev_append stanzas t.leftovers }
     | Include _ -> assert false
@@ -412,7 +451,8 @@ let rec to_dir_map ast =
   let group = Group.of_ast ast in
   let node =
     let subdir_status = Group.subdir_status group in
-    Dir_map.singleton { Dir_map.Per_dir.sexps = group.leftovers; subdir_status }
+    let files = group.files in
+    Dir_map.singleton { Dir_map.Per_dir.sexps = group.leftovers; subdir_status; files }
   in
   let subdirs =
     List.map group.subdirs ~f:(fun (path, stanzas) ->
@@ -463,6 +503,7 @@ let get_static_sexp t = (Dir_map.root t.plain).sexps
 let kind t = t.kind
 let path t = t.path
 let sub_dir_status t = Source_dir_status.Spec.create (Dir_map.root t.plain).subdir_status
+let files t = (Dir_map.root t.plain).files
 
 let load_plain sexps ~file ~from_parent ~project =
   let+ parsed =

src/source/dune_file.mli

@@ -25,6 +25,15 @@ val path : t -> Path.Source.t option
 
 val sub_dir_status : t -> Source_dir_status.Spec.t
 
+module Files : sig
+  type t
+
+  val default : t
+  val eval : t -> files:Filename.Set.t -> Filename.Set.t
+end
+
+val files : t -> Files.t
+
 (** Directories introduced via [(subdir ..)] *)
 val sub_dirnames : t -> Filename.t list
 

src/source/source_tree.ml

@@ -194,6 +194,14 @@ and contents
   =
   let files = Dir_contents.files readdir in
   let+ dune_file = Dune_file.load ~dir:path dir_status project ~files ~parent:dune_file in
+  let files =
+    let predicate =
+      match dune_file with
+      | None -> Dune_file.Files.default
+      | Some dune_file -> Dune_file.files dune_file
+    in
+    Dune_file.Files.eval predicate ~files
+  in
   let vcs = Dir0.Vcs.get_vcs ~default:default_vcs ~readdir ~path in
   let sub_dirs =
     let sub_dirs =

test/blackbox-tests/test-cases/files-stanza.t

@@ -0,0 +1,47 @@
+The ``files`` stanza lets us ignore source artifacts produced by other build
+tools.
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.21)
+  > EOF
+
+First, without the stanza, a pre-existing artifact conflicts with an explicit
+rule targeting the same filename.
+
+  $ touch mymod.ml
+  $ cat >dune <<EOF
+  > (library
+  >  (name mylib)
+  >  (wrapped false))
+  > (rule (with-stdout-to foo.xyz (progn)))
+  > EOF
+  $ touch mylib.cma
+  $ dune build
+  Error: Multiple rules generated for _build/default/mylib.cma:
+  - dune:1
+  - file present in source tree
+  Hint: rm -f mylib.cma
+  [1]
+  $ touch foo.xyz
+  $ dune build
+  Error: Multiple rules generated for _build/default/foo.xyz:
+  - dune:4
+  - file present in source tree
+  Hint: rm -f foo.xyz
+  [1]
+
+With ``(files ...)`` the source artifact is ignored and the rule can build the
+target.
+
+  $ cat >>dune <<EOF
+  > (files :standard \ *.cma *.xyz)
+  > EOF
+
+  $ dune build
+  $ ls _build/default
+  foo.xyz
+  mylib.a
+  mylib.cma
+  mylib.cmxa
+  mylib.cmxs
+  mymod.ml

test/blackbox-tests/test-cases/stanzas/subdir-stanza/basic.t

@@ -38,7 +38,7 @@ dir.
   File "bar/dune", line 1, characters 16-19:
   1 | (data_only_dirs foo)
                       ^^^
-  Error: This stanza stanza was already specified at:
+  Error: This stanza was already specified at:
   dune:1
   [1]