From 66e038ce55c3d56bd3bf951a1aa33d08085d8971 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 --- doc/changes/8212.md | 2 + .../examples/rpc_client/rpc_client.ml | 5 +- otherlibs/dune-rpc/dune_rpc.mli | 1 + otherlibs/dune-rpc/private/exported_types.ml | 9 ++- otherlibs/dune-rpc/private/exported_types.mli | 1 + otherlibs/dune-rpc/private/procedures.ml | 73 ++++++++++++++++++- src/dune_rpc_impl/server.ml | 7 +- 7 files changed, 89 insertions(+), 9 deletions(-) create mode 100644 doc/changes/8212.md diff --git a/doc/changes/8212.md b/doc/changes/8212.md new file mode 100644 index 00000000000..54d33a728d1 --- /dev/null +++ b/doc/changes/8212.md @@ -0,0 +1,2 @@ +- The `progress` RPC procedure now has an extra field for the `In_progress` + constructor for the number of failed jobs. (#8212, @Alizter) 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 3116ae90d3d..d977a7745f5 100644 --- a/otherlibs/dune-rpc-lwt/examples/rpc_client/rpc_client.ml +++ b/otherlibs/dune-rpc-lwt/examples/rpc_client/rpc_client.ml @@ -32,11 +32,12 @@ let () = | Some Success -> "Success" | Some Failed -> "Failed" | Some Interrupted -> "Interrupted" - | Some (In_progress { complete; remaining }) -> + | Some (In_progress { complete; remaining; failed }) -> Printf.sprintf - "In_progress { complete = %d; remaining = %d }" + "In_progress { complete = %d; remaining = %d; failed = %d }" complete remaining + 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 c6d664a2281..462908135c7 100644 --- a/otherlibs/dune-rpc/dune_rpc.mli +++ b/otherlibs/dune-rpc/dune_rpc.mli @@ -158,6 +158,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 60d0d0390bc..1dfe4e4a5cc 100644 --- a/otherlibs/dune-rpc/private/exported_types.ml +++ b/otherlibs/dune-rpc/private/exported_types.ml @@ -316,6 +316,7 @@ module Progress = struct | In_progress of { complete : int ; remaining : int + ; failed : int } | Failed | Interrupted @@ -328,10 +329,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 @@ -341,7 +343,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 e8c7d256023..ec0c70141cd 100644 --- a/otherlibs/dune-rpc/private/exported_types.mli +++ b/otherlibs/dune-rpc/private/exported_types.mli @@ -109,6 +109,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 b0c5e6d4016..0f49f2d495d 100644 --- a/otherlibs/dune-rpc/private/procedures.ml +++ b/otherlibs/dune-rpc/private/procedures.ml @@ -101,13 +101,82 @@ 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_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 @@ -135,7 +204,7 @@ module Poll = struct let progress = let open Progress in - make name [ v1 ] + make name [ v1; v2 ] ;; let diagnostic = diff --git a/src/dune_rpc_impl/server.ml b/src/dune_rpc_impl/server.ml index 281645bece4..003965cf306 100644 --- a/src/dune_rpc_impl/server.ml +++ b/src/dune_rpc_impl/server.ml @@ -305,8 +305,11 @@ let handler (t : _ t Fdecl.t) action_runner_server handle : 'a Dune_rpc_server.H | 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