Display a warning when dune builds via RPC

bin/arg.ml

@@ -41,6 +41,7 @@ module Dep = struct
 
   type t = Dep_conf.t
 
+  let equal = Dep_conf.equal
   let file s = Dep_conf.File (String_with_vars.make_text Loc.none s)
 
   let make_alias_sw ~dir s =

bin/arg.mli

@@ -21,6 +21,7 @@ end
 module Dep : sig
   type t = Dune_lang.Dep_conf.t
 
+  val equal : t -> t -> bool
   val file : string -> t
   val alias : dir:Stdune.Path.Local.t -> Dune_engine.Alias.Name.t -> t
   val alias_rec : dir:Stdune.Path.Local.t -> Dune_engine.Alias.Name.t -> t

bin/build_cmd.ml

@@ -205,7 +205,7 @@ let build =
        state of the lock could otherwise change between checking it and taking
        it. *)
     match Dune_util.Global_lock.lock ~timeout:None with
-    | Error () ->
+    | Error lock_held_by ->
       (* This case is reached if dune detects that another instance of dune
          is already running. Rather than performing the build itself, the
          current instance of dune will instruct the already-running instance to
@@ -215,6 +215,16 @@ let build =
          perform the RPC call.
       *)
       Scheduler.go_without_rpc_server ~common ~config (fun () ->
+        if not (Common.Builder.equal builder Common.Builder.default)
+        then
+          User_warning.emit
+            [ Pp.textf
+                "Your build request is being forwarded to a running Dune instance%s so \
+                 most command-line arguments will be ignored."
+                (match (lock_held_by : Dune_util.Global_lock.Lock_held_by.t) with
+                 | Unknown -> ""
+                 | Pid_from_lockfile pid -> sprintf " (pid: %d)" pid)
+            ];
         build_via_rpc_server ~print_on_success:true ~targets)
     | Ok () ->
       let request setup =

bin/common.ml

@@ -22,7 +22,38 @@ module Workspace = Source.Workspace
 open struct
   open Cmdliner
   module Cmd = Cmd
-  module Term = Term
+
+  module Term = struct
+    include Term
+
+    (* Evaluate a parser, passing it no command-line arguments, in an
+       environment with no variables set. It's only valid to pass a parser
+       which can be evaluated with no arguments, otherwise a code error will
+       be raised. Returns the result of the parser. This is intended to be
+       used to extract the default value for a type implied by the behaviour
+       of its parser when no command-line arguments are passed to it. *)
+    let eval_no_args_empty_env t =
+      let raise_code_error data =
+        Code_error.raise "Unexpected result evaluating term with no args" data
+      in
+      (* Cmdliner doesn't allow argv to be empty. *)
+      let argv = [| "dune" |] in
+      let env _ = None in
+      match Cmd.eval_value ~argv ~env (Cmd.v (Cmd.info "dune") t) with
+      | Ok (`Ok x) -> x
+      | Ok `Help -> raise_code_error [ "ok", Dyn.string "help" ]
+      | Ok `Version -> raise_code_error [ "ok", Dyn.string "version" ]
+      | Error e ->
+        let error_string =
+          match e with
+          | `Parse -> "parse"
+          | `Term -> "term"
+          | `Exn -> "exn"
+        in
+        raise_code_error [ "error", Dyn.string error_string ]
+    ;;
+  end
+
   module Manpage = Manpage
 end
 
@@ -1025,6 +1056,94 @@ module Builder = struct
     ; log_file = Default
     }
   ;;
+
+  let default = Term.eval_no_args_empty_env term
+
+  let equal
+        t
+        { debug_dep_path
+        ; debug_backtraces
+        ; debug_artifact_substitution
+        ; debug_load_dir
+        ; debug_digests
+        ; debug_package_logs
+        ; wait_for_filesystem_clock
+        ; only_packages
+        ; capture_outputs
+        ; diff_command
+        ; promote
+        ; ignore_promoted_rules
+        ; force
+        ; no_print_directory
+        ; ignore_lock_dir
+        ; store_orig_src_dir
+        ; default_target
+        ; watch
+        ; print_metrics
+        ; dump_memo_graph_file
+        ; dump_memo_graph_format
+        ; dump_memo_graph_with_timing
+        ; dump_gc_stats
+        ; always_show_command_line
+        ; promote_install_files
+        ; file_watcher
+        ; workspace_config
+        ; cache_debug_flags
+        ; report_errors_config
+        ; separate_error_messages
+        ; stop_on_first_error
+        ; require_dune_project_file
+        ; watch_exclusions
+        ; build_dir
+        ; root
+        ; stats_trace_file
+        ; stats_trace_extended
+        ; allow_builds
+        ; default_root_is_cwd
+        ; log_file
+        }
+    =
+    Bool.equal t.debug_dep_path debug_dep_path
+    && Bool.equal t.debug_backtraces debug_backtraces
+    && Bool.equal t.debug_artifact_substitution debug_artifact_substitution
+    && Bool.equal t.debug_load_dir debug_load_dir
+    && Bool.equal t.debug_digests debug_digests
+    && Bool.equal t.debug_package_logs debug_package_logs
+    && Bool.equal t.wait_for_filesystem_clock wait_for_filesystem_clock
+    && Only_packages.Clflags.equal t.only_packages only_packages
+    && Bool.equal t.capture_outputs capture_outputs
+    && Option.equal String.equal t.diff_command diff_command
+    && Option.equal Dune_engine.Clflags.Promote.equal t.promote promote
+    && Bool.equal t.ignore_promoted_rules ignore_promoted_rules
+    && Bool.equal t.force force
+    && Bool.equal t.no_print_directory no_print_directory
+    && Bool.equal t.ignore_lock_dir ignore_lock_dir
+    && Bool.equal t.store_orig_src_dir store_orig_src_dir
+    && Arg.Dep.equal t.default_target default_target
+    && Dune_rpc_impl.Watch_mode_config.equal t.watch watch
+    && Bool.equal t.print_metrics print_metrics
+    && Option.equal Path.External.equal t.dump_memo_graph_file dump_memo_graph_file
+    && Graph.File_format.equal t.dump_memo_graph_format dump_memo_graph_format
+    && Bool.equal t.dump_memo_graph_with_timing dump_memo_graph_with_timing
+    && Option.equal Path.External.equal t.dump_gc_stats dump_gc_stats
+    && Bool.equal t.always_show_command_line always_show_command_line
+    && Bool.equal t.promote_install_files promote_install_files
+    && Dune_engine.Scheduler.Run.file_watcher_equal t.file_watcher file_watcher
+    && Source.Workspace.Clflags.equal t.workspace_config workspace_config
+    && Dune_engine.Cache_debug_flags.equal t.cache_debug_flags cache_debug_flags
+    && Dune_engine.Report_errors_config.equal t.report_errors_config report_errors_config
+    && Bool.equal t.separate_error_messages separate_error_messages
+    && Bool.equal t.stop_on_first_error stop_on_first_error
+    && Bool.equal t.require_dune_project_file require_dune_project_file
+    && List.equal String.equal t.watch_exclusions watch_exclusions
+    && String.equal t.build_dir build_dir
+    && Option.equal String.equal t.root root
+    && Option.equal String.equal t.stats_trace_file stats_trace_file
+    && Bool.equal t.stats_trace_extended stats_trace_extended
+    && Bool.equal t.allow_builds allow_builds
+    && Bool.equal t.default_root_is_cwd default_root_is_cwd
+    && Log.File.equal t.log_file log_file
+  ;;
 end
 
 type t =

bin/common.mli

@@ -28,6 +28,7 @@ val prefix_target : t -> string -> string
 module Builder : sig
   type t
 
+  val equal : t -> t -> bool
   val root : t -> string option
   val set_root : t -> string -> t
   val forbid_builds : t -> t
@@ -38,6 +39,7 @@ module Builder : sig
   val set_promote : t -> Dune_engine.Clflags.Promote.t -> t
   val default_target : t -> Arg.Dep.t
   val term : t Cmdliner.Term.t
+  val default : t
 end
 
 (** [init] creates a [Common.t] by executing a sequence of side-effecting actions to

bin/tools/tools_common.ml

@@ -29,7 +29,7 @@ let build_dev_tool_via_rpc dev_tool =
 let lock_and_build_dev_tool ~common ~config dev_tool =
   let open Fiber.O in
   match Dune_util.Global_lock.lock ~timeout:None with
-  | Error () ->
+  | Error _lock_held_by ->
     Scheduler.go_without_rpc_server ~common ~config (fun () ->
       let* () = Lock_dev_tool.lock_dev_tool dev_tool |> Memo.run in
       build_dev_tool_via_rpc dev_tool)

src/dune_cache/config.ml

@@ -8,6 +8,13 @@ module Reproducibility_check = struct
     | Check_with_probability of float
     | Check
 
+  let equal a b =
+    match a, b with
+    | Skip, Skip | Check, Check -> true
+    | Check_with_probability a, Check_with_probability b -> a = b
+    | _, _ -> false
+  ;;
+
   let sample = function
     | Skip -> false
     | Check_with_probability p -> Random.float 1. < p

src/dune_cache/config.mli

@@ -16,6 +16,8 @@ module Reproducibility_check : sig
     | Check_with_probability of float (** [0 < p < 1] *)
     | Check
 
+  val equal : t -> t -> bool
+
   (** Should we check the current build rule for reproducibility?
 
       - If [t = Skip], return [false].

src/dune_cache_storage/mode.ml

@@ -4,6 +4,12 @@ type t =
   | Hardlink
   | Copy
 
+let equal a b =
+  match a, b with
+  | Hardlink, Hardlink | Copy, Copy -> true
+  | _, _ -> false
+;;
+
 let all = [ "hardlink", Hardlink; "copy", Copy ]
 
 let of_string s =

src/dune_cache_storage/mode.mli

@@ -24,6 +24,7 @@ type t =
   | Hardlink
   | Copy
 
+val equal : t -> t -> bool
 val all : (string * t) list
 val to_string : t -> string
 val of_string : string -> (t, string) result

src/dune_config_file/display.ml

@@ -8,6 +8,15 @@ type t =
       }
   | Tui
 
+let equal a b =
+  match a, b with
+  | ( Simple { status_line = a_status_line; verbosity = a_verbosity }
+    , Simple { status_line = b_status_line; verbosity = b_verbosity } ) ->
+    Bool.equal a_status_line b_status_line && Display.equal a_verbosity b_verbosity
+  | Tui, Tui -> true
+  | _, _ -> false
+;;
+
 let progress = Simple { status_line = true; verbosity = Quiet }
 let verbose = Simple { status_line = true; verbosity = Verbose }
 let short = Simple { status_line = true; verbosity = Short }

src/dune_config_file/display.mli

@@ -9,6 +9,8 @@ type t =
       }
   | Tui
 
+val equal : t -> t -> bool
+
 (** All the supported display modes for setting from the command line. *)
 val all : (string * t) list