Show an error when parsing duniverse fails
This commit is contained in:
parent
64045f7dec
commit
ae1d8c553f
3 changed files with 86 additions and 42 deletions
62
lib/views.ml
62
lib/views.ml
|
@ -860,7 +860,7 @@ let compare_builds
|
||||||
~(build_right : Builder_db.Build.t)
|
~(build_right : Builder_db.Build.t)
|
||||||
~env_diff:(added_env, removed_env, changed_env)
|
~env_diff:(added_env, removed_env, changed_env)
|
||||||
~pkg_diff:(added_pkgs, removed_pkgs, changed_pkgs)
|
~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 =
|
let items, data =
|
||||||
List.fold_left (fun (items, data) (id, txt, amount, code) ->
|
List.fold_left (fun (items, data) (id, txt, amount, code) ->
|
||||||
|
@ -871,33 +871,39 @@ let compare_builds
|
||||||
H.li [ H.a ~a:[H.a_href id_href] [txtf "%d %s" amount txt] ] :: items,
|
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)
|
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) ]) ;
|
OpamPackage.Set.cardinal left, [ H.code (packages left) ]) ;
|
||||||
("opam-packages-installede", "New opam packages installed",
|
("opam-packages-installede", "New opam packages installed",
|
||||||
OpamPackage.Set.cardinal right, [ H.code (packages right) ]) ;
|
OpamPackage.Set.cardinal right, [ H.code (packages right) ]) ;
|
||||||
("opam-packages-version-diff", "Opam packages with version changes",
|
("opam-packages-version-diff", "Opam packages with version changes",
|
||||||
List.length version_diff, [ H.code (package_diffs version_diff) ]) ;
|
List.length version_diff, [ H.code (package_diffs version_diff) ]) ;
|
||||||
("duniverse-dirs-removed", "Duniverse directories removed",
|
] @ (match duniverse with
|
||||||
List.length duniverse_left, [ H.code (duniverse_dirs duniverse_left) ]) ;
|
| Ok (duniverse_left, duniverse_right, duniverse_content_diff) ->
|
||||||
("duniverse-dirs-installed", "New duniverse directories installed",
|
[
|
||||||
List.length duniverse_right, [ H.code (duniverse_dirs duniverse_right) ]) ;
|
("duniverse-dirs-removed", "Duniverse directories removed",
|
||||||
("duniverse-dirs-content-diff", "Duniverse directories with content changes",
|
List.length duniverse_left, [ H.code (duniverse_dirs duniverse_left) ]) ;
|
||||||
List.length duniverse_content_diff, [ H.code (duniverse_diffs duniverse_content_diff) ]) ;
|
("duniverse-dirs-installed", "New duniverse directories installed",
|
||||||
("opam-packages-opam-diff", "Opam packages with changes in their opam file",
|
List.length duniverse_right, [ H.code (duniverse_dirs duniverse_right) ]) ;
|
||||||
List.length opam_diff, opam_diffs opam_diff) ;
|
("duniverse-dirs-content-diff", "Duniverse directories with content changes",
|
||||||
("env-removed", "Environment variables removed",
|
List.length duniverse_content_diff, [ H.code (duniverse_diffs duniverse_content_diff) ]) ;
|
||||||
List.length removed_env, [ H.code (key_values removed_env) ]) ;
|
]
|
||||||
("env-added", "New environment variables added",
|
| Error `Msg msg -> [ "duniverse-dirs-error", "Duniverse parsing error", 1, [ H.txt msg ] ]
|
||||||
List.length added_env, [ H.code (key_values added_env) ]) ;
|
) @ [
|
||||||
("env-changed", "Environment variables changed",
|
("opam-packages-opam-diff", "Opam packages with changes in their opam file",
|
||||||
List.length changed_env, [ H.code (key_value_changes changed_env) ]) ;
|
List.length opam_diff, opam_diffs opam_diff) ;
|
||||||
("pkgs-removed", "System packages removed",
|
("env-removed", "Environment variables removed",
|
||||||
List.length removed_pkgs, [ H.code (key_values removed_pkgs) ]) ;
|
List.length removed_env, [ H.code (key_values removed_env) ]) ;
|
||||||
("pkgs-added", "New system packages added",
|
("env-added", "New environment variables added",
|
||||||
List.length added_pkgs, [ H.code (key_values added_pkgs) ]) ;
|
List.length added_env, [ H.code (key_values added_env) ]) ;
|
||||||
("pkgs-changed", "System packages changed",
|
("env-changed", "Environment variables changed",
|
||||||
List.length changed_pkgs, [ H.code (key_value_changes changed_pkgs) ]) ;
|
List.length changed_env, [ H.code (key_value_changes changed_env) ]) ;
|
||||||
]
|
("pkgs-removed", "System packages removed",
|
||||||
|
List.length removed_pkgs, [ H.code (key_values removed_pkgs) ]) ;
|
||||||
|
("pkgs-added", "New system packages added",
|
||||||
|
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
|
in
|
||||||
layout
|
layout
|
||||||
~nav:(`Comparison ((job_left, build_left), (job_right, build_right)))
|
~nav:(`Comparison ((job_left, build_left), (job_right, build_right)))
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
module Set = OpamPackage.Set
|
module Set = OpamPackage.Set
|
||||||
|
|
||||||
type package = OpamPackage.t
|
|
||||||
|
|
||||||
let packages (switch : OpamFile.SwitchExport.t) =
|
let packages (switch : OpamFile.SwitchExport.t) =
|
||||||
assert (Set.cardinal switch.selections.sel_pinned = 0);
|
assert (Set.cardinal switch.selections.sel_pinned = 0);
|
||||||
assert (Set.cardinal switch.selections.sel_compiler = 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
|
let root = switch.OpamFile.SwitchExport.selections.OpamTypes.sel_roots in
|
||||||
if OpamPackage.Set.cardinal root = 1 then
|
if OpamPackage.Set.cardinal root = 1 then
|
||||||
let root = OpamPackage.Set.choose root in
|
let root = OpamPackage.Set.choose root in
|
||||||
Option.bind
|
match OpamPackage.(Name.Map.find_opt root.name switch.OpamFile.SwitchExport.overlays) with
|
||||||
OpamPackage.(Name.Map.find_opt root.name switch.OpamFile.SwitchExport.overlays)
|
| None -> Error (`Msg "opam switch export doesn't contain the main package")
|
||||||
(fun opam ->
|
| Some opam ->
|
||||||
match OpamFile.OPAM.extended opam duniverse_dir duniverse_dirs_data with
|
match OpamFile.OPAM.extended opam duniverse_dir duniverse_dirs_data with
|
||||||
| None -> None
|
| None -> Ok None
|
||||||
| Some Error _ -> None
|
| Some Error e -> Error e
|
||||||
| Some Ok v -> Some v)
|
| Some Ok v -> Ok (Some v)
|
||||||
else
|
else
|
||||||
None
|
Error (`Msg "not a single root package found in opam switch export")
|
||||||
|
|
||||||
type duniverse_diff = {
|
type duniverse_diff = {
|
||||||
name : string ;
|
name : string ;
|
||||||
|
@ -262,8 +260,9 @@ let compare left right =
|
||||||
and right_pkgs = diff packages_right packages_left
|
and right_pkgs = diff packages_right packages_left
|
||||||
in
|
in
|
||||||
let opam_diff = detailed_opam_diffs left right opam_diff in
|
let opam_diff = detailed_opam_diffs left right opam_diff in
|
||||||
let left_duniverse, right_duniverse, duniverse_diff =
|
let duniverse_ret =
|
||||||
duniverse_diff (duniverse left) (duniverse right)
|
match duniverse left, duniverse right with
|
||||||
|
| Ok l, Ok r -> Ok (duniverse_diff l r)
|
||||||
|
| Error _ as e, _ | _, (Error _ as e) -> e
|
||||||
in
|
in
|
||||||
(opam_diff, version_diff, left_pkgs, right_pkgs,
|
(opam_diff, version_diff, left_pkgs, right_pkgs, duniverse_ret)
|
||||||
duniverse_diff, left_duniverse, right_duniverse)
|
|
||||||
|
|
39
opamdiff/opamdiff.mli
Normal file
39
opamdiff/opamdiff.mli
Normal 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
|
||||||
|
|
Loading…
Reference in a new issue