From 0b93ecc90d7c6e66a56f537b40c07afa82d56293 Mon Sep 17 00:00:00 2001 From: Ali Caglayan Date: Wed, 16 Aug 2023 15:00:45 +0100 Subject: [PATCH] feature: show number of errors when waiting in watch mode This is a feature that I added to Dune monitor by keeping track of the cardinality of the diagnostics sent. We can do better in general by threading the correct information through the build system. This displays: Had 4 errors When the watchmode build has been finished with 4 errors. For a single error it say "Had 1 error". Signed-off-by: Ali Caglayan --- bin/import.ml | 13 ++- doc/changes/8408.md | 2 + .../examples/rpc_client/rpc_client.ml | 2 +- otherlibs/dune-rpc/dune_rpc.mli | 2 +- otherlibs/dune-rpc/private/exported_types.ml | 10 +-- otherlibs/dune-rpc/private/exported_types.mli | 2 +- otherlibs/dune-rpc/private/procedures.ml | 81 ++++++++++++++++++- src/dune_engine/build_system.ml | 10 ++- src/dune_engine/build_system.mli | 2 +- src/dune_rpc_impl/server.ml | 3 +- .../test-cases/watching/basic.t | 4 +- .../test-cases/watching/fs-memo.t | 12 +-- .../test-cases/watching/target-promotion.t | 2 +- test/expect-tests/dune_rpc/dune_rpc_tests.ml | 5 +- 14 files changed, 119 insertions(+), 31 deletions(-) create mode 100644 doc/changes/8408.md diff --git a/bin/import.ml b/bin/import.ml index 4c1b67b295bc..0f3bb51ceebc 100644 --- a/bin/import.ml +++ b/bin/import.ml @@ -88,7 +88,7 @@ end = struct | Initializing | Restarting_current_build | Build_succeeded__now_waiting_for_changes - | Build_failed__now_waiting_for_changes -> Pp.nop + | Build_failed__now_waiting_for_changes _ -> Pp.nop | Building { Build_system.Progress.number_of_rules_executed = done_ ; number_of_rules_discovered = total @@ -140,7 +140,7 @@ module Scheduler = struct | Initializing | Restarting_current_build | Build_succeeded__now_waiting_for_changes - | Build_failed__now_waiting_for_changes -> Build_system.Progress.init + | Build_failed__now_waiting_for_changes _ -> Build_system.Progress.init | Building progress -> progress in Pp.seq @@ -154,7 +154,14 @@ module Scheduler = struct let message = match build_result with | Success -> Pp.tag User_message.Style.Success (Pp.verbatim "Success") - | Failure -> Pp.tag User_message.Style.Error (Pp.verbatim "Had errors") + | Failure -> + let failure_message = + match Fiber.Svar.read Build_system.state with + | Build_failed__now_waiting_for_changes 1 -> Pp.textf "Had 1 error" + | Build_failed__now_waiting_for_changes n -> Pp.textf "Had %d errors" n + | _ -> Pp.verbatim "Had errors" + in + Pp.tag User_message.Style.Error failure_message in Console.Status_line.set (Constant (Pp.seq message (Pp.verbatim ", waiting for filesystem changes..."))) diff --git a/doc/changes/8408.md b/doc/changes/8408.md new file mode 100644 index 000000000000..0b559efdae83 --- /dev/null +++ b/doc/changes/8408.md @@ -0,0 +1,2 @@ +- Dune now displays the number of errors when waiting for changes in watch mode. (#8408, + @Alizter) \ No newline at end of file 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 d977a7745f5a..73dc6c5c17c2 100644 --- a/otherlibs/dune-rpc-lwt/examples/rpc_client/rpc_client.ml +++ b/otherlibs/dune-rpc-lwt/examples/rpc_client/rpc_client.ml @@ -30,7 +30,7 @@ let () = match progress_event with | None -> "(none)" | Some Success -> "Success" - | Some Failed -> "Failed" + | Some (Failed number) -> Printf.sprintf "Failed with %d errors" number | Some Interrupted -> "Interrupted" | Some (In_progress { complete; remaining; failed }) -> Printf.sprintf diff --git a/otherlibs/dune-rpc/dune_rpc.mli b/otherlibs/dune-rpc/dune_rpc.mli index 462908135c79..c0aefd65f08d 100644 --- a/otherlibs/dune-rpc/dune_rpc.mli +++ b/otherlibs/dune-rpc/dune_rpc.mli @@ -160,7 +160,7 @@ module V1 : sig ; remaining : int ; failed : int } - | Failed + | Failed of int | Interrupted | Success end diff --git a/otherlibs/dune-rpc/private/exported_types.ml b/otherlibs/dune-rpc/private/exported_types.ml index f497d494cd3f..94860a0776f0 100644 --- a/otherlibs/dune-rpc/private/exported_types.ml +++ b/otherlibs/dune-rpc/private/exported_types.ml @@ -316,14 +316,14 @@ module Progress = struct ; remaining : int ; failed : int } - | Failed + | Failed of int | 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 failed = constr "failed" int (fun failed -> Failed failed) in let in_progress = let complete = field "complete" (required int) in let remaining = field "remaining" (required int) in @@ -336,14 +336,14 @@ module Progress = struct 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 ] + List.map ~f:econstr [ waiting; interrupted; success ] + @ [ econstr failed; econstr in_progress ] in let serialize = function | Waiting -> case () waiting | In_progress { complete; remaining; failed } -> case (complete, remaining, failed) in_progress - | Failed -> case () failed + | Failed n -> case n failed | Interrupted -> case () interrupted | Success -> case () success in diff --git a/otherlibs/dune-rpc/private/exported_types.mli b/otherlibs/dune-rpc/private/exported_types.mli index ec0c70141cd7..f373f4dfb4ca 100644 --- a/otherlibs/dune-rpc/private/exported_types.mli +++ b/otherlibs/dune-rpc/private/exported_types.mli @@ -111,7 +111,7 @@ module Progress : sig ; remaining : int ; failed : int } - | Failed + | Failed of int | Interrupted | Success diff --git a/otherlibs/dune-rpc/private/procedures.ml b/otherlibs/dune-rpc/private/procedures.ml index 0f49f2d495dc..1469ebedb999 100644 --- a/otherlibs/dune-rpc/private/procedures.ml +++ b/otherlibs/dune-rpc/private/procedures.ml @@ -144,7 +144,7 @@ module Poll = struct | Waiting -> Waiting | In_progress { complete; remaining } -> In_progress { complete; remaining; failed = 0 } - | Failed -> Failed + | Failed -> Failed 0 | Interrupted -> Interrupted | Success -> Success ;; @@ -153,7 +153,69 @@ module Poll = struct | Waiting -> Waiting | In_progress { complete; remaining; failed = _ } -> In_progress { complete; remaining } - | Failed -> Failed + | Failed _ -> Failed + | Interrupted -> Interrupted + | Success -> Success + ;; + end + + module V2 = struct + type t = + | Waiting + | In_progress of + { complete : int + ; remaining : int + ; failed : 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 + let failed = field "failed" (required int) in + constr + "in_progress" + (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 + 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, failed) 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; failed } -> + In_progress { complete; remaining; failed } + | Failed -> Failed 0 + | Interrupted -> Interrupted + | Success -> Success + ;; + + let of_progress : Progress.t -> t = function + | Waiting -> Waiting + | In_progress { complete; remaining; failed } -> + In_progress { complete; remaining; failed } + | Failed _ -> Failed | Interrupted -> Interrupted | Success -> Success ;; @@ -173,9 +235,20 @@ module Poll = struct ;; let v2 = - Decl.Request.make_current_gen + Decl.Request.make_gen ~version:2 ~req:Id.sexp + ~resp:(Conv.option V2.sexp) + ~upgrade_req:Fun.id + ~downgrade_req:Fun.id + ~upgrade_resp:(Option.map ~f:V2.to_progress) + ~downgrade_resp:(Option.map ~f:V2.of_progress) + ;; + + let v3 = + Decl.Request.make_current_gen + ~version:3 + ~req:Id.sexp ~resp:(Conv.option Progress.sexp) ;; end @@ -204,7 +277,7 @@ module Poll = struct let progress = let open Progress in - make name [ v1; v2 ] + make name [ v1; v2; v3 ] ;; let diagnostic = diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml index 8b59841ee042..6504565f2d55 100644 --- a/src/dune_engine/build_system.ml +++ b/src/dune_engine/build_system.ml @@ -151,7 +151,7 @@ module State = struct | Building of Progress.t | Restarting_current_build | Build_succeeded__now_waiting_for_changes - | Build_failed__now_waiting_for_changes + | Build_failed__now_waiting_for_changes of int let equal x y = match x, y with @@ -159,12 +159,14 @@ module State = struct | Initializing, Initializing | Restarting_current_build, Restarting_current_build | Build_succeeded__now_waiting_for_changes, Build_succeeded__now_waiting_for_changes - | Build_failed__now_waiting_for_changes, Build_failed__now_waiting_for_changes -> true + -> true + | Build_failed__now_waiting_for_changes x, Build_failed__now_waiting_for_changes y -> + Int.equal x y | Building _, _ | Initializing, _ | Restarting_current_build, _ | Build_succeeded__now_waiting_for_changes, _ - | Build_failed__now_waiting_for_changes, _ -> false + | Build_failed__now_waiting_for_changes _, _ -> false ;; let t = Fiber.Svar.create Initializing @@ -1279,7 +1281,7 @@ let run f = let final_status = if List.exists exns ~f:caused_by_cancellation then State.Restarting_current_build - else Build_failed__now_waiting_for_changes + else Build_failed__now_waiting_for_changes (List.length exns) in let+ () = State.set final_status in Error `Already_reported diff --git a/src/dune_engine/build_system.mli b/src/dune_engine/build_system.mli index c86e939d053a..baa5b97d4e5f 100644 --- a/src/dune_engine/build_system.mli +++ b/src/dune_engine/build_system.mli @@ -74,7 +74,7 @@ module State : sig | Building of Progress.t | Restarting_current_build | Build_succeeded__now_waiting_for_changes - | Build_failed__now_waiting_for_changes + | Build_failed__now_waiting_for_changes of int val equal : t -> t -> bool end diff --git a/src/dune_rpc_impl/server.ml b/src/dune_rpc_impl/server.ml index 003965cf3067..427df2126396 100644 --- a/src/dune_rpc_impl/server.ml +++ b/src/dune_rpc_impl/server.ml @@ -303,7 +303,8 @@ let handler (t : _ t Fdecl.t) action_runner_server handle : 'a Dune_rpc_server.H | Initializing -> Progress.Waiting | Restarting_current_build -> Interrupted | Build_succeeded__now_waiting_for_changes -> Success - | Build_failed__now_waiting_for_changes -> Failed + | Build_failed__now_waiting_for_changes number_of_rules_failed -> + Failed number_of_rules_failed | Building now -> In_progress { complete = now.number_of_rules_executed diff --git a/test/blackbox-tests/test-cases/watching/basic.t b/test/blackbox-tests/test-cases/watching/basic.t index 3cc3a2f18e1f..c5d5ae550def 100644 --- a/test/blackbox-tests/test-cases/watching/basic.t +++ b/test/blackbox-tests/test-cases/watching/basic.t @@ -68,12 +68,12 @@ Basic tests for the file-watching mode. 3 | (deps x) 4 | (action (system "cat x > y"))) Error: No rule found for x - Had errors, waiting for filesystem changes... + Had 1 error, waiting for filesystem changes... File "dune", line 1, characters 0-59: 1 | (rule 2 | (target y) 3 | (deps x) 4 | (action (system "cat x > y"))) Error: No rule found for x - Had errors, waiting for filesystem changes... + Had 1 error, waiting for filesystem changes... Success, waiting for filesystem changes... diff --git a/test/blackbox-tests/test-cases/watching/fs-memo.t b/test/blackbox-tests/test-cases/watching/fs-memo.t index b3c44f9ff63c..8034a7ff0e3d 100644 --- a/test/blackbox-tests/test-cases/watching/fs-memo.t +++ b/test/blackbox-tests/test-cases/watching/fs-memo.t @@ -240,9 +240,9 @@ If we repeat the test, we finally see the failure. How about now? Failure Error: inotify_add_watch(subdir): Permission denied - Had errors, waiting for filesystem changes... + Had 1 error, waiting for filesystem changes... Error: inotify_add_watch(subdir): Permission denied - Had errors, waiting for filesystem changes... + Had 1 error, waiting for filesystem changes... ------------------------------------------ result = '13' -> '13' -> '13' ------------------------------------------ @@ -254,9 +254,9 @@ Same problem in the other direction. Failure Failure Error: inotify_add_watch(subdir): Permission denied - Had errors, waiting for filesystem changes... + Had 1 error, waiting for filesystem changes... Error: inotify_add_watch(subdir): Permission denied - Had errors, waiting for filesystem changes... + Had 1 error, waiting for filesystem changes... ------------------------------------------ result = '13' -> '13' -> '13' ------------------------------------------ @@ -288,12 +288,12 @@ Same problem for files. -> required by _build/default/file-1 -> required by _build/default/result -> required by alias default - Had errors, waiting for filesystem changes... + Had 1 error, waiting for filesystem changes... Error: file-1: Permission denied -> required by _build/default/file-1 -> required by _build/default/result -> required by alias default - Had errors, waiting for filesystem changes... + Had 1 error, waiting for filesystem changes... ------------------------------------------ result = '13' -> '13' -> '13' ------------------------------------------ diff --git a/test/blackbox-tests/test-cases/watching/target-promotion.t b/test/blackbox-tests/test-cases/watching/target-promotion.t index dbe10ca7d525..d924637854d9 100644 --- a/test/blackbox-tests/test-cases/watching/target-promotion.t +++ b/test/blackbox-tests/test-cases/watching/target-promotion.t @@ -142,7 +142,7 @@ We're done. - file present in source tree - dune:1 Hint: rm -f promoted - Had errors, waiting for filesystem changes... + Had 1 error, waiting for filesystem changes... Success, waiting for filesystem changes... Success, waiting for filesystem changes... Success, waiting for filesystem changes... diff --git a/test/expect-tests/dune_rpc/dune_rpc_tests.ml b/test/expect-tests/dune_rpc/dune_rpc_tests.ml index 1dcacfc169e9..2cf02aaa3a11 100644 --- a/test/expect-tests/dune_rpc/dune_rpc_tests.ml +++ b/test/expect-tests/dune_rpc/dune_rpc_tests.ml @@ -911,7 +911,10 @@ let%expect_test "print digests for all public RPCs" = Response: 889aa68f4ad3fc68ef5dfffbb7282c18 Version 2: Request: Sexp - Response: 929074caab98360dc7116b6f27c2b9ad |}]; + Response: 929074caab98360dc7116b6f27c2b9ad + Version 3: + Request: Sexp + Response: c62f32534a04d0788a44ca29e05c069b |}]; Decl.Request.print_generations (Procedures.Poll.poll Procedures.Poll.diagnostic); [%expect {|