diff --git a/src/dune/action_exec.ml b/src/dune/action_exec.ml index 4fc77413366..843f7a16b6e 100644 --- a/src/dune/action_exec.ml +++ b/src/dune/action_exec.ml @@ -19,6 +19,8 @@ module Dynamic_dep = struct function | File fn -> File (to_dune_path fn) | Directory dir -> Glob (to_dune_path dir, Glob.universal) + | Glob { path; glob } -> + Glob (to_dune_path path, Glob.of_string_exn Loc.none glob) let compare x y = match (x, y) with diff --git a/src/dune/dune b/src/dune/dune index 32a552cc169..0e166902663 100644 --- a/src/dune/dune +++ b/src/dune/dune @@ -4,11 +4,11 @@ (name dune) (libraries unix stdune fiber incremental_cycles dag memo xdg dune_re threads.posix opam_file_format dune_lang dune_manager dune_memory - ocaml_config catapult jbuild_support dune_action_plugin) + dune_glob_lexer ocaml_config catapult jbuild_support dune_action_plugin) (synopsis "Internal Dune library, do not use!") (preprocess future_syntax)) -(ocamllex glob_lexer dune_lexer ocamlobjinfo) +(ocamllex dune_lexer ocamlobjinfo) (rule (targets setup.ml) diff --git a/src/dune/glob.ml b/src/dune/glob.ml index a548fcdb129..9355a4e6fd1 100644 --- a/src/dune/glob.ml +++ b/src/dune/glob.ml @@ -15,7 +15,7 @@ let hash t = String.hash t.repr let to_dyn t = Dyn.Encoder.string t.repr let of_string repr = - Glob_lexer.parse_string repr + Dune_glob_lexer.parse_string repr |> Result.map ~f:(fun re -> { re = Re.compile re; repr }) let of_string_exn loc repr = diff --git a/src/dune_action_plugin/dune b/src/dune_action_plugin/dune index 07dd0dba3b4..16a278db671 100644 --- a/src/dune_action_plugin/dune +++ b/src/dune_action_plugin/dune @@ -1,6 +1,6 @@ (library (name dune_action_plugin) (public_name dune._dune_action_plugin) - (libraries stdune) + (libraries stdune dune_re dune_glob_lexer) (synopsis "Monadic interface for defining scripts with dynamic or complex set of depencencies.")) diff --git a/src/dune_action_plugin/dune_action_plugin.ml b/src/dune_action_plugin/dune_action_plugin.ml index 6b1a79ef963..54911a9bad3 100644 --- a/src/dune_action_plugin/dune_action_plugin.ml +++ b/src/dune_action_plugin/dune_action_plugin.ml @@ -1,4 +1,5 @@ module Path = Path +module Glob = Glob open Protocol module Execution_error = struct @@ -123,6 +124,19 @@ let read_directory ~path = ; targets = Stdune.String.Set.empty } +let read_directory_with_glob ~path ~glob = + let path = Path.to_string path in + let action () = + Fs.read_directory path |> Execution_error.raise_on_fs_error + |> List.filter (Glob.test glob) + in + lift_stage + { action + ; dependencies = + Dependency.Set.singleton (Glob { path; glob = Glob.to_string glob }) + ; targets = Stdune.String.Set.empty + } + let rec run_by_dune t context = match t with | Pure () -> Context.respond context Done diff --git a/src/dune_action_plugin/dune_action_plugin.mli b/src/dune_action_plugin/dune_action_plugin.mli index 769cb5cd58e..2ea630ee2f6 100644 --- a/src/dune_action_plugin/dune_action_plugin.mli +++ b/src/dune_action_plugin/dune_action_plugin.mli @@ -8,6 +8,7 @@ [stage] to discourage people from overusing it. *) module Path = Path +module Glob = Glob type 'a t @@ -63,6 +64,11 @@ val write_file : path:Path.t -> data:string -> unit t directory. Computation will result in a directory listing. *) val read_directory : path:Path.t -> string list t +(** [read_directory_with_glob ~path:directory ~glob] returns a computation + depending on a listing of a [directory] filtered by glob and resulting in + that listing. *) +val read_directory_with_glob : path:Path.t -> glob:Glob.t -> string list t + (** {1:running Running the computation} *) (** Runs the computation. This function never returns. *) diff --git a/src/dune_action_plugin/glob.ml b/src/dune_action_plugin/glob.ml new file mode 100644 index 00000000000..20d72fb6df0 --- /dev/null +++ b/src/dune_action_plugin/glob.ml @@ -0,0 +1,19 @@ +open Stdune + +type t = + { re : Dune_re.re + ; repr : string + } + +let test t = Dune_re.execp t.re + +let of_string repr = + let result = + Dune_glob_lexer.parse_string repr + |> Result.map ~f:(fun re -> { re = Dune_re.compile re; repr }) + in + match result with + | Error (_, msg) -> invalid_arg (Printf.sprintf "invalid glob: :%s" msg) + | Ok t -> t + +let to_string (t : t) = t.repr diff --git a/src/dune_action_plugin/glob.mli b/src/dune_action_plugin/glob.mli new file mode 100644 index 00000000000..5ebc8842f2f --- /dev/null +++ b/src/dune_action_plugin/glob.mli @@ -0,0 +1,13 @@ +(** Simple glob support library. *) + +type t + +(** Tests if string matches the glob. *) +val test : t -> string -> bool + +(** Returns textual representation of a glob. *) +val to_string : t -> string + +(** Converts string to glob. Throws [Invalid_argument] exception if string is + not a valid glob. *) +val of_string : string -> t diff --git a/src/dune_action_plugin/protocol.ml b/src/dune_action_plugin/protocol.ml index b18f9dd4adb..5f60b881726 100644 --- a/src/dune_action_plugin/protocol.ml +++ b/src/dune_action_plugin/protocol.ml @@ -19,14 +19,21 @@ module Dependency = struct type t = | File of string | Directory of string + | Glob of + { path : string + ; glob : string + } let sexp_of_t : _ -> Sexp.t = function | File path -> List [ Atom "file"; Atom path ] | Directory path -> List [ Atom "directory"; Atom path ] + | Glob { path; glob } -> List [ Atom "glob"; Atom path; Atom glob ] let t_of_sexp : Sexp.t -> _ = function | List [ Atom "file"; Atom path ] -> Some (File path) | List [ Atom "directory"; Atom path ] -> Some (Directory path) + | List [ Atom "glob"; Atom path; Atom glob ] -> + Some (Glob { path; glob }) | _ -> None let compare x y = @@ -35,6 +42,13 @@ module Dependency = struct | File _, _ -> Lt | _, File _ -> Gt | Directory x, Directory y -> String.compare x y + | Directory _, _ -> Lt + | _, Directory _ -> Gt + | ( Glob { path = path1; glob = glob1 } + , Glob { path = path2; glob = glob2 } ) -> ( + match String.compare path1 path2 with + | Eq -> String.compare glob1 glob2 + | not_eq -> not_eq ) let to_dyn _ = Dyn.opaque end diff --git a/src/dune_action_plugin/protocol.mli b/src/dune_action_plugin/protocol.mli index d5470292114..e6160138aa8 100644 --- a/src/dune_action_plugin/protocol.mli +++ b/src/dune_action_plugin/protocol.mli @@ -6,6 +6,10 @@ module Dependency : sig type t = | File of string | Directory of string + | Glob of + { path : string + ; glob : string + } include Sexpable with type t := t diff --git a/src/dune_glob_lexer/dune b/src/dune_glob_lexer/dune new file mode 100644 index 00000000000..46146c64be0 --- /dev/null +++ b/src/dune_glob_lexer/dune @@ -0,0 +1,8 @@ +(library + (name dune_glob_lexer) + (public_name dune._dune_glob_lexer) + (flags (:standard -w -50)) + (synopsis "Internal Dune library, do not use!") + (libraries stdune dune_re)) + + (ocamllex dune_glob_lexer) diff --git a/src/dune/glob_lexer.mli b/src/dune_glob_lexer/dune_glob_lexer.mli similarity index 100% rename from src/dune/glob_lexer.mli rename to src/dune_glob_lexer/dune_glob_lexer.mli diff --git a/src/dune/glob_lexer.mll b/src/dune_glob_lexer/dune_glob_lexer.mll similarity index 100% rename from src/dune/glob_lexer.mll rename to src/dune_glob_lexer/dune_glob_lexer.mll diff --git a/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/bin/dune b/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/bin/dune new file mode 100644 index 00000000000..999e7b8250d --- /dev/null +++ b/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/bin/dune @@ -0,0 +1,3 @@ +(executables + (names foo) + (libraries dune_action_plugin)) diff --git a/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/bin/foo.ml b/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/bin/foo.ml new file mode 100644 index 00000000000..d6657d7e173 --- /dev/null +++ b/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/bin/foo.ml @@ -0,0 +1,11 @@ +open Dune_action_plugin + +let action = + let open Dune_action_plugin.O in + let glob = Glob.of_string "some_file*" in + let+ listing = + read_directory_with_glob ~path:(Path.of_string "some_dir") ~glob + in + String.concat "\n" listing |> print_endline + +let () = run action diff --git a/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/dune b/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/dune new file mode 100644 index 00000000000..3603d2251b1 --- /dev/null +++ b/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/dune @@ -0,0 +1,19 @@ +(data_only_dirs test) + +(alias + (name run_dynamic) + (deps + (package dune) + (source_tree test/) + (glob_files bin/*.exe)) + (action + (chdir + test + (progn + (run %{bin:cram} -test run.t) + (diff? run.t run.t.corrected))))) + +(alias + (name runtest) + (deps + (alias run_dynamic))) diff --git a/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/test/run.t b/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/test/run.t new file mode 100644 index 00000000000..ca6e079e60d --- /dev/null +++ b/test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/test/run.t @@ -0,0 +1,42 @@ + $ echo "(lang dune 2.0)" > dune-project + + $ cat > dune << EOF + > (alias + > (name runtest) + > (action (dynamic-run ./foo.exe))) + > EOF + + $ mkdir some_dir + + $ cat > some_dir/dune << EOF + > (rule + > (target some_file) + > (action + > (progn + > (echo "Building some_file!\n") + > (with-stdout-to %{target} (echo ""))))) + > \ + > (rule + > (target another_file) + > (action + > (progn + > (echo "SHOULD NOT BE PRINTED!") + > (with-stdout-to %{target} (echo ""))))) + > \ + > (rule + > (target some_file_but_different) + > (action + > (progn + > (echo "Building some_file_but_different!\n") + > (with-stdout-to %{target} (echo ""))))) + > EOF + + $ cp ../bin/foo.exe ./ + + $ dune runtest --display short + foo alias runtest + Building some_file! + Building some_file_but_different! + foo alias runtest + some_file + some_file_but_different diff --git a/vendor/re/src/dune b/vendor/re/src/dune index 4de1b0c895b..fd85d82c5a9 100644 --- a/vendor/re/src/dune +++ b/vendor/re/src/dune @@ -1,6 +1,7 @@ (library - (name dune_re) - (flags (:standard -w -50)) + (name dune_re) + (public_name dune._dune_re) + (flags (:standard -w -50)) (synopsis "Internal Dune library, do not use!")) (rule (with-stdout-to dune_re.ml (echo "include Re")))