diff --git a/doc/changes/added/12879.md b/doc/changes/added/12879.md new file mode 100644 index 00000000000..a3764e828a2 --- /dev/null +++ b/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) \ No newline at end of file diff --git a/doc/reference/dune/files.rst b/doc/reference/dune/files.rst new file mode 100644 index 00000000000..dcf0e338b7a --- /dev/null +++ b/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 diff --git a/doc/reference/dune/index.rst b/doc/reference/dune/index.rst index 351e7c68b5e..02270d2d380 100644 --- a/doc/reference/dune/index.rst +++ b/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 diff --git a/src/source/dune_file.ml b/src/source/dune_file.ml index 72567adfcbc..b938aaac031 100644 --- a/src/source/dune_file.ml +++ b/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 = diff --git a/src/source/dune_file.mli b/src/source/dune_file.mli index ee99da30fd0..50496861598 100644 --- a/src/source/dune_file.mli +++ b/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 diff --git a/src/source/source_tree.ml b/src/source/source_tree.ml index e572c813737..adde5f4530c 100644 --- a/src/source/source_tree.ml +++ b/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 = diff --git a/test/blackbox-tests/test-cases/files-stanza.t b/test/blackbox-tests/test-cases/files-stanza.t new file mode 100644 index 00000000000..77191c94012 --- /dev/null +++ b/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 < (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 < (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 < (files :standard \ *.cma *.xyz) + > EOF + + $ dune build + $ ls _build/default + foo.xyz + mylib.a + mylib.cma + mylib.cmxa + mylib.cmxs + mymod.ml diff --git a/test/blackbox-tests/test-cases/stanzas/subdir-stanza/basic.t b/test/blackbox-tests/test-cases/stanzas/subdir-stanza/basic.t index 6ed2b17fcbc..7c510ae7ce1 100644 --- a/test/blackbox-tests/test-cases/stanzas/subdir-stanza/basic.t +++ b/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]