From 8bb97480ea89523fbd4fefeb72b9ce39643ea585 Mon Sep 17 00:00:00 2001 From: Arseniy Alekseyev Date: Thu, 12 Sep 2019 10:51:40 +0100 Subject: [PATCH] Adds support for globs in dune-action-plugin. Signed-off-by: Jakub Staron --- src/dune/action_exec.ml | 2 + src/dune/dune | 4 +- src/dune/glob.ml | 2 +- src/dune_action_plugin/dune | 2 +- src/dune_action_plugin/dune_action_plugin.ml | 14 +++++++ src/dune_action_plugin/dune_action_plugin.mli | 6 +++ src/dune_action_plugin/glob.ml | 19 +++++++++ src/dune_action_plugin/glob.mli | 13 ++++++ src/dune_action_plugin/protocol.ml | 14 +++++++ src/dune_action_plugin/protocol.mli | 4 ++ src/dune_glob_lexer/dune | 8 ++++ .../dune_glob_lexer.mli} | 0 .../dune_glob_lexer.mll} | 1 - .../depends-on-directory-with-glob/bin/dune | 3 ++ .../depends-on-directory-with-glob/bin/foo.ml | 11 +++++ .../depends-on-directory-with-glob/dune | 19 +++++++++ .../depends-on-directory-with-glob/test/run.t | 42 +++++++++++++++++++ vendor/re/src/dune | 5 ++- 18 files changed, 162 insertions(+), 7 deletions(-) create mode 100644 src/dune_action_plugin/glob.ml create mode 100644 src/dune_action_plugin/glob.mli create mode 100644 src/dune_glob_lexer/dune rename src/{dune/glob_lexer.mli => dune_glob_lexer/dune_glob_lexer.mli} (100%) rename src/{dune/glob_lexer.mll => dune_glob_lexer/dune_glob_lexer.mll} (99%) create mode 100644 test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/bin/dune create mode 100644 test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/bin/foo.ml create mode 100644 test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/dune create mode 100644 test/blackbox-tests/test-cases-with-libs/dune-action-plugin/depends-on-directory-with-glob/test/run.t diff --git a/src/dune/action_exec.ml b/src/dune/action_exec.ml index 4fc774133668..843f7a16b6ef 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 32a552cc169a..0e1669026638 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 a548fcdb129e..9355a4e6fd1d 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 07dd0dba3b4d..16a278db6714 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 6b1a79ef9634..54911a9bad31 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 769cb5cd58e6..2ea630ee2f67 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 000000000000..20d72fb6df01 --- /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 000000000000..5ebc8842f2fd --- /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 b18f9dd4adb8..5f60b8817264 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 d5470292114f..e6160138aa8a 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 000000000000..46146c64be04 --- /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 99% rename from src/dune/glob_lexer.mll rename to src/dune_glob_lexer/dune_glob_lexer.mll index 01be871fa31a..fede064835b0 100644 --- a/src/dune/glob_lexer.mll +++ b/src/dune_glob_lexer/dune_glob_lexer.mll @@ -65,4 +65,3 @@ and char_set st = parse | exception Failure msg -> Error (Lexing.lexeme_start lb, msg) } - 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 000000000000..999e7b8250d7 --- /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 000000000000..d6657d7e173c --- /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 000000000000..3603d2251b17 --- /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 000000000000..ca6e079e60d9 --- /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 4de1b0c895bb..fd85d82c5a92 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")))