From b702168ff073e09311e9b94979dc1ec7c2659516 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 --- .../examples/rpc_client/rpc_client.ml | 7 +++- otherlibs/dune-rpc/dune_rpc.mli | 1 + otherlibs/dune-rpc/private/exported_types.ml | 41 +++++++++++++++++-- otherlibs/dune-rpc/private/exported_types.mli | 5 +++ otherlibs/dune-rpc/private/procedures.ml | 9 +++- src/dune_rpc_impl/server.ml | 10 +++-- 6 files changed, 61 insertions(+), 12 deletions(-) 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..c3859df1b4d6 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,13 +352,43 @@ 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 in sum constrs serialize + + module V1 = struct + 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; failed = 0 }) + 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; failed = _ } -> + case (complete, remaining) in_progress + | Failed -> case () failed + | Interrupted -> case () interrupted + | Success -> case () success + in + sum constrs serialize + end end module Message = struct diff --git a/otherlibs/dune-rpc/private/exported_types.mli b/otherlibs/dune-rpc/private/exported_types.mli index 0cdc14a6dd2c..27b293698137 100644 --- a/otherlibs/dune-rpc/private/exported_types.mli +++ b/otherlibs/dune-rpc/private/exported_types.mli @@ -132,12 +132,17 @@ module Progress : sig | In_progress of { complete : int ; remaining : int + ; failed : int } | Failed | Interrupted | Success val sexp : (t, Conv.values) Conv.t + + module V1 : sig + val sexp : (t, Conv.values) Conv.t + end end module Message : sig diff --git a/otherlibs/dune-rpc/private/procedures.ml b/otherlibs/dune-rpc/private/procedures.ml index 30ac95a8d16a..047ccb5997a0 100644 --- a/otherlibs/dune-rpc/private/procedures.ml +++ b/otherlibs/dune-rpc/private/procedures.ml @@ -122,8 +122,13 @@ module Poll = struct let v1 = Decl.Request.make_current_gen ~req:Id.sexp - ~resp:(Conv.option Progress.sexp) + ~resp:(Conv.option Progress.V1.sexp) ~version:1 + + let v2 = + Decl.Request.make_current_gen ~req:Id.sexp + ~resp:(Conv.option Progress.sexp) + ~version:2 end module Diagnostic = struct @@ -146,7 +151,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