Implement job, job run

This commit is contained in:
Reynir Björnsson 2020-12-07 10:17:49 +01:00
parent 0a92bdae65
commit 41b0b6c031
6 changed files with 89 additions and 28 deletions

View file

@ -1,6 +1,6 @@
open Opium
let t = { Builder_web.Model.dir = Fpath.v "sample" }
let t = { Builder_web.dir = Fpath.v "sample" }
let app =
App.empty

View file

@ -3,20 +3,49 @@ module Log = (val Logs.src_log src : Logs.LOG)
open Opium
module Model = Model
type t = Model.t = {
dir : Fpath.t
}
let routes (t : Model.t) =
let builder _req =
match Model.jobs t with
| Error (`Msg e) ->
Log.warn (fun f -> f "Error getting jobs: %s" e);
Log.warn (fun m -> m "Error getting jobs: %s" e);
Response.of_plain_text ~status:`Internal_server_error
"Error getting jobs" |> Lwt.return
| Ok jobs ->
Views.builder jobs |> Response.of_html |> Lwt.return
in
[ App.get "/" builder ]
let job req =
let job = Router.param req "job" in
match Model.job t (Fpath.v job) with
| Error (`Msg e) ->
Log.warn (fun m -> m "Error getting job: %s" e);
Response.of_plain_text ~status:`Internal_server_error
"Error getting job" |> Lwt.return
| Ok job ->
Views.job job |> Response.of_html |> Lwt.return
in
let job_run req =
let job = Router.param req "job"
and run = Router.param req "run" in
match Model.read_full t (Fpath.v job) (Fpath.v run) with
| Error (`Msg e) ->
Log.warn (fun m -> m "Error getting job run: %s" e);
Response.of_plain_text ~status:`Internal_server_error
"Error getting job run" |> Lwt.return
| Ok job_run ->
Views.job_run job_run |> Response.of_html |> Lwt.return
in
[
App.get "/" builder;
App.get "/job/:job" job;
App.get "/job/:job/run/:run" job_run;
]
let add_routes t (app : App.t) =
List.fold_right

View file

@ -1,3 +1,3 @@
(library
(name builder_web)
(libraries builder opium bos rresult))
(libraries builder opium bos rresult duration))

View file

@ -7,16 +7,12 @@ type t = {
dir : Fpath.t;
}
type job_run = Fpath.t
type job = {
name : Fpath.t;
runs : job_run list;
path : Fpath.t;
runs : Fpath.t list;
}
let job_name { name; _ } = Fpath.to_string name
(* TODO: ensure invariant: jobs are always valid UUIDs *)
let job_run_uuid f = Option.get (Uuidm.of_string (Fpath.to_string f))
let job_name { path; _ } = Fpath.to_string path
type job_run_info = {
job_info : Builder.job;
@ -28,24 +24,24 @@ type job_run_info = {
data : (Fpath.t * string) list
}
let read_full t job run =
let f = Fpath.(t.dir // job.name // run / "full") in
let read_full t path run =
let f = Fpath.(t.dir // path // run / "full") in
Bos.OS.File.read f >>= fun s ->
Builder.Asn.exec_of_cs (Cstruct.of_string s)
>>| fun (job_info, uuid, out, start, finish, result, data) ->
{ job_info; uuid; out; start; finish; result; data }
let job_runs t job =
let job t job =
Bos.OS.Dir.contents ~rel:true Fpath.(t.dir // job) >>= fun job_runs ->
Ok { name = job; runs = job_runs }
Ok { path = job; runs = job_runs }
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 job ->
match job_runs t job with
List.filter_map (fun f ->
match job t f with
| Ok job -> Some job
| Error (`Msg e) ->
Log.warn (fun f -> f "Error reading job run dir %a: %s" Fpath.pp
Fpath.(t.dir // job) e);
Log.warn (fun m -> m "Error reading job run dir %a: %s" Fpath.pp
Fpath.(t.dir // f) e);
None)

View file

@ -2,9 +2,11 @@ type t = {
dir : Fpath.t
}
type job
type job = {
path : Fpath.t;
runs : Fpath.t list;
}
type job_run
type job_run_info = {
job_info : Builder.job;
@ -17,8 +19,8 @@ type job_run_info = {
}
val job_name : job -> string
val job_run_uuid : job_run -> Uuidm.t
val read_full : t -> job -> job_run -> (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 jobs : t -> (job list, [> `Msg of string ]) result

View file

@ -1,5 +1,7 @@
open Tyxml.Html
let txtf fmt = Fmt.kstrf txt fmt
let layout ~title:title_ body_ =
html
(head (title (txt title_))
@ -10,11 +12,43 @@ let builder jobs =
layout ~title:"Builder Web"
[ h1 [txt "Builder web"];
p [
txt "We have currently ";
txt (string_of_int (List.length jobs));
txt " jobs.";
txtf "We have currently %d jobs."
(List.length jobs);
];
ul (List.map (fun job ->
li [txt (Model.job_name job)])
li [
a ~a:[a_href ("job/" ^ Model.job_name job)]
[txt (Model.job_name job)];
])
jobs);
]
let job job =
let name = Model.job_name job in
layout ~title:(Printf.sprintf "Job %s" name)
[ h1 [txtf "Job %s" name];
p [
txtf "Currently %d job runs."
(List.length job.Model.runs)
];
ul (List.map (fun (run : Fpath.t) ->
li [
a ~a:[a_href Fpath.(to_string (job.path / "run" // run))]
[txtf "%a" Fpath.pp run];
])
job.Model.runs);
]
let job_run { Model.job_info = { Builder.name; _ };
uuid; result; out; _ } =
layout ~title:(Printf.sprintf "Job run %s (%s)" name (Uuidm.to_string uuid))
[ h1 [txtf "Job build %s (%a)" name Uuidm.pp uuid];
p [txtf "Status: %a" Builder.pp_execution_result result];
div (List.concat_map (fun (ts, line) ->
[
code [txtf "%d ms %s" (Duration.to_ms (Int64.of_int ts)) line];
br ();
])
(List.rev out));
]