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 9cc4234e66e..5a91e51ffce 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). -- @@ -267,31 +268,31 @@ showOption qpn@(Q _pp pn) (POption i linkedTo) = -- | Shows a mixed list of instances and versions in a human-friendly way, -- abbreviated. --- >>> showOptions foobarQPN [v0, v1] +-- >>> showOptions verbose foobarQPN [v0, v1] -- "foo-bar; 0, 1" --- >>> showOptions foobarQPN [v0] +-- >>> showOptions verbose foobarQPN [v0] -- "foo-bar-0" --- >>> showOptions foobarQPN [i0, i1] +-- >>> showOptions verbose foobarQPN [i0, i1] -- "foo-bar; 0/installed-inplace, 1/installed-inplace" --- >>> showOptions foobarQPN [i0, v1] +-- >>> showOptions verbose foobarQPN [i0, v1] -- "foo-bar; 0/installed-inplace, 1" --- >>> showOptions foobarQPN [v0, i1] +-- >>> showOptions verbose foobarQPN [v0, i1] -- "foo-bar; 0, 1/installed-inplace" --- >>> showOptions foobarQPN [] +-- >>> showOptions verbose foobarQPN [] -- "unexpected empty list of versions" --- >>> showOptions foobarQPN [k1, k2] +-- >>> showOptions verbose foobarQPN [k1, k2] -- "foo-bar; foo-bar~>bazqux.foo-bar-1, foo-bar~>bazqux.foo-bar-2" --- >>> showOptions foobarQPN [v0, i1, k2] +-- >>> showOptions verbose 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 ", " +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 a65c41cb046..f0b1e68ef7d 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -864,7 +864,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 691d9b1d39e..4a8adc57e8a 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -973,8 +973,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" [] @@ -984,7 +985,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.