Merge pull request #4678 from dra27/depext-chains

Improve depext unavailable messages from the solver

master_changes.md

@@ -36,6 +36,8 @@ New option/command/subcommand are prefixed with ◈.
   * Keep global lock only if root format upgrade is performed [#4612 @rjbou - fix #4597]
   * Improve installation times by only tracking files listed in `.install` instead of the whole switch prefix when there are no `install:` instructions (and no preinstall commands) [#4494 @kit-ty-kate @rjbou - fix #4422]
   * Scrub OPAM* environment variables added since 2.0 from package builds to prevent warnings when a package calls opam [#4663 @dra27 - fix #4660]
+  * Correct the message when more than one depext is missing [#4678 @dra27]
+  * Only display one conflict message when they are all owing to identical missing depexts [#4678 @dra27]
 
 ## Remove
   *

src/client/opamSolution.ml

@@ -137,13 +137,22 @@ let check_availability ?permissive t set atoms =
     match OpamSwitchState.depexts_unavailable
             t (OpamPackage.Set.max_elt pkgs) with
     | Some missing ->
+      let missing =
+        List.rev_map OpamSysPkg.to_string (OpamSysPkg.Set.elements missing)
+      in
+      let msg =
+        match missing with
+        | [pkg] ->
+          " '" ^ pkg ^ "'"
+        | pkgs ->
+          "s " ^ (OpamStd.Format.pretty_list (List.rev_map (Printf.sprintf "'%s'") pkgs))
+      in
       Some
         (Printf.sprintf
-           "Package %s depends on the unavailable system package '%s'. You \
+           "Package %s depends on the unavailable system package%s. You \
             can use `--no-depexts' to attempt installation anyway."
            (OpamFormula.short_string_of_atom atom)
-           (OpamStd.List.concat_map " " OpamSysPkg.to_string
-              (OpamSysPkg.Set.elements missing)))
+           msg)
     | None -> None
   in
   let check_atom (name, cstr as atom) =

src/solver/opamCudf.ml

@@ -913,36 +913,23 @@ let extract_explanations packages cudfnv2opam unav_reasons reasons =
             let ct_chains, csr = cst ct_chains r in
             let msg1 =
               if l.Cudf.package = r.Cudf.package then
-                Printf.sprintf "No agreement on the version of %s:"
-                  (OpamConsole.colorise `bold (Package.name_to_string l))
+                Some (Package.name_to_string l)
               else
-                "Incompatible packages:"
+                None
             in
             let msg2 = List.sort_uniq compare [csl; csr] in
             let msg3 =
-              let msg =
-                "You can temporarily relax the switch invariant with \
-                 `--update-invariant'"
-              in
-              if (has_invariant l || has_invariant r) &&
-                 not (List.exists (fun (_,_,m) -> List.mem msg m) explanations)
-              then [msg] else []
+              (has_invariant l || has_invariant r) &&
+                 not (List.exists (function `Conflict (_,_,has_invariant) -> has_invariant | _ -> false) explanations)
             in
-            let msg = msg1, msg2, msg3 in
+            let msg = `Conflict (msg1, msg2, msg3) in
             if List.mem msg explanations then raise Not_found else
               msg :: explanations, ct_chains
           | Missing (p, deps) ->
             let ct_chains, csp = cst ~hl_last:false ct_chains p in
             let fdeps = formula_of_vpkgl cudfnv2opam packages deps in
             let sdeps = OpamFormula.to_string fdeps in
-            let msg1 = "Missing dependency:" in
-            let msg2 =
-              [arrow_concat [csp; OpamConsole.colorise' [`red;`bold] sdeps]]
-            in
-            let msg3 =
-              OpamFormula.fold_right (fun a x -> unav_reasons x::a) [] fdeps
-            in
-            let msg = msg1, msg2, msg3 in
+            let msg = `Missing (Some csp, sdeps, fdeps) in
             if List.mem msg explanations then raise Not_found else
               msg :: explanations, ct_chains
           | Dependency _ ->
@@ -951,7 +938,45 @@ let extract_explanations packages cudfnv2opam unav_reasons reasons =
           explanations, ct_chains)
       ([], ct_chains) reasons
   in
-  List.rev explanations
+
+  let explanations =
+    let same_depexts sdeps fdeps =
+      List.for_all (function
+          | `Missing (_, sdeps', fdeps') -> sdeps = sdeps' && fdeps = fdeps'
+          | _ -> false)
+    in
+    match explanations with
+    | `Missing (_, sdeps, fdeps) :: rest when same_depexts sdeps fdeps rest ->
+      [`Missing (None, sdeps, fdeps)]
+    | _ -> explanations
+  in
+
+  let format_explanation = function
+  | `Conflict (kind, packages, has_invariant) ->
+      let msg1 =
+        let format_package_name p =
+          Printf.sprintf "No agreement on the version of %s:" (OpamConsole.colorise `bold p)
+        in
+        OpamStd.Option.map_default format_package_name "Incompatible packages:" kind
+      and msg3 =
+        if has_invariant then
+          ["You can temporarily relax the switch invariant with \
+            `--update-invariant'"]
+        else
+          []
+      in
+        (msg1, packages, msg3)
+  | `Missing (csp, sdeps, fdeps) ->
+      let sdeps = OpamConsole.colorise' [`red;`bold] sdeps in
+      let msg1 = "Missing dependency:"
+      and msg2 =
+        OpamStd.Option.map_default (fun csp -> arrow_concat [csp; sdeps]) sdeps csp
+      and msg3 = OpamFormula.fold_right (fun a x -> unav_reasons x::a) [] fdeps
+      in
+        (msg1, [msg2], msg3)
+  in
+
+  List.rev_map format_explanation explanations
 
 let strings_of_cycles cycles =
   List.map arrow_concat cycles

src/state/opamSwitchState.ml

@@ -1076,11 +1076,19 @@ let unavailable_reason st ?(default="") (name, vformula) =
     else
     match depexts_unavailable st (OpamPackage.Set.max_elt candidates) with
     | Some missing ->
+      let missing =
+        List.rev_map OpamSysPkg.to_string (OpamSysPkg.Set.elements missing)
+      in
+      let msg =
+        match missing with
+        | [pkg] ->
+          " '" ^ pkg ^ "'"
+        | pkgs ->
+          "s " ^ (OpamStd.Format.pretty_list (List.rev_map (Printf.sprintf "'%s'") pkgs))
+      in
       Printf.sprintf
-        "depends on the unavailable system package '%s'. Use \
-         `--assume-depexts' to attempt installation anyway."
-        (OpamStd.List.concat_map " " OpamSysPkg.to_string
-           (OpamSysPkg.Set.elements missing))
+        "depends on the unavailable system package%s. Use \
+         `--assume-depexts' to attempt installation anyway." msg
     | None -> default
 
 let update_package_metadata nv opam st =