Views: Builds: Separated html-generation out into named functions for ease of reading

This commit is contained in:
rand00 2022-02-03 13:50:32 +01:00
parent b631b05de2
commit 87442c4a09

View file

@ -187,89 +187,99 @@ let artifact
module Builds = struct module Builds = struct
let make section_job_map = let make_header =
layout ~title:"Reproducible OPAM builds" [
([ H.h1 [ H.txt "Reproducible OPAM builds" ];
H.h1 [ H.txt "Reproducible OPAM builds" ]; H.p [ H.txt "This website offers binary MirageOS unikernels and \
H.p [ H.txt "This website offers binary MirageOS unikernels and \ supplementary OS packages." ];
supplementary OS packages." ]; H.p [
H.p [ H.txt "Following is a list of jobs that are built daily. A \
H.txt "Following is a list of jobs that are built daily. A \ persistent link to the latest successful build is available \
persistent link to the latest successful build is available \ as /job/*jobname*/build/latest/. All builds can be \
as /job/*jobname*/build/latest/. All builds can be \ reproduced with ";
reproduced with "; H.a ~a:H.[a_href "https://github.com/roburio/orb/"]
H.a ~a:H.[a_href "https://github.com/roburio/orb/"] [H.txt "orb"];
[H.txt "orb"]; H.txt ". The builds are scheduled and executed by ";
H.txt ". The builds are scheduled and executed by "; H.a ~a:H.[a_href "https://github.com/roburio/builder/"]
H.a ~a:H.[a_href "https://github.com/roburio/builder/"] [H.txt "builder"];
[H.txt "builder"]; H.txt ". The web interface is ";
H.txt ". The web interface is "; H.a ~a:H.[a_href "https://git.robur.io/robur/builder-web/"]
H.a ~a:H.[a_href "https://git.robur.io/robur/builder-web/"] [H.txt "builder-web"];
[H.txt "builder-web"]; H.txt ". Contact team@robur.coop if you have any questions or \
H.txt ". Contact team@robur.coop if you have any questions or \
suggestions."; suggestions.";
]; ];
H.form ~a:H.[a_action "/hash"; a_method `Get] H.form ~a:H.[a_action "/hash"; a_method `Get]
[ [
H.label [ H.label [
H.txt "Search artifact by SHA256"; H.txt "Search artifact by SHA256";
H.br (); H.br ();
H.input ~a:H.[
a_input_type `Search;
a_id "sha256";
a_name "sha256";
] ();
];
H.input ~a:H.[ H.input ~a:H.[
a_input_type `Submit; a_input_type `Search;
a_value "Search"; a_id "sha256";
a_name "sha256";
] (); ] ();
]; ];
] @ H.input ~a:H.[
Utils.String_map.fold (fun section jobs acc -> a_input_type `Submit;
acc @ [ a_value "Search";
H.h2 [ H.txt section ]; ] ();
H.ul (List.map (fun (job_name, synopsis, platform_builds) -> ];
H.li ([ ]
H.a ~a:H.[a_href ("job/" ^ job_name ^ "/")]
[H.txt job_name]; let make_platform_builds ~job_name (platform, latest_build, latest_artifact) =
H.br (); [
H.txt (Option.value ~default:"" synopsis); check_icon latest_build.Builder_db.Build.result;
H.br () H.txt " ";
] @ List.concat_map (fun (platform, latest_build, latest_artifact) -> H.a ~a:[
[ Fmt.kstr H.a_href "job/%s/%a"
check_icon latest_build.Builder_db.Build.result; job_name
H.txt " "; pp_platform_query (Some platform)]
H.a ~a:[ [H.txt platform];
Fmt.kstr H.a_href "job/%s/%a" H.txt " ";
job_name H.a ~a:[
pp_platform_query (Some platform)] Fmt.kstr H.a_href "job/%s/build/%a/"
[H.txt platform]; job_name
H.txt " "; Uuidm.pp latest_build.Builder_db.Build.uuid]
H.a ~a:[ [txtf "%a" pp_ptime latest_build.Builder_db.Build.start];
Fmt.kstr H.a_href "job/%s/build/%a/" H.txt " ";
job_name ] @ (match latest_artifact with
Uuidm.pp latest_build.Builder_db.Build.uuid] | Some main_binary ->
[txtf "%a" pp_ptime latest_build.Builder_db.Build.start]; artifact
H.txt " "; ~basename:true
] @ (match latest_artifact with ~job_name
| Some main_binary -> ~build:latest_build
artifact ~file:main_binary
~basename:true | None ->
~job_name [ txtf "Build failure: %a" Builder.pp_execution_result
~build:latest_build latest_build.Builder_db.Build.result ]
~file:main_binary ) @ [ H.br () ]
| None ->
[ txtf "Build failure: %a" Builder.pp_execution_result let make_jobs jobs =
latest_build.Builder_db.Build.result ] jobs |> List.map (fun (job_name, synopsis, platform_builds) ->
) @ [ H.br () ] H.li ([
) H.a ~a:H.[a_href ("job/" ^ job_name ^ "/")]
platform_builds) [H.txt job_name];
) H.br ();
jobs) H.txt (Option.value ~default:"" synopsis);
]) H.br ()
section_job_map ]
[] @ @ List.concat_map (make_platform_builds ~job_name) platform_builds)
)
let make_body section_job_map =
let aux section jobs acc =
acc @ [
H.h2 [ H.txt section ];
H.ul (make_jobs jobs)
]
in
Utils.String_map.fold aux section_job_map []
let make section_job_map =
layout ~title:"Reproducible OPAM builds"
(make_header
@ make_body section_job_map
@
[ H.p [ [ H.p [
H.txt "View the latest failed builds "; H.txt "View the latest failed builds ";
H.a ~a:H.[a_href "/failed-builds/"] H.a ~a:H.[a_href "/failed-builds/"]