From e3a0b32ab8cfc3c957b5655e125e3d1275b08278 Mon Sep 17 00:00:00 2001 From: Ali Caglayan Date: Wed, 12 Jul 2023 19:29:25 +0200 Subject: [PATCH] rpc: add failed jobs to progress Signed-off-by: Ali Caglayan --- CHANGES.md | 3 + .../examples/rpc_client/rpc_client.ml | 7 +- otherlibs/dune-rpc/dune_rpc.mli | 1 + otherlibs/dune-rpc/private/exported_types.ml | 11 ++-- otherlibs/dune-rpc/private/exported_types.mli | 1 + otherlibs/dune-rpc/private/procedures.ml | 66 ++++++++++++++++++- src/dune_rpc_impl/server.ml | 10 +-- 7 files changed, 86 insertions(+), 13 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 93555786c663..79b76c78fc36 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -3,6 +3,9 @@ Unreleased - No longer emit linkopts(javascript) in META files (#8168, @hhugo) +- The `progress` RPC procedure now has an extra field for the `In_progress` + constructor for the number of failed jobs. (#8212, @Alizter) + 3.10.0 (2023-07-31) ------------------- diff --git a/otherlibs/dune-rpc-lwt/examples/rpc_client/rpc_client.ml b/otherlibs/dune-rpc-lwt/examples/rpc_client/rpc_client.ml index fa6138127565..56c707421d7e 100644 --- a/otherlibs/dune-rpc-lwt/examples/rpc_client/rpc_client.ml +++ b/otherlibs/dune-rpc-lwt/examples/rpc_client/rpc_client.ml @@ -34,9 +34,12 @@ let () = | Some Success -> "Success" | Some Failed -> "Failed" | Some Interrupted -> "Interrupted" - | Some (In_progress { complete; remaining }) -> - Printf.sprintf "In_progress { complete = %d; remaining = %d }" + | Some (In_progress { complete; remaining; failed }) -> + Printf.sprintf "In_progress { complete = %d; remaining = %d%s }" complete remaining + (match failed with + | 0 -> "" + | failed -> Printf.sprintf "; failed = %d" failed) | Some Waiting -> "Waiting" in print_endline (Printf.sprintf "Got progress_event: %s" message); diff --git a/otherlibs/dune-rpc/dune_rpc.mli b/otherlibs/dune-rpc/dune_rpc.mli index 00806839ff06..b5fdd67924f9 100644 --- a/otherlibs/dune-rpc/dune_rpc.mli +++ b/otherlibs/dune-rpc/dune_rpc.mli @@ -175,6 +175,7 @@ module V1 : sig | In_progress of { complete : int ; remaining : int + ; failed : int } | Failed | Interrupted diff --git a/otherlibs/dune-rpc/private/exported_types.ml b/otherlibs/dune-rpc/private/exported_types.ml index 7ca6739aec99..56609f87e0b3 100644 --- a/otherlibs/dune-rpc/private/exported_types.ml +++ b/otherlibs/dune-rpc/private/exported_types.ml @@ -325,6 +325,7 @@ module Progress = struct | In_progress of { complete : int ; remaining : int + ; failed : int } | Failed | Interrupted @@ -337,9 +338,11 @@ module Progress = struct let in_progress = let complete = field "complete" (required int) in let remaining = field "remaining" (required int) in + let failed = field "failed" (required int) in constr "in_progress" - (record (both complete remaining)) - (fun (complete, remaining) -> In_progress { complete; remaining }) + (record (three complete remaining failed)) + (fun (complete, remaining, failed) -> + In_progress { complete; remaining; failed }) in let interrupted = constr "interrupted" unit (fun () -> Interrupted) in let success = constr "success" unit (fun () -> Success) in @@ -349,8 +352,8 @@ module Progress = struct in let serialize = function | Waiting -> case () waiting - | In_progress { complete; remaining } -> - case (complete, remaining) in_progress + | In_progress { complete; remaining; failed } -> + case (complete, remaining, failed) in_progress | Failed -> case () failed | Interrupted -> case () interrupted | Success -> case () success diff --git a/otherlibs/dune-rpc/private/exported_types.mli b/otherlibs/dune-rpc/private/exported_types.mli index 0cdc14a6dd2c..b2005542ddfb 100644 --- a/otherlibs/dune-rpc/private/exported_types.mli +++ b/otherlibs/dune-rpc/private/exported_types.mli @@ -132,6 +132,7 @@ module Progress : sig | In_progress of { complete : int ; remaining : int + ; failed : int } | Failed | Interrupted diff --git a/otherlibs/dune-rpc/private/procedures.ml b/otherlibs/dune-rpc/private/procedures.ml index 30ac95a8d16a..d237a1959b8b 100644 --- a/otherlibs/dune-rpc/private/procedures.ml +++ b/otherlibs/dune-rpc/private/procedures.ml @@ -118,12 +118,72 @@ module Poll = struct let name t = t.name module Progress = struct + module V1 = struct + type t = + | Waiting + | In_progress of + { complete : int + ; remaining : int + } + | Failed + | Interrupted + | Success + + let sexp = + let open Conv in + let waiting = constr "waiting" unit (fun () -> Waiting) in + let failed = constr "failed" unit (fun () -> Failed) in + let in_progress = + let complete = field "complete" (required int) in + let remaining = field "remaining" (required int) in + constr "in_progress" + (record (both complete remaining)) + (fun (complete, remaining) -> In_progress { complete; remaining }) + in + let interrupted = constr "interrupted" unit (fun () -> Interrupted) in + let success = constr "success" unit (fun () -> Success) in + let constrs = + List.map ~f:econstr [ waiting; failed; interrupted; success ] + @ [ econstr in_progress ] + in + let serialize = function + | Waiting -> case () waiting + | In_progress { complete; remaining } -> + case (complete, remaining) in_progress + | Failed -> case () failed + | Interrupted -> case () interrupted + | Success -> case () success + in + sum constrs serialize + + let to_progress : t -> Progress.t = function + | Waiting -> Waiting + | In_progress { complete; remaining } -> + In_progress { complete; remaining; failed = 0 } + | Failed -> Failed + | Interrupted -> Interrupted + | Success -> Success + + let of_progress : Progress.t -> t = function + | Waiting -> Waiting + | In_progress { complete; remaining; failed = _ } -> + In_progress { complete; remaining } + | Failed -> Failed + | Interrupted -> Interrupted + | Success -> Success + end + let name = "progress" let v1 = - Decl.Request.make_current_gen ~req:Id.sexp + Decl.Request.make_gen ~version:1 ~req:Id.sexp ~resp:(Conv.option V1.sexp) + ~upgrade_req:Fun.id ~downgrade_req:Fun.id + ~upgrade_resp:(Option.map ~f:V1.to_progress) + ~downgrade_resp:(Option.map ~f:V1.of_progress) + + let v2 = + Decl.Request.make_current_gen ~version:2 ~req:Id.sexp ~resp:(Conv.option Progress.sexp) - ~version:1 end module Diagnostic = struct @@ -146,7 +206,7 @@ module Poll = struct let progress = let open Progress in - make name [ v1 ] + make name [ v1; v2 ] let diagnostic = let open Diagnostic in diff --git a/src/dune_rpc_impl/server.ml b/src/dune_rpc_impl/server.ml index 61adb0aa3003..80ecd901ab3a 100644 --- a/src/dune_rpc_impl/server.ml +++ b/src/dune_rpc_impl/server.ml @@ -303,10 +303,12 @@ let handler (t : _ t Fdecl.t) action_runner_server handle : | Build_succeeded__now_waiting_for_changes -> Success | Build_failed__now_waiting_for_changes -> Failed | Building now -> - let remaining = - now.number_of_rules_discovered - now.number_of_rules_executed - in - In_progress { complete = now.number_of_rules_executed; remaining } + In_progress + { complete = now.number_of_rules_executed + ; remaining = + now.number_of_rules_discovered - now.number_of_rules_executed + ; failed = now.number_of_rules_failed + } in Handler.implement_long_poll rpc Procedures.Poll.progress Build_system.state ~equal:Build_system.State.equal ~diff