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>

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)
 ------------------
 

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>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 )

editor-integration/emacs/dune.el

@@ -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

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

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

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)))

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.