From 088b55acc3bed16625c89dfe139a2d8bca26923c Mon Sep 17 00:00:00 2001 From: Robur Date: Wed, 17 Nov 2021 16:39:49 +0000 Subject: [PATCH] remove failed builds from job page add a job page with failed builds, link to it --- db/builder_db.ml | 10 ++++------ db/builder_db.mli | 8 ++++---- lib/builder_web.ml | 22 ++++++++++++++-------- lib/model.ml | 36 +++++++++++++++++++----------------- lib/model.mli | 3 +++ lib/views.ml | 9 ++++++--- test/test_builder_db.ml | 2 +- 7 files changed, 51 insertions(+), 39 deletions(-) diff --git a/db/builder_db.ml b/db/builder_db.ml index 8cb6c95..cf156e1 100644 --- a/db/builder_db.ml +++ b/db/builder_db.ml @@ -365,8 +365,8 @@ module Build = struct ORDER BY b.start_d DESC, b.start_ps DESC |} - let get_latest_failed = - Caqti_request.find_opt + let get_failed_builds = + Caqti_request.collect (id `job) t {| SELECT uuid, start_d, start_ps, finish_d, finish_ps, @@ -375,11 +375,10 @@ module Build = struct FROM build WHERE job = ? AND result_code <> 0 ORDER BY start_d DESC, start_ps DESC - LIMIT 1 |} - let get_latest_failed_by_platform = - Caqti_request.find_opt + let get_failed_builds_by_platform = + Caqti_request.collect Caqti_type.(tup2 (id `job) string) t {| SELECT uuid, start_d, start_ps, finish_d, finish_ps, @@ -388,7 +387,6 @@ module Build = struct FROM build WHERE job = ? AND platform = ? AND result_code <> 0 ORDER BY start_d DESC, start_ps DESC - LIMIT 1 |} let get_latest_successful_with_binary = diff --git a/db/builder_db.mli b/db/builder_db.mli index da9f7d3..34c46e8 100644 --- a/db/builder_db.mli +++ b/db/builder_db.mli @@ -124,10 +124,10 @@ sig val get_latest_successful_with_binary : ([`job] id * string, [`build] id * t * file option, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t - val get_latest_failed : - ([`job] id, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t - val get_latest_failed_by_platform : - ([`job] id * string, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t + val get_failed_builds : + ([`job] id, t, [ `Many | `One | `Zero ]) Caqti_request.t + val get_failed_builds_by_platform : + ([`job] id * string, t, [ `Many | `One | `Zero ]) Caqti_request.t val get_latest_successful : ([`job] id, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 150171a..249a371 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -88,7 +88,6 @@ let add_routes datadir = let datadir_global = Dream.new_global ~name:"datadir" (fun () -> datadir) in let builder req = - (* TODO filter unsuccessful builds, ?failed=true *) Dream.sql req Model.jobs_with_section_synopsis |> if_error "Error getting jobs" ~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e)) @@ -126,7 +125,19 @@ let add_routes datadir = |> if_error "Error getting job" ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e)) >>= fun (readme, builds) -> - Views.job job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok + Views.job ~failed:false job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok + in + + let job_with_failed req = + let job_name = Dream.param "job" req in + let platform = Dream.query "platform" req in + (Dream.sql req (Model.job_and_readme job_name) >>= fun (job_id, readme) -> + Dream.sql req (Model.builds_grouped_by_output_with_failed job_id platform) >|= fun builds -> + (readme, builds)) + |> if_error "Error getting job" + ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e)) + >>= fun (readme, builds) -> + Views.job ~failed:true job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok in let redirect_latest req = @@ -366,15 +377,10 @@ let add_routes datadir = let w f req = or_error_response (f req) in - (* - /job/:job/developer(?platform=XX) <- job list with failed builds - /job/:job/?platform=...&failed=true - /job/:job/failed(?platform=...) - *) - Dream.router [ Dream.get "/" (w builder); Dream.get "/job/:job/" (w job); + Dream.get "/job/:job/failed/" (w job_with_failed); Dream.get "/job/:job/build/latest/**" (w redirect_latest); Dream.get "/job/:job/build/:build/" (w job_build); Dream.get "/job/:job/build/:build/f/**" (w job_build_file); diff --git a/lib/model.ml b/lib/model.ml index acb0f12..956c30b 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -137,24 +137,26 @@ let job_and_readme job (module Db : CONN) = let builds_grouped_by_output job_id platform (module Db : CONN) = (match platform with - | None -> - Db.find_opt Builder_db.Build.get_latest_failed job_id >>= fun failed -> - Db.collect_list Builder_db.Build.get_all_artifact_sha job_id >|= fun sha -> - (failed, sha) - | Some p -> - Db.find_opt Builder_db.Build.get_latest_failed_by_platform (job_id, p) >>= fun failed -> - Db.collect_list Builder_db.Build.get_all_artifact_sha_by_platform (job_id, p) >|= fun sha -> - (failed, sha)) >>= fun (failed, sha) -> + | None -> Db.collect_list Builder_db.Build.get_all_artifact_sha job_id + | Some p -> Db.collect_list Builder_db.Build.get_all_artifact_sha_by_platform (job_id, p)) + >>= fun sha -> Lwt_list.fold_left_s (fun acc hash -> - match acc with - | Error _ as e -> Lwt.return e - | Ok (fail, builds) -> - Db.find Builder_db.Build.get_with_main_binary_by_hash hash >|= fun (build, file) -> - match fail with - | Some f when Ptime.is_later ~than:build.Builder_db.Build.start f.Builder_db.Build.start -> None, (build, file) :: (f, None) :: builds - | x -> x, (build, file) :: builds) - (Ok (failed, [])) sha >|= fun (x, builds) -> - (match x with None -> builds | Some f -> (f, None) :: builds) |> List.rev + match acc with + | Error _ as e -> Lwt.return e + | Ok builds -> + Db.find Builder_db.Build.get_with_main_binary_by_hash hash >|= fun b -> + b :: builds) + (Ok []) sha >|= List.rev + +let builds_grouped_by_output_with_failed job_id platform ((module Db : CONN) as db) = + builds_grouped_by_output job_id platform db >>= fun builds -> + (match platform with + | None -> Db.collect_list Builder_db.Build.get_failed_builds job_id + | Some p -> Db.collect_list Builder_db.Build.get_failed_builds_by_platform (job_id, p)) + >|= fun failed -> + let failed = List.map (fun b -> b, None) failed in + let cmp (a, _) (b, _) = Ptime.compare b.Builder_db.Build.start a.Builder_db.Build.start in + List.merge cmp builds failed let jobs_with_section_synopsis (module Db : CONN) = Db.collect_list Builder_db.Job.get_all_with_section_synopsis () diff --git a/lib/model.mli b/lib/model.mli index e739ddb..a7e00d4 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -75,6 +75,9 @@ val job_and_readme : string -> Caqti_lwt.connection -> val builds_grouped_by_output : [`job] Builder_db.id -> string option -> Caqti_lwt.connection -> ((Builder_db.Build.t * Builder_db.file option) list, [> error ]) result Lwt.t +val builds_grouped_by_output_with_failed : [`job] Builder_db.id -> string option -> Caqti_lwt.connection -> + ((Builder_db.Build.t * Builder_db.file option) list, [> error ]) result Lwt.t + val job_id : string -> Caqti_lwt.connection -> ([`job] Builder_db.id option, [> Caqti_error.call_or_retrieve ]) result Lwt.t diff --git a/lib/views.ml b/lib/views.ml index 7f0bf58..5aece48 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -224,7 +224,7 @@ let builder section_job_map = txt "." ]]) -let job name platform readme builds = +let job ~failed name platform readme builds = layout ~nav:(`Job (name, platform)) ~title:(Fmt.str "Job %s %a" name pp_platform platform) ((h1 [txtf "Job %s %a" name pp_platform platform] :: (match readme with @@ -242,7 +242,7 @@ let job name platform readme builds = li ([ check_icon build.Builder_db.Build.result; txtf " %s " build.platform; - a ~a:[Fmt.kstr a_href "build/%a/" Uuidm.pp build.Builder_db.Build.uuid] + a ~a:[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp build.Builder_db.Build.uuid] [ txtf "%a" pp_ptime build.Builder_db.Build.start; ]; @@ -254,7 +254,10 @@ let job name platform readme builds = [ txtf "Build failure: %a" Builder.pp_execution_result build.Builder_db.Build.result ])) builds); - + if failed then + p [ txt "Excluding failed builds " ; a ~a:[a_href "../"] [txt "here"] ; txt "." ] + else + p [ txt "Including failed builds " ; a ~a:[a_href "failed/"] [txt "here"] ; txt "." ] ]) let job_build diff --git a/test/test_builder_db.ml b/test/test_builder_db.ml index 5d13f8c..77f61e0 100644 --- a/test/test_builder_db.ml +++ b/test/test_builder_db.ml @@ -225,7 +225,7 @@ let test_build_get_latest (module Db : CONN) = add_second_build (module Db) >>= fun () -> (* Test *) Db.find_opt Builder_db.Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id -> - Db.find_opt Builder_db.Build.get_latest (job_id, platform) + Db.find_opt Builder_db.Build.get_latest_successful_with_binary (job_id, platform) >>| get_opt "no latest build" >>| fun (_id, meta, main_binary') -> Alcotest.(check (option Testable.file)) "same main binary" main_binary' (Some main_binary2); Alcotest.(check Testable.uuid) "same uuid" meta.uuid uuid'