Passive watch mode for tests

bin/build_cmd.ml

@@ -20,41 +20,79 @@ let run_build_system ?report_error ~common ~(request : unit Action_builder.t) ()
              ]));
       Fiber.return ())
 
-let run_build_command_poll ~(common : Common.t) ~config ~request ~setup =
+let run_build_command_poll_eager ~(common : Common.t) ~config ~request ~setup :
+    unit =
   let open Fiber.O in
   let every ~report_error () =
     Cached_digest.invalidate_cached_timestamps ();
     let* setup = setup () in
-    let* request =
-      match
-        let open Option.O in
-        let* rpc = Common.rpc common in
-        Dune_rpc_impl.Server.pending_build_action rpc
-      with
-      | None -> Fiber.return (request setup)
-      | Some (Build (targets, ivar)) ->
-        let+ () = Fiber.Ivar.fill ivar Accepted in
-        Target.interpret_targets (Common.root common) config setup targets
-    in
+    let request = request setup in
     let+ () = run_build_system ~report_error ~common ~request () in
     `Continue
   in
-  Scheduler.poll ~common ~config ~every ~finally:Hooks.End_of_build.run
+  Import.Scheduler.go_with_rpc_server_and_console_status_reporting ~common
+    ~config (fun () ->
+      Scheduler.Run.poll (fun ~report_error ->
+          Fiber.finalize (every ~report_error) ~finally:(fun () ->
+              Fiber.return (Hooks.End_of_build.run ()))))
+
+let run_build_command_poll_passive ~(common : Common.t) ~config ~request ~setup
+    : unit =
+  let _ =
+    (* CR-someday aalekseyev: It would've been better to complain if request are
+       non-empty, but we can't check that here because [request] is a function.*)
+    ignore request
+  in
+  let open Fiber.O in
+  let run_build ~report_error request =
+    Fiber.of_thunk (fun () ->
+        Cached_digest.invalidate_cached_timestamps ();
+        let* setup = setup () in
+        let request = request setup in
+        let+ () = run_build_system ~report_error ~common ~request () in
+        `Continue)
+  in
+  match Common.rpc common with
+  | None ->
+    Code_error.raise
+      "Attempted to start a passive polling mode without an RPC server" []
+  | Some rpc ->
+    Import.Scheduler.go_with_rpc_server_and_console_status_reporting ~common
+      ~config (fun () ->
+        Scheduler.Run.poll_passive
+          ~get_build_request:
+            (let+ (Build (targets, ivar)) =
+               Dune_rpc_impl.Server.pending_build_action rpc
+             in
+             let targets setup =
+               Target.interpret_targets (Common.root common) config setup
+                 targets
+             in
+             ( (fun ~report_error ->
+                 Fiber.of_thunk (fun () ->
+                     Fiber.finalize
+                       ~finally:(fun () ->
+                         Hooks.End_of_build.run ();
+                         Fiber.return ())
+                       (fun () -> run_build ~report_error targets)))
+             , ivar )))
 
-let run_build_command_once ~(common : Common.t) ~config ~request ~setup =
+let run_build_command_once ~(common : Common.t) ~config ~request
+    ~(setup : unit -> Import.Main.build_system Fiber.t) =
   let open Fiber.O in
   let once () =
     let* setup = setup () in
-    run_build_system ~common ~request:(request setup) ()
+    let request = request setup in
+    run_build_system ~common ~request ()
   in
   Scheduler.go ~common ~config once
 
 let run_build_command ~(common : Common.t) ~config ~request =
   let setup () = Import.Main.setup () in
-  (if Common.watch common then
-    run_build_command_poll
-  else
-    run_build_command_once)
+  (match Common.watch common with
+  | Yes Eager -> run_build_command_poll_eager
+  | Yes Passive -> run_build_command_poll_passive
+  | No -> run_build_command_once)
     ~setup ~common ~config ~request
 
 let runtest =

bin/common.ml

@@ -37,7 +37,7 @@ type t =
     orig_args : string list
   ; rpc : Dune_rpc_impl.Server.t option
   ; default_target : Arg.Dep.t (* For build & runtest only *)
-  ; watch : bool
+  ; watch : Dune_engine.Watch_mode_config.t
   ; print_metrics : bool
   ; stats_trace_file : string option
   ; always_show_command_line : bool
@@ -799,12 +799,34 @@ let term =
             "Force actions associated to aliases to be re-executed even\n\
             \                   if their dependencies haven't changed.")
   and+ watch =
-    Arg.(
-      value & flag
-      & info [ "watch"; "w" ]
-          ~doc:
-            "Instead of terminating build after completion, wait continuously \
-             for file changes.")
+    Term.ret
+      (let watch_arg_name = "watch" in
+       let passive_watch_mode_arg_name = "passive-watch-mode" in
+       let+ w_flag =
+         Arg.(
+           value & flag
+           & info [ watch_arg_name; "w" ]
+               ~doc:
+                 "Instead of terminating build after completion, wait \
+                  continuously for file changes.")
+       and+ passive_watch_mode_flag =
+         Arg.(
+           value & flag
+           & info
+               [ passive_watch_mode_arg_name ]
+               ~doc:
+                 "Do not automatically start or re-start a build. Only do it \
+                  when a build RPC is received.")
+       in
+       match (w_flag, passive_watch_mode_flag) with
+       | false, false -> `Ok Dune_engine.Watch_mode_config.No
+       | false, true ->
+         `Error
+           ( true
+           , sprintf "Cannot use %s if %s was not passed"
+               passive_watch_mode_arg_name watch_arg_name )
+       | true, false -> `Ok (Dune_engine.Watch_mode_config.Yes Eager)
+       | true, true -> `Ok (Dune_engine.Watch_mode_config.Yes Passive))
   and+ print_metrics =
     Arg.(
       value & flag
@@ -928,10 +950,9 @@ let term =
   let build_dir = Option.value ~default:default_build_dir build_dir in
   let root = Workspace_root.create ~specified_by_user:root in
   let rpc =
-    if watch then
-      Some (Dune_rpc_impl.Server.create ())
-    else
-      None
+    match watch with
+    | Yes _ -> Some (Dune_rpc_impl.Server.create ())
+    | No -> None
   in
   let stats =
     Option.map stats_trace_file ~f:(fun f ->

bin/common.mli

@@ -10,7 +10,7 @@ val stats : t -> Dune_stats.t option
 
 val print_metrics : t -> bool
 
-val watch : t -> bool
+val watch : t -> Dune_engine.Watch_mode_config.t
 
 val file_watcher : t -> Dune_engine.Scheduler.Run.file_watcher
 

bin/import.ml

@@ -32,7 +32,13 @@ include Common.Let_syntax
 
 let in_group (t, info) = (Term.Group.Term t, info)
 
-module Main = struct
+module Main : sig
+  include module type of struct
+    include Dune_rules.Main
+  end
+
+  val setup : unit -> build_system Fiber.t
+end = struct
   include Dune_rules.Main
 
   let setup () =
@@ -92,17 +98,13 @@ module Scheduler = struct
     let config = Dune_config.for_scheduler dune_config None stats in
     Scheduler.Run.go config ~on_event:(on_event dune_config) f
 
-  let poll ~(common : Common.t) ~config:dune_config ~every ~finally =
+  let go_with_rpc_server_and_console_status_reporting ~(common : Common.t)
+      ~config:dune_config run =
     let stats = Common.stats common in
     let rpc_where = Some (Dune_rpc_private.Where.default ()) in
     let config = Dune_config.for_scheduler dune_config rpc_where stats in
     let file_watcher = Common.file_watcher common in
     let run =
-      let run () =
-        Scheduler.Run.poll (fun ~report_error () ->
-            Fiber.finalize (every ~report_error) ~finally:(fun () ->
-                Fiber.return (finally ())))
-      in
       match Common.rpc common with
       | None -> run
       | Some rpc ->

bin/rpc.ml

@@ -99,6 +99,10 @@ module Init = struct
   let term = (Term.Group.Term term, info)
 end
 
+let report_error error =
+  Printf.printf "Error: %s\n%!"
+    (Dyn.to_string (Dune_rpc_private.Response.Error.to_dyn error))
+
 module Status = struct
   let term =
     let+ (common : Common.t) = Common.term in
@@ -117,20 +121,52 @@ module Status = struct
             ()
         in
         match response with
-        | Error _ -> assert false
-        (* TODO *)
+        | Error error -> report_error error
         | Ok { clients } ->
           List.iter clients ~f:(fun client ->
               let sexp = Dune_rpc.Conv.to_sexp Dune_rpc.Id.sexp client in
               Sexp.to_string sexp |> print_endline))
 
   let info =
-    let doc = "shot active connections" in
+    let doc = "show active connections" in
     Term.info "status" ~doc
 
   let term = (Term.Group.Term term, info)
 end
 
+module Build = struct
+  let term =
+    let name_ = Arg.info [] ~docv:"TARGET" in
+    let+ (common : Common.t) = Common.term
+    and+ targets = Arg.(value & pos_all string [] name_) in
+    client_term common @@ fun common ->
+    let where = wait_for_server common in
+    Dune_rpc_impl.Run.client where
+      (Dune_rpc.Initialize.Request.create
+         ~id:(Dune_rpc.Id.make (Sexp.Atom "build")))
+      ~on_notification:(fun _ -> assert false)
+      ~f:(fun session ->
+        let open Fiber.O in
+        let+ response =
+          Dune_rpc_impl.Client.request session Dune_rpc_impl.Server.Decl.build
+            targets
+        in
+        match response with
+        | Error (error : Dune_rpc_private.Response.Error.t) ->
+          report_error error
+        | Ok Failure -> print_endline "Failure"
+        | Ok Success -> print_endline "Success")
+
+  let info =
+    let doc =
+      "build a given target (requires dune to be running in passive watching \
+       mode)"
+    in
+    Term.info "build" ~doc
+
+  let term = (Term.Group.Term term, info)
+end
+
 let info =
   let doc = "Dune's RPC mechanism. Experimental." in
   let man =
@@ -141,4 +177,4 @@ let info =
   in
   Term.info "rpc" ~doc ~man
 
-let group = (Term.Group.Group [ Init.term; Status.term ], info)
+let group = (Term.Group.Group [ Init.term; Status.term; Build.term ], info)

otherlibs/dune-rpc/private/dune_rpc_private.mli

@@ -52,6 +52,8 @@ module Response : sig
 
     exception E of t
 
+    val to_dyn : t -> Stdune.Dyn.t
+
     val of_conv : Conv.error -> t
 
     val create : ?payload:Csexp.t -> kind:kind -> message:string -> unit -> t

otherlibs/dune-rpc/private/types.mli

@@ -58,6 +58,8 @@ module Response : sig
       ; kind : kind
       }
 
+    val to_dyn : t -> Dyn.t
+
     val payload : t -> Sexp.t option
 
     val message : t -> string

src/dune_engine/clflags.ml

@@ -26,7 +26,7 @@ let promote = ref None
 
 let force = ref false
 
-let watch = ref false
+let watch = ref Watch_mode_config.No
 
 let no_print_directory = ref false
 

src/dune_engine/clflags.mli

@@ -37,7 +37,7 @@ val promote : Promote.t option ref
 val force : bool ref
 
 (** Instead of terminating build after completion, watch for changes *)
-val watch : bool ref
+val watch : Watch_mode_config.t ref
 
 (** Do not print "Entering directory" messages *)
 val no_print_directory : bool ref

src/dune_engine/dune_engine.ml

@@ -58,3 +58,4 @@ module Execution_parameters = Execution_parameters
 module Cache_debug_flags = Cache_debug_flags
 module Reversible_digest = Reversible_digest
 module Report_errors_config = Report_errors_config
+module Watch_mode_config = Watch_mode_config

src/dune_engine/fs_memo.ml

@@ -123,4 +123,8 @@ module Event = struct
     | Directory_deleted
     | Unknown ->
       invalidate_path_and_its_parent path
+
+  let path t = t.path
+
+  let kind t = t.kind
 end

src/dune_engine/fs_memo.mli

@@ -50,6 +50,10 @@ module Event : sig
 
   type t
 
+  val kind : t -> kind
+
+  val path : t -> Path.t
+
   val create : kind:kind -> path:Path.t -> t
 
   (** Handle file system event. *)