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
|
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 =
|
let add =
|
||||||
Caqti_request.exec
|
Caqti_request.exec
|
||||||
|
|
|
@ -124,6 +124,9 @@ sig
|
||||||
(id, id * Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t
|
(id, id * Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||||
val get_all_meta_by_name :
|
val get_all_meta_by_name :
|
||||||
(string, id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t
|
(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
|
val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -73,15 +73,34 @@ let authorized t handler = fun req ->
|
||||||
|
|
||||||
let routes t =
|
let routes t =
|
||||||
let builder _req =
|
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 ->
|
||||||
|
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
|
match jobs with
|
||||||
| Error e ->
|
| Error e ->
|
||||||
Log.warn (fun m -> m "Error getting jobs: %a" pp_error e);
|
Log.warn (fun m -> m "Error getting jobs: %a" pp_error e);
|
||||||
Response.of_plain_text ~status:`Internal_server_error
|
Response.of_plain_text ~status:`Internal_server_error
|
||||||
"Error getting jobs"
|
"Error getting jobs"
|
||||||
| Ok jobs ->
|
| Ok jobs ->
|
||||||
List.sort String.compare jobs
|
Views.builder jobs |> Response.of_html
|
||||||
|> Views.builder |> Response.of_html
|
|
||||||
in
|
in
|
||||||
|
|
||||||
let job req =
|
let job req =
|
||||||
|
|
|
@ -45,6 +45,10 @@ let build uuid (module Db : CONN) =
|
||||||
Db.find_opt Builder_db.Build.get_by_uuid uuid >>=
|
Db.find_opt Builder_db.Build.get_by_uuid uuid >>=
|
||||||
not_found
|
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) =
|
let build_exists uuid (module Db : CONN) =
|
||||||
Db.find_opt Builder_db.Build.get_by_uuid uuid >|=
|
Db.find_opt Builder_db.Build.get_by_uuid uuid >|=
|
||||||
Option.is_some
|
Option.is_some
|
||||||
|
@ -61,8 +65,7 @@ let job job (module Db : CONN) =
|
||||||
List.map (fun (_id, meta, main_binary) -> (meta, main_binary))
|
List.map (fun (_id, meta, main_binary) -> (meta, main_binary))
|
||||||
|
|
||||||
let jobs (module Db : CONN) =
|
let jobs (module Db : CONN) =
|
||||||
Db.collect_list Builder_db.Job.get_all () >|=
|
Db.collect_list Builder_db.Job.get_all ()
|
||||||
List.map snd
|
|
||||||
|
|
||||||
let user username (module Db : CONN) =
|
let user username (module Db : CONN) =
|
||||||
Db.find_opt Builder_db.User.get_user username >|=
|
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 ->
|
val build : Uuidm.t -> Caqti_lwt.connection ->
|
||||||
(Builder_db.id * Builder_db.Build.t, [> error ]) result Lwt.t
|
(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 ->
|
val build_exists : Uuidm.t -> Caqti_lwt.connection ->
|
||||||
(bool, [> error ]) result Lwt.t
|
(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
|
((Builder_db.Build.Meta.t * Builder_db.file option) list, [> error ]) result Lwt.t
|
||||||
|
|
||||||
val jobs : Caqti_lwt.connection ->
|
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 ->
|
val user : string -> Caqti_lwt.connection ->
|
||||||
(Builder_web_auth.user_info option, [> error ]) result Lwt.t
|
(Builder_web_auth.user_info option, [> error ]) result Lwt.t
|
||||||
|
|
32
lib/views.ml
32
lib/views.ml
|
@ -86,11 +86,33 @@ let builder jobs =
|
||||||
txtf "We have currently %d jobs."
|
txtf "We have currently %d jobs."
|
||||||
(List.length jobs);
|
(List.length jobs);
|
||||||
];
|
];
|
||||||
ul (List.map (fun job ->
|
ul (List.map (fun (job_name, latest_build, latest_artifact) ->
|
||||||
li [
|
li ([
|
||||||
a ~a:[a_href ("job/" ^ job ^ "/")]
|
a ~a:[a_href ("job/" ^ job_name ^ "/")]
|
||||||
[txt job];
|
[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);
|
jobs);
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue