rpc: add failed jobs to progress

Signed-off-by: Ali Caglayan <alizter@gmail.com>

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)

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);

otherlibs/dune-rpc/dune_rpc.mli

@@ -158,6 +158,7 @@ module V1 : sig
       | In_progress of
           { complete : int
           ; remaining : int
+          ; failed : int
           }
       | Failed
       | Interrupted

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

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

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 =

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