Show builds by platform
This commit is contained in:
parent
594c6d5917
commit
16748b8995
7 changed files with 260 additions and 184 deletions
|
@ -325,6 +325,16 @@ module Build = struct
|
|||
ORDER BY b.start_d DESC, b.start_ps DESC
|
||||
|}
|
||||
|
||||
let get_all_artifact_sha_by_platform =
|
||||
Caqti_request.collect
|
||||
Caqti_type.(tup2 (id `job) string)
|
||||
Rep.cstruct
|
||||
{| SELECT DISTINCT a.sha256
|
||||
FROM build_artifact a, build b
|
||||
WHERE b.job = ? AND b.platform = ? AND b.main_binary = a.id
|
||||
ORDER BY b.start_d DESC, b.start_ps DESC
|
||||
|}
|
||||
|
||||
let get_latest_failed =
|
||||
Caqti_request.find_opt
|
||||
(id `job)
|
||||
|
@ -338,9 +348,22 @@ module Build = struct
|
|||
LIMIT 1
|
||||
|}
|
||||
|
||||
let get_latest_failed_by_platform =
|
||||
Caqti_request.find_opt
|
||||
Caqti_type.(tup2 (id `job) string)
|
||||
t
|
||||
{| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
|
||||
result_code, result_msg, console, script,
|
||||
platform, main_binary, input_id, user, job
|
||||
FROM build
|
||||
WHERE job = ? AND platform = ? AND result_code <> 0
|
||||
ORDER BY start_d DESC, start_ps DESC
|
||||
LIMIT 1
|
||||
|}
|
||||
|
||||
let get_latest =
|
||||
Caqti_request.find_opt
|
||||
(id `job)
|
||||
Caqti_type.(tup2 (id `job) string)
|
||||
Caqti_type.(tup3
|
||||
(id `build)
|
||||
t
|
||||
|
@ -353,7 +376,7 @@ module Build = struct
|
|||
FROM build b
|
||||
LEFT JOIN build_artifact a ON
|
||||
b.main_binary = a.id
|
||||
WHERE b.job = ?
|
||||
WHERE b.job = ?1 AND b.platform = ?2
|
||||
ORDER BY b.start_d DESC, b.start_ps DESC
|
||||
LIMIT 1
|
||||
|}
|
||||
|
@ -369,22 +392,46 @@ module Build = struct
|
|||
LIMIT 1
|
||||
|}
|
||||
|
||||
let get_previous_successful =
|
||||
let get_latest_successful_uuid_by_platform =
|
||||
Caqti_request.find_opt
|
||||
Caqti_type.(tup2 (id `job) string)
|
||||
Rep.uuid
|
||||
{| SELECT b.uuid
|
||||
FROM build b
|
||||
WHERE b.job = ?1 AND b.result_code = 0 AND b.platform = ?2
|
||||
ORDER BY b.start_d DESC, b.start_ps DESC
|
||||
LIMIT 1
|
||||
|}
|
||||
|
||||
|
||||
let get_previous_successful_uuid =
|
||||
Caqti_request.find_opt
|
||||
(id `build)
|
||||
Caqti_type.(tup2 (id `build) t)
|
||||
{| SELECT b.id,
|
||||
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
|
||||
b.result_code, b.result_msg, b.console, b.script,
|
||||
b.platform, b.main_binary, b.input_id, b.user, b.job
|
||||
Rep.uuid
|
||||
{| SELECT b.uuid
|
||||
FROM build b, build b0
|
||||
WHERE b0.id = ? AND b0.job = b.job AND
|
||||
b.platform = b0.platform AND
|
||||
b.result_code = 0 AND
|
||||
(b0.start_d > b.start_d OR b0.start_d = b.start_d AND b0.start_ps > b.start_ps)
|
||||
ORDER BY b.start_d DESC, b.start_ps DESC
|
||||
LIMIT 1
|
||||
|}
|
||||
|
||||
let get_next_successful_uuid =
|
||||
Caqti_request.find_opt
|
||||
(id `build)
|
||||
Rep.uuid
|
||||
{| SELECT b.uuid
|
||||
FROM build b, build b0
|
||||
WHERE b0.id = ? AND b0.job = b.job AND
|
||||
b.platform = b0.platform AND
|
||||
b.result_code = 0 AND
|
||||
(b0.start_d < b.start_d OR b0.start_d = b.start_d AND b0.start_ps < b.start_ps)
|
||||
ORDER BY b.start_d ASC, b.start_ps ASC
|
||||
LIMIT 1
|
||||
|}
|
||||
|
||||
let get_same_input_same_output_builds =
|
||||
Caqti_request.collect
|
||||
(id `build)
|
||||
|
@ -432,6 +479,12 @@ module Build = struct
|
|||
LIMIT 1
|
||||
|}
|
||||
|
||||
let get_platforms_for_job =
|
||||
Caqti_request.collect
|
||||
(id `job)
|
||||
Caqti_type.string
|
||||
"SELECT DISTINCT platform FROM build WHERE job = ?"
|
||||
|
||||
let add =
|
||||
Caqti_request.exec
|
||||
t
|
||||
|
|
|
@ -115,16 +115,26 @@ sig
|
|||
([`job] id, [`build] id * t, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
val get_all_artifact_sha :
|
||||
([`job] id, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
val get_all_artifact_sha_by_platform :
|
||||
([`job] id * string, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
val get_latest :
|
||||
([`job] id, [`build] id * t * file option, [< `Many | `One | `Zero > `One `Zero ])
|
||||
([`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_latest_successful_uuid :
|
||||
([`job] id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
|
||||
Caqti_request.t
|
||||
val get_previous_successful :
|
||||
([`build] id, [`build] id * t, [< `Many | `One | `Zero > `One `Zero ])
|
||||
val get_latest_successful_uuid_by_platform :
|
||||
([`job] id * string, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
|
||||
Caqti_request.t
|
||||
val get_previous_successful_uuid :
|
||||
([`build] id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
|
||||
Caqti_request.t
|
||||
val get_next_successful_uuid :
|
||||
([`build] id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
|
||||
Caqti_request.t
|
||||
val get_same_input_same_output_builds :
|
||||
([`build] id, t, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
|
@ -134,6 +144,8 @@ sig
|
|||
([`build] id, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
val get_one_by_input_id :
|
||||
(Cstruct.t, t, [< `Many | `One | `Zero > `One ]) Caqti_request.t
|
||||
val get_platforms_for_job :
|
||||
([`job] id, string, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
|
||||
val get_by_hash :
|
||||
(Cstruct.t, t, [< `Many | `One | `Zero > `One]) Caqti_request.t
|
||||
|
|
|
@ -96,14 +96,19 @@ let add_routes datadir =
|
|||
List.fold_right
|
||||
(fun (job_id, job_name, section, synopsis) r ->
|
||||
r >>= fun acc ->
|
||||
Dream.sql req (Model.build_with_main_binary job_id) >>= function
|
||||
| Some (latest_build, latest_artifact) ->
|
||||
let v = (job_name, synopsis, latest_build, latest_artifact) in
|
||||
let section = Option.value ~default:"Failed" section in
|
||||
Lwt_result.return (Utils.String_map.add_or_create section v acc)
|
||||
Dream.sql req (Model.platforms_of_job job_id) >>= fun ps ->
|
||||
List.fold_right (fun platform r ->
|
||||
r >>= fun acc ->
|
||||
Dream.sql req (Model.build_with_main_binary job_id platform) >>= function
|
||||
| Some (build, artifact) ->
|
||||
Lwt_result.return ((platform, build, artifact) :: acc)
|
||||
| None ->
|
||||
Log.warn (fun m -> m "Job without builds: %s" job_name);
|
||||
Lwt_result.return acc)
|
||||
ps (Lwt_result.return []) >>= fun platform_builds ->
|
||||
let v = (job_name, synopsis, platform_builds) in
|
||||
let section = Option.value ~default:"Uncategorized" section in
|
||||
Lwt_result.return (Utils.String_map.add_or_create section v acc))
|
||||
jobs
|
||||
(Lwt_result.return Utils.String_map.empty)
|
||||
|> if_error "Error getting jobs"
|
||||
|
@ -114,7 +119,10 @@ let add_routes datadir =
|
|||
|
||||
let job req =
|
||||
let job_name = Dream.param "job" req in
|
||||
Dream.sql req (Model.job_and_readme job_name)
|
||||
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 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) ->
|
||||
|
@ -123,9 +131,10 @@ let add_routes datadir =
|
|||
|
||||
let redirect_latest req =
|
||||
let job_name = Dream.param "job" req in
|
||||
let platform = Dream.query "platform" req in
|
||||
let path = Dream.path req |> String.concat "/" in
|
||||
(Dream.sql req (Model.job_id job_name) >>= Model.not_found >>= fun job_id ->
|
||||
Dream.sql req (Model.latest_successful_build_uuid job_id))
|
||||
Dream.sql req (Model.latest_successful_build_uuid job_id platform))
|
||||
>>= Model.not_found
|
||||
|> if_error "Error getting job" >>= fun build ->
|
||||
Dream.redirect req
|
||||
|
@ -162,12 +171,14 @@ let add_routes datadir =
|
|||
Dream.sql req (Model.builds_with_same_input_and_same_main_binary build_id) >>= fun same_input_same_output ->
|
||||
Dream.sql req (Model.builds_with_different_input_and_same_main_binary build_id) >>= fun different_input_same_output ->
|
||||
Dream.sql req (Model.builds_with_same_input_and_different_main_binary build_id) >>= fun same_input_different_output ->
|
||||
Dream.sql req (Model.latest_successful_build_uuid build.job_id) >|= fun latest_uuid ->
|
||||
(readme, build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest_uuid))
|
||||
Dream.sql req (Model.latest_successful_build_uuid build.job_id (Some build.Builder_db.Build.platform)) >>= fun latest_uuid ->
|
||||
Dream.sql req (Model.next_successful_build_uuid build_id) >>= fun next_uuid ->
|
||||
Dream.sql req (Model.previous_successful_build_uuid build_id) >|= fun previous_uuid ->
|
||||
(readme, build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest_uuid, next_uuid, previous_uuid))
|
||||
|> 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, same_input_same_output, different_input_same_output, same_input_different_output, latest_uuid) ->
|
||||
Views.job_build job_name readme build artifacts same_input_same_output different_input_same_output same_input_different_output latest_uuid
|
||||
>>= fun (readme, build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest_uuid, next_uuid, previous_uuid) ->
|
||||
Views.job_build job_name readme build artifacts same_input_same_output different_input_same_output same_input_different_output latest_uuid next_uuid previous_uuid
|
||||
|> string_of_html |> Dream.html |> Lwt_result.ok
|
||||
in
|
||||
|
||||
|
@ -343,6 +354,12 @@ let add_routes datadir =
|
|||
|
||||
let w f req = or_error_response (f req) in
|
||||
|
||||
(*
|
||||
/developer <- front page with failed builds (indication)
|
||||
/job/:job/developer(?platform=XX) <- job list with failed builds
|
||||
/failed-builds(?platform=XX) <- all failed builds across all jobs (limit by the most recent 10)
|
||||
*)
|
||||
|
||||
Dream.router [
|
||||
Dream.get "/" (w builder);
|
||||
Dream.get "/job/:job/" (w job);
|
||||
|
|
99
lib/model.ml
99
lib/model.ml
|
@ -50,12 +50,15 @@ let build_artifacts build (module Db : CONN) =
|
|||
Db.collect_list Builder_db.Build_artifact.get_all_by_build build >|=
|
||||
List.map snd
|
||||
|
||||
let platforms_of_job id (module Db : CONN) =
|
||||
Db.collect_list Builder_db.Build.get_platforms_for_job id
|
||||
|
||||
let build uuid (module Db : CONN) =
|
||||
Db.find_opt Builder_db.Build.get_by_uuid uuid >>=
|
||||
not_found
|
||||
|
||||
let build_with_main_binary job (module Db : CONN) =
|
||||
Db.find_opt Builder_db.Build.get_latest job >|=
|
||||
let build_with_main_binary job platform (module Db : CONN) =
|
||||
Db.find_opt Builder_db.Build.get_latest (job, platform) >|=
|
||||
Option.map (fun (_id, build, file) -> (build, file))
|
||||
|
||||
let build_hash hash (module Db : CONN) =
|
||||
|
@ -65,12 +68,18 @@ let build_exists uuid (module Db : CONN) =
|
|||
Db.find_opt Builder_db.Build.get_by_uuid uuid >|=
|
||||
Option.is_some
|
||||
|
||||
let latest_successful_build_uuid job_id (module Db : CONN) =
|
||||
let latest_successful_build_uuid job_id platform (module Db : CONN) =
|
||||
match platform with
|
||||
| None ->
|
||||
Db.find_opt Builder_db.Build.get_latest_successful_uuid job_id
|
||||
| Some platform ->
|
||||
Db.find_opt Builder_db.Build.get_latest_successful_uuid_by_platform (job_id, platform)
|
||||
|
||||
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 previous_successful_build_uuid id (module Db : CONN) =
|
||||
Db.find_opt Builder_db.Build.get_previous_successful_uuid id
|
||||
|
||||
let next_successful_build_uuid id (module Db : CONN) =
|
||||
Db.find_opt Builder_db.Build.get_next_successful_uuid id
|
||||
|
||||
let builds_with_different_input_and_same_main_binary id (module Db : CONN) =
|
||||
Db.collect_list Builder_db.Build.get_different_input_same_output_input_ids id >>= fun ids ->
|
||||
|
@ -114,9 +123,19 @@ let readme job (module Db : CONN) =
|
|||
let job_and_readme job (module Db : CONN) =
|
||||
job_id job (module Db) >>= not_found >>= fun job_id ->
|
||||
Db.find Builder_db.Tag.get_id_by_name "readme.md" >>= fun readme_id ->
|
||||
Db.find_opt Builder_db.Job_tag.get_value (readme_id, job_id) >>= fun readme ->
|
||||
Db.find_opt Builder_db.Job_tag.get_value (readme_id, job_id) >|= fun readme ->
|
||||
job_id, readme
|
||||
|
||||
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 ->
|
||||
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) ->
|
||||
Lwt_list.fold_left_s (fun acc hash ->
|
||||
match acc with
|
||||
| Error _ as e -> Lwt.return e
|
||||
|
@ -126,8 +145,7 @@ let job_and_readme job (module Db : CONN) =
|
|||
| 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) ->
|
||||
let builds = match x with None -> builds | Some f -> (f, None) :: builds in
|
||||
readme, List.rev builds
|
||||
(match x with None -> builds | Some f -> (f, None) :: builds) |> List.rev
|
||||
|
||||
let jobs_with_section_synopsis (module Db : CONN) =
|
||||
Db.collect_list Builder_db.Job.get_all_with_section_synopsis ()
|
||||
|
@ -220,64 +238,35 @@ let commit_files datadir staging_dir job_name uuid =
|
|||
Lwt.return (Bos.OS.Dir.create job_dir) >>= fun _ ->
|
||||
Lwt.return (Bos.OS.Path.move staging_dir dest)
|
||||
|
||||
let infer_section_and_synopsis platform name artifacts =
|
||||
let opam_switch =
|
||||
match List.find_opt (fun (p, _) -> String.equal (Fpath.basename p) "opam-switch") artifacts with
|
||||
| None -> None
|
||||
| Some (_, data) -> Some (OpamFile.SwitchExport.read_from_string data)
|
||||
in
|
||||
let infer_synopsis_and_descr switch =
|
||||
let root = switch.OpamFile.SwitchExport.selections.OpamTypes.sel_roots in
|
||||
if OpamPackage.Set.cardinal root <> 1 then
|
||||
None, None
|
||||
else
|
||||
let root = OpamPackage.Set.choose root in
|
||||
let infer_section_and_synopsis artifacts =
|
||||
let infer_synopsis_and_descr switch root =
|
||||
match OpamPackage.Name.Map.find_opt root.OpamPackage.name switch.OpamFile.SwitchExport.overlays with
|
||||
| None -> None, None
|
||||
| Some opam -> OpamFile.OPAM.synopsis opam, OpamFile.OPAM.descr_body opam
|
||||
in
|
||||
let infer_section_from_packages switch =
|
||||
let root = switch.OpamFile.SwitchExport.selections.OpamTypes.sel_roots in
|
||||
if OpamPackage.Set.cardinal root <> 1 then
|
||||
None
|
||||
else
|
||||
let root = OpamPackage.Set.choose root in
|
||||
let infer_section switch root =
|
||||
let root_pkg_name = OpamPackage.Name.to_string root.OpamPackage.name in
|
||||
if Astring.String.is_prefix ~affix:"mirage-unikernel-" root_pkg_name then
|
||||
let influx = OpamPackage.Name.of_string "metrics-influx" in
|
||||
if OpamPackage.Set.exists (fun p -> OpamPackage.Name.equal p.OpamPackage.name influx)
|
||||
switch.OpamFile.SwitchExport.selections.OpamTypes.sel_installed
|
||||
then
|
||||
Some "Unikernels (with metrics reported to Influx)"
|
||||
"Unikernels (with metrics reported to Influx)"
|
||||
else
|
||||
Some "Unikernels"
|
||||
"Unikernels"
|
||||
else
|
||||
None
|
||||
"Packages"
|
||||
in
|
||||
let infer_section_from_platform_or_name =
|
||||
if String.equal platform "no-platform" then
|
||||
let map = [
|
||||
"-freebsd", "FreeBSD" ;
|
||||
"-debian", "Debian" ;
|
||||
"-ubuntu", "Ubuntu" ;
|
||||
] in
|
||||
match
|
||||
List.find_opt (fun (affix, _) -> Astring.String.is_infix ~affix name) map
|
||||
with
|
||||
| None -> None
|
||||
| Some (_, os) -> Some (os ^ " Packages")
|
||||
else
|
||||
Some (platform ^ " Packages")
|
||||
in
|
||||
match opam_switch with
|
||||
match List.find_opt (fun (p, _) -> String.equal (Fpath.basename p) "opam-switch") artifacts with
|
||||
| None -> None, (None, None)
|
||||
| Some opam_switch ->
|
||||
let section =
|
||||
match infer_section_from_packages opam_switch with
|
||||
| None -> infer_section_from_platform_or_name
|
||||
| Some x -> Some x
|
||||
in
|
||||
section, infer_synopsis_and_descr opam_switch
|
||||
| Some (_, data) ->
|
||||
try
|
||||
let switch = OpamFile.SwitchExport.read_from_string data in
|
||||
let root = switch.OpamFile.SwitchExport.selections.OpamTypes.sel_roots in
|
||||
assert (OpamPackage.Set.cardinal root = 1);
|
||||
let root = OpamPackage.Set.choose root in
|
||||
Some (infer_section switch root), infer_synopsis_and_descr switch root
|
||||
with _ -> None, (None, None)
|
||||
|
||||
let compute_input_id artifacts =
|
||||
let get_hash filename =
|
||||
|
@ -363,7 +352,7 @@ let add_build
|
|||
console; script; platform;
|
||||
main_binary = None; input_id; user_id; job_id } >>= fun () ->
|
||||
Db.find last_insert_rowid () >>= fun id ->
|
||||
let sec_syn = infer_section_and_synopsis platform job_name raw_artifacts in
|
||||
let sec_syn = infer_section_and_synopsis raw_artifacts in
|
||||
let add_or_update tag_id tag_value =
|
||||
Db.find_opt Job_tag.get_value (tag_id, job_id) >>= function
|
||||
| None -> Db.exec Job_tag.add (tag_id, tag_value, job_id)
|
||||
|
|
|
@ -21,10 +21,13 @@ val build_artifact_data : Fpath.t -> Builder_db.file ->
|
|||
val build_artifacts : [`build] Builder_db.id -> Caqti_lwt.connection ->
|
||||
(Builder_db.file list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||
|
||||
val platforms_of_job : [`job] Builder_db.id -> Caqti_lwt.connection ->
|
||||
(string list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||
|
||||
val build : Uuidm.t -> Caqti_lwt.connection ->
|
||||
([`build] Builder_db.id * Builder_db.Build.t, [> error ]) result Lwt.t
|
||||
|
||||
val build_with_main_binary : [`job] Builder_db.id -> Caqti_lwt.connection ->
|
||||
val build_with_main_binary : [`job] Builder_db.id -> string -> Caqti_lwt.connection ->
|
||||
((Builder_db.Build.t * Builder_db.file option) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||
|
||||
val build_hash : Cstruct.t -> Caqti_lwt.connection ->
|
||||
|
@ -33,11 +36,14 @@ val build_hash : Cstruct.t -> Caqti_lwt.connection ->
|
|||
val build_exists : Uuidm.t -> Caqti_lwt.connection ->
|
||||
(bool, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||
|
||||
val latest_successful_build_uuid : [`job] Builder_db.id -> Caqti_lwt.connection ->
|
||||
val latest_successful_build_uuid : [`job] Builder_db.id -> string option -> Caqti_lwt.connection ->
|
||||
(Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||
|
||||
val previous_successful_build : [`build] Builder_db.id -> Caqti_lwt.connection ->
|
||||
(Builder_db.Build.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||
val previous_successful_build_uuid : [`build] Builder_db.id -> Caqti_lwt.connection ->
|
||||
(Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||
|
||||
val next_successful_build_uuid : [`build] Builder_db.id -> Caqti_lwt.connection ->
|
||||
(Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||
|
||||
val builds_with_different_input_and_same_main_binary : [`build] Builder_db.id -> Caqti_lwt.connection ->
|
||||
(Builder_db.Build.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||
|
@ -58,7 +64,10 @@ val readme : string -> Caqti_lwt.connection ->
|
|||
(string option, [> error ]) result Lwt.t
|
||||
|
||||
val job_and_readme : string -> Caqti_lwt.connection ->
|
||||
(string option * (Builder_db.Build.t * Builder_db.file option) list, [> error ]) result Lwt.t
|
||||
([`job] Builder_db.id * string option, [> error ]) result Lwt.t
|
||||
|
||||
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 job_id : string -> Caqti_lwt.connection ->
|
||||
([`job] Builder_db.id option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||
|
|
140
lib/views.ml
140
lib/views.ml
|
@ -127,26 +127,34 @@ let builder section_job_map =
|
|||
Utils.String_map.fold (fun section jobs acc ->
|
||||
acc @ [
|
||||
h2 [ txt section ];
|
||||
ul (List.map (fun (job_name, synopsis, latest_build, latest_artifact) ->
|
||||
ul (List.map (fun (job_name, synopsis, platform_builds) ->
|
||||
li ([
|
||||
a ~a:[a_href ("job/" ^ job_name ^ "/")]
|
||||
[txt job_name];
|
||||
txt " ";
|
||||
check_icon latest_build.Builder_db.Build.result;
|
||||
a ~a:[a_href ("job/" ^ job_name ^ "/")] [txt job_name];
|
||||
br ();
|
||||
txt (Option.value ~default:"" synopsis);
|
||||
br ();
|
||||
br ()
|
||||
] @
|
||||
List.flatten
|
||||
(List.map (fun (platform, latest_build, latest_artifact) ->
|
||||
[
|
||||
check_icon latest_build.Builder_db.Build.result;
|
||||
txt " ";
|
||||
a ~a:[a_href (Fmt.str "job/%s/?platform=%s" job_name platform)][txt platform];
|
||||
txt " ";
|
||||
a ~a:[a_href (Fmt.str "job/%s/build/%a/" job_name Uuidm.pp
|
||||
latest_build.Builder_db.Build.uuid)]
|
||||
[txtf "%a" (Ptime.pp_human ()) latest_build.Builder_db.Build.start];
|
||||
txt " ";
|
||||
] @ match latest_artifact with
|
||||
] @ (match latest_artifact with
|
||||
| Some main_binary ->
|
||||
artifact ~basename:true job_name latest_build main_binary
|
||||
| None ->
|
||||
[
|
||||
txtf "Build failed";
|
||||
])) jobs)
|
||||
[ txtf "Build failure: %a" Builder.pp_execution_result
|
||||
latest_build.Builder_db.Build.result ]
|
||||
) @ [ br () ])
|
||||
platform_builds)
|
||||
))
|
||||
jobs)
|
||||
])
|
||||
section_job_map
|
||||
[])
|
||||
|
@ -165,26 +173,21 @@ let job name readme builds =
|
|||
[
|
||||
h2 ~a:[a_id "builds"] [txt "Builds"];
|
||||
a ~a:[a_href "#readme"] [txt "Back to readme"];
|
||||
p [
|
||||
txtf "Currently %d builds."
|
||||
(List.length builds)
|
||||
];
|
||||
ul (List.map (fun (build, main_binary) ->
|
||||
li ([
|
||||
check_icon build.Builder_db.Build.result;
|
||||
txtf " %s " build.platform;
|
||||
a ~a:[a_href Fpath.(to_string (v "build" / Uuidm.to_string build.Builder_db.Build.uuid / ""))]
|
||||
[
|
||||
txtf "%a" (Ptime.pp_human ()) build.Builder_db.Build.start;
|
||||
];
|
||||
txt " ";
|
||||
check_icon build.result;
|
||||
br ();
|
||||
] @ match main_binary with
|
||||
| Some main_binary ->
|
||||
artifact ~basename:true name build main_binary
|
||||
| None ->
|
||||
[
|
||||
txtf "Build failed";
|
||||
]))
|
||||
[ txtf "Build failure: %a" Builder.pp_execution_result
|
||||
build.Builder_db.Build.result ]))
|
||||
builds);
|
||||
|
||||
])
|
||||
|
@ -195,10 +198,9 @@ let job_build
|
|||
{ Builder_db.Build.uuid; start; finish; result; platform; _ }
|
||||
artifacts
|
||||
same_input_same_output different_input_same_output same_input_different_output
|
||||
latest_uuid
|
||||
latest_uuid next_uuid previous_uuid
|
||||
=
|
||||
let delta = Ptime.diff finish start in
|
||||
let successful_build = match result with Builder.Exited 0 -> true | _ -> false in
|
||||
layout ~title:(Fmt.str "Job %s %a" name pp_ptime start)
|
||||
((h1 [txtf "Job %s" name] ::
|
||||
(match readme with
|
||||
|
@ -214,14 +216,7 @@ let job_build
|
|||
a ~a:[a_href "#readme"] [txt "Back to readme"];
|
||||
p [txtf "Built on platform %s" platform ];
|
||||
p [txtf "Build took %a." Ptime.Span.pp delta ];
|
||||
p [txtf "Execution result: %a." Builder.pp_execution_result result]; ] @
|
||||
(match same_input_same_output with [] -> [] | xs -> [
|
||||
h3 [ txt "Reproduced by builds"] ;
|
||||
p (List.concat_map (fun { Builder_db.Build.start ; uuid ; _ } ->
|
||||
[ a ~a:[Fmt.kstr a_href "/job/%s/build/%a" name Uuidm.pp uuid]
|
||||
[txtf "%a" pp_ptime start] ;
|
||||
txt ", " ])
|
||||
xs) ] ) @ [
|
||||
p [txtf "Execution result: %a." Builder.pp_execution_result result];
|
||||
h3 [txt "Build info"];
|
||||
ul [
|
||||
li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp uuid]
|
||||
|
@ -231,26 +226,6 @@ let job_build
|
|||
[txt "Build script"];
|
||||
]
|
||||
];
|
||||
h3 [txt "Comparisons with other builds"];
|
||||
p
|
||||
((match latest_uuid with
|
||||
| Some latest_uuid when successful_build && not (Uuidm.equal latest_uuid uuid) ->
|
||||
[ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
|
||||
Uuidm.pp uuid Uuidm.pp latest_uuid]
|
||||
[txt "With latest build"] ; br () ]
|
||||
| _ -> []) @
|
||||
List.concat_map (fun { Builder_db.Build.start = other_start ; uuid = other_uuid ; _ } ->
|
||||
let fst, snd = if Ptime.is_later ~than:start other_start then uuid, other_uuid else other_uuid, uuid in
|
||||
[ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
|
||||
Uuidm.pp fst Uuidm.pp snd]
|
||||
[txtf "With build %a (output is identical binary)" pp_ptime other_start] ; br () ])
|
||||
different_input_same_output @
|
||||
List.concat_map (fun { Builder_db.Build.start = other_start ; uuid = other_uuid ; _ } ->
|
||||
let fst, snd = if Ptime.is_later ~than:start other_start then uuid, other_uuid else other_uuid, uuid in
|
||||
[ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
|
||||
Uuidm.pp fst Uuidm.pp snd]
|
||||
[txtf "With build %a (same input, different output)" pp_ptime other_start] ; br () ])
|
||||
same_input_different_output);
|
||||
h3 [txt "Build artifacts"];
|
||||
dl (List.concat_map
|
||||
(fun { Builder_db.filepath; localpath=_; sha256; size } ->
|
||||
|
@ -265,30 +240,51 @@ let job_build
|
|||
];
|
||||
])
|
||||
artifacts);
|
||||
(*
|
||||
(* FIXME *)
|
||||
h3 [txt "Job script"];
|
||||
toggleable "job-script" "Show/hide"
|
||||
[ pre [txt script] ];
|
||||
h3 [txt "Build log"];
|
||||
toggleable ~hidden:false "build-log" "Show/hide build log"
|
||||
[
|
||||
table
|
||||
(List.mapi (fun idx (ts, line) ->
|
||||
let ts_id = "L" ^ string_of_int idx in
|
||||
tr [
|
||||
td ~a:[
|
||||
a_class ["output-ts"];
|
||||
a_id ts_id;
|
||||
]
|
||||
[a ~a:[a_href ("#"^ts_id); a_class ["output-ts-anchor"]]
|
||||
[code [txtf "%#d ms" (Duration.to_ms (Int64.of_int ts))]]];
|
||||
td ~a:[a_class ["output-code"]]
|
||||
[code [txt line]];
|
||||
h3 [ txtf "Reproduced by %d builds" (List.length (same_input_same_output @ different_input_same_output))] ;
|
||||
ul
|
||||
((List.map (fun { Builder_db.Build.start ; uuid ; platform ; _ } ->
|
||||
li [
|
||||
txtf "on %s, same input, " platform;
|
||||
a ~a:[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp uuid]
|
||||
[txtf "%a" pp_ptime start]
|
||||
])
|
||||
(List.rev console));
|
||||
];
|
||||
*)
|
||||
same_input_same_output) @
|
||||
List.map (fun { Builder_db.Build.start = other_start ; uuid = other_uuid ; platform ; _ } ->
|
||||
let fst, snd = if Ptime.is_later ~than:start other_start then uuid, other_uuid else other_uuid, uuid in
|
||||
li [
|
||||
txtf "on %s, different input, " platform;
|
||||
a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
|
||||
Uuidm.pp fst Uuidm.pp snd]
|
||||
[txtf "%a" pp_ptime other_start]
|
||||
])
|
||||
different_input_same_output)
|
||||
] @
|
||||
(if same_input_different_output = [] then
|
||||
[]
|
||||
else
|
||||
[ h3 [txt "Same input, different output (not reproducible!)"];
|
||||
ul (
|
||||
List.map (fun { Builder_db.Build.start = other_start ; uuid = other_uuid ; platform ; _ } ->
|
||||
let fst, snd = if Ptime.is_later ~than:start other_start then uuid, other_uuid else other_uuid, uuid in
|
||||
li [
|
||||
txtf "on %s, " platform ;
|
||||
a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch" Uuidm.pp fst Uuidm.pp snd]
|
||||
[txtf "%a" pp_ptime other_start]
|
||||
])
|
||||
same_input_different_output)
|
||||
]) @
|
||||
[ h3 [txt "Comparisons with other builds on the same platform"];
|
||||
let opt_build (ctx, uu) =
|
||||
match uu with
|
||||
| Some uu when not (Uuidm.equal uuid uu) ->
|
||||
[ li [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
|
||||
Uuidm.pp uuid Uuidm.pp uu]
|
||||
[txtf "With %s build" ctx]]
|
||||
]
|
||||
| _ -> []
|
||||
in
|
||||
ul
|
||||
(List.concat_map opt_build [ ("latest", latest_uuid) ; ("next", next_uuid) ; ("previous", previous_uuid) ])
|
||||
])
|
||||
|
||||
let key_values xs =
|
||||
|
|
|
@ -220,7 +220,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
|
||||
Db.find_opt Builder_db.Build.get_latest (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_binary);
|
||||
Alcotest.(check Testable.uuid) "same uuid" meta.uuid uuid'
|
||||
|
@ -229,17 +229,17 @@ let test_build_get_previous (module Db : CONN) =
|
|||
add_second_build (module Db) >>= fun () ->
|
||||
Db.find_opt Builder_db.Build.get_by_uuid uuid'
|
||||
>>| get_opt "no build" >>= fun (id, _build) ->
|
||||
Db.find_opt Builder_db.Build.get_previous_successful id
|
||||
>>| get_opt "no previous build" >>| fun (_id, meta) ->
|
||||
Alcotest.(check Testable.uuid) "same uuid" meta.uuid uuid
|
||||
Db.find_opt Builder_db.Build.get_previous_successful_uuid id
|
||||
>>| get_opt "no previous build" >>| fun uuid' ->
|
||||
Alcotest.(check Testable.uuid) "same uuid" uuid' uuid
|
||||
|
||||
let test_build_get_previous_none (module Db : CONN) =
|
||||
Db.find_opt Builder_db.Build.get_by_uuid uuid
|
||||
>>| get_opt "no build" >>= fun (id, _build) ->
|
||||
Db.find_opt Builder_db.Build.get_previous_successful id >>| function
|
||||
Db.find_opt Builder_db.Build.get_previous_successful_uuid id >>| function
|
||||
| None -> ()
|
||||
| Some (_id, meta) ->
|
||||
Alcotest.failf "Got unexpected result %a" Uuidm.pp meta.uuid
|
||||
| Some uuid ->
|
||||
Alcotest.failf "Got unexpected result %a" Uuidm.pp uuid
|
||||
|
||||
let test_build_get_with_jobname_by_hash (module Db : CONN) =
|
||||
add_second_build (module Db) >>= fun () ->
|
||||
|
|
Loading…
Reference in a new issue