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

improve comparison page and always link with current build as head (right_build)

Browse source
This commit is contained in:
Robur 2021-11-12 13:01:20 +00:00
parent 1dd1fe54ba
commit e15bd00fe5
3 changed files with 42 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lib/builder_web.ml
View file

@ -274,7 +274,7 @@ let add_routes datadir =
|> Lwt_result.ok |> Lwt_result.ok
in in
let compare_opam req = let compare_builds req =
let datadir = Dream.global datadir_global req in let datadir = Dream.global datadir_global req in
let build_left = Dream.param "build_left" req in let build_left = Dream.param "build_left" req in
let build_right = Dream.param "build_right" req in let build_right = Dream.param "build_right" req in
@ -309,7 +309,7 @@ let add_routes datadir =
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 Opamdiff.compare switch_left switch_right
|> Views.compare_opam 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
|> string_of_html |> Dream.html |> Lwt_result.ok |> string_of_html |> Dream.html |> Lwt_result.ok
in in
@ -370,7 +370,7 @@ let add_routes datadir =
Dream.get "/job/:job/build/:build/script" (w (job_build_static_file `Script)); Dream.get "/job/:job/build/:build/script" (w (job_build_static_file `Script));
Dream.get "/job/:job/build/:build/console" (w (job_build_static_file `Console)); Dream.get "/job/:job/build/:build/console" (w (job_build_static_file `Console));
Dream.get "/hash" (w hash); Dream.get "/hash" (w hash);
Dream.get "/compare/:build_left/:build_right/opam-switch" (w compare_opam); Dream.get "/compare/:build_left/:build_right/" (w compare_builds);
Dream.post "/upload" (Authorization.authenticate (w upload)); Dream.post "/upload" (Authorization.authenticate (w upload));
Dream.post "/job/:job/platform/:platform/upload" (Authorization.authenticate (w upload_binary)); Dream.post "/job/:job/platform/:platform/upload" (Authorization.authenticate (w upload_binary));
] ]

4
lib/utils.ml
View file

@ -10,7 +10,7 @@ let diff_map a b =
let diff a b = let diff a b =
String_map.fold (fun k v acc -> String_map.fold (fun k v acc ->
if not (String_map.mem k b) then (k, v) :: acc else acc) if not (String_map.mem k b) then (k, v) :: acc else acc)
a [] a [] |> List.rev
in in
let added = diff b a let added = diff b a
and removed = diff a b and removed = diff a b
@ -19,7 +19,7 @@ let diff_map a b =
match String_map.find_opt k b with match String_map.find_opt k b with
| None -> acc | None -> acc
| Some v' -> if String.equal v v' then acc else (k, v, v') :: acc) | Some v' -> if String.equal v v' then acc else (k, v, v') :: acc)
a [] a [] |> List.rev
in in
(added, removed, changed) (added, removed, changed)

74
lib/views.ml
View file

@ -56,7 +56,7 @@ let layout ?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/opam-switch" 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
html html
@ -306,13 +306,12 @@ let job_build
[txtf "%a" pp_ptime start] [txtf "%a" pp_ptime start]
]) ])
same_input_same_output) @ same_input_same_output) @
List.map (fun { Builder_db.Build.start = other_start ; uuid = other_uuid ; platform ; _ } -> List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } ->
let fst, snd = if Ptime.is_later ~than:start other_start then uuid, other_uuid else other_uuid, uuid in
li [ li [
txtf "on %s, different input, " platform; txtf "on %s, different input, " platform;
a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch" a ~a:[Fmt.kstr a_href "/compare/%a/%a/"
Uuidm.pp fst Uuidm.pp snd] Uuidm.pp other_uuid Uuidm.pp uuid]
[txtf "%a" pp_ptime other_start] [txtf "%a" pp_ptime start]
]) ])
different_input_same_output) different_input_same_output)
] @ ] @
@ -321,12 +320,11 @@ let job_build
else else
[ h3 [txt "Same input, different output (not reproducible!)"]; [ h3 [txt "Same input, different output (not reproducible!)"];
ul ( ul (
List.map (fun { Builder_db.Build.start = other_start ; uuid = other_uuid ; platform ; _ } -> List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } ->
let fst, snd = if Ptime.is_later ~than:start other_start then uuid, other_uuid else other_uuid, uuid in
li [ li [
txtf "on %s, " platform ; txtf "on %s, " platform ;
a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch" Uuidm.pp fst Uuidm.pp snd] a ~a:[Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp other_uuid Uuidm.pp uuid]
[txtf "%a" pp_ptime other_start] [txtf "%a" pp_ptime start]
]) ])
same_input_different_output) same_input_different_output)
]) @ ]) @
@ -334,8 +332,8 @@ let job_build
let opt_build (ctx, uu) = let opt_build (ctx, uu) =
match uu with match uu with
| Some uu when not (Uuidm.equal uuid uu) -> | Some uu when not (Uuidm.equal uuid uu) ->
[ li [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch" [ li [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/"
Uuidm.pp uuid Uuidm.pp uu] Uuidm.pp uu Uuidm.pp uuid]
[txtf "With %s build" ctx]] [txtf "With %s build" ctx]]
] ]
| _ -> [] | _ -> []
@ -394,51 +392,53 @@ let opam_diffs diffs =
[ br () ]) [ br () ])
diffs diffs
let compare_opam job_left job_right let compare_builds job_left job_right
(build_left : Builder_db.Build.t) (build_right : Builder_db.Build.t) (build_left : Builder_db.Build.t) (build_right : Builder_db.Build.t)
(added_env, removed_env, changed_env) (added_env, removed_env, changed_env)
(added_pkgs, removed_pkgs, changed_pkgs) (added_pkgs, removed_pkgs, changed_pkgs)
(same, opam_diff, version_diff, left, right) = (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 opam switches between builds %a and %a" ~title:(Fmt.str "Comparing builds %a and %a"
Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid) Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid)
([ ([
h1 [txt "Comparing opam switches"]; h1 [txt "Comparing builds"];
h2 [ h2 [
txt "Builds "; txt "Builds ";
a ~a:[a_href a ~a:[a_href
(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 "%a" pp_ptime build_left.start]; [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 "%a" pp_ptime build_right.start]; [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]
[txt "Compare in reverse direction"]] ;
ul [ ul [
li [ li [
a ~a:[a_href "#packages-removed"] a ~a:[a_href "#opam-packages-removed"]
[txtf "%d packages removed" (OpamPackage.Set.cardinal left)] [txtf "%d opam packages removed" (OpamPackage.Set.cardinal left)]
]; ];
li [ li [
a ~a:[a_href "#packages-installed"] a ~a:[a_href "#opam-packages-installed"]
[txtf "%d new packages installed" (OpamPackage.Set.cardinal right)] [txtf "%d new opam packages installed" (OpamPackage.Set.cardinal right)]
]; ];
li [ li [
a ~a:[a_href "#packages-version-diff"] a ~a:[a_href "#opam-packages-version-diff"]
[txtf "%d 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 "#packages-opam-diff"] a ~a:[a_href "#opam-packages-opam-diff"]
[txtf "%d 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 "#packages-unchanged"] a ~a:[a_href "#opam-packages-unchanged"]
[txtf "%d packages unchanged" (OpamPackage.Set.cardinal same)] [txtf "%d opam packages unchanged" (OpamPackage.Set.cardinal same)]
]; ];
li [ li [
a ~a:[a_href "#env-added"] a ~a:[a_href "#env-added"]
@ -465,20 +465,20 @@ let compare_opam job_left job_right
[ txtf "%d system packages changed" (List.length changed_pkgs)] [ txtf "%d system packages changed" (List.length changed_pkgs)]
]; ];
]; ];
h3 ~a:[a_id "packages-removed"] h3 ~a:[a_id "opam-packages-removed"]
[txt "Packages removed"]; [txt "Opam packages removed"];
code (packages left); code (packages left);
h3 ~a:[a_id "packages-installed"] h3 ~a:[a_id "opam-packages-installed"]
[txt "New packages installed"]; [txt "New opam packages installed"];
code (packages right); code (packages right);
h3 ~a:[a_id "packages-version-diff"] h3 ~a:[a_id "opam-packages-version-diff"]
[txt "Packages with version changes"]; [txt "Opam packages with version changes"];
code (package_diffs version_diff); code (package_diffs version_diff);
h3 ~a:[a_id "packages-opam-diff"] h3 ~a:[a_id "opam-packages-opam-diff"]
[txt "Packages with changes in their opam file"]] @ [txt "Opam packages with changes in their opam file"]] @
opam_diffs opam_diff @ [ opam_diffs opam_diff @ [
h3 ~a:[a_id "packages-unchanged"] h3 ~a:[a_id "opam-packages-unchanged"]
[txt "Unchanged packages"]; [txt "Unchanged opam packages"];
code (packages same); code (packages same);
h3 ~a:[a_id "env-added"] [txt "Environment variables added"]; h3 ~a:[a_id "env-added"] [txt "Environment variables added"];
code (key_values added_env); code (key_values added_env);