Display a warning when dune builds via RPC

When an instance of dune is already running, invoking `dune build` will
still build the target, howwever other command line arguments are
silently ignored by dune as the current RPC interface is too limited to
express them. This may change over time, but currently it's unusual UX
for `dune build` to behave differently depending on whether or not
another instance of `dune build` is already running. To more accurately
set user expectations, print a warning when dune is running with this
reduced functionality.

Signed-off-by: Stephen Sherratt <[email protected]>

Author: gridbugs

bin/build_cmd.ml

@@ -207,7 +207,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
@@ -217,6 +217,12 @@ let build =
          perform the RPC call.
       *)
       Scheduler.go_without_rpc_server ~common ~config (fun () ->
+        User_warning.emit
+          [ Dune_util.Global_lock.Lock_held_by.message lock_held_by
+          ; Pp.text
+              "The requested targets will still be built however functionality will be \
+               reduced and some command line arguments will be ignored."
+          ];
         build_via_rpc_server targets)
     | Ok () ->
       let request setup =

src/dune_util/global_lock.ml

@@ -66,6 +66,28 @@ end
 
 let locked = ref false
 
+module Lock_held_by = struct
+  type t =
+    | Pid_from_lockfile of string
+    | Unknown
+
+  let read_lock_file () =
+    match Io.read_file (Path.build lock_file) with
+    | exception _ -> Unknown
+    | pid -> Pid_from_lockfile pid
+  ;;
+
+  let message t =
+    Pp.textf
+      "A running dune%s instance has locked the build directory. If this is not the \
+       case, please delete %S."
+      (match t with
+       | Unknown -> ""
+       | Pid_from_lockfile pid -> sprintf " (pid: %s)" pid)
+      (Path.Build.to_string_maybe_quoted lock_file)
+  ;;
+end
+
 let lock ~timeout =
   match Config.(get global_lock) with
   | `Disabled -> Ok ()
@@ -90,22 +112,15 @@ let lock ~timeout =
       | `Success ->
         locked := true;
         Ok ()
-      | `Failure -> Error ())
+      | `Failure ->
+        let lock_held_by = Lock_held_by.read_lock_file () in
+        Error lock_held_by)
 ;;
 
 let lock_exn ~timeout =
   match lock ~timeout with
   | Ok () -> ()
-  | Error () ->
-    User_error.raise
-      [ Pp.textf
-          "A running dune%s instance has locked the build directory. If this is not the \
-           case, please delete %s"
-          (match Io.read_file (Path.build lock_file) with
-           | exception _ -> ""
-           | pid -> sprintf " (pid: %s)" pid)
-          (Path.Build.to_string_maybe_quoted lock_file)
-      ]
+  | Error lock_held_by -> User_error.raise [ Lock_held_by.message lock_held_by ]
 ;;
 
 let unlock () =

src/dune_util/global_lock.mli

@@ -2,10 +2,16 @@
 
     Before starting rpc, writing to the build dir, this lock should be locked. *)
 
-(** attempt to acquire a lock. once a lock is locked, subsequent locks always
+module Lock_held_by : sig
+  type t
+
+  val message : t -> 'a Pp.t
+end
+
+(** Attempt to acquire a lock. once a lock is locked, subsequent locks always
     succeed. Returns [Ok ()] if the lock is acquired within [timeout] seconds,
     and [Error ()] otherwise. *)
-val lock : timeout:float option -> (unit, unit) result
+val lock : timeout:float option -> (unit, Lock_held_by.t) result
 
 val lock_exn : timeout:float option -> unit
 

test/blackbox-tests/test-cases/watching/watching-eager-concurrent-build-command.t

@@ -24,12 +24,20 @@ Build the project once before starting the watch server so the watch server star
 
 Demonstrate that we can run "dune build" while the watch server is running.
   $ dune build
+  Warning: A running dune (pid: 124305) instance has locked the build
+  directory. If this is not the case, please delete "_build/.lock".
+  The requested targets will still be built however functionality will be
+  reduced and some command line arguments will be ignored.
   Success
 
 Demonstrate that error messages are still printed by "dune build" when it's
 acting as an RPC client while running concurrently with an RPC server.
   $ echo 'let () = print_endlin "Hello, World!"' > foo.ml
   $ dune build
+  Warning: A running dune (pid: 124305) instance has locked the build
+  directory. If this is not the case, please delete "_build/.lock".
+  The requested targets will still be built however functionality will be
+  reduced and some command line arguments will be ignored.
   File "$TESTCASE_ROOT/foo.ml", line 1, characters 9-21:
   1 | let () = print_endlin "Hello, World!"
                ^^^^^^^^^^^^