refactor: move diff action + promotion to library (#10796)

None of this code needs to exist in the engine and lives just as happily
as a separate library.

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

bin/build_cmd.ml

@@ -32,7 +32,7 @@ let with_metrics ~common f =
 
 let run_build_system ~common ~request =
   let run ~(toplevel : unit Memo.Lazy.t) =
-    with_metrics ~common (fun () -> Build_system.run (fun () -> Memo.Lazy.force toplevel))
+    with_metrics ~common (fun () -> build (fun () -> Memo.Lazy.force toplevel))
   in
   let open Fiber.O in
   Fiber.finalize

bin/common.ml

@@ -1251,7 +1251,7 @@ let init (builder : Builder.t) =
   Dune_rules.Clflags.debug_package_logs := c.builder.debug_package_logs;
   Dune_digest.Clflags.wait_for_filesystem_clock := c.builder.wait_for_filesystem_clock;
   Dune_engine.Clflags.capture_outputs := c.builder.capture_outputs;
-  Dune_engine.Clflags.diff_command := c.builder.diff_command;
+  Promote.Clflags.diff_command := c.builder.diff_command;
   Dune_engine.Clflags.promote := c.builder.promote;
   Dune_engine.Clflags.force := c.builder.force;
   Dune_engine.Clflags.stop_on_first_error := c.builder.stop_on_first_error;

bin/coq/coqtop.ml

@@ -59,7 +59,7 @@ let term =
       |> Path.Build.append_local (Context.build_dir context)
     in
     let* coqtop, args, env =
-      Build_system.run_exn
+      build_exn
       @@ fun () ->
       let open Memo.O in
       let* (tr : Dune_rules.Dir_contents.triage) =

bin/describe/describe_external_lib_deps.ml

@@ -213,7 +213,7 @@ let term =
   let* setup = Import.Main.setup () in
   let* setup = Memo.run setup in
   let super_context = Import.Main.find_scontext_exn setup ~name:context_name in
-  Build_system.run_exn
+  build_exn
   @@ fun () ->
   let open Memo.O in
   let context_name =

bin/describe/describe_opam_files.ml

@@ -7,7 +7,7 @@ let term =
   let common, config = Common.init builder in
   Scheduler.go ~common ~config
   @@ fun () ->
-  Build_system.run_exn
+  build_exn
   @@ fun () ->
   let open Memo.O in
   let+ project = Source_tree.root () >>| Source_tree.Dir.project in

bin/describe/describe_pp.ml

@@ -167,7 +167,7 @@ let term =
   let* setup = Import.Main.setup () in
   let* setup = Memo.run setup in
   let sctx = Import.Main.find_scontext_exn setup ~name:context_name in
-  Build_system.run_exn
+  build_exn
   @@ fun () ->
   let open Memo.O in
   let* result = get_pped_file sctx file in

bin/describe/describe_workspace.ml

@@ -654,7 +654,7 @@ let term : unit Term.t =
   @@ fun () ->
   let open Fiber.O in
   let* setup = Import.Main.setup () in
-  Build_system.run_exn
+  build_exn
   @@ fun () ->
   let open Memo.O in
   let* setup = setup in

bin/describe/package_entries.ml

@@ -11,7 +11,7 @@ let term =
   let* setup = Import.Main.setup () in
   let* setup = Memo.run setup in
   let super_context = Import.Main.find_scontext_exn setup ~name:context_name in
-  Build_system.run_exn
+  build_exn
   @@ fun () ->
   let open Memo.O in
   Dune_rules.Install_rules.stanzas_to_entries super_context

bin/dune

@@ -8,6 +8,7 @@
   (<> %{profile} dune-bootstrap))
  (libraries
   memo
+  promote
   ocaml
   ocaml_config
   dune_lang

bin/exec.ml

@@ -280,7 +280,7 @@ module Exec_context = struct
     let open Fiber.O in
     let* path, args, env =
       let* { sctx; env; prog; args; get_path_and_build_if_necessary } = t in
-      Build_system.run_exn (fun () ->
+      build_exn (fun () ->
         let open Memo.O in
         let* env = env
         and* sctx = sctx in
@@ -316,7 +316,7 @@ module Exec_context = struct
             (* TODO we should release the dune lock. But we aren't doing it
                because we don't unload the database files we've marshalled.
             *)
-            Build_system.run (fun () -> get_path_and_build_if_necessary ~prog))
+            build (fun () -> get_path_and_build_if_necessary ~prog))
       ; prog
       ; args
       ; env

bin/import.ml

@@ -265,3 +265,13 @@ let command_alias ?orig_name cmd term name =
   in
   Cmd.v (Cmd.info name ~docs:"COMMAND ALIASES" ~doc ~man) term
 ;;
+
+let build f =
+  Hooks.End_of_build.once Promote.Diff_promotion.finalize;
+  Build_system.run f
+;;
+
+let build_exn f =
+  Hooks.End_of_build.once Promote.Diff_promotion.finalize;
+  Build_system.run_exn f
+;;

bin/ocaml/top.ml

@@ -41,7 +41,7 @@ let term =
   Scheduler.go ~common ~config (fun () ->
     let open Fiber.O in
     let* setup = Import.Main.setup () in
-    Build_system.run_exn (fun () ->
+    build_exn (fun () ->
       let open Memo.O in
       let* setup = setup in
       let sctx =
@@ -200,7 +200,7 @@ module Module = struct
     Scheduler.go ~common ~config (fun () ->
       let open Fiber.O in
       let* setup = Import.Main.setup () in
-      Build_system.run_exn (fun () ->
+      build_exn (fun () ->
         let open Memo.O in
         let* setup = setup in
         let sctx =

bin/ocaml/utop.ml

@@ -25,7 +25,7 @@ let term =
     Scheduler.go ~common ~config (fun () ->
       let open Fiber.O in
       let* setup = Import.Main.setup () in
-      Build_system.run_exn (fun () ->
+      build_exn (fun () ->
         let open Memo.O in
         let* setup = setup in
         let context = Import.Main.find_context_exn setup ~name:ctx_name in

bin/print_rules.ml

@@ -98,13 +98,6 @@ let rec encode : Action.For_shell.t -> Dune_lang.t =
   | Rename (x, y) -> List [ atom "rename"; target x; target y ]
   | Remove_tree x -> List [ atom "remove-tree"; target x ]
   | Mkdir x -> List [ atom "mkdir"; target x ]
-  | Diff { optional; file1; file2; mode = Binary } ->
-    assert (not optional);
-    List [ atom "cmp"; path file1; target file2 ]
-  | Diff { optional = false; file1; file2; mode = _ } ->
-    List [ atom "diff"; path file1; target file2 ]
-  | Diff { optional = true; file1; file2; mode = _ } ->
-    List [ atom "diff?"; path file1; target file2 ]
   | Pipe (outputs, l) ->
     List (atom (sprintf "pipe-%s" (Outputs.to_string outputs)) :: List.map l ~f:encode)
   | Extension ext -> List [ atom "ext"; ext ]
@@ -186,7 +179,7 @@ let term =
   Scheduler.go ~common ~config (fun () ->
     let open Fiber.O in
     let* setup = Import.Main.setup () in
-    Build_system.run_exn (fun () ->
+    build_exn (fun () ->
       let open Memo.O in
       let* setup = setup in
       let* request =

bin/printenv.ml

@@ -101,7 +101,7 @@ let term =
          | In_install_dir _ ->
            User_error.raise [ Pp.text "Environment is not defined in install dirs" ])
     in
-    Build_system.run_exn (fun () ->
+    build_exn (fun () ->
       let open Memo.O in
       let+ res, _facts = Action_builder.evaluate_and_collect_facts request in
       res)

bin/promotion.ml

@@ -1,4 +1,5 @@
 open Import
+module Diff_promotion = Promote.Diff_promotion
 
 let files_to_promote ~common files : Diff_promotion.files_to_promote =
   match files with

boot/libs.ml

@@ -14,36 +14,27 @@ let local_libraries =
   ; ("vendor/fiber/src", Some "Fiber", false, None)
   ; ("src/dune_console", Some "Dune_console", false, None)
   ; ("src/memo", Some "Memo", false, None)
-  ; ("vendor/uutf", None, false, None)
-  ; ("src/dune_sexp", Some "Dune_sexp", false, None)
-  ; ("src/ocaml-config", Some "Ocaml_config", false, None)
-  ; ("src/ocaml", Some "Ocaml", false, None)
+  ; ("src/dune_config", Some "Dune_config", false, None)
+  ; ("src/dune_async_io", Some "Dune_async_io", false, None)
   ; ("vendor/re/src", Some "Dune_re", false, None)
   ; ("otherlibs/dune-glob/src", Some "Dune_glob", false, None)
-  ; ("otherlibs/xdg", Some "Xdg", false, None)
-  ; ("otherlibs/dune-rpc/private", Some "Dune_rpc_private", false, None)
-  ; ("src/dune_config", Some "Dune_config", false, None)
-  ; ("vendor/sha", None, false, None)
-  ; ("vendor/opam/src/core", None, false, None)
-  ; ("vendor/opam-file-format", None, false, None)
-  ; ("vendor/opam/src/format", None, false, None)
+  ; ("src/dune_metrics", Some "Dune_metrics", false, None)
   ; ("otherlibs/chrome-trace/src", Some "Chrome_trace", false, None)
   ; ("vendor/spawn/src", Some "Spawn", false, None)
   ; ("src/dune_stats", Some "Dune_stats", false, None)
+  ; ("otherlibs/xdg", Some "Xdg", false, None)
   ; ("vendor/build_path_prefix_map/src", Some "Build_path_prefix_map", false,
     None)
+  ; ("vendor/uutf", None, false, None)
+  ; ("src/dune_sexp", Some "Dune_sexp", false, None)
   ; ("src/dune_util", Some "Dune_util", false, None)
-  ; ("src/dune_metrics", Some "Dune_metrics", false, None)
   ; ("src/dune_digest", Some "Dune_digest", false, None)
   ; ("src/predicate_lang", Some "Predicate_lang", false, None)
-  ; ("otherlibs/dune-private-libs/section", Some "Dune_section", false, None)
-  ; ("src/dune_lang", Some "Dune_lang", false, None)
-  ; ("src/fiber_event_bus", Some "Fiber_event_bus", false, None)
-  ; ("src/dune_async_io", Some "Dune_async_io", false, None)
   ; ("src/fiber_util", Some "Fiber_util", false, None)
   ; ("src/dune_cache_storage", Some "Dune_cache_storage", false, None)
   ; ("src/dune_targets", Some "Dune_targets", false, None)
   ; ("src/dune_cache", Some "Dune_cache", false, None)
+  ; ("otherlibs/dune-rpc/private", Some "Dune_rpc_private", false, None)
   ; ("otherlibs/dune-action-plugin/src", Some "Dune_action_plugin", false,
     None)
   ; ("src/dune_output_truncation", Some "Dune_output_truncation", false,
@@ -60,6 +51,16 @@ let local_libraries =
   ; ("src/fswatch_win", Some "Fswatch_win", false, None)
   ; ("src/dune_file_watcher", Some "Dune_file_watcher", false, None)
   ; ("src/dune_engine", Some "Dune_engine", false, None)
+  ; ("src/promote", Some "Promote", false, None)
+  ; ("src/ocaml-config", Some "Ocaml_config", false, None)
+  ; ("src/ocaml", Some "Ocaml", false, None)
+  ; ("vendor/sha", None, false, None)
+  ; ("vendor/opam/src/core", None, false, None)
+  ; ("vendor/opam-file-format", None, false, None)
+  ; ("vendor/opam/src/format", None, false, None)
+  ; ("otherlibs/dune-private-libs/section", Some "Dune_section", false, None)
+  ; ("src/dune_lang", Some "Dune_lang", false, None)
+  ; ("src/fiber_event_bus", Some "Fiber_event_bus", false, None)
   ; ("otherlibs/dune-private-libs/meta_parser", Some "Dune_meta_parser",
     false, None)
   ; ("src/fs", Some "Fs", false, None)

src/dune_engine/action.ml

@@ -53,10 +53,6 @@ struct
   let rename a b = Rename (a, b)
   let remove_tree path = Remove_tree path
   let mkdir path = Mkdir path
-
-  let diff ?(optional = false) ?(mode = Diff.Mode.Text) file1 file2 =
-    Diff { optional; file1; file2; mode }
-  ;;
 end
 
 module Prog = struct
@@ -197,7 +193,6 @@ let fold_one_step t ~init:acc ~f =
   | Rename _
   | Remove_tree _
   | Mkdir _
-  | Diff _
   | Extension _ -> acc
 ;;
 
@@ -243,7 +238,6 @@ let rec is_dynamic = function
   | Write_file _
   | Rename _
   | Remove_tree _
-  | Diff _
   | Mkdir _
   | Extension _ -> false
 ;;
@@ -293,7 +287,6 @@ let is_useful_to memoize =
     | Write_file _ -> true
     | Rename _ -> memoize
     | Remove_tree _ -> false
-    | Diff _ -> true
     | Mkdir _ -> false
     | Run _ -> true
     | Dynamic_run _ -> true

src/dune_engine/action_exec.ml

@@ -309,17 +309,6 @@ let restrict_env
   { Action.Ext.working_dir; env; stdout_to; stderr_to; stdin_from; exit_codes }
 ;;
 
-let compare_files = function
-  | Action.Diff.Mode.Binary -> Io.compare_files
-  | Text -> Io.compare_text_files
-;;
-
-let diff_eq_files { Action.Diff.optional; mode; file1; file2 } =
-  let file1 = if Path.Untracked.exists file1 then file1 else Dev_null.path in
-  let file2 = Path.build file2 in
-  (optional && not (Path.Untracked.exists file2)) || compare_files mode file1 file2 = Eq
-;;
-
 let zero = Predicate_lang.element 0
 let maybe_async f = Produce.of_fiber (maybe_async f)
 
@@ -381,7 +370,9 @@ let rec exec t ~display ~ectx ~eenv : done_or_more_deps Produce.t =
     let+ () = maybe_async (fun () -> Io.portable_hardlink ~src ~dst:(Path.build dst)) in
     Done
   | System cmd ->
-    let path, arg = Utils.system_shell_exn ~needed_to:"interpret (system ...) actions" in
+    let path, arg =
+      Dune_util.Prog.system_shell_exn ~needed_to:"interpret (system ...) actions"
+    in
     let+ () = exec_run ~display ~ectx ~eenv path [ arg; cmd ] in
     Done
   | Bash cmd ->
@@ -409,78 +400,6 @@ let rec exec t ~display ~ectx ~eenv : done_or_more_deps Produce.t =
   | Mkdir path ->
     let+ () = maybe_async (fun () -> Path.mkdir_p (Path.build path)) in
     Done
-  | Diff ({ optional; file1; file2; mode } as diff) ->
-    let remove_intermediate_file () =
-      if optional
-      then (
-        try Path.unlink_exn (Path.build file2) with
-        | Unix.Unix_error (ENOENT, _, _) -> ())
-    in
-    if diff_eq_files diff
-    then (
-      remove_intermediate_file ();
-      Produce.return Done)
-    else (
-      let is_copied_from_source_tree file =
-        match Path.extract_build_context_dir_maybe_sandboxed file with
-        | None -> false
-        | Some (_, file) -> Path.Untracked.exists (Path.source file)
-      in
-      let+ () =
-        let in_source_or_target =
-          is_copied_from_source_tree file1 || not (Path.Untracked.exists file1)
-        in
-        let source_file =
-          snd (Option.value_exn (Path.extract_build_context_dir_maybe_sandboxed file1))
-        in
-        Produce.of_fiber
-        @@ Fiber.finalize
-             (fun () ->
-               let annots =
-                 User_message.Annots.singleton
-                   Diff_promotion.Annot.annot
-                   { Diff_promotion.Annot.in_source = source_file
-                   ; in_build =
-                       (if optional && in_source_or_target
-                        then Diff_promotion.File.in_staging_area source_file
-                        else file2)
-                   }
-               in
-               if mode = Binary
-               then
-                 User_error.raise
-                   ~annots
-                   ~loc:ectx.rule_loc
-                   [ Pp.textf
-                       "Files %s and %s differ."
-                       (Path.to_string_maybe_quoted file1)
-                       (Path.to_string_maybe_quoted (Path.build file2))
-                   ]
-               else
-                 Print_diff.print
-                   annots
-                   file1
-                   (Path.build file2)
-                   ~skip_trailing_cr:(mode = Text && Sys.win32))
-             ~finally:(fun () ->
-               (match optional with
-                | false ->
-                  (* Promote if in the source tree or not a target. The second case
-                     means that the diffing have been done with the empty file *)
-                  if in_source_or_target
-                     && not (is_copied_from_source_tree (Path.build file2))
-                  then
-                    Diff_promotion.File.register_dep ~source_file ~correction_file:file2
-                | true ->
-                  if in_source_or_target
-                  then
-                    Diff_promotion.File.register_intermediate
-                      ~source_file
-                      ~correction_file:file2
-                  else remove_intermediate_file ());
-               Fiber.return ())
-      in
-      Done)
   | Pipe (outputs, l) -> exec_pipe ~display ~ectx ~eenv outputs l
   | Extension (module A) ->
     let+ () =

src/dune_engine/action_intf.ml

@@ -50,7 +50,6 @@ module type Ast = sig
     | Rename of target * target
     | Remove_tree of target
     | Mkdir of target
-    | Diff of (path, target) Diff.t
     | Pipe of Outputs.t * t list
     | Extension of ext
 end
@@ -85,7 +84,6 @@ module type Helpers = sig
   val rename : target -> target -> t
   val remove_tree : target -> t
   val mkdir : target -> t
-  val diff : ?optional:bool -> ?mode:Diff.Mode.t -> path -> target -> t
 end
 
 module Ext = struct