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

Show an error when parsing duniverse fails

Browse source
This commit is contained in:
Robur 2023-03-13 15:25:14 +00:00
parent 64045f7dec
commit ae1d8c553f
3 changed files with 86 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
lib/views.ml
View file

@ -860,7 +860,7 @@ let compare_builds
~(build_right : Builder_db.Build.t)
~env_diff:(added_env, removed_env, changed_env)
~pkg_diff:(added_pkgs, removed_pkgs, changed_pkgs)
~opam_diff:(opam_diff, version_diff, left, right, duniverse_content_diff, duniverse_left, duniverse_right)
~opam_diff:(opam_diff, version_diff, left, right, duniverse)
=
let items, data =
List.fold_left (fun (items, data) (id, txt, amount, code) ->
@ -871,18 +871,24 @@ let compare_builds
H.li [ H.a ~a:[H.a_href id_href] [txtf "%d %s" amount txt] ] :: items,
data @ H.h3 ~a:[H.a_id id] [H.txt txt] :: code)
([], [])
[ ("opam-packages-removed", "Opam packages removed",
([ ("opam-packages-removed", "Opam packages removed",
OpamPackage.Set.cardinal left, [ H.code (packages left) ]) ;
("opam-packages-installede", "New opam packages installed",
OpamPackage.Set.cardinal right, [ H.code (packages right) ]) ;
("opam-packages-version-diff", "Opam packages with version changes",
List.length version_diff, [ H.code (package_diffs version_diff) ]) ;
] @ (match duniverse with
| Ok (duniverse_left, duniverse_right, duniverse_content_diff) ->
[
("duniverse-dirs-removed", "Duniverse directories removed",
List.length duniverse_left, [ H.code (duniverse_dirs duniverse_left) ]) ;
("duniverse-dirs-installed", "New duniverse directories installed",
List.length duniverse_right, [ H.code (duniverse_dirs duniverse_right) ]) ;
("duniverse-dirs-content-diff", "Duniverse directories with content changes",
List.length duniverse_content_diff, [ H.code (duniverse_diffs duniverse_content_diff) ]) ;
]
| Error `Msg msg -> [ "duniverse-dirs-error", "Duniverse parsing error", 1, [ H.txt msg ] ]
) @ [
("opam-packages-opam-diff", "Opam packages with changes in their opam file",
List.length opam_diff, opam_diffs opam_diff) ;
("env-removed", "Environment variables removed",
@ -897,7 +903,7 @@ let compare_builds
List.length added_pkgs, [ H.code (key_values added_pkgs) ]) ;
("pkgs-changed", "System packages changed",
List.length changed_pkgs, [ H.code (key_value_changes changed_pkgs) ]) ;
]
])
in
layout
~nav:(`Comparison ((job_left, build_left), (job_right, build_right)))

25
opamdiff/opamdiff.ml
View file

@ -1,7 +1,5 @@
module Set = OpamPackage.Set
type package = OpamPackage.t
let packages (switch : OpamFile.SwitchExport.t) =
assert (Set.cardinal switch.selections.sel_pinned = 0);
assert (Set.cardinal switch.selections.sel_compiler = 0);
@ -58,15 +56,15 @@ let duniverse (switch : OpamFile.SwitchExport.t) =
let root = switch.OpamFile.SwitchExport.selections.OpamTypes.sel_roots in
if OpamPackage.Set.cardinal root = 1 then
let root = OpamPackage.Set.choose root in
Option.bind
OpamPackage.(Name.Map.find_opt root.name switch.OpamFile.SwitchExport.overlays)
(fun opam ->
match OpamPackage.(Name.Map.find_opt root.name switch.OpamFile.SwitchExport.overlays) with
| None -> Error (`Msg "opam switch export doesn't contain the main package")
| Some opam ->
match OpamFile.OPAM.extended opam duniverse_dir duniverse_dirs_data with
| None -> None
| Some Error _ -> None
| Some Ok v -> Some v)
| None -> Ok None
| Some Error e -> Error e
| Some Ok v -> Ok (Some v)
else
None
Error (`Msg "not a single root package found in opam switch export")
type duniverse_diff = {
name : string ;
@ -262,8 +260,9 @@ let compare left right =
and right_pkgs = diff packages_right packages_left
in
let opam_diff = detailed_opam_diffs left right opam_diff in
let left_duniverse, right_duniverse, duniverse_diff =
duniverse_diff (duniverse left) (duniverse right)
let duniverse_ret =
match duniverse left, duniverse right with
| Ok l, Ok r -> Ok (duniverse_diff l r)
| Error _ as e, _ | _, (Error _ as e) -> e
in
(opam_diff, version_diff, left_pkgs, right_pkgs,
duniverse_diff, left_duniverse, right_duniverse)
(opam_diff, version_diff, left_pkgs, right_pkgs, duniverse_ret)

39
opamdiff/opamdiff.mli Normal file
View file

@ -0,0 +1,39 @@
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 ;
}
type version_diff = {
name : OpamPackage.Name.t;
version_left : OpamPackage.Version.t;
version_right : OpamPackage.Version.t;
}
type duniverse_diff = {
name : string ;
urls : string * string option ;
hash : (OpamHash.kind * string option * string option) list ;
}
val pp_opampackage : Format.formatter -> OpamPackage.t -> unit
val pp_version_diff : Format.formatter -> version_diff -> unit
val pp_duniverse_diff : Format.formatter -> duniverse_diff -> unit
val pp_duniverse_dir : Format.formatter -> string * string -> unit
val pp_opam_diff : Format.formatter -> opam_diff -> unit
val commands_to_strings : OpamTypes.command list * OpamTypes.command list -> string list * string list
val opt_url_to_string : OpamFile.URL.t option * OpamFile.URL.t option -> string * string
val compare: OpamFile.SwitchExport.t ->
OpamFile.SwitchExport.t ->
opam_diff list * version_diff list * OpamPackage.Set.t * OpamPackage.Set.t * ((string * string) list * (string * string) list * duniverse_diff list, [> `Msg of string ]) result