diff --git a/cabal-install-solver/src/Distribution/Solver/Modular.hs b/cabal-install-solver/src/Distribution/Solver/Modular.hs index a4baebf496c..850b06ea007 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular.hs @@ -200,7 +200,7 @@ solve' sc cinfo idx pkgConfigDB pprefs gcs pns = -- original goal order. goalOrder' = preferGoalsFromConflictSet cs <> fromMaybe mempty (goalOrder sc) - in unlines ("Could not resolve dependencies:" : map renderSummarizedMessage (messages (toProgress (runSolver True sc')))) + in unlines ("Could not resolve dependencies:" : map (renderSummarizedMessage (solverVerbosity sc)) (messages (toProgress (runSolver True sc')))) printFullLog = solverVerbosity sc >= verbose diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs index d6ffadf0abf..e1325dcfa04 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs @@ -54,6 +54,7 @@ import Distribution.Types.LibraryName ( LibraryName(LSubLibName, LMainLibName) ) import Distribution.Types.UnqualComponentName ( unUnqualComponentName ) +import Distribution.Verbosity (Verbosity, verbose) import Text.PrettyPrint ( nest, render ) @@ -69,32 +70,32 @@ data Message = | Success | Failure ConflictSet FailReason -renderSummarizedMessage :: SummarizedMessage -> String -renderSummarizedMessage (SummarizedMsg i) = displayMessageAtLevel i -renderSummarizedMessage (StringMsg s) = s +renderSummarizedMessage :: Verbosity -> SummarizedMessage -> String +renderSummarizedMessage verb (SummarizedMsg i) = displayMessageAtLevel verb i +renderSummarizedMessage _ (StringMsg s) = s -displayMessageAtLevel :: EntryAtLevel -> String -displayMessageAtLevel (AtLevel l msg) = +displayMessageAtLevel :: Verbosity -> EntryAtLevel -> String +displayMessageAtLevel verb (AtLevel l msg) = let s = show l - in "[" ++ replicate (3 - length s) '_' ++ s ++ "] " ++ displayMessage msg - -displayMessage :: Entry -> String -displayMessage (EntryPackageGoal qpn gr) = "next goal: " ++ showQPN qpn ++ showGR gr -displayMessage (EntryRejectF qfn b c fr) = "rejecting: " ++ showQFNBool qfn b ++ showFR c fr -displayMessage (EntryRejectS qsn b c fr) = "rejecting: " ++ showQSNBool qsn b ++ showFR c fr -displayMessage (EntrySkipping cs) = "skipping: " ++ showConflicts cs -displayMessage (EntryTryingF qfn b) = "trying: " ++ showQFNBool qfn b -displayMessage (EntryTryingP qpn i) = "trying: " ++ showOption qpn i -displayMessage (EntryTryingNewP qpn i gr) = "trying: " ++ showOption qpn i ++ showGR gr -displayMessage (EntryTryingS qsn b) = "trying: " ++ showQSNBool qsn b -displayMessage (EntryUnknownPackage qpn gr) = "unknown package: " ++ showQPN qpn ++ showGR gr -displayMessage EntrySuccess = "done" -displayMessage (EntryFailure c fr) = "fail" ++ showFR c fr -displayMessage (EntrySkipMany qsn b cs) = "skipping: " ++ showOptions qsn b ++ " " ++ showConflicts cs + in "[" ++ replicate (3 - length s) '_' ++ s ++ "] " ++ displayMessage verb msg + +displayMessage :: Verbosity -> Entry -> String +displayMessage _ (EntryPackageGoal qpn gr) = "next goal: " ++ showQPN qpn ++ showGR gr +displayMessage _ (EntryRejectF qfn b c fr) = "rejecting: " ++ showQFNBool qfn b ++ showFR c fr +displayMessage _ (EntryRejectS qsn b c fr) = "rejecting: " ++ showQSNBool qsn b ++ showFR c fr +displayMessage _ (EntrySkipping cs) = "skipping: " ++ showConflicts cs +displayMessage _ (EntryTryingF qfn b) = "trying: " ++ showQFNBool qfn b +displayMessage _ (EntryTryingP qpn i) = "trying: " ++ showOption qpn i +displayMessage _ (EntryTryingNewP qpn i gr) = "trying: " ++ showOption qpn i ++ showGR gr +displayMessage _ (EntryTryingS qsn b) = "trying: " ++ showQSNBool qsn b +displayMessage _ (EntryUnknownPackage qpn gr) = "unknown package: " ++ showQPN qpn ++ showGR gr +displayMessage _ EntrySuccess = "done" +displayMessage _ (EntryFailure c fr) = "fail" ++ showFR c fr +displayMessage verb (EntrySkipMany qsn b cs) = "skipping: " ++ showOptions verb qsn b ++ " " ++ showConflicts cs -- Instead of displaying `aeson-1.0.2.1, aeson-1.0.2.0, aeson-1.0.1.0, ...`, -- the following line aims to display `aeson: 1.0.2.1, 1.0.2.0, 1.0.1.0, ...`. -- -displayMessage (EntryRejectMany qpn is c fr) = "rejecting: " ++ showOptions qpn is ++ showFR c fr +displayMessage verb (EntryRejectMany qpn is c fr) = "rejecting: " ++ showOptions verb qpn is ++ showFR c fr -- | Transforms the structured message type to actual messages (SummarizedMessage s). -- @@ -282,16 +283,16 @@ showOption qpn@(Q _pp pn) (POption i linkedTo) = -- >>> showOptions foobarQPN [k1, k2] -- "foo-bar; foo-bar~>bazqux.foo-bar-1, foo-bar~>bazqux.foo-bar-2" -- >>> showOptions foobarQPN [v0, i1, k2] --- "foo-bar; 0, 1/installed-inplace, foo-bar~>bazqux.foo-bar-2" -showOptions :: QPN -> [POption] -> String -showOptions _ [] = "unexpected empty list of versions" -showOptions q [x] = showOption q x -showOptions q xs = showQPN q ++ "; " ++ (L.intercalate ", " +-- "foo-bar; 0, 1/installed-inplace, foo-bar~>bazqux.foo-bar-2 and earlier versions" +showOptions :: Verbosity -> QPN -> [POption] -> String +showOptions _ _ [] = "unexpected empty list of versions" +showOptions _ q [x] = showOption q x +showOptions verb q xs = showQPN q ++ "; " ++ (L.intercalate ", " [if isJust linkedTo then showOption q x else showI i -- Don't show the package, just the version - | x@(POption i linkedTo) <- xs - ]) + | x@(POption i linkedTo) <- if verb >= verbose then xs else take 1 xs + ] ++ if verb < verbose && length xs > 1 then " and " ++ show (length xs - 1) ++" other versions" else "") showGR :: QGoalReason -> String showGR UserGoal = " (user goal)" diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs index 594afb9e24f..465364a0b00 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -854,7 +854,7 @@ resolveDependencies platform comp pkgConfigDB params = else dontInstallNonReinstallablePackages params formatProgress :: Progress SummarizedMessage String a -> Progress String String a - formatProgress p = foldProgress (\x xs -> Step (renderSummarizedMessage x) xs) Fail Done p + formatProgress p = foldProgress (\x xs -> Step (renderSummarizedMessage (depResolverVerbosity params) x) xs) Fail Done p preferences :: PackageName -> PackagePreferences preferences = interpretPackagesPreference targets defpref prefs diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index a1f5eed3c62..742b6dc9517 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -951,8 +951,9 @@ tests = ] rejecting = "rejecting: A-3.0.0" skipping = "skipping: A; 2.0.0, 1.0.0" - in mkTest db "show skipping versions list" ["B"] $ - solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg) + in setVerbose $ + mkTest db "show skipping versions list" ["B"] $ + solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg) , runTest $ let db = [ Left $ exInst "A" 1 "A-1.0.0" [] @@ -962,7 +963,19 @@ tests = ] rejecting = "rejecting: A-3.0.0/installed-3.0.0" skipping = "skipping: A; 2.0.0/installed-2.0.0, 1.0.0/installed-1.0.0" - in mkTest db "show skipping versions list, installed" ["B"] $ + in setVerbose $ + mkTest db "show skipping versions list, installed" ["B"] $ + solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg) + , runTest $ + let db = + [ Right $ exAv "A" 1 [] + , Right $ exAv "A" 2 [] + , Right $ exAv "A" 3 [] + , Right $ exAv "B" 1 [ExFix "A" 4] + ] + rejecting = "rejecting: A-3.0.0 (conflict: B => A==4.0.0)" + skipping = "skipping: A; 2.0.0 and 1 other versions (has" + in mkTest db "show summarized skipping versions list" ["B"] $ solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg) ] ] diff --git a/changelog.d/pr-11062 b/changelog.d/pr-11062 new file mode 100644 index 00000000000..5798a87a69d --- /dev/null +++ b/changelog.d/pr-11062 @@ -0,0 +1,8 @@ +synopsis: Solver: shorten the skipping message if needed +packages: cabal-install-solver +prs: #11062 + +When the solver fails to find a solution, it can print out a long list +of package versions which failed to meet the requirements. This PR +shortens the message price the one version that failed and the number +of other versions which failed to meet the requriements.