Output links to comparisons of other builds with the identical main binary

in /job/:job/build/:build

db/builder_db.ml

@@ -443,6 +443,18 @@ module Build = struct
          LIMIT 1
       |}
 
+  let get_other_builds_with_same_output =
+    Caqti_request.collect
+      (id `build)
+      Meta.t
+      {| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
+           b.result_kind, b.result_code, b.result_msg,
+           b.main_binary, b.user, b.job
+         FROM build b0, build_artifact a0, build b, build_artifact a
+         WHERE b0.id = ? AND a0.id = b0.main_binary AND a0.sha256 = a.sha256 AND b.main_binary = a.id AND b.id <> b0.id
+         ORDER BY b.start_d DESC, b.start_ps DESC
+      |}
+
   let add =
     Caqti_request.exec
       t

db/builder_db.mli

@@ -169,6 +169,8 @@ sig
   val get_previous_successful :
     ([`build] id, [`build] id * Meta.t, [< `Many | `One | `Zero > `One `Zero ])
       Caqti_request.t
+  val get_other_builds_with_same_output :
+    ([`build] id, Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t
   val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
   val get_by_hash :
     (Cstruct.t, string * t, [< `Many | `One | `Zero > `One `Zero]) Caqti_request.t

lib/builder_web.ml

@@ -137,14 +137,15 @@ let add_routes datadir =
     (Dream.sql req (Model.readme job_name) >>= fun readme ->
      Dream.sql req (Model.build uuid) >>= fun (build_id, build) ->
      Dream.sql req (Model.build_artifacts build_id) >>= fun artifacts ->
+     Dream.sql req (Model.builds_with_same_main_binary build_id) >>= fun other_builds ->
      Dream.sql req (Model.latest_successful_build_uuid build.job_id) >>= fun latest_uuid ->
      Dream.sql req (Model.previous_successful_build build_id) >|= fun previous_build ->
-         (readme, build, artifacts, latest_uuid, previous_build))
+         (readme, build, artifacts, other_builds, latest_uuid, previous_build))
     |> if_error "Error getting job build"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
-    >>= fun (readme, build, artifacts, latest_uuid, previous_build) ->
-    Views.job_build job_name readme build artifacts latest_uuid previous_build |> string_of_html |> Dream.html
-    |> Lwt_result.ok
+    >>= fun (readme, build, artifacts, other_builds, latest_uuid, previous_build) ->
+    Views.job_build job_name readme build artifacts other_builds latest_uuid previous_build
+    |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
   let job_build_file req =

lib/model.ml

@@ -70,12 +70,8 @@ let previous_successful_build id (module Db : CONN) =
   Db.find_opt Builder_db.Build.get_previous_successful id >|=
   Option.map (fun (_id, meta) -> meta)
 
-let main_binary id main_binary (module Db : CONN) =
-  match main_binary with
-  | None -> Lwt_result.return None
-  | Some main_binary ->
-    Db.find Builder_db.Build_artifact.get_by_build (id, main_binary) >|= fun (_id, file) ->
-    Some file
+let builds_with_same_main_binary id (module Db : CONN) =
+  Db.collect_list Builder_db.Build.get_other_builds_with_same_output id
 
 let job_id job_name (module Db : CONN) =
   Db.find_opt Builder_db.Job.get_id_by_name job_name

lib/model.mli

@@ -39,8 +39,8 @@ val latest_successful_build_uuid : [`job] Builder_db.id -> Caqti_lwt.connection
 val previous_successful_build : [`build] Builder_db.id -> Caqti_lwt.connection ->
   (Builder_db.Build.Meta.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 
-val main_binary : [`build] Builder_db.id -> Fpath.t option -> Caqti_lwt.connection ->
-  (Builder_db.file option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
+val builds_with_same_main_binary : [`build] Builder_db.id -> Caqti_lwt.connection ->
+  (Builder_db.Build.Meta.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 
 val readme : string -> Caqti_lwt.connection ->
   (string option, [> error ]) result Lwt.t

lib/views.ml

@@ -194,6 +194,7 @@ let job_build
   readme
   { Builder_db.Build.uuid; start; finish; result; console; script; _ }
   artifacts
+  other_builds
   latest_uuid
   previous_build
   =
@@ -214,22 +215,25 @@ let job_build
       a ~a:[a_href "#readme"] [txt "Back to readme"];
       p [txtf "Build took %a." Ptime.Span.pp delta ];
       p [txtf "Execution result: %a." Builder.pp_execution_result result];
-      (match latest_uuid with
+      h3 [txt "Compare with other builds"];
+      p
+        ((match latest_uuid with
           | Some latest_uuid when successful_build && not (Uuidm.equal latest_uuid uuid) ->
-         p [
-           a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
+            [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
                       Uuidm.pp uuid Uuidm.pp latest_uuid]
-             [txt "Compare opam-switch with latest build"];
-         ]
-       | _ -> txt "");
+                [txt "With latest build"] ; br () ]
+          | _ -> []) @
           (match previous_build with
            | Some previous_build when successful_build ->
-         p [
-           a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
+             [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
                      Uuidm.pp previous_build.Builder_db.Build.Meta.uuid Uuidm.pp uuid]
-             [txt "Compare opam-switch with previous build"];
-         ]
-       | _ -> txt "");
+                [txt "With previous build"] ; br () ]
+           | _ -> []) @
+         List.concat_map (fun { Builder_db.Build.Meta.start ; uuid = other_uuid ; _ } ->
+             [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
+                     Uuidm.pp other_uuid Uuidm.pp uuid]
+                [txtf "With build %a (output is identical binary)" pp_ptime start] ; br () ])
+           other_builds);
       h3 [txt "Digests of build artifacts"];
       dl (List.concat_map
             (fun { Builder_db.filepath; localpath=_; sha256; size } ->