remove failed builds from job page

add a job page with failed builds, link to it

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 =
+  let get_failed_builds =
-    Caqti_request.find_opt
+    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 =
+  let get_failed_builds_by_platform =
-    Caqti_request.find_opt
+    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 =

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 :
+  val get_failed_builds :
-    ([`job] id, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t
+    ([`job] id, t, [ `Many | `One | `Zero ]) Caqti_request.t
-  val get_latest_failed_by_platform :
+  val get_failed_builds_by_platform :
-    ([`job] id * string, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t
+    ([`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

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

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 ->
+   | None -> Db.collect_list Builder_db.Build.get_all_artifact_sha job_id
-     Db.find_opt Builder_db.Build.get_latest_failed job_id >>= fun failed ->
+   | Some p -> Db.collect_list Builder_db.Build.get_all_artifact_sha_by_platform (job_id, p))
-     Db.collect_list Builder_db.Build.get_all_artifact_sha job_id >|= fun sha ->
+  >>= 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) ->
   Lwt_list.fold_left_s (fun acc hash ->
     match acc with
     | Error _ as e -> Lwt.return e
-     | Ok (fail, builds) ->
+    | Ok builds ->
-       Db.find Builder_db.Build.get_with_main_binary_by_hash hash >|= fun (build, file) ->
+      Db.find Builder_db.Build.get_with_main_binary_by_hash hash >|= fun b ->
-       match fail with
+      b :: builds)
-       | Some f when Ptime.is_later ~than:build.Builder_db.Build.start f.Builder_db.Build.start -> None, (build, file) :: (f, None) :: builds
+    (Ok []) sha >|= List.rev
-       | x -> x, (build, file) :: builds)
+
-    (Ok (failed, [])) sha >|= fun (x, builds) ->
+let builds_grouped_by_output_with_failed job_id platform ((module Db : CONN) as db) =
-  (match x with None -> builds | Some f -> (f, None) :: builds) |> List.rev
+  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 ()

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
 

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

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'