robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Don't get job runs from disk when listing jobs

Browse source
This commit is contained in:
Reynir Björnsson 2020-12-07 21:21:01 +01:00
parent 17b0107ffe
commit 17570ebc76
4 changed files with 11 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lib/builder_web.ml
View file

@ -21,7 +21,7 @@ let routes (t : Model.t) =
Response.of_plain_text ~status:`Internal_server_error Response.of_plain_text ~status:`Internal_server_error
"Error getting jobs" |> Lwt.return "Error getting jobs" |> Lwt.return
| Ok jobs -> | Ok jobs ->
List.sort (fun j1 j2 -> Fpath.compare j1.Model.path j2.Model.path) jobs List.sort Fpath.compare jobs
|> Views.builder |> Response.of_html |> Lwt.return |> Views.builder |> Response.of_html |> Lwt.return
in in

10
lib/model.ml
View file

@ -81,9 +81,13 @@ let jobs t =
Bos.OS.Dir.contents ~rel:true t.dir >>| Bos.OS.Dir.contents ~rel:true t.dir >>|
List.filter (fun f -> not (Fpath.equal (Fpath.v "state") f)) >>| List.filter (fun f -> not (Fpath.equal (Fpath.v "state") f)) >>|
List.filter_map (fun f -> List.filter_map (fun f ->
match job t f with match Bos.OS.Dir.exists Fpath.(t.dir // f) with
| Ok job -> Some job | Ok true -> Some f
| Ok false ->
Log.warn (fun m -> m "dir %a doesn't exist" Fpath.pp
Fpath.(t.dir // f));
None
| Error (`Msg e) -> | Error (`Msg e) ->
Log.warn (fun m -> m "error reading job run dir %a: %s" Fpath.pp Log.warn (fun m -> m "error reading job dir %a: %s" Fpath.pp
Fpath.(t.dir // f) e); Fpath.(t.dir // f) e);
None) None)

2
lib/model.mli
View file

@ -26,4 +26,4 @@ val job_name : job -> string
val read_full : t -> Fpath.t -> Fpath.t -> (job_run_info, [> `Msg of string ]) result val read_full : t -> Fpath.t -> Fpath.t -> (job_run_info, [> `Msg of string ]) result
val job : t -> Fpath.t -> (job, [> `Msg of string]) result val job : t -> Fpath.t -> (job, [> `Msg of string]) result
val jobs : t -> (job list, [> `Msg of string ]) result val jobs : t -> (Fpath.t list, [> `Msg of string ]) result

4
lib/views.ml
View file

@ -37,8 +37,8 @@ let builder jobs =
]; ];
ul (List.map (fun job -> ul (List.map (fun job ->
li [ li [
a ~a:[a_href ("job/" ^ Model.job_name job ^ "/")] a ~a:[a_href ("job/" ^ Fpath.to_string job ^ "/")]
[txt (Model.job_name job)]; [txt (Fpath.to_string job)];
]) ])
jobs); jobs);
] ]