Initial commit

This commit is contained in:
Reynir Björnsson 2020-12-02 14:33:15 +01:00
commit 0a92bdae65
9 changed files with 163 additions and 0 deletions

11
bin/builder_web_app.ml Normal file
View file

@ -0,0 +1,11 @@
open Opium
let t = { Builder_web.Model.dir = Fpath.v "sample" }
let app =
App.empty
|> App.cmd_name "Builder Web"
|> Builder_web.add_routes t
let () =
App.run_command app

4
bin/dune Normal file
View file

@ -0,0 +1,4 @@
(executable
(public_name builder_web)
(name builder_web_app)
(libraries builder_web))

23
builder-web.opam Normal file
View file

@ -0,0 +1,23 @@
opam-version: "2.0"
maintainer: "Reynir Björnsson <reynir@reynir.dk>"
authors: ["Reynir Björnsson <reynir@reynir.dk>"]
homepage: "https://github.com/roburio/builder-web"
dev-repo: "git+https://github.com/roburio/builder-web.git"
bug-reports: "https://github.com/roburio/builder-web/issues"
license: "ISC"
build: [
["dune" "subst"] {pinned}
["dune" "build" "-p" name "-j" jobs]
]
depends: [
"builder"
"opium"
]
synopsis: "Web interface for builder"
pin-depends: [
["builder.dev" "git+https://git.data.coop/reynir/builder.git"]
]

2
dune-project Normal file
View file

@ -0,0 +1,2 @@
(lang dune 2.7)
(name builder-web)

25
lib/builder_web.ml Normal file
View file

@ -0,0 +1,25 @@
let src = Logs.Src.create "builder-web" ~doc:"Builder_web"
module Log = (val Logs.src_log src : Logs.LOG)
open Opium
module Model = Model
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);
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 add_routes t (app : App.t) =
List.fold_right
(fun route app -> route app)
(routes t)
app

3
lib/dune Normal file
View file

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

51
lib/model.ml Normal file
View file

@ -0,0 +1,51 @@
let src = Logs.Src.create "builder-web.model" ~doc:"Builder_web model"
module Log = (val Logs.src_log src : Logs.LOG)
open Rresult.R.Infix
type t = {
dir : Fpath.t;
}
type job_run = Fpath.t
type job = {
name : Fpath.t;
runs : job_run 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))
type job_run_info = {
job_info : Builder.job;
uuid : Uuidm.t;
out : (int * string) list;
start : Ptime.t;
finish : Ptime.t;
result : Builder.execution_result;
data : (Fpath.t * string) list
}
let read_full t job run =
let f = Fpath.(t.dir // job.name // 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 =
Bos.OS.Dir.contents ~rel:true Fpath.(t.dir // job) >>= fun job_runs ->
Ok { name = 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
| 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);
None)

24
lib/model.mli Normal file
View file

@ -0,0 +1,24 @@
type t = {
dir : Fpath.t
}
type job
type job_run
type job_run_info = {
job_info : Builder.job;
uuid : Uuidm.t;
out : (int * string) list;
start : Ptime.t;
finish : Ptime.t;
result : Builder.execution_result;
data : (Fpath.t * string) list
}
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 jobs : t -> (job list, [> `Msg of string ]) result

20
lib/views.ml Normal file
View file

@ -0,0 +1,20 @@
open Tyxml.Html
let layout ~title:title_ body_ =
html
(head (title (txt title_))
[])
(body body_)
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.";
];
ul (List.map (fun job ->
li [txt (Model.job_name job)])
jobs);
]