From 62c37e2ca4afcc809da3ec1bd4b6c9f85e1d1e36 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Fri, 11 Jul 2025 12:59:05 +1000 Subject: [PATCH 1/4] Solver: shorten the skipping message if needed Also add a test to prevent this regressing. Closes: https://github.com/haskell/cabal/issues/4251 --- .../src/Distribution/Solver/Modular/Message.hs | 6 +++--- .../UnitTests/Distribution/Solver/Modular/Solver.hs | 13 +++++++++++++ changelog.d/pr-11062 | 8 ++++++++ 3 files changed, 24 insertions(+), 3 deletions(-) create mode 100644 changelog.d/pr-11062 diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs index d6ffadf0abf..21e27fe675c 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs @@ -282,7 +282,7 @@ 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" +-- "foo-bar; 0, 1/installed-inplace, foo-bar~>bazqux.foo-bar-2 and earlier versions" showOptions :: QPN -> [POption] -> String showOptions _ [] = "unexpected empty list of versions" showOptions q [x] = showOption q x @@ -290,8 +290,8 @@ showOptions 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) <- take 3 xs + ] ++ if length xs >= 3 then " and earlier versions" else "") showGR :: QGoalReason -> String showGR UserGoal = " (user goal)" diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index a1f5eed3c62..cb32a33a1e2 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -964,6 +964,19 @@ tests = 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"] $ 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 "A" 4 [] + , Right $ exAv "A" 5 [] + , Right $ exAv "B" 1 [ExFix "A" 6] + ] + rejecting = "rejecting: A-5.0.0 (conflict: B => A==6.0.0)" + skipping = "skipping: A; 4.0.0, 3.0.0, 2.0.0 and earlier 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..50dfa1919f1 --- /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 to at most 3 versions which failed to meet the +requriements. From d818dc9ecff0aa57337d57313e1b2aae85a6ef0c Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 15 Jul 2025 08:27:44 +1000 Subject: [PATCH 2/4] Change earlier to other in skipped versions msg --- cabal-install-solver/src/Distribution/Solver/Modular/Message.hs | 2 +- .../tests/UnitTests/Distribution/Solver/Modular/Solver.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs index 21e27fe675c..9da18b9eeee 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs @@ -291,7 +291,7 @@ showOptions q xs = showQPN q ++ "; " ++ (L.intercalate ", " then showOption q x else showI i -- Don't show the package, just the version | x@(POption i linkedTo) <- take 3 xs - ] ++ if length xs >= 3 then " and earlier versions" else "") + ] ++ if length xs >= 3 then " and other versions" else "") showGR :: QGoalReason -> String showGR UserGoal = " (user goal)" diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index cb32a33a1e2..e6bbdf16e7e 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -974,7 +974,7 @@ tests = , Right $ exAv "B" 1 [ExFix "A" 6] ] rejecting = "rejecting: A-5.0.0 (conflict: B => A==6.0.0)" - skipping = "skipping: A; 4.0.0, 3.0.0, 2.0.0 and earlier versions (has" + skipping = "skipping: A; 4.0.0, 3.0.0, 2.0.0 and other versions (has" in mkTest db "show summarized skipping versions list" ["B"] $ solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg) ] From 326f0e3f4815f2946265822b7ff58fa85509cb5c Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 15 Jul 2025 13:46:31 +1000 Subject: [PATCH 3/4] Plumb verbosity level down to where its needed Use `setVerbose` in two of the unit tests in preparation for upcoming changes to the `skipping ...` message. --- .../src/Distribution/Solver/Modular.hs | 2 +- .../Distribution/Solver/Modular/Message.hs | 55 ++++++++++--------- .../src/Distribution/Client/Dependency.hs | 2 +- .../Distribution/Solver/Modular/Solver.hs | 10 ++-- 4 files changed, 36 insertions(+), 33 deletions(-) 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 9da18b9eeee..df737771695 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). -- @@ -283,15 +284,15 @@ showOption qpn@(Q _pp pn) (POption i linkedTo) = -- "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 and earlier versions" -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) <- take 3 xs - ] ++ if length xs >= 3 then " and other versions" else "") + | x@(POption i linkedTo) <- if verb >= verbose then xs else take 3 xs + ] ++ if verb < verbose && length xs >= 3 then " and 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 e6bbdf16e7e..a412f6c0e21 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,8 +963,9 @@ 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"] $ - solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg) + 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 [] From d60581dafc265f5cda310dcf7a5e69ae5e1ef4ab Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 7 Aug 2025 17:46:00 +1000 Subject: [PATCH 4/4] Reduce show skipped versions from 3 to 1 And fix associated unit test expected string. --- .../src/Distribution/Solver/Modular/Message.hs | 4 ++-- .../tests/UnitTests/Distribution/Solver/Modular/Solver.hs | 8 +++----- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs index df737771695..784e319fa72 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs @@ -291,8 +291,8 @@ 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) <- if verb >= verbose then xs else take 3 xs - ] ++ if verb < verbose && length xs >= 3 then " and other versions" else "") + | x@(POption i linkedTo) <- if verb >= verbose then xs else take 1 xs + ] ++ if verb < verbose && length xs >= 1 then " and other versions" else "") showGR :: QGoalReason -> String showGR UserGoal = " (user goal)" diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index a412f6c0e21..256fce5ba13 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -971,12 +971,10 @@ tests = [ Right $ exAv "A" 1 [] , Right $ exAv "A" 2 [] , Right $ exAv "A" 3 [] - , Right $ exAv "A" 4 [] - , Right $ exAv "A" 5 [] - , Right $ exAv "B" 1 [ExFix "A" 6] + , Right $ exAv "B" 1 [ExFix "A" 4] ] - rejecting = "rejecting: A-5.0.0 (conflict: B => A==6.0.0)" - skipping = "skipping: A; 4.0.0, 3.0.0, 2.0.0 and other versions (has" + rejecting = "rejecting: A-3.0.0 (conflict: B => A==4.0.0)" + skipping = "skipping: A; 2.0.0 and other versions (has" in mkTest db "show summarized skipping versions list" ["B"] $ solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg) ]