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 <jeremie@dimino.org>
This commit is contained in:
parent
d8e474c716
commit
5cad714100
|
@ -31,6 +31,11 @@ next
|
||||||
`findlib.dynload`, automatically record linked in libraries and
|
`findlib.dynload`, automatically record linked in libraries and
|
||||||
findlib predicates (#1172, @bobot)
|
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)
|
1.1.1 (08/08/2018)
|
||||||
------------------
|
------------------
|
||||||
|
|
||||||
|
|
19
bin/main.ml
19
bin/main.ml
|
@ -1424,12 +1424,27 @@ let promote =
|
||||||
; `Blocks help_secs
|
; `Blocks help_secs
|
||||||
] in
|
] in
|
||||||
let term =
|
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:[];
|
set_common common ~targets:[];
|
||||||
(* We load and restore the digest cache as we need to clear the
|
(* We load and restore the digest cache as we need to clear the
|
||||||
cache for promoted files, due to issues on OSX. *)
|
cache for promoted files, due to issues on OSX. *)
|
||||||
Utils.Cached_digest.load ();
|
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>Warning@}: Nothing to promote for %a.@."
|
||||||
|
Path.pp fn
|
||||||
|
in
|
||||||
|
These (files, on_missing));
|
||||||
Utils.Cached_digest.dump ()
|
Utils.Cached_digest.dump ()
|
||||||
in
|
in
|
||||||
(term, Term.info "promote" ~doc ~man )
|
(term, Term.info "promote" ~doc ~man )
|
||||||
|
|
|
@ -0,0 +1,54 @@
|
||||||
|
;;; dune.el --- Align words in an intelligent way
|
||||||
|
|
||||||
|
;; Copyright 2018 Jane Street Group, LLC <opensource@janestreet.com>
|
||||||
|
;; 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
|
|
@ -49,7 +49,11 @@ let group_by_targets db =
|
||||||
(* Sort the list of possible sources for deterministic behavior *)
|
(* Sort the list of possible sources for deterministic behavior *)
|
||||||
|> Path.Map.map ~f:(List.sort ~compare:Path.compare)
|
|> 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 by_targets = group_by_targets db in
|
||||||
let potential_build_contexts =
|
let potential_build_contexts =
|
||||||
match Path.readdir_unsorted Path.build_dir with
|
match Path.readdir_unsorted Path.build_dir with
|
||||||
|
@ -63,7 +67,7 @@ let do_promote db =
|
||||||
Option.some_if (Path.is_directory path) path)
|
Option.some_if (Path.is_directory path) path)
|
||||||
in
|
in
|
||||||
let dirs_to_clear_from_cache = Path.root :: potential_build_contexts 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
|
match srcs with
|
||||||
| [] -> assert false
|
| [] -> assert false
|
||||||
| src :: others ->
|
| src :: others ->
|
||||||
|
@ -77,18 +81,40 @@ let do_promote db =
|
||||||
File.promote { src; dst };
|
File.promote { src; dst };
|
||||||
List.iter others ~f:(fun path ->
|
List.iter others ~f:(fun path ->
|
||||||
Format.eprintf " -> ignored %s.@."
|
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 finalize () =
|
||||||
let db =
|
let db =
|
||||||
if !Clflags.auto_promote then
|
if !Clflags.auto_promote then
|
||||||
(do_promote !File.db; [])
|
do_promote !File.db All
|
||||||
else
|
else
|
||||||
!File.db
|
!File.db
|
||||||
in
|
in
|
||||||
dump_db db
|
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
|
let db = load_db () in
|
||||||
do_promote db;
|
let db = do_promote db files_to_promote in
|
||||||
dump_db []
|
dump_db db
|
||||||
|
|
|
@ -10,8 +10,15 @@ module File : sig
|
||||||
val register : t -> unit
|
val register : t -> unit
|
||||||
end
|
end
|
||||||
|
|
||||||
(** Promote all registered files if [!Clflags.auto_promote]. Otherwise dump the list of
|
(** Promote all registered files if [!Clflags.auto_promote]. Otherwise
|
||||||
registered files to [_build/.to-promote]. *)
|
dump the list of registered files to [_build/.to-promote]. *)
|
||||||
val finalize : unit -> unit
|
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
|
||||||
|
|
|
@ -3,3 +3,9 @@
|
||||||
(alias
|
(alias
|
||||||
(name blah)
|
(name blah)
|
||||||
(action (diff x x.gen)))
|
(action (diff x x.gen)))
|
||||||
|
|
||||||
|
(rule (with-stdout-to y.gen (echo "titi")))
|
||||||
|
|
||||||
|
(alias
|
||||||
|
(name blah2)
|
||||||
|
(action (diff y y.gen)))
|
||||||
|
|
|
@ -1,3 +1,6 @@
|
||||||
|
General tests
|
||||||
|
--------------------------
|
||||||
|
|
||||||
$ printf titi > x
|
$ printf titi > x
|
||||||
|
|
||||||
$ dune build --display short --diff-command false @blah 2>&1 | sed 's/.*false.*/DIFF/'
|
$ 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
|
$ dune build --display short --diff-command false @blah
|
||||||
$ cat x
|
$ cat x
|
||||||
toto
|
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.
|
||||||
|
|
Loading…
Reference in New Issue