Link to opam diff

Compare with latest build as well as previous build.

db/builder_db.ml

@@ -382,6 +382,17 @@ module Build = struct
          LIMIT 1
       |}
 
+  let get_latest_uuid =
+    Caqti_request.find_opt
+      id
+      Caqti_type.(tup2 id Rep.uuid)
+      {| SELECT b.id, b.uuid
+         FROM build b
+         WHERE b.job = ?
+         ORDER BY start_d DESC, start_ps DESC
+         LIMIT 1
+      |}
+
   let get_previous =
     Caqti_request.find_opt
       id

db/builder_db.mli

@@ -146,6 +146,9 @@ sig
   val get_latest :
     (id, id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ])
       Caqti_request.t
+  val get_latest_uuid :
+    (id, id * Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
+      Caqti_request.t
   val get_previous :
     (id, id * Meta.t, [< `Many | `One | `Zero > `One `Zero ])
       Caqti_request.t

lib/builder_web.ml

@@ -157,18 +157,20 @@ let routes t =
         "Bad request.\n"
       |> Lwt.return
     | Some uuid ->
-      let+ build_and_artifacts =
+      let+ data =
         Caqti_lwt.Pool.use (Model.build uuid) t.pool >>= fun (build_id, build) ->
-        Caqti_lwt.Pool.use (Model.build_artifacts build_id) t.pool >|= fun artifacts ->
-        (build, artifacts)
+        Caqti_lwt.Pool.use (Model.build_artifacts build_id) t.pool >>= fun artifacts ->
+        Caqti_lwt.Pool.use (Model.latest_build_uuid build.job_id) t.pool >>= fun latest_uuid ->
+        Caqti_lwt.Pool.use (Model.build_previous build_id) t.pool >|= fun previous_build ->
+        (build, artifacts, latest_uuid, previous_build)
       in
-      match build_and_artifacts with
+      match data with
       | Error e ->
         Log.warn (fun m -> m "Error getting job build: %a" pp_error e);
         Response.of_plain_text ~status:`Internal_server_error
           "Error getting job build"
-      | Ok (build, artifacts) ->
-        Views.job_build job_name build artifacts |> Response.of_html
+      | Ok (build, artifacts, latest_uuid, previous_build) ->
+        Views.job_build job_name build artifacts latest_uuid previous_build |> Response.of_html
   in
 
   let job_build_file req =

lib/model.ml

@@ -58,6 +58,15 @@ let build_exists uuid (module Db : CONN) =
   Db.find_opt Builder_db.Build.get_by_uuid uuid >|=
   Option.is_some
 
+let latest_build_uuid job_id (module Db : CONN) =
+  Db.find_opt Builder_db.Build.get_latest_uuid job_id >>=
+  (* We know there's at least one job when this is called, probably. *)
+  not_found >|= snd
+
+let build_previous id (module Db : CONN) =
+  Db.find_opt Builder_db.Build.get_previous 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

lib/model.mli

@@ -25,6 +25,12 @@ val build_hash : Cstruct.t -> Caqti_lwt.connection ->
 val build_exists : Uuidm.t -> Caqti_lwt.connection ->
   (bool, [> error ]) result Lwt.t
 
+val latest_build_uuid : Builder_db.id -> Caqti_lwt.connection ->
+  (Uuidm.t, [> error ]) result Lwt.t
+
+val build_previous : Builder_db.id -> Caqti_lwt.connection ->
+  (Builder_db.Build.Meta.t option, [> error ]) result Lwt.t
+
 val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection ->
   (Builder_db.file option, [> error ]) result Lwt.t
 

lib/views.ml

@@ -168,14 +168,30 @@ let job name builds =
 
 let job_build
   name
-  { Builder_db.Build.uuid = _; start; finish; result; console; script; main_binary = _; job_id = _ }
+  { Builder_db.Build.uuid; start; finish; result; console; script; main_binary = _; job_id = _ }
   artifacts
+  latest_uuid
+  previous_build
   =
   let delta = Ptime.diff finish start in
   layout ~title:(Fmt.strf "Job build %s %a" name pp_ptime start)
     [ h1 [txtf "Job build %s %a" name pp_ptime start];
       p [txtf "Build took %a." Ptime.Span.pp delta ];
       p [txtf "Execution result: %a." Builder.pp_execution_result result];
+      p [
+        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"];
+      ];
+      (match previous_build with
+       | Some previous_build ->
+         p [
+           a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
+                   Uuidm.pp uuid Uuidm.pp previous_build.Builder_db.Build.Meta.uuid]
+             [txt "Compare opam-switch with previous build"];
+         ]
+       | None ->
+         txt "");
       h3 [txt "Digests of build artifacts"];
       dl (List.concat_map
             (fun { Builder_db.filepath; localpath=_; sha256; size } ->

test/builder_db.ml

@@ -233,6 +233,14 @@ let test_build_get_latest (module Db : CONN) =
   Alcotest.(check (option Testable.file)) "same main binary" main_binary' (Some main_binary);
   Alcotest.(check Testable.uuid) "same uuid" meta.uuid uuid'
 
+let test_build_get_latest_uuid (module Db : CONN) =
+  add_second_build (module Db) >>= fun () ->
+  (* Test *)
+  Db.find Builder_db.Job.get_id_by_name job_name >>= fun job_id ->
+  Db.find_opt Builder_db.Build.get_latest_uuid job_id
+  >>| get_opt "no latest build" >>| fun (_id, latest_uuid) ->
+  Alcotest.(check Testable.uuid) "same uuid" latest_uuid uuid'
+
 let test_build_get_previous (module Db : CONN) =
   add_second_build (module Db) >>= fun () ->
   Db.find_opt Builder_db.Build.get_by_uuid uuid'
@@ -308,6 +316,7 @@ let () =
       test_case "One build" `Quick (with_build_db test_build_get_all);
       test_case "One build (meta data)" `Quick (with_build_db test_build_get_all_meta);
       test_case "Get latest build" `Quick (with_build_db test_build_get_latest);
+      test_case "Get latest build uuid" `Quick (with_build_db test_build_get_latest_uuid);
       test_case "Get build by hash" `Quick (with_build_db test_build_get_by_hash);
       test_case "Get previous build" `Quick (with_build_db test_build_get_previous);
       test_case "Get previous build when first" `Quick (with_build_db test_build_get_previous_none);