diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 573bf72..b9806a9 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.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 diff --git a/lib/utils.ml b/lib/utils.ml index f83cc14..bb427a8 100644 --- a/lib/utils.ml +++ b/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) diff --git a/lib/views.ml b/lib/views.ml index 9746583..51c36e3 100644 --- a/lib/views.ml +++ b/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); + ]) diff --git a/opamdiff/opamdiff.ml b/opamdiff/opamdiff.ml index 89b6f6c..430f7b3 100644 --- a/opamdiff/opamdiff.ml +++ b/opamdiff/opamdiff.ml @@ -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)