remove failed builds from job page

add a job page with failed builds, link to it
This commit is contained in:
Robur 2021-11-17 16:39:49 +00:00
parent 2e82778e87
commit 088b55acc3
7 changed files with 51 additions and 39 deletions

View file

@ -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 =

View file

@ -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

View file

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

View file

@ -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
| 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 ()

View file

@ -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

View file

@ -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

View file

@ -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'