From 408b30f2d40072358effff645e94244d46daa144 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 1 Aug 2022 22:19:58 +0100 Subject: [PATCH] Fix some of the unhelpful conflict messages by merging formulas that include each other --- master_changes.md | 2 + src/core/opamStd.ml | 6 ++ src/core/opamStd.mli | 2 + src/solver/opamCudf.ml | 62 +++++++++++++++++++-- src/solver/opamCudf.mli | 4 +- tests/reftests/unhelpful-conflicts-002.test | 35 +----------- 6 files changed, 69 insertions(+), 42 deletions(-) diff --git a/master_changes.md b/master_changes.md index 64a3f3230f9..47fcdfcb33c 100644 --- a/master_changes.md +++ b/master_changes.md @@ -101,6 +101,7 @@ users) ## Opam file format ## Solver + * Fix some of the unhelpful conflict messages by merging formulas that include each other [#5210 @kit-ty-kate] ## Client @@ -154,3 +155,4 @@ users) ## opam-format ## opam-core + * Add `OpamStd.List.equal` [#5210 @kit-ty-kate] diff --git a/src/core/opamStd.ml b/src/core/opamStd.ml index ddcf8c3de41..e087bdba8bd 100644 --- a/src/core/opamStd.ml +++ b/src/core/opamStd.ml @@ -84,6 +84,12 @@ let max_print = 100 module OpamList = struct + let rec equal f x y = match x, y with + | [], [] -> true + | x::xs, y::ys when f x y -> equal f xs ys + | _::xs, _::ys -> equal f xs ys + | [], _::_ | _::_, [] -> false + let cons x xs = x :: xs let concat_map ?(left="") ?(right="") ?nil ?last_sep sep f = diff --git a/src/core/opamStd.mli b/src/core/opamStd.mli index 3ba4aa261f0..a45aebf164e 100644 --- a/src/core/opamStd.mli +++ b/src/core/opamStd.mli @@ -184,6 +184,8 @@ end module List : sig + val equal : ('a -> 'a -> bool) -> 'a list -> 'a list -> bool + val cons: 'a -> 'a list -> 'a list (** Convert list items to string and concat. [sconcat_map sep f x] is equivalent diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml index 9318ab39152..63836eb29cc 100644 --- a/src/solver/opamCudf.ml +++ b/src/solver/opamCudf.ml @@ -747,9 +747,7 @@ end type explanation = [ `Conflict of string option * string list * bool - | `Missing of string option * string * - (OpamPackage.Name.t * OpamFormula.version_formula) - OpamFormula.formula + | `Missing of string option * string * OpamFormula.t ] module Pp_explanation = struct @@ -1024,6 +1022,7 @@ let extract_explanations packages cudfnv2opam reasons : explanation list = not (List.exists (function `Conflict (_,_,has_invariant) -> has_invariant | _ -> false) explanations) in let msg = `Conflict (msg1, msg2, msg3) in + (* TODO: remove this List.mem *) if List.mem msg explanations then raise Not_found else msg :: explanations, ct_chains | Missing (p, deps) -> @@ -1043,8 +1042,7 @@ let extract_explanations packages cudfnv2opam reasons : explanation list = let sdeps = OpamFormula.to_string fdeps in `Missing (Some csp, sdeps, fdeps) in - if List.mem msg explanations then raise Not_found else - msg :: explanations, ct_chains + msg :: explanations, ct_chains | Dependency _ -> explanations, ct_chains with Not_found -> @@ -1052,6 +1050,60 @@ let extract_explanations packages cudfnv2opam reasons : explanation list = ([], ct_chains) reasons in + let rec is_included_in_formula formula1 formula2 = + match formula1, formula2 with + | Empty, Empty -> true + | Atom (name1, vformula1), Atom (name2, vformula2) -> + OpamPackage.Name.equal name1 name2 && + let formula_eq x y = OpamFormula.compare_nc (name1, x) (name2, y) = 0 in + begin match OpamFormula.simplify_version_formula (Or (vformula1, vformula2)) with + | Some simplified -> formula_eq simplified vformula2 + | None -> false + end + | Block x, y | x, Block y -> is_included_in_formula x y + | And (x1, x2), And (y1, y2) | Or (x1, x2), Or (y1, y2) -> + is_included_in_formula x1 y1 && + is_included_in_formula x2 y2 + | Empty, _ + | Atom _, _ + | And _, _ + | Or _, _ -> false + in + + let explanations = + let rec simplify acc = function + | [] -> acc + | (`Conflict (s, l, b) as x)::xs -> + simplify + (x :: acc) + (List.filter (function + | `Conflict (s', l', b') -> + not (OpamStd.Option.equal String.equal s s' && + OpamStd.List.equal String.equal l l' && + Bool.equal b b') + | `Missing _ -> true) + xs) + | `Missing x::xs -> + let x, xs = + List.fold_left (fun ((csp, _, fdeps) as x, xs) -> function + | `Conflict _ as y -> (x, xs @ [y]) + | `Missing ((csp', _, fdeps') as y) -> + if OpamStd.Option.equal String.equal csp csp' then + if is_included_in_formula fdeps fdeps' then + (y, xs) + else if is_included_in_formula fdeps' fdeps then + (x, xs) + else + (x, xs @ [`Missing y]) + else + (x, xs @ [`Missing y])) + (x, []) xs + in + simplify (`Missing x :: acc) xs + in + List.rev (simplify [] explanations) + in + let same_depexts sdeps fdeps = List.for_all (function | `Missing (_, sdeps', fdeps') -> sdeps = sdeps' && fdeps = fdeps' diff --git a/src/solver/opamCudf.mli b/src/solver/opamCudf.mli index 278be48c1c3..8547026aae1 100644 --- a/src/solver/opamCudf.mli +++ b/src/solver/opamCudf.mli @@ -218,9 +218,7 @@ val cycle_conflict: type explanation = [ `Conflict of string option * string list * bool - | `Missing of string option * string * - (OpamPackage.Name.t * OpamFormula.version_formula) - OpamFormula.formula + | `Missing of string option * string * OpamFormula.t ] (** Convert a conflict to something readable by the user. The second argument diff --git a/tests/reftests/unhelpful-conflicts-002.test b/tests/reftests/unhelpful-conflicts-002.test index 2da7ef74963..9c3a717ff34 100644 --- a/tests/reftests/unhelpful-conflicts-002.test +++ b/tests/reftests/unhelpful-conflicts-002.test @@ -28,40 +28,7 @@ ocaml-config is now pinned locally (version 1) ### opam install --show expect.0.0.6 [ERROR] Package conflict! * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.00.0 - not available because the package is pinned to version 4.12.0 - * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.01.0 - not available because the package is pinned to version 4.12.0 - * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.02.0 - not available because the package is pinned to version 4.12.0 - * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.03.0 - not available because the package is pinned to version 4.12.0 - * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.04.0 - not available because the package is pinned to version 4.12.0 - * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.05.0 - not available because the package is pinned to version 4.12.0 - * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.06.0 - not available because the package is pinned to version 4.12.0 - * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.07.0 - not available because the package is pinned to version 4.12.0 - * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.08.0 - not available because the package is pinned to version 4.12.0 - * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.10.0 - not available because the package is pinned to version 4.12.0 - * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.11.0 - not available because the package is pinned to version 4.12.0 - * Missing dependency: - - expect >= 0.0.6 -> batteries -> ocaml < 4.12.0 + - ocaml < 4.12.0 not available because the package is pinned to version 4.12.0 No solution found, exiting