From 6f573d2a4453ff7b989c0f375c2196b0b3c34796 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 displays: Had 4 errors, waiting for filesystem changes... When the watch mode build has been finished with 4 errors. For a single error it say "Had 1 error". Signed-off-by: Ali Caglayan --- bin/import.ml | 11 ++- 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_rpc_impl/server.ml | 8 +- .../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 +- 12 files changed, 117 insertions(+), 24 deletions(-) create mode 100644 doc/changes/8408.md diff --git a/bin/import.ml b/bin/import.ml index 4c1b67b295bc..ee2fecf14a31 100644 --- a/bin/import.ml +++ b/bin/import.ml @@ -154,7 +154,16 @@ 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 + Build_system.Error.( + Id.Map.cardinal (Set.current (Fiber.Svar.read Build_system.errors))) + with + | 1 -> Pp.textf "Had 1 error" + | n -> Pp.textf "Had %d errors" n + 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_rpc_impl/server.ml b/src/dune_rpc_impl/server.ml index 003965cf3067..b0bfb017279b 100644 --- a/src/dune_rpc_impl/server.ml +++ b/src/dune_rpc_impl/server.ml @@ -303,7 +303,13 @@ 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 -> + let number_of_errors = + Fiber.Svar.read Build_system.errors + |> Build_system.Error.Set.current + |> Build_system.Error.Id.Map.cardinal + in + Failed number_of_errors | 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 {|