Fix most unhelpful conflict explanation message by merging all formulas together

master_changes.md

@@ -141,6 +141,7 @@ users)
   * Add support for the `-count[avoid-version,solution]` criteria with the `builtin-0install` solver, to avoid packages marked with `avoid-version` flag [#6130 @kit-ty-kate]
   * The default criteria for the `builtin-0install` solver changed from empty to `-changed,-count[avoid-version,solution]` [#6130 @kit-ty-kate]
   * The upgrade and fixup criteria for the `builtin-0install` solver changed from empty to `-count[avoid-version,solution]` [#6130 @kit-ty-kate]
+  * Fix some of the unhelpful conflict messages by merging formulas that include each other [#5210 @kit-ty-kate]
 
 ## Client
 
@@ -199,6 +200,7 @@ users)
   * lint: add E73 test [#5561 @rjbou]
   * lint: add more test cases for E59: special cases (conf, git url), with and without option `--with-check-upstream` [#5561 @rjbou]
   * lint: add more test cases for W59: special cases (conf, git url), with and without `--with-check-upstream` [#5561 @rjbou]
+  * Add a test showing an unhelpful conflict message [#5210 @kit-ty-kate]
 
 ### Engine
   * Add a test filtering mechanism [#6105 @Keryan-dev]

src/solver/opamCudf.ml

@@ -732,24 +732,12 @@ module ChainSet = struct
     if Set.is_empty hds then []
     else hds :: transpose tls
 
-  (** cs1 precludes cs2 if it contains a list that is prefix to all elements of
-      cs2 *)
-  let precludes cs1 cs2 =
-    let rec list_is_prefix pfx l = match pfx, l with
-      | [], _ -> true
-      | a::r1, b::r2 when Package.equal a b -> list_is_prefix r1 r2
-      | _ -> false
-    in
-    exists (fun pfx -> for_all (fun l -> list_is_prefix pfx l) cs2) cs1
-
   let length cs = fold (fun l acc -> min (List.length l) acc) cs max_int
 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
@@ -848,10 +836,17 @@ let extract_explanations packages cudfnv2opam reasons : explanation list =
       OpamPackage.Set.empty
       reasons
   in
-  let print_set pkgs =
+  let open (struct
+    type bold = bool
+    type construct =
+      | Invariant
+      | Request
+      | Formula of bold * OpamFormula.t
+  end) in
+  let construct_of_set pkgs =
     if Set.exists is_artefact pkgs then
-      if Set.exists is_opam_invariant pkgs then "(invariant)"
-      else "(request)"
+      if Set.exists is_opam_invariant pkgs then Invariant
+      else Request
     else
     let nvs =
       OpamPackage.to_map @@
@@ -864,10 +859,10 @@ let extract_explanations packages cudfnv2opam reasons : explanation list =
           let formula =
             OpamFormula.formula_of_version_set all_versions versions
           in
-          OpamFormula.to_string (Atom (name, formula)))
+          Atom (name, formula))
         nvs
     in
-    String.concat ", " (OpamPackage.Name.Map.values strs)
+    Formula (false, OpamFormula.ors (OpamPackage.Name.Map.values strs))
   in
   let cs_to_string ?(hl_last=true) cs =
     let rec aux vpkgl = function
@@ -882,12 +877,11 @@ let extract_explanations packages cudfnv2opam reasons : explanation list =
         in
         if Set.exists is_artefact pkgs then
           if Set.exists is_opam_invariant pkgs then
-            Printf.sprintf "(invariant)"
-            :: aux vpkgl1 r
-          else if r = [] then ["(request)"]
+            Invariant :: aux vpkgl1 r
+          else if r = [] then [Request]
           else aux vpkgl1 r (* request *)
         else if vpkgl = [] then
-          print_set pkgs :: aux vpkgl1 r
+          construct_of_set pkgs :: aux vpkgl1 r
         else
         let f =
           let vpkgl =
@@ -899,11 +893,9 @@ let extract_explanations packages cudfnv2opam reasons : explanation list =
           (* Dose is precise enough from what i'm seeing *)
           formula_of_vpkgl cudfnv2opam packages vpkgl
         in
-        let s = OpamFormula.to_string f in
-        (if hl_last && r = [] then OpamConsole.colorise' [`red;`bold]  s else s)
-        :: aux vpkgl1 r
+        Formula (hl_last && r = [], f) :: aux vpkgl1 r
     in
-    arrow_concat (aux [] (CS.transpose (CS.map List.rev cs)))
+    aux [] (CS.transpose (CS.map List.rev cs))
   in
   let get t x = try Hashtbl.find t x with Not_found -> Set.empty in
   let add_set t l set =
@@ -1000,34 +992,40 @@ let extract_explanations packages cudfnv2opam reasons : explanation list =
     with Not_found -> false
   in
 
-  let explanations, _remaining_ct_chains =
-    List.fold_left (fun (explanations, ct_chains) re ->
+  let construct_to_string cst =
+    let aux = function
+      | Invariant -> "(invariant)"
+      | Request -> "(request)"
+      | Formula (bold, f) ->
+        let s = OpamFormula.to_string f in
+        if bold then OpamConsole.colorise' [`red;`bold] s else s
+    in
+    arrow_concat (List.map aux cst)
+  in
+
+  let explanations =
+    List.fold_left (fun explanations re ->
         let cst ?hl_last ct_chains p =
           let chains = Map.find p ct_chains in
-          Map.filter (fun _ c -> not (CS.precludes chains c)) ct_chains,
           cs_to_string ?hl_last chains
         in
         try
           match re with
           | Conflict (l, r, _) ->
-            let ct_chains, csl = cst ct_chains l in
-            let ct_chains, csr = cst ct_chains r in
+            let csl = cst ct_chains l in
+            let csr = cst ct_chains r in
             let msg1 =
               if l.Cudf.package = r.Cudf.package then
                 Some (Package.name_to_string l)
               else
                 None
             in
             let msg2 = List.sort_uniq compare [csl; csr] in
-            let msg3 =
-              (has_invariant l || has_invariant r) &&
-                 not (List.exists (function `Conflict (_,_,has_invariant) -> has_invariant | _ -> false) explanations)
-            in
+            let msg3 = has_invariant l || has_invariant r in
             let msg = `Conflict (msg1, msg2, msg3) in
-            if List.mem msg explanations then raise Not_found else
-              msg :: explanations, ct_chains
+            msg :: explanations
           | Missing (p, deps) ->
-            let ct_chains, csp = cst ~hl_last:false ct_chains p in
+            let csp = cst ~hl_last:false ct_chains p in
             let msg =
               if List.exists
                   (fun (name, _) -> name = unavailable_package_name)
@@ -1037,35 +1035,134 @@ let extract_explanations packages cudfnv2opam reasons : explanation list =
                   Printf.sprintf "%s: no longer available"
                     (OpamPackage.to_string (cudf2opam p))
                 in
-                `Missing (Some csp, msg, OpamFormula.Empty)
+                let csp = construct_to_string csp in
+                `NoLongerAvailable (csp, msg, OpamFormula.Empty)
               else
               let fdeps = formula_of_vpkgl cudfnv2opam packages deps in
-              let sdeps = OpamFormula.to_string fdeps in
-              `Missing (Some csp, sdeps, fdeps)
+              `Missing (csp, fdeps)
             in
-            if List.mem msg explanations then raise Not_found else
-              msg :: explanations, ct_chains
+            msg :: explanations
           | Dependency _ ->
-            explanations, ct_chains
+            explanations
         with Not_found ->
-          explanations, ct_chains)
-      ([], ct_chains) reasons
+          explanations)
+      [] reasons
+  in
+
+  let rec simplify_formula formula1 formula2 =
+    let open OpamStd.Option.Op in
+    match formula1, formula2 with
+    | Empty, Empty -> Some Empty
+    | Atom (name1, vformula1), Atom (name2, vformula2) ->
+      if OpamPackage.Name.equal name1 name2 then
+        OpamFormula.simplify_version_formula (Or (vformula1, vformula2))
+        >>= fun vformula -> Some (Atom (name1, vformula))
+      else
+        None
+    | Block x, y | x, Block y -> simplify_formula x y
+    | And (x1, x2), And (y1, y2) ->
+        simplify_formula x1 y1 >>= fun z1 ->
+        simplify_formula x2 y2 >>= fun z2 ->
+        Some (And (z1, z2))
+    | Or (x1, x2), Or (y1, y2) ->
+        simplify_formula x1 y1 >>= fun z1 ->
+        simplify_formula x2 y2 >>= fun z2 ->
+        Some (Or (z1, z2))
+    | Empty, _
+    | Atom _, _
+    | And _, _
+    | Or _, _ -> None
+  in
+
+  (* Merge similar explanation together by removing duplicates
+     and merging every formula into one containing all of them *)
+  let explanations =
+    let simplify_cst f f' =
+      match f, f' with
+      | Invariant, Invariant
+      | Request, Request -> f
+      | Formula (bold, f), Formula (bold', f') ->
+        if Bool.equal bold bold' then
+          match simplify_formula f f' with
+          | Some simplified -> Formula (bold, simplified)
+          | None -> raise Not_found
+        else
+          raise Not_found
+      | Invariant, _ | Request, _ | Formula _, _ ->
+        raise Not_found
+    in
+    let rec simplify acc = function
+      | [] -> acc
+      | `Conflict x::xs ->
+        let x, xs =
+          List.fold_left (fun ((s, l, b) as x, xs) -> function
+              | `Conflict ((s', l', b') as y) ->
+                if OpamStd.Option.equal String.equal s s' &&
+                   Bool.equal b b' then
+                  match List.map2 (List.map2 simplify_cst) l l' with
+                  | new_l -> ((s, new_l, b), xs)
+                  | exception (Invalid_argument _ | Not_found) ->
+                    (x, `Conflict y :: xs)
+                else
+                  (x, `Conflict y :: xs)
+              | (`Missing _ | `NoLongerAvailable _) as y -> (x, y :: xs))
+            (x, []) xs
+        in
+        simplify (`Conflict x :: acc) (List.rev xs)
+      | `Missing x::xs ->
+        let x, xs =
+          List.fold_left (fun ((csp, fdeps) as x, xs) -> function
+              | (`Conflict _ | `NoLongerAvailable _) as y -> (x, y :: xs)
+              | `Missing ((csp', fdeps') as y) ->
+                (match List.map2 simplify_cst csp csp' with
+                 | simplified_csp ->
+                   (match simplify_formula fdeps fdeps' with
+                    | Some simplified_formula ->
+                      ((simplified_csp, simplified_formula), xs)
+                    | None -> (x, `Missing y :: xs))
+                 | exception (Invalid_argument _ | Not_found) ->
+                   (x, `Missing y :: xs)))
+            (x, []) xs
+        in
+        simplify (`Missing x :: acc) (List.rev xs)
+      | `NoLongerAvailable _ as x::xs ->
+        simplify (x :: acc) xs
+    in
+    simplify [] explanations
   in
 
-  let same_depexts sdeps fdeps =
-    List.for_all (function
-        | `Missing (_, sdeps', fdeps') -> sdeps = sdeps' && fdeps = fdeps'
-        | _ -> false)
+  (* Make sure had_invariant only appears once *)
+  let explanations =
+    let rec reduce_invariant_msg acc had_invariant = function
+      | [] -> acc
+      | `Conflict (s, l, b)::xs ->
+        let l = List.map construct_to_string l in
+        reduce_invariant_msg
+          (`Conflict (s, l, b && not had_invariant) :: acc)
+          (had_invariant || b)
+          xs
+      | `Missing (csp, fdeps)::xs ->
+        let csp = construct_to_string csp in
+        reduce_invariant_msg
+          (`Missing (Some csp, OpamFormula.to_string fdeps, fdeps) :: acc)
+          had_invariant
+          xs
+      | `NoLongerAvailable (csp, sdeps, fdeps)::xs ->
+        reduce_invariant_msg
+          (`Missing (Some csp, sdeps, fdeps) :: acc)
+          had_invariant
+          xs
+    in
+    reduce_invariant_msg [] false explanations
   in
+
   log ~level:3 "Explanations: %a" Pp_explanation.pp_explanationlist explanations;
   match explanations with
   | [] ->
     OpamConsole.error_and_exit `Internal_error
       "Internal error while computing conflict explanations:\n\
        sorry about that. Please report how you got here in \
        https://github.com/ocaml/opam/discussions/5130 if possible."
-  | `Missing (_, sdeps, fdeps) :: rest when same_depexts sdeps fdeps rest ->
-    [`Missing (None, sdeps, fdeps)]
   | _ -> explanations
 
 let strings_of_cycles cycles =

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

tests/reftests/conflict-badversion.test

@@ -20,11 +20,20 @@ Done.
     - core != 112.17.00
   * No agreement on the version of ocaml:
     - (invariant) -> ocaml-base-compiler = 4.02.3 -> ocaml = 4.02.3
-    - core != 112.17.00 -> ocaml < 4.00.1
+    - core != 112.17.00 -> ocaml (< 4.00.1 | >= 4.03.0)
     You can temporarily relax the switch invariant with `--update-invariant'
   * No agreement on the version of ocaml-base-compiler:
     - (invariant) -> ocaml-base-compiler = 4.02.3
-    - core != 112.17.00 -> ocaml < 4.00.1 -> ocaml-base-compiler < 3.07+1
+    - core != 112.17.00 -> ocaml (< 4.01.0 | >= 4.03.0) -> ocaml-base-compiler (< 3.07+1 | = 3.07+2 | = 3.08.0 | = 3.08.1 | = 3.08.2 | = 3.08.3 | = 3.08.4 | = 3.09.0 | = 3.09.1 | = 3.09.3 | = 3.10.0 | = 3.10.1 | = 3.10.2 | = 3.11.0 | = 3.11.2 | = 3.12.1 | = 4.00.0 | = 4.00.1 | = 4.03.0 | = 4.04.0 | = 4.04.1 | = 4.04.2 | = 4.05.0 | = 4.06.0 | = 4.06.1 | = 4.07.1 | >= 4.08.0)
+  * No agreement on the version of ocaml-base-compiler:
+    - (invariant) -> ocaml-base-compiler = 4.02.3
+    - core != 112.17.00 -> core_kernel = 109.35.01 -> ocaml < 4.02.1 -> ocaml-base-compiler (= 4.01.0 | = 4.02.0)
+  * Incompatible packages:
+    - (invariant) -> ocaml-base-compiler = 4.02.3
+    - core != 112.17.00 -> ocaml < 4.00.1 -> ocaml-system >= 3.09.1
+  * Incompatible packages:
+    - (invariant) -> ocaml-base-compiler = 4.02.3
+    - core != 112.17.00 -> ocaml < 4.00.1 -> ocaml-variants
   * Missing dependency:
     - core != 112.17.00 -> ocaml < 4.00.1 -> ocaml-variants -> ocaml-beta
     unmet availability conditions: 'enable-ocaml-beta-repository'

tests/reftests/conflict-camlp4.test

@@ -8,6 +8,15 @@ Switch invariant: ["camlp4" "ocaml-system"]
     - (invariant) -> camlp4
     - (invariant) -> ocaml-system
     You can temporarily relax the switch invariant with `--update-invariant'
+  * Incompatible packages:
+    - (invariant) -> camlp4 -> ocaml-variants (= 4.02.0+modular-implicits | = 4.02.1+modular-implicits-ber)
+    - (invariant) -> ocaml-system
+  * Incompatible packages:
+    - (invariant) -> camlp4 -> ocaml < 4.08 -> ocaml-base-compiler (<= 3.07+1 | = 3.07+2 | = 3.08.0 | = 3.08.1 | = 3.08.2 | = 3.08.3 | = 3.08.4 | = 3.09.0 | = 3.09.1 | = 3.09.2 | = 3.09.3 | = 3.10.0 | = 3.10.1 | = 3.10.2 | = 3.11.0 | = 3.11.1 | = 3.11.2 | = 3.12.0 | = 3.12.1 | = 4.00.0 | = 4.00.1 | = 4.01.0 | = 4.02.0 | = 4.02.1 | = 4.02.2 | = 4.02.3 | = 4.03.0 | = 4.04.0 | = 4.04.1 | = 4.04.2 | = 4.05.0 | = 4.06.0 | = 4.06.1 | = 4.07.0 | = 4.07.1)
+    - (invariant) -> ocaml-system
+  * Incompatible packages:
+    - (invariant) -> camlp4 -> ocaml < 4.08 -> ocaml-variants < 4.07.2~
+    - (invariant) -> ocaml-system
 
 
 # Return code 20 #

tests/reftests/conflict-core.test

@@ -17,11 +17,17 @@ Done.
 [ERROR] Package conflict!
   * No agreement on the version of ocaml:
     - (invariant) -> ocaml-base-compiler >= 4.08.0 -> ocaml = 4.08.0
-    - core < 112.17.00 -> ocaml < 4.00.1
+    - core < 112.17.00 -> ocaml < 4.03
     You can temporarily relax the switch invariant with `--update-invariant'
   * No agreement on the version of ocaml-base-compiler:
     - (invariant) -> ocaml-base-compiler >= 4.08.0
-    - core < 112.17.00 -> ocaml < 4.00.1 -> ocaml-base-compiler = 3.07+2
+    - core < 112.17.00 -> ocaml < 4.00.1 -> ocaml-base-compiler (< 3.07+1 | = 3.07+2 | = 3.09.3 | = 3.11.0)
+  * Incompatible packages:
+    - (invariant) -> ocaml-base-compiler >= 4.08.0
+    - core < 112.17.00 -> ocaml < 4.00.1 -> ocaml-system >= 3.09.3
+  * Incompatible packages:
+    - (invariant) -> ocaml-base-compiler >= 4.08.0
+    - core < 112.17.00 -> ocaml < 4.00.1 -> ocaml-variants >= 3.09.3
   * Missing dependency:
     - core < 112.17.00 -> ocaml < 4.00.1 -> ocaml-variants >= 3.09.3 -> ocaml-beta
     unmet availability conditions: 'enable-ocaml-beta-repository'