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

Views: Using ocp-indent to indent everything consistently + fixed code aesthetics (80 char rule etc.)

Browse source
This commit is contained in:
rand00 2022-02-02 23:27:25 +01:00
parent c17802d84f
commit ae5c5cb67d
1 changed files with 224 additions and 150 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

162
lib/views.ml
View file

@ -29,8 +29,10 @@ type nav = [
| `Comparison of (string * Builder_db.Build.t) * (string * Builder_db.Build.t) | `Comparison of (string * Builder_db.Build.t) * (string * Builder_db.Build.t)
] ]
let pp_platform = Fmt.(option ~none:(any "") (append (any "on ") string)) let pp_platform =
let pp_platform_query = Fmt.(option ~none:(any "") (append (any "?platform=") string)) Fmt.(option ~none:(any "") (append (any "on ") string))
let pp_platform_query =
Fmt.(option ~none:(any "") (append (any "?platform=") string))
let static_css = Tyxml.Html.Unsafe.data {| let static_css = Tyxml.Html.Unsafe.data {|
body { body {
@ -89,14 +91,28 @@ let layout ?include_static_css ?nav:(nav_=`Default) ~title:title_ body_ =
| `Default -> | `Default ->
to_nav [txt "Home", "/"] to_nav [txt "Home", "/"]
| `Job (job_name, platform) -> | `Job (job_name, platform) ->
to_nav [txt "Home", "/"; txtf "Job %s" job_name, Fmt.str "/job/%s/" job_name ; txtf "%a" pp_platform platform, Fmt.str "/job/%s/%a" job_name pp_platform_query platform ] to_nav [
txt "Home", "/";
txtf "Job %s" job_name, Fmt.str "/job/%s/" job_name ;
(
txtf "%a" pp_platform platform,
Fmt.str "/job/%s/%a" job_name pp_platform_query platform
)
]
| `Build (job_name, build) -> | `Build (job_name, build) ->
to_nav [ to_nav [
txt "Home", "/"; txt "Home", "/";
txtf "Job %s" job_name, Fmt.str "/job/%s/" job_name; txtf "Job %s" job_name, Fmt.str "/job/%s/" job_name;
txtf "%a" pp_platform (Some build.Builder_db.Build.platform), Fmt.str "/job/%s/%a" job_name pp_platform_query (Some build.Builder_db.Build.platform); (
txtf "%a" pp_platform (Some build.Builder_db.Build.platform),
Fmt.str "/job/%s/%a"
job_name
pp_platform_query (Some build.Builder_db.Build.platform)
);
txtf "Build %a" pp_ptime build.Builder_db.Build.start, txtf "Build %a" pp_ptime build.Builder_db.Build.start,
Fmt.str "/job/%s/build/%a/" job_name Uuidm.pp build.Builder_db.Build.uuid; Fmt.str "/job/%s/build/%a/"
job_name
Uuidm.pp build.Builder_db.Build.uuid;
] ]
| `Comparison ((job_left, build_left), (job_right, build_right)) -> | `Comparison ((job_left, build_left), (job_right, build_right)) ->
to_nav [ to_nav [
@ -104,7 +120,9 @@ let layout ?include_static_css ?nav:(nav_=`Default) ~title:title_ body_ =
txtf "Comparison between %s@%a and %s@%a" txtf "Comparison between %s@%a and %s@%a"
job_left pp_ptime build_left.Builder_db.Build.start job_left pp_ptime build_left.Builder_db.Build.start
job_right pp_ptime build_right.Builder_db.Build.start, job_right pp_ptime build_right.Builder_db.Build.start,
Fmt.str "/compare/%a/%a/" Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid; Fmt.str "/compare/%a/%a/"
Uuidm.pp build_left.uuid
Uuidm.pp build_right.uuid;
] ]
in in
(*> Note: Last declared CSS wins - so one can override here*) (*> Note: Last declared CSS wins - so one can override here*)
@ -141,15 +159,24 @@ let toggleable ?(hidden=true) id description content =
content; content;
] ]
let artifact ?(basename=false) job_name build { Builder_db.filepath; localpath = _; sha256; size } = let artifact
[ ?(basename=false)
a ~a:[a_href (Fmt.str "/job/%s/build/%a/f/%a" job_name
build
{ Builder_db.filepath; localpath = _; sha256; size }
=
let artifact_link =
Fmt.str "/job/%s/build/%a/f/%a"
job_name job_name
Uuidm.pp build.Builder_db.Build.uuid Uuidm.pp build.Builder_db.Build.uuid
Fpath.pp filepath)] Fpath.pp filepath
[if basename in
then txt (Fpath.basename filepath) [
else txtf "%a" Fpath.pp filepath]; a ~a:[a_href artifact_link]
[
if basename then txt (Fpath.basename filepath)
else txtf "%a" Fpath.pp filepath
];
txt " "; txt " ";
code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct sha256)]; code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct sha256)];
txtf " (%a)" Fmt.byte_size size; txtf " (%a)" Fmt.byte_size size;
@ -159,15 +186,22 @@ module Builds = struct
let make section_job_map = let make section_job_map =
layout ~title:"Reproducible OPAM builds" layout ~title:"Reproducible OPAM builds"
([ h1 [txt "Reproducible OPAM builds"]; ([
p [ txt "This website offers binary MirageOS unikernels and supplementary OS packages." ]; h1 [txt "Reproducible OPAM builds"];
p [ txt {|Following is a list of jobs that are built daily. A persistent link to the latest successful build is available as /job/*jobname*/build/latest/. All builds can be reproduced with |} ; p [ txt "This website offers binary MirageOS unikernels and \
supplementary OS packages." ];
p [ txt "Following is a list of jobs that are built daily. A \
persistent link to the latest successful build is available \
as /job/*jobname*/build/latest/. All builds can be \
reproduced with ";
a ~a:[a_href "https://github.com/roburio/orb/"] [txt "orb"]; a ~a:[a_href "https://github.com/roburio/orb/"] [txt "orb"];
txt ". The builds are scheduled and executed by "; txt ". The builds are scheduled and executed by ";
a ~a:[a_href "https://github.com/roburio/builder/"] [txt "builder"]; a ~a:[a_href "https://github.com/roburio/builder/"] [txt "builder"];
txt ". The web interface is "; txt ". The web interface is ";
a ~a:[a_href "https://git.robur.io/robur/builder-web/"] [txt "builder-web"]; a ~a:[a_href "https://git.robur.io/robur/builder-web/"]
txt ". Contact team@robur.coop if you have any questions or suggestions."; [txt "builder-web"];
txt ". Contact team@robur.coop if you have any questions or \
suggestions.";
]; ];
form ~a:[a_action "/hash"; a_method `Get] form ~a:[a_action "/hash"; a_method `Get]
[ [
@ -195,16 +229,20 @@ module Builds = struct
br (); br ();
txt (Option.value ~default:"" synopsis); txt (Option.value ~default:"" synopsis);
br () br ()
] @ ] @ List.concat_map (fun (platform, latest_build, latest_artifact) ->
List.flatten
(List.map (fun (platform, latest_build, latest_artifact) ->
[ [
check_icon latest_build.Builder_db.Build.result; check_icon latest_build.Builder_db.Build.result;
txt " "; txt " ";
a ~a:[Fmt.kstr a_href "job/%s/%a" job_name pp_platform_query (Some platform)][txt platform]; a ~a:[
Fmt.kstr a_href "job/%s/%a"
job_name
pp_platform_query (Some platform)]
[txt platform];
txt " "; txt " ";
a ~a:[Fmt.kstr a_href "job/%s/build/%a/" job_name Uuidm.pp a ~a:[
latest_build.Builder_db.Build.uuid] Fmt.kstr a_href "job/%s/build/%a/"
job_name
Uuidm.pp latest_build.Builder_db.Build.uuid]
[txtf "%a" pp_ptime latest_build.Builder_db.Build.start]; [txtf "%a" pp_ptime latest_build.Builder_db.Build.start];
txt " "; txt " ";
] @ (match latest_artifact with ] @ (match latest_artifact with
@ -213,9 +251,10 @@ module Builds = struct
| None -> | None ->
[ txtf "Build failure: %a" Builder.pp_execution_result [ txtf "Build failure: %a" Builder.pp_execution_result
latest_build.Builder_db.Build.result ] latest_build.Builder_db.Build.result ]
) @ [ br () ]) ) @ [ br () ]
)
platform_builds) platform_builds)
)) )
jobs) jobs)
]) ])
section_job_map section_job_map
@ -232,7 +271,9 @@ end
module Job = struct module Job = struct
let make ~failed name platform readme builds = let make ~failed name platform readme builds =
layout ~nav:(`Job (name, platform)) ~title:(Fmt.str "Job %s %a" name pp_platform platform) layout
~nav:(`Job (name, platform))
~title:(Fmt.str "Job %s %a" name pp_platform platform)
((h1 [txtf "Job %s %a" name pp_platform platform] :: ((h1 [txtf "Job %s %a" name pp_platform platform] ::
(match readme with (match readme with
| None -> [] | None -> []
@ -249,7 +290,10 @@ module Job = struct
li ([ li ([
check_icon build.Builder_db.Build.result; check_icon build.Builder_db.Build.result;
txtf " %s " build.platform; txtf " %s " build.platform;
a ~a:[Fmt.kstr a_href "/job/%s/build/%a/" name Uuidm.pp build.Builder_db.Build.uuid] a ~a:[
Fmt.kstr a_href "/job/%s/build/%a/"
name
Uuidm.pp build.Builder_db.Build.uuid ]
[ [
txtf "%a" pp_ptime build.Builder_db.Build.start; txtf "%a" pp_ptime build.Builder_db.Build.start;
]; ];
@ -262,9 +306,15 @@ module Job = struct
build.Builder_db.Build.result ])) build.Builder_db.Build.result ]))
builds); builds);
if failed then if failed then
p [ txt "Excluding failed builds " ; a ~a:[a_href "../"] [txt "here"] ; txt "." ] p [
txt "Excluding failed builds " ;
a ~a:[a_href "../"] [txt "here"] ;
txt "." ]
else else
p [ txt "Including failed builds " ; a ~a:[a_href "failed/"] [txt "here"] ; txt "." ] p [
txt "Including failed builds " ;
a ~a:[a_href "failed/"] [txt "here"] ;
txt "." ]
]) ])
end end
@ -315,7 +365,9 @@ module Job_build = struct
]; ];
]) ])
artifacts); artifacts);
h3 [ txtf "Reproduced by %d builds" (List.length (same_input_same_output @ different_input_same_output))] ; h3 [
txtf "Reproduced by %d builds"
(List.length (same_input_same_output @ different_input_same_output))] ;
ul ul
((List.map (fun { Builder_db.Build.start ; uuid ; platform ; _ } -> ((List.map (fun { Builder_db.Build.start ; uuid ; platform ; _ } ->
li [ li [
@ -327,8 +379,10 @@ module Job_build = struct
List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } ->
li [ li [
txtf "on %s, different input, " platform; txtf "on %s, different input, " platform;
a ~a:[Fmt.kstr a_href "/compare/%a/%a/" a ~a:[
Uuidm.pp other_uuid Uuidm.pp build.uuid] Fmt.kstr a_href "/compare/%a/%a/"
Uuidm.pp other_uuid
Uuidm.pp build.uuid]
[txtf "%a" pp_ptime start] [txtf "%a" pp_ptime start]
]) ])
different_input_same_output) different_input_same_output)
@ -341,7 +395,10 @@ module Job_build = struct
List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } -> List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } ->
li [ li [
txtf "on %s, " platform ; txtf "on %s, " platform ;
a ~a:[Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp other_uuid Uuidm.pp build.uuid] a ~a:[
Fmt.kstr a_href "/compare/%a/%a/"
Uuidm.pp other_uuid
Uuidm.pp build.uuid]
[txtf "%a" pp_ptime start] [txtf "%a" pp_ptime start]
]) ])
same_input_different_output) same_input_different_output)
@ -437,7 +494,8 @@ module Job_build = struct
" "
in in
let style_col_container = a_style "" in let style_col_container = a_style "" in
let style_col_left = a_style "width: 45em; min-width: 43em; padding-left: 2%" in let style_col_left =
a_style "width: 45em; min-width: 43em; padding-left: 2%" in
let style_col_right = a_style "width: 50%" in let style_col_right = a_style "width: 50%" in
let body = [ let body = [
div ~a:[ style_grid_container ] [ div ~a:[ style_grid_container ] [
@ -526,32 +584,45 @@ let compare_builds job_left job_right
(Fmt.str "/job/%s/build/%a/" (Fmt.str "/job/%s/build/%a/"
job_left job_left
Uuidm.pp build_left.uuid)] Uuidm.pp build_left.uuid)]
[txtf "%s@%a %a" job_left pp_ptime build_left.start pp_platform (Some build_left.platform)]; [ txtf "%s@%a %a"
job_left
pp_ptime build_left.start
pp_platform (Some build_left.platform)];
txt " and "; txt " and ";
a ~a:[a_href a ~a:[a_href
(Fmt.str "/job/%s/build/%a/" (Fmt.str "/job/%s/build/%a/"
job_right job_right
Uuidm.pp build_right.uuid)] Uuidm.pp build_right.uuid)]
[txtf "%s@%a %a" job_right pp_ptime build_right.start pp_platform (Some build_right.platform)]; [ txtf "%s@%a %a"
job_right
pp_ptime build_right.start
pp_platform (Some build_right.platform)];
]; ];
h3 [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp build_right.uuid Uuidm.pp build_left.uuid] h3 [ a ~a:[
Fmt.kstr a_href "/compare/%a/%a/"
Uuidm.pp build_right.uuid
Uuidm.pp build_left.uuid ]
[txt "Compare in reverse direction"]] ; [txt "Compare in reverse direction"]] ;
ul [ ul [
li [ li [
a ~a:[a_href "#opam-packages-removed"] a ~a:[a_href "#opam-packages-removed"]
[txtf "%d opam packages removed" (OpamPackage.Set.cardinal left)] [txtf "%d opam packages removed"
(OpamPackage.Set.cardinal left)]
]; ];
li [ li [
a ~a:[a_href "#opam-packages-installed"] a ~a:[a_href "#opam-packages-installed"]
[txtf "%d new opam packages installed" (OpamPackage.Set.cardinal right)] [txtf "%d new opam packages installed"
(OpamPackage.Set.cardinal right)]
]; ];
li [ li [
a ~a:[a_href "#opam-packages-version-diff"] a ~a:[a_href "#opam-packages-version-diff"]
[txtf "%d opam packages with version changes" (List.length version_diff)] [txtf "%d opam packages with version changes"
(List.length version_diff)]
]; ];
li [ li [
a ~a:[a_href "#opam-packages-opam-diff"] a ~a:[a_href "#opam-packages-opam-diff"]
[txtf "%d opam packages with changes in their opam file" (List.length opam_diff)] [txtf "%d opam packages with changes in their opam file"
(List.length opam_diff)]
]; ];
li [ li [
a ~a:[a_href "#opam-packages-unchanged"] a ~a:[a_href "#opam-packages-unchanged"]
@ -622,10 +693,13 @@ let failed_builds ~start ~count builds =
] ]
in in
layout ~title:"Failed builds" layout ~title:"Failed builds"
([ h1 [txt "Failed builds"]; ([
h1 [txt "Failed builds"];
ul (List.map build builds); ul (List.map build builds);
p [ txtf "View the next %d failed builds " count; p [ txtf "View the next %d failed builds " count;
a ~a:[Fmt.kstr a_href "/failed-builds/?count=%d&start=%d" count (start + count)] a ~a:[
Fmt.kstr a_href "/failed-builds/?count=%d&start=%d"
count (start + count) ]
[ txt "here"]; [ txt "here"];
txt "."; txt ".";
] ]