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: #48
Co-Authored-By: hannes <hannes@mehnert.org>
Co-Committed-By: hannes <hannes@mehnert.org>
pull/50/head
hannes 1 year ago
parent 7c7282894b
commit 9c326679ba
  1. 21
      lib/builder_web.ml
  2. 38
      lib/utils.ml
  3. 86
      lib/views.ml
  4. 76
      opamdiff/opamdiff.ml

@ -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

@ -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)

@ -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…
Cancel
Save