From 5cad7141007d140f667d0a3712b84128f441aac5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Fri, 31 Aug 2018 11:12:49 +0100 Subject: [PATCH] Promote a subset of the files + emacs integration (#1192) - add support for promoting a selected list of files - add an emacs mode with helpers for promoting the correction for the current buffer Signed-off-by: Jeremie Dimino --- CHANGES.md | 5 ++ bin/main.ml | 19 ++++++- editor-integration/emacs/dune.el | 54 ++++++++++++++++++++ src/promotion.ml | 40 ++++++++++++--- src/promotion.mli | 13 +++-- test/blackbox-tests/test-cases/promote/dune | 6 +++ test/blackbox-tests/test-cases/promote/run.t | 29 +++++++++++ 7 files changed, 154 insertions(+), 12 deletions(-) create mode 100644 editor-integration/emacs/dune.el diff --git a/CHANGES.md b/CHANGES.md index d5735a32..9b9aff69 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -31,6 +31,11 @@ next `findlib.dynload`, automatically record linked in libraries and findlib predicates (#1172, @bobot) +- Add support for promoting a selected list of files (#1192, @diml) + +- Add an emacs mode providing helpers to promote correction files + (#1192, @diml) + 1.1.1 (08/08/2018) ------------------ diff --git a/bin/main.ml b/bin/main.ml index 51e8acea..e97d373f 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1424,12 +1424,27 @@ let promote = ; `Blocks help_secs ] in let term = - let%map common = common in + let%map common = common + and files = + Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE") + in set_common common ~targets:[]; (* We load and restore the digest cache as we need to clear the cache for promoted files, due to issues on OSX. *) Utils.Cached_digest.load (); - Promotion.promote_files_registered_in_last_run (); + Promotion.promote_files_registered_in_last_run + (match files with + | [] -> All + | _ -> + let files = + List.map files + ~f:(fun fn -> Path.of_string (prefix_target common fn)) + in + let on_missing fn = + Format.eprintf "@{Warning@}: Nothing to promote for %a.@." + Path.pp fn + in + These (files, on_missing)); Utils.Cached_digest.dump () in (term, Term.info "promote" ~doc ~man ) diff --git a/editor-integration/emacs/dune.el b/editor-integration/emacs/dune.el new file mode 100644 index 00000000..0672111c --- /dev/null +++ b/editor-integration/emacs/dune.el @@ -0,0 +1,54 @@ +;;; dune.el --- Align words in an intelligent way + +;; Copyright 2018 Jane Street Group, LLC +;; URL: https://github.com/ocaml/dune +;; Version: 1.0 + +;;; Commentary: + +;; This package provides helper functions for interacting with the +;; dune build system from emacs. + +;; Installation: +;; You need to install the OCaml program ``dune''. The +;; easiest way to do so is to install the opam package manager: +;; +;; https://opam.ocaml.org/doc/Install.html +;; +;; and then run "opam install dune". + +;;; Code: + +(defgroup dune nil + "Integration with the dune build system." + :tag "Dune build system." + :version "1.0" + :group 'align) + +(defcustom dune-command "dune" + "The dune command." + :type 'string + :group 'dune) + +;;;###autoload +(defun dune-promote () + "Promote the correction for the current file." + (interactive) + (if (buffer-modified-p) + (error "Cannot promote as buffer is modified.") + (shell-command + (format "%s promote %s" + dune-command + (file-name-nondirectory (buffer-file-name)))) + (revert-buffer nil t))) + +;;;###autoload +(defun dune-runtest-and-promote () + "Run tests in the current directory and promote the current buffer." + (interactive) + (compile (format "%s build @@runtest" dune-command)) + (dune-promote)) + +(provide 'dune) + +;;; dune.el ends here diff --git a/src/promotion.ml b/src/promotion.ml index e1a75c97..4a7ff880 100644 --- a/src/promotion.ml +++ b/src/promotion.ml @@ -49,7 +49,11 @@ let group_by_targets db = (* Sort the list of possible sources for deterministic behavior *) |> Path.Map.map ~f:(List.sort ~compare:Path.compare) -let do_promote db = +type files_to_promote = + | All + | These of Path.t list * (Path.t -> unit) + +let do_promote db files_to_promote = let by_targets = group_by_targets db in let potential_build_contexts = match Path.readdir_unsorted Path.build_dir with @@ -63,7 +67,7 @@ let do_promote db = Option.some_if (Path.is_directory path) path) in let dirs_to_clear_from_cache = Path.root :: potential_build_contexts in - Path.Map.iteri by_targets ~f:(fun dst srcs -> + let promote_one dst srcs = match srcs with | [] -> assert false | src :: others -> @@ -77,18 +81,40 @@ let do_promote db = File.promote { src; dst }; List.iter others ~f:(fun path -> Format.eprintf " -> ignored %s.@." - (Path.to_string_maybe_quoted path))) + (Path.to_string_maybe_quoted path)) + in + match files_to_promote with + | All -> + Path.Map.iteri by_targets ~f:promote_one; + [] + | These (files, on_missing) -> + let files = + Path.Set.of_list files |> Path.Set.to_list + in + let by_targets = + List.fold_left files ~init:by_targets ~f:(fun map fn -> + match Path.Map.find by_targets fn with + | None -> + on_missing fn; + map + | Some srcs -> + promote_one fn srcs; + Path.Map.remove by_targets fn) + in + Path.Map.to_list by_targets + |> List.concat_map ~f:(fun (dst, srcs) -> + List.map srcs ~f:(fun src -> { File.src; dst })) let finalize () = let db = if !Clflags.auto_promote then - (do_promote !File.db; []) + do_promote !File.db All else !File.db in dump_db db -let promote_files_registered_in_last_run () = +let promote_files_registered_in_last_run files_to_promote = let db = load_db () in - do_promote db; - dump_db [] + let db = do_promote db files_to_promote in + dump_db db diff --git a/src/promotion.mli b/src/promotion.mli index a307b1ab..0a1025e7 100644 --- a/src/promotion.mli +++ b/src/promotion.mli @@ -10,8 +10,15 @@ module File : sig val register : t -> unit end -(** Promote all registered files if [!Clflags.auto_promote]. Otherwise dump the list of - registered files to [_build/.to-promote]. *) +(** Promote all registered files if [!Clflags.auto_promote]. Otherwise + dump the list of registered files to [_build/.to-promote]. *) val finalize : unit -> unit -val promote_files_registered_in_last_run : unit -> unit +(** Describe what files should be promoted. The second argument of + [These] is a function that is called on files that cannot be + promoted. *) +type files_to_promote = + | All + | These of Path.t list * (Path.t -> unit) + +val promote_files_registered_in_last_run : files_to_promote -> unit diff --git a/test/blackbox-tests/test-cases/promote/dune b/test/blackbox-tests/test-cases/promote/dune index 3d764f93..46c9beb0 100644 --- a/test/blackbox-tests/test-cases/promote/dune +++ b/test/blackbox-tests/test-cases/promote/dune @@ -3,3 +3,9 @@ (alias (name blah) (action (diff x x.gen))) + +(rule (with-stdout-to y.gen (echo "titi"))) + +(alias + (name blah2) + (action (diff y y.gen))) diff --git a/test/blackbox-tests/test-cases/promote/run.t b/test/blackbox-tests/test-cases/promote/run.t index 3564d891..cbc26144 100644 --- a/test/blackbox-tests/test-cases/promote/run.t +++ b/test/blackbox-tests/test-cases/promote/run.t @@ -1,3 +1,6 @@ +General tests +-------------------------- + $ printf titi > x $ dune build --display short --diff-command false @blah 2>&1 | sed 's/.*false.*/DIFF/' @@ -28,3 +31,29 @@ Otherwise this test fails on OSX $ dune build --display short --diff-command false @blah $ cat x toto + +Test single file promotion +-------------------------- + + $ printf a > x + $ printf a > y + $ dune build --display short --diff-command false @blah @blah2 2>&1 | sed 's/.*false.*/DIFF/' + sh (internal) (exit 1) + DIFF + sh (internal) (exit 1) + DIFF + $ dune promote x + Promoting _build/default/x.gen to x. + $ cat x + toto + $ cat y + a + $ dune promote y + Promoting _build/default/y.gen to y. + $ cat x + toto + $ cat y + titi + $ dune promote x y + Warning: Nothing to promote for x. + Warning: Nothing to promote for y.