Don't get job runs from disk when listing jobs

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

View file

@ -21,7 +21,7 @@ let routes (t : Model.t) =
Response.of_plain_text ~status:`Internal_server_error
"Error getting jobs" |> Lwt.return
| 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
in

View file

@ -81,9 +81,13 @@ let jobs t =
Bos.OS.Dir.contents ~rel:true t.dir >>|
List.filter (fun f -> not (Fpath.equal (Fpath.v "state") f)) >>|
List.filter_map (fun f ->
match job t f with
| Ok job -> Some job
match Bos.OS.Dir.exists Fpath.(t.dir // f) with
| 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) ->
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);
None)

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 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

View file

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