Show latest build info in jobs view
This does N+1 queries where N is the number of jobs.
This commit is contained in:
parent
1dce5eeda3
commit
3a106342f5
6 changed files with 81 additions and 12 deletions
|
@ -358,6 +358,25 @@ module Build = struct
|
|||
ORDER BY start_d DESC, start_ps DESC
|
||||
|}
|
||||
|
||||
let get_latest =
|
||||
Caqti_request.find_opt
|
||||
id
|
||||
Caqti_type.(tup3
|
||||
id
|
||||
Meta.t
|
||||
file_opt)
|
||||
{| SELECT b.id,
|
||||
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.job,
|
||||
a.filepath, a.localpath, a.sha256
|
||||
FROM build b
|
||||
LEFT JOIN build_artifact a ON
|
||||
a.build = b.id AND b.main_binary = a.filepath
|
||||
WHERE b.job = ?
|
||||
ORDER BY start_d DESC, start_ps DESC
|
||||
LIMIT 1
|
||||
|}
|
||||
|
||||
let add =
|
||||
Caqti_request.exec
|
||||
|
|
|
@ -124,6 +124,9 @@ sig
|
|||
(id, id * Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
val get_all_meta_by_name :
|
||||
(string, id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
val get_latest :
|
||||
(id, id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ])
|
||||
Caqti_request.t
|
||||
val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
|
||||
end
|
||||
|
||||
|
|
|
@ -73,15 +73,34 @@ let authorized t handler = fun req ->
|
|||
|
||||
let routes t =
|
||||
let builder _req =
|
||||
let+ jobs = Caqti_lwt.Pool.use Model.jobs t.pool in
|
||||
let* jobs = Caqti_lwt.Pool.use Model.jobs t.pool in
|
||||
match jobs with
|
||||
| Error e ->
|
||||
Log.warn (fun m -> m "Error getting jobs: %a" pp_error e);
|
||||
Response.of_plain_text ~status:`Internal_server_error
|
||||
"Error getting jobs"
|
||||
|> Lwt.return
|
||||
| Ok jobs ->
|
||||
List.sort String.compare jobs
|
||||
|> Views.builder |> Response.of_html
|
||||
let+ jobs =
|
||||
List.fold_right
|
||||
(fun (job_id, job_name) r ->
|
||||
r >>= fun acc ->
|
||||
Caqti_lwt.Pool.use (Model.build_meta job_id) t.pool >>= function
|
||||
| Some (latest_build, latest_artifact) ->
|
||||
Lwt_result.return ((job_name, latest_build, latest_artifact) :: acc)
|
||||
| None ->
|
||||
Log.warn (fun m -> m "Job without builds: %s" job_name);
|
||||
Lwt_result.return acc)
|
||||
jobs
|
||||
(Lwt_result.return [])
|
||||
in
|
||||
match jobs with
|
||||
| Error e ->
|
||||
Log.warn (fun m -> m "Error getting jobs: %a" pp_error e);
|
||||
Response.of_plain_text ~status:`Internal_server_error
|
||||
"Error getting jobs"
|
||||
| Ok jobs ->
|
||||
Views.builder jobs |> Response.of_html
|
||||
in
|
||||
|
||||
let job req =
|
||||
|
|
|
@ -45,6 +45,10 @@ let build uuid (module Db : CONN) =
|
|||
Db.find_opt Builder_db.Build.get_by_uuid uuid >>=
|
||||
not_found
|
||||
|
||||
let build_meta job (module Db : CONN) =
|
||||
Db.find_opt Builder_db.Build.get_latest job >|=
|
||||
Option.map (fun (_id, meta, file) -> (meta, file))
|
||||
|
||||
let build_exists uuid (module Db : CONN) =
|
||||
Db.find_opt Builder_db.Build.get_by_uuid uuid >|=
|
||||
Option.is_some
|
||||
|
@ -61,8 +65,7 @@ let job job (module Db : CONN) =
|
|||
List.map (fun (_id, meta, main_binary) -> (meta, main_binary))
|
||||
|
||||
let jobs (module Db : CONN) =
|
||||
Db.collect_list Builder_db.Job.get_all () >|=
|
||||
List.map snd
|
||||
Db.collect_list Builder_db.Job.get_all ()
|
||||
|
||||
let user username (module Db : CONN) =
|
||||
Db.find_opt Builder_db.User.get_user username >|=
|
||||
|
|
|
@ -11,6 +11,9 @@ val build_artifacts : Builder_db.id -> Caqti_lwt.connection ->
|
|||
val build : Uuidm.t -> Caqti_lwt.connection ->
|
||||
(Builder_db.id * Builder_db.Build.t, [> error ]) result Lwt.t
|
||||
|
||||
val build_meta : Builder_db.id -> Caqti_lwt.connection ->
|
||||
((Builder_db.Build.Meta.t * Builder_db.file option) option, [> error ]) result Lwt.t
|
||||
|
||||
val build_exists : Uuidm.t -> Caqti_lwt.connection ->
|
||||
(bool, [> error ]) result Lwt.t
|
||||
|
||||
|
@ -21,7 +24,7 @@ val job : string -> Caqti_lwt.connection ->
|
|||
((Builder_db.Build.Meta.t * Builder_db.file option) list, [> error ]) result Lwt.t
|
||||
|
||||
val jobs : Caqti_lwt.connection ->
|
||||
(string list, [> error ]) result Lwt.t
|
||||
((Builder_db.id * string) list, [> error ]) result Lwt.t
|
||||
|
||||
val user : string -> Caqti_lwt.connection ->
|
||||
(Builder_web_auth.user_info option, [> error ]) result Lwt.t
|
||||
|
|
34
lib/views.ml
34
lib/views.ml
|
@ -86,12 +86,34 @@ let builder jobs =
|
|||
txtf "We have currently %d jobs."
|
||||
(List.length jobs);
|
||||
];
|
||||
ul (List.map (fun job ->
|
||||
li [
|
||||
a ~a:[a_href ("job/" ^ job ^ "/")]
|
||||
[txt job];
|
||||
])
|
||||
jobs);
|
||||
ul (List.map (fun (job_name, latest_build, latest_artifact) ->
|
||||
li ([
|
||||
a ~a:[a_href ("job/" ^ job_name ^ "/")]
|
||||
[txt job_name];
|
||||
txt " ";
|
||||
check_icon latest_build.Builder_db.Build.Meta.result;
|
||||
br ();
|
||||
a ~a:[a_href (Fmt.strf "job/%s/build/%a/" job_name Uuidm.pp
|
||||
latest_build.Builder_db.Build.Meta.uuid)]
|
||||
[txtf "%a" (Ptime.pp_human ()) latest_build.Builder_db.Build.Meta.start];
|
||||
txt " ";
|
||||
] @ match latest_artifact with
|
||||
| Some main_binary ->
|
||||
[
|
||||
a ~a:[a_href (Fmt.strf
|
||||
"job/%s/build/%a/f/%a"
|
||||
job_name
|
||||
Uuidm.pp latest_build.Builder_db.Build.Meta.uuid
|
||||
Fpath.pp main_binary.Builder_db.filepath)]
|
||||
[txtf "%s" (Fpath.basename main_binary.Builder_db.filepath)];
|
||||
txt " ";
|
||||
code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct main_binary.Builder_db.sha256)];
|
||||
]
|
||||
| None ->
|
||||
[
|
||||
txtf "Build failed";
|
||||
]))
|
||||
jobs);
|
||||
]
|
||||
|
||||
let job name builds =
|
||||
|
|
Loading…
Reference in a new issue