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)
]
let pp_platform = Fmt.(option ~none:(any "") (append (any "on ") string))
let pp_platform_query = Fmt.(option ~none:(any "") (append (any "?platform=") string))
let pp_platform =
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 {|
body {
@ -89,14 +91,28 @@ let layout ?include_static_css ?nav:(nav_=`Default) ~title:title_ body_ =
| `Default ->
to_nav [txt "Home", "/"]
| `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) ->
to_nav [
txt "Home", "/";
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,
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)) ->
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"
job_left pp_ptime build_left.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
(*> Note: Last declared CSS wins - so one can override here*)
@ -141,15 +159,24 @@ let toggleable ?(hidden=true) id description content =
content;
]
let artifact ?(basename=false) job_name build { Builder_db.filepath; localpath = _; sha256; size } =
[
a ~a:[a_href (Fmt.str "/job/%s/build/%a/f/%a"
let artifact
?(basename=false)
job_name
build
{ Builder_db.filepath; localpath = _; sha256; size }
=
let artifact_link =
Fmt.str "/job/%s/build/%a/f/%a"
job_name
Uuidm.pp build.Builder_db.Build.uuid
Fpath.pp filepath)]
[if basename
then txt (Fpath.basename filepath)
else txtf "%a" Fpath.pp filepath];
Fpath.pp filepath
in
[
a ~a:[a_href artifact_link]
[
if basename then txt (Fpath.basename filepath)
else txtf "%a" Fpath.pp filepath
];
txt " ";
code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct sha256)];
txtf " (%a)" Fmt.byte_size size;
@ -159,15 +186,22 @@ module Builds = struct
let make section_job_map =
layout ~title:"Reproducible OPAM builds"
([ h1 [txt "Reproducible OPAM builds"];
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 |} ;
([
h1 [txt "Reproducible OPAM builds"];
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"];
txt ". The builds are scheduled and executed by ";
a ~a:[a_href "https://github.com/roburio/builder/"] [txt "builder"];
txt ". The web interface is ";
a ~a:[a_href "https://git.robur.io/robur/builder-web/"] [txt "builder-web"];
txt ". Contact team@robur.coop if you have any questions or suggestions.";
a ~a:[a_href "https://git.robur.io/robur/builder-web/"]
[txt "builder-web"];
txt ". Contact team@robur.coop if you have any questions or \
suggestions.";
];
form ~a:[a_action "/hash"; a_method `Get]
[
@ -195,16 +229,20 @@ module Builds = struct
br ();
txt (Option.value ~default:"" synopsis);
br ()
] @
List.flatten
(List.map (fun (platform, latest_build, latest_artifact) ->
] @ List.concat_map (fun (platform, latest_build, latest_artifact) ->
[
check_icon latest_build.Builder_db.Build.result;
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 " ";
a ~a:[Fmt.kstr a_href "job/%s/build/%a/" job_name Uuidm.pp
latest_build.Builder_db.Build.uuid]
a ~a:[
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];
txt " ";
] @ (match latest_artifact with
@ -213,9 +251,10 @@ module Builds = struct
| None ->
[ txtf "Build failure: %a" Builder.pp_execution_result
latest_build.Builder_db.Build.result ]
) @ [ br () ])
) @ [ br () ]
)
platform_builds)
))
)
jobs)
])
section_job_map
@ -232,7 +271,9 @@ end
module Job = struct
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] ::
(match readme with
| None -> []
@ -249,7 +290,10 @@ module Job = struct
li ([
check_icon build.Builder_db.Build.result;
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;
];
@ -262,9 +306,15 @@ module Job = struct
build.Builder_db.Build.result ]))
builds);
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
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
@ -315,7 +365,9 @@ module Job_build = struct
];
])
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
((List.map (fun { Builder_db.Build.start ; uuid ; platform ; _ } ->
li [
@ -327,8 +379,10 @@ module Job_build = struct
List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } ->
li [
txtf "on %s, different input, " 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]
])
different_input_same_output)
@ -341,7 +395,10 @@ module Job_build = struct
List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } ->
li [
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]
])
same_input_different_output)
@ -437,7 +494,8 @@ module Job_build = struct
"
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 body = [
div ~a:[ style_grid_container ] [
@ -526,32 +584,45 @@ let compare_builds job_left job_right
(Fmt.str "/job/%s/build/%a/"
job_left
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 ";
a ~a:[a_href
(Fmt.str "/job/%s/build/%a/"
job_right
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"]] ;
ul [
li [
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 [
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 [
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 [
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 [
a ~a:[a_href "#opam-packages-unchanged"]
@ -622,10 +693,13 @@ let failed_builds ~start ~count builds =
]
in
layout ~title:"Failed builds"
([ h1 [txt "Failed builds"];
([
h1 [txt "Failed builds"];
ul (List.map build builds);
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 ".";
]