render README from latest build (preserved as a tag value in job_tag table)
This commit is contained in:
parent
5285872865
commit
009fa49e9e
9 changed files with 156 additions and 26 deletions
|
@ -121,5 +121,6 @@ let () =
|
||||||
actions (module M20210609);
|
actions (module M20210609);
|
||||||
actions (module M20210625);
|
actions (module M20210625);
|
||||||
actions (module M20210629);
|
actions (module M20210629);
|
||||||
|
actions (module M20210630);
|
||||||
])
|
])
|
||||||
|> Cmdliner.Term.exit
|
|> Cmdliner.Term.exit
|
||||||
|
|
88
bin/migrations/m20210630.ml
Normal file
88
bin/migrations/m20210630.ml
Normal file
|
@ -0,0 +1,88 @@
|
||||||
|
let new_version = 10L and old_version = 9L
|
||||||
|
let identifier = "2021-06-30"
|
||||||
|
let migrate_doc = "add readme.md tag"
|
||||||
|
let rollback_doc = "remove readme.md tag"
|
||||||
|
|
||||||
|
let jobs =
|
||||||
|
Caqti_request.collect
|
||||||
|
Caqti_type.unit
|
||||||
|
Builder_db.Rep.id
|
||||||
|
"SELECT id FROM job"
|
||||||
|
|
||||||
|
let latest_successful_build =
|
||||||
|
Caqti_request.find
|
||||||
|
Builder_db.Rep.id
|
||||||
|
Builder_db.Rep.id
|
||||||
|
{| SELECT b.id
|
||||||
|
FROM build b
|
||||||
|
WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0
|
||||||
|
ORDER BY b.start_d DESC, b.start_ps DESC
|
||||||
|
LIMIT 1
|
||||||
|
|}
|
||||||
|
|
||||||
|
let build_artifacts =
|
||||||
|
Caqti_request.collect
|
||||||
|
Builder_db.Rep.id
|
||||||
|
Caqti_type.(tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath)
|
||||||
|
{| SELECT a.filepath, a.localpath
|
||||||
|
FROM build_artifact a
|
||||||
|
WHERE a.build = ?
|
||||||
|
|}
|
||||||
|
|
||||||
|
let insert_tag =
|
||||||
|
Caqti_request.exec
|
||||||
|
Caqti_type.string
|
||||||
|
"INSERT INTO tag (tag) VALUES (?)"
|
||||||
|
|
||||||
|
let insert_job_tag =
|
||||||
|
Caqti_request.exec
|
||||||
|
Caqti_type.(tup3 Builder_db.Rep.id string Builder_db.Rep.id)
|
||||||
|
"INSERT INTO job_tag (tag, value, job) VALUES (?, ?, ?)"
|
||||||
|
|
||||||
|
let find_tag =
|
||||||
|
Caqti_request.find
|
||||||
|
Caqti_type.string
|
||||||
|
Builder_db.Rep.id
|
||||||
|
"SELECT id FROM tag where tag = ?"
|
||||||
|
|
||||||
|
let remove_job_tag =
|
||||||
|
Caqti_request.exec
|
||||||
|
Builder_db.Rep.id
|
||||||
|
"DELETE FROM job_tag where tag = ?"
|
||||||
|
|
||||||
|
let remove_tag =
|
||||||
|
Caqti_request.exec
|
||||||
|
Builder_db.Rep.id
|
||||||
|
"DELETE FROM tag where id = ?"
|
||||||
|
|
||||||
|
open Rresult.R.Infix
|
||||||
|
|
||||||
|
let migrate datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||||
|
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
|
||||||
|
Db.exec insert_tag "readme.md" >>= fun () ->
|
||||||
|
Db.find find_tag "readme.md" >>= fun readme_id ->
|
||||||
|
Db.collect_list jobs () >>= fun jobs ->
|
||||||
|
Grej.list_iter_result (fun job ->
|
||||||
|
Db.find latest_successful_build job >>= fun build ->
|
||||||
|
Db.collect_list build_artifacts build >>= fun artifacts ->
|
||||||
|
List.fold_left (fun acc (fpath, lpath) ->
|
||||||
|
acc >>= fun acc ->
|
||||||
|
Bos.OS.File.read Fpath.(append datadir lpath) >>= fun data ->
|
||||||
|
Ok ((fpath, data) :: acc))
|
||||||
|
(Ok [])
|
||||||
|
artifacts >>= fun files ->
|
||||||
|
(match List.find_opt (fun (p, _) -> Fpath.(equal (v "README.md") p)) files with
|
||||||
|
| None -> Ok ()
|
||||||
|
| Some (_, data) -> Db.exec insert_job_tag (readme_id, data, job)))
|
||||||
|
jobs >>= fun () ->
|
||||||
|
Db.exec (Grej.set_version new_version) ()
|
||||||
|
|
||||||
|
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||||
|
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
|
||||||
|
Db.find find_tag "readme.md" >>= fun readme_id ->
|
||||||
|
Db.exec remove_job_tag readme_id >>= fun () ->
|
||||||
|
Db.exec remove_tag readme_id >>= fun () ->
|
||||||
|
Db.exec (Grej.set_version old_version) ()
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -43,6 +43,7 @@ depends: [
|
||||||
"cmdliner"
|
"cmdliner"
|
||||||
"uri"
|
"uri"
|
||||||
"fmt"
|
"fmt"
|
||||||
|
"omd"
|
||||||
]
|
]
|
||||||
|
|
||||||
synopsis: "Web interface for builder"
|
synopsis: "Web interface for builder"
|
||||||
|
|
|
@ -4,7 +4,7 @@ open Rep
|
||||||
let application_id = 1234839235l
|
let application_id = 1234839235l
|
||||||
|
|
||||||
(* Please update this when making changes! *)
|
(* Please update this when making changes! *)
|
||||||
let current_version = 9L
|
let current_version = 10L
|
||||||
|
|
||||||
type id = Rep.id
|
type id = Rep.id
|
||||||
|
|
||||||
|
|
|
@ -111,11 +111,11 @@ let add_routes datadir =
|
||||||
|
|
||||||
let job req =
|
let job req =
|
||||||
let job_name = Dream.param "job" req in
|
let job_name = Dream.param "job" req in
|
||||||
Dream.sql req (Model.job job_name)
|
Dream.sql req (Model.job_and_readme job_name)
|
||||||
|> if_error "Error getting job"
|
|> if_error "Error getting job"
|
||||||
~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
|
~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
|
||||||
>>= fun builds ->
|
>>= fun (readme, builds) ->
|
||||||
Views.job job_name builds |> string_of_html |> Dream.html |> Lwt_result.ok
|
Views.job job_name readme builds |> string_of_html |> Dream.html |> Lwt_result.ok
|
||||||
in
|
in
|
||||||
|
|
||||||
let redirect_latest req =
|
let redirect_latest req =
|
||||||
|
@ -134,15 +134,16 @@ let add_routes datadir =
|
||||||
let job_name = Dream.param "job" req
|
let job_name = Dream.param "job" req
|
||||||
and build = Dream.param "build" req in
|
and build = Dream.param "build" req in
|
||||||
get_uuid build >>= fun uuid ->
|
get_uuid build >>= fun uuid ->
|
||||||
(Dream.sql req (Model.build uuid) >>= fun (build_id, build) ->
|
(Dream.sql req (Model.readme job_name) >>= fun readme ->
|
||||||
|
Dream.sql req (Model.build uuid) >>= fun (build_id, build) ->
|
||||||
Dream.sql req (Model.build_artifacts build_id) >>= fun artifacts ->
|
Dream.sql req (Model.build_artifacts build_id) >>= fun artifacts ->
|
||||||
Dream.sql req (Model.latest_successful_build_uuid build.job_id) >>= fun latest_uuid ->
|
Dream.sql req (Model.latest_successful_build_uuid build.job_id) >>= fun latest_uuid ->
|
||||||
Dream.sql req (Model.previous_successful_build build_id) >|= fun previous_build ->
|
Dream.sql req (Model.previous_successful_build build_id) >|= fun previous_build ->
|
||||||
(build, artifacts, latest_uuid, previous_build))
|
(readme, build, artifacts, latest_uuid, previous_build))
|
||||||
|> if_error "Error getting job build"
|
|> if_error "Error getting job build"
|
||||||
~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
|
~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
|
||||||
>>= fun (build, artifacts, latest_uuid, previous_build) ->
|
>>= fun (readme, build, artifacts, latest_uuid, previous_build) ->
|
||||||
Views.job_build job_name build artifacts latest_uuid previous_build |> string_of_html |> Dream.html
|
Views.job_build job_name readme build artifacts latest_uuid previous_build |> string_of_html |> Dream.html
|
||||||
|> Lwt_result.ok
|
|> Lwt_result.ok
|
||||||
in
|
in
|
||||||
|
|
||||||
|
|
2
lib/dune
2
lib/dune
|
@ -1,3 +1,3 @@
|
||||||
(library
|
(library
|
||||||
(name builder_web)
|
(name builder_web)
|
||||||
(libraries builder builder_db dream tyxml bos rresult duration hex caqti-lwt opamdiff ptime.clock.os))
|
(libraries builder builder_db dream tyxml bos rresult duration hex caqti-lwt opamdiff ptime.clock.os omd))
|
||||||
|
|
31
lib/model.ml
31
lib/model.ml
|
@ -80,10 +80,17 @@ let main_binary id main_binary (module Db : CONN) =
|
||||||
let job_id job_name (module Db : CONN) =
|
let job_id job_name (module Db : CONN) =
|
||||||
Db.find_opt Builder_db.Job.get_id_by_name job_name
|
Db.find_opt Builder_db.Job.get_id_by_name job_name
|
||||||
|
|
||||||
let job job (module Db : CONN) =
|
let readme job (module Db : CONN) =
|
||||||
job_id job (module Db) >>= not_found >>= fun job_id ->
|
job_id job (module Db) >>= not_found >>= fun job_id ->
|
||||||
Db.collect_list Builder_db.Build.get_all_meta job_id >|=
|
Db.find Builder_db.Tag.get_id_by_name "readme.md" >>= fun readme_id ->
|
||||||
List.map (fun (_id, meta, main_binary) -> (meta, main_binary))
|
Db.find_opt Builder_db.Job_tag.get_value (readme_id, job_id)
|
||||||
|
|
||||||
|
let job_and_readme job (module Db : CONN) =
|
||||||
|
job_id job (module Db) >>= not_found >>= fun job_id ->
|
||||||
|
Db.find Builder_db.Tag.get_id_by_name "readme.md" >>= fun readme_id ->
|
||||||
|
Db.find_opt Builder_db.Job_tag.get_value (readme_id, job_id) >>= fun readme ->
|
||||||
|
Db.collect_list Builder_db.Build.get_all_meta job_id >|= fun builds ->
|
||||||
|
readme, List.map (fun (_id, meta, main_binary) -> (meta, main_binary)) builds
|
||||||
|
|
||||||
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 ()
|
||||||
|
@ -265,6 +272,9 @@ let add_build
|
||||||
let descr_tag = "description" in
|
let descr_tag = "description" in
|
||||||
Db.exec Tag.try_add descr_tag >>= fun () ->
|
Db.exec Tag.try_add descr_tag >>= fun () ->
|
||||||
Db.find Tag.get_id_by_name descr_tag >>= fun descr_id ->
|
Db.find Tag.get_id_by_name descr_tag >>= fun descr_id ->
|
||||||
|
let readme_tag = "readme.md" in
|
||||||
|
Db.exec Tag.try_add readme_tag >>= fun () ->
|
||||||
|
Db.find Tag.get_id_by_name readme_tag >>= fun readme_id ->
|
||||||
Db.exec Build.add { Build.uuid; start; finish; result;
|
Db.exec Build.add { Build.uuid; start; finish; result;
|
||||||
console; script = job.Builder.script;
|
console; script = job.Builder.script;
|
||||||
main_binary = None; user_id; job_id } >>= fun () ->
|
main_binary = None; user_id; job_id } >>= fun () ->
|
||||||
|
@ -276,14 +286,17 @@ let add_build
|
||||||
| Some _ -> Db.exec Job_tag.update (tag_id, tag_value, job_id)
|
| Some _ -> Db.exec Job_tag.update (tag_id, tag_value, job_id)
|
||||||
in
|
in
|
||||||
(match fst sec_syn with
|
(match fst sec_syn with
|
||||||
| None -> Lwt_result.return ()
|
| None -> Lwt_result.return ()
|
||||||
| Some section_v -> add_or_update section_id section_v) >>= fun () ->
|
| Some section_v -> add_or_update section_id section_v) >>= fun () ->
|
||||||
(match snd sec_syn with
|
(match snd sec_syn with
|
||||||
| None, _-> Lwt_result.return ()
|
| None, _-> Lwt_result.return ()
|
||||||
| Some synopsis_v, _ -> add_or_update synopsis_id synopsis_v) >>= fun () ->
|
| Some synopsis_v, _ -> add_or_update synopsis_id synopsis_v) >>= fun () ->
|
||||||
(match snd sec_syn with
|
(match snd sec_syn with
|
||||||
| _, None -> Lwt_result.return ()
|
| _, None -> Lwt_result.return ()
|
||||||
| _, Some descr_v -> add_or_update descr_id descr_v) >>= fun () ->
|
| _, Some descr_v -> add_or_update descr_id descr_v) >>= fun () ->
|
||||||
|
(match List.find_opt (fun (p, _) -> Fpath.(equal (v "README.md") p)) raw_artifacts with
|
||||||
|
| None -> Lwt_result.return ()
|
||||||
|
| Some (_, data) -> add_or_update readme_id data) >>= fun () ->
|
||||||
List.fold_left
|
List.fold_left
|
||||||
(fun r file ->
|
(fun r file ->
|
||||||
r >>= fun () ->
|
r >>= fun () ->
|
||||||
|
|
|
@ -42,8 +42,11 @@ val previous_successful_build : Builder_db.id -> Caqti_lwt.connection ->
|
||||||
val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection ->
|
val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection ->
|
||||||
(Builder_db.file option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
(Builder_db.file option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||||
|
|
||||||
val job : string -> Caqti_lwt.connection ->
|
val readme : string -> Caqti_lwt.connection ->
|
||||||
((Builder_db.Build.Meta.t * Builder_db.file option) list, [> error ]) result Lwt.t
|
(string option, [> error ]) result Lwt.t
|
||||||
|
|
||||||
|
val job_and_readme : string -> Caqti_lwt.connection ->
|
||||||
|
(string option * (Builder_db.Build.Meta.t * Builder_db.file option) list, [> error ]) result Lwt.t
|
||||||
|
|
||||||
val job_id : string -> Caqti_lwt.connection ->
|
val job_id : string -> Caqti_lwt.connection ->
|
||||||
(Builder_db.id option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
(Builder_db.id option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
|
||||||
|
|
35
lib/views.ml
35
lib/views.ml
|
@ -151,9 +151,20 @@ let builder section_job_map =
|
||||||
section_job_map
|
section_job_map
|
||||||
[])
|
[])
|
||||||
|
|
||||||
let job name builds =
|
let job name readme builds =
|
||||||
layout ~title:(Printf.sprintf "Job %s" name)
|
layout ~title:(Printf.sprintf "Job %s" name)
|
||||||
[ h1 [txtf "Job %s" name];
|
((h1 [txtf "Job %s" name] ::
|
||||||
|
(match readme with
|
||||||
|
| None -> []
|
||||||
|
| Some data ->
|
||||||
|
[
|
||||||
|
h2 ~a:[a_id "readme"] [txt "README"];
|
||||||
|
a ~a:[a_href "#builds"] [txt "Skip to builds"];
|
||||||
|
Unsafe.data Omd.(to_html (of_string data))
|
||||||
|
])) @
|
||||||
|
[
|
||||||
|
h2 ~a:[a_id "builds"] [txt "Builds"];
|
||||||
|
a ~a:[a_href "#readme"] [txt "Back to readme"];
|
||||||
p [
|
p [
|
||||||
txtf "Currently %d builds."
|
txtf "Currently %d builds."
|
||||||
(List.length builds)
|
(List.length builds)
|
||||||
|
@ -176,10 +187,11 @@ let job name builds =
|
||||||
]))
|
]))
|
||||||
builds);
|
builds);
|
||||||
|
|
||||||
]
|
])
|
||||||
|
|
||||||
let job_build
|
let job_build
|
||||||
name
|
name
|
||||||
|
readme
|
||||||
{ Builder_db.Build.uuid; start; finish; result; console; script; _ }
|
{ Builder_db.Build.uuid; start; finish; result; console; script; _ }
|
||||||
artifacts
|
artifacts
|
||||||
latest_uuid
|
latest_uuid
|
||||||
|
@ -187,8 +199,19 @@ let job_build
|
||||||
=
|
=
|
||||||
let delta = Ptime.diff finish start in
|
let delta = Ptime.diff finish start in
|
||||||
let successful_build = match result with Builder.Exited 0 -> true | _ -> false in
|
let successful_build = match result with Builder.Exited 0 -> true | _ -> false in
|
||||||
layout ~title:(Fmt.strf "Job build %s %a" name pp_ptime start)
|
layout ~title:(Fmt.strf "Job %s %a" name pp_ptime start)
|
||||||
[ h1 [txtf "Job build %s %a" name pp_ptime start];
|
((h1 [txtf "Job %s" name] ::
|
||||||
|
(match readme with
|
||||||
|
| None -> []
|
||||||
|
| Some data ->
|
||||||
|
[
|
||||||
|
h2 ~a:[a_id "readme"] [txt "README"];
|
||||||
|
a ~a:[a_href "#build"] [txt "Skip to build"];
|
||||||
|
Unsafe.data Omd.(to_html (of_string data))
|
||||||
|
])) @
|
||||||
|
[
|
||||||
|
h2 ~a:[a_id "build"] [txtf "Build %a" pp_ptime start];
|
||||||
|
a ~a:[a_href "#readme"] [txt "Back to readme"];
|
||||||
p [txtf "Build took %a." Ptime.Span.pp delta ];
|
p [txtf "Build took %a." Ptime.Span.pp delta ];
|
||||||
p [txtf "Execution result: %a." Builder.pp_execution_result result];
|
p [txtf "Execution result: %a." Builder.pp_execution_result result];
|
||||||
(match latest_uuid with
|
(match latest_uuid with
|
||||||
|
@ -242,7 +265,7 @@ let job_build
|
||||||
])
|
])
|
||||||
(List.rev console));
|
(List.rev console));
|
||||||
];
|
];
|
||||||
]
|
])
|
||||||
|
|
||||||
let packages packages =
|
let packages packages =
|
||||||
OpamPackage.Set.elements packages
|
OpamPackage.Set.elements packages
|
||||||
|
|
Loading…
Reference in a new issue