investigate differences in build, install, and uri when opam file differed (#48)
compare environment and system packages as well investigate differences in build, install, and uri when opam file differed Co-authored-by: Robur <team@robur.coop> Reviewed-on: https://git.robur.io/robur/builder-web/pulls/48 Co-Authored-By: hannes <hannes@mehnert.org> Co-Committed-By: hannes <hannes@mehnert.org>
This commit is contained in:
parent
7c7282894b
commit
9c326679ba
4 changed files with 209 additions and 12 deletions
|
|
@ -232,17 +232,32 @@ let add_routes datadir =
|
|||
Dream.sql req (Model.build build_right) >>= fun (_id, build_right) ->
|
||||
Dream.sql req (Model.build_artifact build_left.Builder_db.Build.uuid (Fpath.v "opam-switch")) >>=
|
||||
Model.build_artifact_data datadir >>= fun switch_left ->
|
||||
Dream.sql req (Model.build_artifact build_left.Builder_db.Build.uuid (Fpath.v "build-environment")) >>=
|
||||
Model.build_artifact_data datadir >>= fun build_env_left ->
|
||||
Dream.sql req (Model.build_artifact build_left.Builder_db.Build.uuid (Fpath.v "system-packages")) >>=
|
||||
Model.build_artifact_data datadir >>= fun system_packages_left ->
|
||||
Dream.sql req (Model.build_artifact build_right.Builder_db.Build.uuid (Fpath.v "opam-switch")) >>=
|
||||
Model.build_artifact_data datadir >>= fun switch_right ->
|
||||
Dream.sql req (Model.build_artifact build_right.Builder_db.Build.uuid (Fpath.v "build-environment")) >>=
|
||||
Model.build_artifact_data datadir >>= fun build_env_right ->
|
||||
Dream.sql req (Model.build_artifact build_right.Builder_db.Build.uuid (Fpath.v "system-packages")) >>=
|
||||
Model.build_artifact_data datadir >>= fun system_packages_right ->
|
||||
Dream.sql req (Model.job_name build_left.job_id) >>= fun job_left ->
|
||||
Dream.sql req (Model.job_name build_right.job_id) >|= fun job_right ->
|
||||
(job_left, job_right, build_left, build_right, switch_left, switch_right))
|
||||
(job_left, job_right, build_left, build_right,
|
||||
switch_left, build_env_left, system_packages_left,
|
||||
switch_right, build_env_right, system_packages_right))
|
||||
|> if_error "Internal server error"
|
||||
>>= fun (job_left, job_right, build_left, build_right, switch_left, switch_right) ->
|
||||
>>= fun (job_left, job_right, build_left, build_right,
|
||||
switch_left, build_env_left, system_packages_left,
|
||||
switch_right, build_env_right, system_packages_right) ->
|
||||
let env_diff = Utils.compare_env build_env_left build_env_right
|
||||
and pkg_diff = Utils.compare_pkgs system_packages_left system_packages_right
|
||||
in
|
||||
let switch_left = OpamFile.SwitchExport.read_from_string switch_left
|
||||
and switch_right = OpamFile.SwitchExport.read_from_string switch_right in
|
||||
Opamdiff.compare switch_left switch_right
|
||||
|> Views.compare_opam job_left job_right build_left build_right
|
||||
|> Views.compare_opam job_left job_right build_left build_right env_diff pkg_diff
|
||||
|> string_of_html |> Dream.html |> Lwt_result.ok
|
||||
in
|
||||
|
||||
|
|
|
|||
38
lib/utils.ml
38
lib/utils.ml
|
|
@ -6,3 +6,41 @@ module String_map = struct
|
|||
update key (function None -> Some [ v ] | Some xs -> Some (v :: xs)) t
|
||||
end
|
||||
|
||||
let diff_map a b =
|
||||
let diff a b =
|
||||
String_map.fold (fun k v acc ->
|
||||
if not (String_map.mem k b) then (k, v) :: acc else acc)
|
||||
a []
|
||||
in
|
||||
let added = diff b a
|
||||
and removed = diff a b
|
||||
and changed =
|
||||
String_map.fold (fun k v acc ->
|
||||
match String_map.find_opt k b with
|
||||
| None -> acc
|
||||
| Some v' -> if String.equal v v' then acc else (k, v, v') :: acc)
|
||||
a []
|
||||
in
|
||||
(added, removed, changed)
|
||||
|
||||
let compare_env env1 env2 =
|
||||
let parse_env e =
|
||||
List.fold_left (fun m s ->
|
||||
match Astring.String.cut ~sep:"=" s with
|
||||
| Some (key, value) -> String_map.add key value m
|
||||
| None -> String_map.add s "" m)
|
||||
String_map.empty (Astring.String.cuts ~sep:"\n" e)
|
||||
in
|
||||
diff_map (parse_env env1) (parse_env env2)
|
||||
|
||||
let compare_pkgs p1 p2 =
|
||||
let parse_pkgs p =
|
||||
List.fold_left (fun m s ->
|
||||
match Astring.String.cut ~sep:"=" s with
|
||||
| Some (name, version) -> String_map.add name version m
|
||||
| None -> match Astring.String.cut ~sep:"-" s with
|
||||
| Some (name, version) -> String_map.add name version m
|
||||
| None -> String_map.add s "" m)
|
||||
String_map.empty (Astring.String.cuts ~sep:"\n" p)
|
||||
in
|
||||
diff_map (parse_pkgs p1) (parse_pkgs p2)
|
||||
|
|
|
|||
86
lib/views.ml
86
lib/views.ml
|
|
@ -226,7 +226,7 @@ let job_build
|
|||
| Some previous_build when successful_build ->
|
||||
p [
|
||||
a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
|
||||
Uuidm.pp uuid Uuidm.pp previous_build.Builder_db.Build.Meta.uuid]
|
||||
Uuidm.pp previous_build.Builder_db.Build.Meta.uuid Uuidm.pp uuid]
|
||||
[txt "Compare opam-switch with previous build"];
|
||||
]
|
||||
| _ -> txt "");
|
||||
|
|
@ -267,6 +267,12 @@ let job_build
|
|||
];
|
||||
])
|
||||
|
||||
let key_values xs =
|
||||
List.concat_map (fun (k, v) -> [ txtf "%s %s" k v ; br () ]) xs
|
||||
|
||||
let key_value_changes xs =
|
||||
List.concat_map (fun (k, v, v') -> [ txtf "%s %s->%s" k v v' ; br () ]) xs
|
||||
|
||||
let packages packages =
|
||||
OpamPackage.Set.elements packages
|
||||
|> List.concat_map (fun p -> [
|
||||
|
|
@ -281,12 +287,44 @@ let package_diffs diffs =
|
|||
])
|
||||
diffs
|
||||
|
||||
let opam_diffs diffs =
|
||||
List.concat_map (fun pd ->
|
||||
h4 [ txtf "%a" Opamdiff.pp_opam_diff pd ] ::
|
||||
(match pd.Opamdiff.build with None -> [] | Some a ->
|
||||
let l, r = Opamdiff.commands_to_strings a in
|
||||
[
|
||||
h5 [ txt "build instruction (without common prefix) modifications, old:" ] ;
|
||||
code (List.concat_map (fun s -> [ txt s ; br () ]) l) ;
|
||||
h5 [ txt "new" ] ;
|
||||
code (List.concat_map (fun s -> [ txt s ; br () ]) r)
|
||||
]) @
|
||||
(match pd.Opamdiff.install with None -> [] | Some a ->
|
||||
let l, r = Opamdiff.commands_to_strings a in
|
||||
[
|
||||
h5 [ txt "install instruction (without common prefix) modifications, old:" ] ;
|
||||
code (List.concat_map (fun s -> [ txt s ; br () ]) l) ;
|
||||
h5 [ txt "new" ] ;
|
||||
code (List.concat_map (fun s -> [ txt s ; br () ]) r)
|
||||
]) @
|
||||
(match pd.Opamdiff.url with None -> [] | Some a ->
|
||||
let l, r = Opamdiff.opt_url_to_string a in
|
||||
[
|
||||
h5 [ txt "URL" ] ;
|
||||
txtf "old: %s" l;
|
||||
br ();
|
||||
txtf "new: %s" r
|
||||
]) @
|
||||
[ br () ])
|
||||
diffs
|
||||
|
||||
let compare_opam job_left job_right
|
||||
(build_left : Builder_db.Build.t) (build_right : Builder_db.Build.t)
|
||||
(added_env, removed_env, changed_env)
|
||||
(added_pkgs, removed_pkgs, changed_pkgs)
|
||||
(same, opam_diff, version_diff, left, right) =
|
||||
layout ~title:(Fmt.strf "Comparing opam switches between builds %a and %a"
|
||||
Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid)
|
||||
[
|
||||
([
|
||||
h1 [txt "Comparing opam switches"];
|
||||
h2 [
|
||||
txt "Builds ";
|
||||
|
|
@ -317,12 +355,36 @@ let compare_opam job_left job_right
|
|||
];
|
||||
li [
|
||||
a ~a:[a_href "#packages-opam-diff"]
|
||||
[txtf "%d packages with changes in their opam file" (OpamPackage.Set.cardinal opam_diff)]
|
||||
[txtf "%d packages with changes in their opam file" (List.length opam_diff)]
|
||||
];
|
||||
li [
|
||||
a ~a:[a_href "#packages-unchanged"]
|
||||
[txtf "%d packages unchanged" (OpamPackage.Set.cardinal same)]
|
||||
];
|
||||
li [
|
||||
a ~a:[a_href "#env-added"]
|
||||
[ txtf "%d environment variables added" (List.length added_env)]
|
||||
];
|
||||
li [
|
||||
a ~a:[a_href "#env-removed"]
|
||||
[ txtf "%d environment variables removed" (List.length removed_env)]
|
||||
];
|
||||
li [
|
||||
a ~a:[a_href "#env-changed"]
|
||||
[ txtf "%d environment variables changed" (List.length changed_env)]
|
||||
];
|
||||
li [
|
||||
a ~a:[a_href "#pkgs-added"]
|
||||
[ txtf "%d system packages added" (List.length added_pkgs)]
|
||||
];
|
||||
li [
|
||||
a ~a:[a_href "#pkgs-removed"]
|
||||
[ txtf "%d system packages removed" (List.length removed_pkgs)]
|
||||
];
|
||||
li [
|
||||
a ~a:[a_href "#pkgs-changed"]
|
||||
[ txtf "%d system packages changed" (List.length changed_pkgs)]
|
||||
];
|
||||
];
|
||||
h3 ~a:[a_id "packages-removed"]
|
||||
[txt "Packages removed"];
|
||||
|
|
@ -334,9 +396,21 @@ let compare_opam job_left job_right
|
|||
[txt "Packages with version changes"];
|
||||
code (package_diffs version_diff);
|
||||
h3 ~a:[a_id "packages-opam-diff"]
|
||||
[txt "Packages with changes in their opam file"];
|
||||
code (packages opam_diff);
|
||||
[txt "Packages with changes in their opam file"]] @
|
||||
opam_diffs opam_diff @ [
|
||||
h3 ~a:[a_id "packages-unchanged"]
|
||||
[txt "Unchanged packages"];
|
||||
code (packages same);
|
||||
]
|
||||
h3 ~a:[a_id "env-added"] [txt "Environment variables added"];
|
||||
code (key_values added_env);
|
||||
h3 ~a:[a_id "env-removed"] [txt "Environment variables removed"];
|
||||
code (key_values removed_env);
|
||||
h3 ~a:[a_id "env-changed"] [txt "Environment variables changed"];
|
||||
code (key_value_changes changed_env);
|
||||
h3 ~a:[a_id "pkgs-added"] [txt "System packages added"];
|
||||
code (key_values added_pkgs);
|
||||
h3 ~a:[a_id "pkgs-removed"] [txt "System packages removed"];
|
||||
code (key_values removed_pkgs);
|
||||
h3 ~a:[a_id "pkgs-changed"] [txt "System packages changed"];
|
||||
code (key_value_changes changed_pkgs);
|
||||
])
|
||||
|
|
|
|||
|
|
@ -23,6 +23,75 @@ let pp_version_diff ppf { name; version_left; version_right } =
|
|||
(OpamPackage.Version.to_string version_left)
|
||||
(OpamPackage.Version.to_string version_right)
|
||||
|
||||
type opam_diff = {
|
||||
pkg : OpamPackage.t ;
|
||||
build : (OpamTypes.command list * OpamTypes.command list) option ;
|
||||
install : (OpamTypes.command list * OpamTypes.command list) option ;
|
||||
url : (OpamFile.URL.t option * OpamFile.URL.t option) option ;
|
||||
otherwise_equal : bool ;
|
||||
}
|
||||
|
||||
let commands_to_strings (l, r) =
|
||||
let v a =
|
||||
OpamPrinter.FullPos.value (OpamPp.print OpamFormat.V.command a)
|
||||
in
|
||||
List.map v l, List.map v r
|
||||
|
||||
let opt_url_to_string (l, r) =
|
||||
let url_to_s = function
|
||||
| None -> "" | Some u -> OpamFile.URL.write_to_string u
|
||||
in
|
||||
url_to_s l, url_to_s r
|
||||
|
||||
let pp_opam_diff ppf { pkg ; otherwise_equal ; _ } =
|
||||
Format.fprintf ppf "%a%s"
|
||||
pp_opampackage pkg
|
||||
(if otherwise_equal then "" else " (and additional changes)")
|
||||
|
||||
let rec strip_common_prefix a b =
|
||||
match a, b with
|
||||
| hd::tl, hd'::tl' ->
|
||||
if hd = hd' then
|
||||
strip_common_prefix tl tl'
|
||||
else
|
||||
a, b
|
||||
| a, b -> a, b
|
||||
|
||||
let detailed_opam_diff pkg l r =
|
||||
let no_build_install_url p =
|
||||
OpamFile.OPAM.with_url_opt None
|
||||
(OpamFile.OPAM.with_install []
|
||||
(OpamFile.OPAM.with_build [] p))
|
||||
in
|
||||
let otherwise_equal =
|
||||
OpamFile.OPAM.effectively_equal
|
||||
(no_build_install_url l) (no_build_install_url r)
|
||||
and build =
|
||||
if OpamFile.OPAM.build l = OpamFile.OPAM.build r then
|
||||
None
|
||||
else
|
||||
Some (strip_common_prefix (OpamFile.OPAM.build l) (OpamFile.OPAM.build r))
|
||||
and install =
|
||||
if OpamFile.OPAM.install l = OpamFile.OPAM.install r then
|
||||
None
|
||||
else
|
||||
Some (strip_common_prefix (OpamFile.OPAM.install l) (OpamFile.OPAM.install r))
|
||||
and url =
|
||||
if OpamFile.OPAM.url l = OpamFile.OPAM.url r then
|
||||
None
|
||||
else
|
||||
Some (OpamFile.OPAM.url l, OpamFile.OPAM.url r)
|
||||
in
|
||||
{ pkg ; build ; install ; url ; otherwise_equal }
|
||||
|
||||
let detailed_opam_diffs left right pkgs =
|
||||
OpamPackage.Set.fold (fun p acc ->
|
||||
let find = OpamPackage.Name.Map.find p.name in
|
||||
let opam_left = find left.OpamFile.SwitchExport.overlays
|
||||
and opam_right = find right.OpamFile.SwitchExport.overlays in
|
||||
(detailed_opam_diff p opam_left opam_right) :: acc)
|
||||
pkgs []
|
||||
|
||||
let compare left right =
|
||||
let packages_left = packages left and packages_right = packages right in
|
||||
let module Set = OpamPackage.Set in
|
||||
|
|
@ -53,7 +122,8 @@ let compare left right =
|
|||
| None ->
|
||||
None)
|
||||
(Set.elements packages_left)
|
||||
and left = diff packages_left packages_right
|
||||
and right = diff packages_right packages_left
|
||||
and left_pkgs = diff packages_left packages_right
|
||||
and right_pkgs = diff packages_right packages_left
|
||||
in
|
||||
(same, opam_diff, version_diff, left, right)
|
||||
let opam_diff = detailed_opam_diffs left right opam_diff in
|
||||
(same, opam_diff, version_diff, left_pkgs, right_pkgs)
|
||||
|
|
|
|||
Loading…
Reference in a new issue