Views++: Made long parameter-lists into named parameters

This commit is contained in:
rand00 2022-02-03 13:27:22 +01:00
parent 3680336b22
commit db3f87934b
2 changed files with 40 additions and 21 deletions

View file

@ -138,7 +138,9 @@ let add_routes datadir =
|> 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 (readme, builds) -> >>= fun (readme, builds) ->
Views.Job.make ~failed:false job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok builds
|> Views.Job.make ~failed:false ~job_name ~platform ~readme
|> string_of_html |> Dream.html |> Lwt_result.ok
in in
let job_with_failed req = let job_with_failed req =
@ -150,7 +152,9 @@ let add_routes datadir =
|> 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 (readme, builds) -> >>= fun (readme, builds) ->
Views.Job.make ~failed:true job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok builds
|> Views.Job.make ~failed:true ~job_name ~platform ~readme
|> string_of_html |> Dream.html |> Lwt_result.ok
in in
let redirect_latest req = let redirect_latest req =
@ -446,8 +450,13 @@ let add_routes datadir =
in in
let switch_left = OpamFile.SwitchExport.read_from_string switch_left let switch_left = OpamFile.SwitchExport.read_from_string switch_left
and switch_right = OpamFile.SwitchExport.read_from_string switch_right in and switch_right = OpamFile.SwitchExport.read_from_string switch_right in
Opamdiff.compare switch_left switch_right let opam_diff = Opamdiff.compare switch_left switch_right in
|> Views.compare_builds job_left job_right build_left build_right env_diff pkg_diff Views.compare_builds
~job_left ~job_right
~build_left ~build_right
~env_diff
~pkg_diff
~opam_diff
|> string_of_html |> Dream.html |> Lwt_result.ok |> string_of_html |> Dream.html |> Lwt_result.ok
in in

View file

@ -140,7 +140,7 @@ let layout ?include_static_css ?(nav=`Default) ~title body =
H.main body H.main body
]) ])
let toggleable ?(hidden=true) id description content = let toggleable ?(hidden=true) ~id ~description content =
let checked = if hidden then [] else H.[a_checked ()] in let checked = if hidden then [] else H.[a_checked ()] in
H.div [ H.div [
H.label H.label
@ -163,10 +163,10 @@ let toggleable ?(hidden=true) id description content =
] ]
let artifact let artifact
?(basename=false) ~basename
job_name ~job_name
build ~build
{ Builder_db.filepath; localpath = _; sha256; size } ~file:{ Builder_db.filepath; localpath = _; sha256; size }
= =
let artifact_link = let artifact_link =
Fmt.str "/job/%s/build/%a/f/%a" Fmt.str "/job/%s/build/%a/f/%a"
@ -254,7 +254,11 @@ module Builds = struct
H.txt " "; H.txt " ";
] @ (match latest_artifact with ] @ (match latest_artifact with
| Some main_binary -> | Some main_binary ->
artifact ~basename:true job_name latest_build main_binary artifact
~basename:true
~job_name
~build:latest_build
~file:main_binary
| 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 ]
@ -277,11 +281,11 @@ end
module Job = struct module Job = struct
let make ~failed name platform readme builds = let make ~failed ~job_name ~platform ~readme builds =
layout layout
~nav:(`Job (name, platform)) ~nav:(`Job (job_name, platform))
~title:(Fmt.str "Job %s %a" name pp_platform platform) ~title:(Fmt.str "Job %s %a" job_name pp_platform platform)
((H.h1 [txtf "Job %s %a" name pp_platform platform] :: ((H.h1 [txtf "Job %s %a" job_name pp_platform platform] ::
(match readme with (match readme with
| None -> [] | None -> []
| Some data -> | Some data ->
@ -299,7 +303,7 @@ module Job = struct
txtf " %s " build.platform; txtf " %s " build.platform;
H.a ~a:H.[ H.a ~a:H.[
Fmt.kstr a_href "/job/%s/build/%a/" Fmt.kstr a_href "/job/%s/build/%a/"
name job_name
Uuidm.pp build.Builder_db.Build.uuid ] 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;
@ -307,7 +311,11 @@ module Job = struct
H.txt " "; H.txt " ";
] @ match main_binary with ] @ match main_binary with
| Some main_binary -> | Some main_binary ->
artifact ~basename:true name build main_binary artifact
~basename:true
~job_name
~build
~file:main_binary
| None -> | None ->
[ txtf "Build failure: %a" Builder.pp_execution_result [ txtf "Build failure: %a" Builder.pp_execution_result
build.Builder_db.Build.result ])) build.Builder_db.Build.result ]))
@ -580,11 +588,13 @@ let opam_diffs diffs =
[ H.br () ]) [ H.br () ])
diffs diffs
let compare_builds job_left job_right let compare_builds
(build_left : Builder_db.Build.t) (build_right : Builder_db.Build.t) ~job_left ~job_right
(added_env, removed_env, changed_env) ~(build_left : Builder_db.Build.t) ~(build_right : Builder_db.Build.t)
(added_pkgs, removed_pkgs, changed_pkgs) ~env_diff:(added_env, removed_env, changed_env)
(same, opam_diff, version_diff, left, right) = ~pkg_diff:(added_pkgs, removed_pkgs, changed_pkgs)
~opam_diff:(same, opam_diff, version_diff, left, right)
=
layout layout
~nav:(`Comparison ((job_left, build_left), (job_right, build_right))) ~nav:(`Comparison ((job_left, build_left), (job_right, build_right)))
~title:(Fmt.str "Comparing builds %a and %a" ~title:(Fmt.str "Comparing builds %a and %a"