Commit 5cb0408e authored by kristenk's avatar kristenk Committed by Edward Z. Yang

Solver: Only print conflict counts at higher verbosity (fixes #4150).

parent 85e92fab
......@@ -362,6 +362,8 @@ planLocalPackage verbosity comp platform configFlags configExFlags
-- installed package index
. setSolveExecutables (SolveExecutables False)
. setSolverVerbosity verbosity
$ standardInstallPolicy
installedPkgIndex
-- NB: We pass in an *empty* source package database,
......
......@@ -56,6 +56,7 @@ module Distribution.Client.Dependency (
setEnableBackjumping,
setSolveExecutables,
setGoalOrder,
setSolverVerbosity,
removeLowerBounds,
removeUpperBounds,
addDefaultSetupDependencies,
......@@ -106,7 +107,7 @@ import Distribution.Simple.Setup
import Distribution.Text
( display )
import Distribution.Verbosity
( Verbosity )
( normal, Verbosity )
import qualified Distribution.Compat.Graph as Graph
import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
......@@ -174,7 +175,8 @@ data DepResolverParams = DepResolverParams {
depResolverSolveExecutables :: SolveExecutables,
-- | Function to override the solver's goal-ordering heuristics.
depResolverGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering)
depResolverGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering),
depResolverVerbosity :: Verbosity
}
showDepResolverParams :: DepResolverParams -> String
......@@ -252,7 +254,8 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex =
depResolverMaxBackjumps = Nothing,
depResolverEnableBackjumping = EnableBackjumping True,
depResolverSolveExecutables = SolveExecutables True,
depResolverGoalOrder = Nothing
depResolverGoalOrder = Nothing,
depResolverVerbosity = normal
}
addTargets :: [PackageName]
......@@ -353,6 +356,12 @@ setGoalOrder order params =
depResolverGoalOrder = order
}
setSolverVerbosity :: Verbosity -> DepResolverParams -> DepResolverParams
setSolverVerbosity verbosity params =
params {
depResolverVerbosity = verbosity
}
-- | Some packages are specific to a given compiler version and should never be
-- upgraded.
dontUpgradeNonUpgradeablePackages :: DepResolverParams -> DepResolverParams
......@@ -663,7 +672,7 @@ resolveDependencies platform comp pkgConfigDB solver params =
$ runSolver solver (SolverConfig reordGoals cntConflicts
indGoals noReinstalls
shadowing strFlags allowBootLibs maxBkjumps enableBj
solveExes order)
solveExes order verbosity)
platform comp installedPkgIndex sourcePkgIndex
pkgConfigDB preferences constraints targets
where
......@@ -683,9 +692,11 @@ resolveDependencies platform comp pkgConfigDB solver params =
maxBkjumps
enableBj
solveExes
order) = if asBool (depResolverAllowBootLibInstalls params)
then params
else dontUpgradeNonUpgradeablePackages params
order
verbosity) =
if asBool (depResolverAllowBootLibInstalls params)
then params
else dontUpgradeNonUpgradeablePackages params
preferences = interpretPackagesPreference targets defpref prefs
......@@ -911,7 +922,7 @@ resolveWithoutDependencies (DepResolverParams targets constraints
prefs defpref installedPkgIndex sourcePkgIndex
_reorderGoals _countConflicts _indGoals _avoidReinstalls
_shadowing _strFlags _maxBjumps _enableBj
_solveExes _allowBootLibInstalls _order) =
_solveExes _allowBootLibInstalls _order _verbosity) =
collectEithers $ map selectPackage (Set.toList targets)
where
selectPackage :: PackageName -> Either ResolveNoDepsError UnresolvedSourcePackage
......
......@@ -166,6 +166,8 @@ planPackages verbosity comp platform fetchFlags
. setAllowBootLibInstalls allowBootLibInstalls
. setSolverVerbosity verbosity
-- Reinstall the targets given on the command line so that the dep
-- resolver will decide that they need fetching, even if they're
-- already installed. Since we want to get the source packages of
......
......@@ -181,6 +181,8 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
. setAllowBootLibInstalls allowBootLibInstalls
. setSolverVerbosity verbosity
. addConstraints
[ let pkg = pkgSpecifierTarget pkgSpecifier
pc = PackageConstraint (scopeToplevel pkg)
......
......@@ -320,7 +320,7 @@ makeInstallPlan verbosity
solver <- chooseSolver verbosity (fromFlag (configSolver configExFlags))
(compilerInfo comp)
notice verbosity "Resolving dependencies..."
return $ planPackages comp platform mSandboxPkgInfo solver
return $ planPackages verbosity comp platform mSandboxPkgInfo solver
configFlags configExFlags installFlags
installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers
......@@ -349,7 +349,8 @@ processInstallPlan verbosity
-- * Installation planning
-- ------------------------------------------------------------
planPackages :: Compiler
planPackages :: Verbosity
-> Compiler
-> Platform
-> Maybe SandboxPackageInfo
-> Solver
......@@ -361,7 +362,7 @@ planPackages :: Compiler
-> PkgConfigDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> Progress String String SolverInstallPlan
planPackages comp platform mSandboxPkgInfo solver
planPackages verbosity comp platform mSandboxPkgInfo solver
configFlags configExFlags installFlags
installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers =
......@@ -392,6 +393,8 @@ planPackages comp platform mSandboxPkgInfo solver
. setAllowBootLibInstalls allowBootLibInstalls
. setSolverVerbosity verbosity
. setPreferenceDefault (if upgradeDeps then PreferAllLatest
else PreferLatestForSelected)
......
......@@ -517,7 +517,7 @@ rebuildInstallPlan verbosity
notice verbosity "Resolving dependencies..."
plan <- foldProgress logMsg die return $
planPackages compiler platform solver solverSettings
planPackages verbosity compiler platform solver solverSettings
installedPkgIndex sourcePkgDb pkgConfigDB
localPackages localPackagesEnabledStanzas
return (plan, pkgConfigDB)
......@@ -894,7 +894,8 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
-- * Installation planning
-- ------------------------------------------------------------
planPackages :: Compiler
planPackages :: Verbosity
-> Compiler
-> Platform
-> Solver -> SolverSettings
-> InstalledPackageIndex
......@@ -903,7 +904,7 @@ planPackages :: Compiler
-> [UnresolvedSourcePackage]
-> Map PackageName (Map OptionalStanza Bool)
-> Progress String String SolverInstallPlan
planPackages comp platform solver SolverSettings{..}
planPackages verbosity comp platform solver SolverSettings{..}
installedPkgIndex sourcePkgDb pkgConfigDB
localPackages pkgStanzasEnable =
......@@ -937,6 +938,8 @@ planPackages comp platform solver SolverSettings{..}
. setAllowBootLibInstalls solverSettingAllowBootLibInstalls
. setSolverVerbosity verbosity
--TODO: [required eventually] decide if we need to prefer installed for
-- global packages, or prefer latest even for global packages. Perhaps
-- should be configurable but with a different name than "upgrade-dependencies".
......
......@@ -39,8 +39,8 @@ import Distribution.System
-- solver. Performs the necessary translations before and after.
modularResolver :: SolverConfig -> DependencyResolver loc
modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns =
fmap (uncurry postprocess) $ -- convert install plan
logToProgress (maxBackjumps sc) $ -- convert log format into progress format
fmap (uncurry postprocess) $ -- convert install plan
logToProgress (solverVerbosity sc) (maxBackjumps sc) $ -- convert log format into progress format
solve sc cinfo idx pkgConfigDB pprefs gcs pns
where
-- Indices have to be converted into solver-specific uniform index.
......
......@@ -14,7 +14,8 @@ module Distribution.Solver.Modular.ConflictSet (
#ifdef DEBUG_CONFLICT_SETS
, conflictSetOrigin
#endif
, showCS
, showConflictSet
, showCSSortedByFrequency
, showCSWithFrequency
-- Set-like operations
, toList
......@@ -74,16 +75,24 @@ instance Eq ConflictSet where
instance Ord ConflictSet where
compare = compare `on` conflictSetToSet
showCS :: ConflictSet -> String
showCS = intercalate ", " . map showVar . toList
showConflictSet :: ConflictSet -> String
showConflictSet = intercalate ", " . map showVar . toList
showCSSortedByFrequency :: ConflictMap -> ConflictSet -> String
showCSSortedByFrequency = showCS False
showCSWithFrequency :: ConflictMap -> ConflictSet -> String
showCSWithFrequency cm = intercalate ", " . map showWithFrequency . indexByFrequency
showCSWithFrequency = showCS True
showCS :: Bool -> ConflictMap -> ConflictSet -> String
showCS showCount cm =
intercalate ", " . map showWithFrequency . indexByFrequency
where
indexByFrequency = sortBy (flip compare `on` snd) . map (\c -> (c, M.lookup c cm)) . toList
showWithFrequency (conflict, maybeFrequency) = case maybeFrequency of
Just frequency -> showVar conflict ++ " (" ++ show frequency ++ ")"
Nothing -> showVar conflict
Just frequency
| showCount -> showVar conflict ++ " (" ++ show frequency ++ ")"
_ -> showVar conflict
{-------------------------------------------------------------------------------
Set-like operations
......
......@@ -13,7 +13,7 @@ module Distribution.Solver.Modular.Dependency (
-- * Conflict sets
, ConflictSet
, ConflictMap
, CS.showCS
, CS.showConflictSet
-- * Constrained instances
, CI(..)
, merge
......
......@@ -14,6 +14,7 @@ import Distribution.Solver.Modular.Dependency
import Distribution.Solver.Modular.Message
import Distribution.Solver.Modular.Tree (FailReason(..))
import qualified Distribution.Solver.Modular.ConflictSet as CS
import Distribution.Verbosity
-- | The 'Log' datatype.
--
......@@ -30,12 +31,12 @@ data Exhaustiveness = Exhaustive | BackjumpLimitReached
-- | Postprocesses a log file. Takes as an argument a limit on allowed backjumps.
-- If the limit is 'Nothing', then infinitely many backjumps are allowed. If the
-- limit is 'Just 0', backtracking is completely disabled.
logToProgress :: Maybe Int -> Log Message a -> Progress String String a
logToProgress mbj l = let
es = proc (Just 0) l -- catch first error (always)
ms = proc mbj l
in go es es -- trace for first error
(showMessages (const True) True ms) -- run with backjump limit applied
logToProgress :: Verbosity -> Maybe Int -> Log Message a -> Progress String String a
logToProgress verbosity mbj l =
let es = proc (Just 0) l -- catch first error (always)
ms = proc mbj l
in go es es -- trace for first error
(showMessages (const True) True ms) -- run with backjump limit applied
where
-- Proc takes the allowed number of backjumps and a 'Progress' and explores the
-- messages until the maximum number of backjumps has been reached. It filters out
......@@ -73,7 +74,11 @@ logToProgress mbj l = let
Exhaustive ->
"After searching the rest of the dependency tree exhaustively, "
++ "these were the goals I've had most trouble fulfilling: "
++ CS.showCSWithFrequency cm cs
++ showCS cm cs
where
showCS = if verbosity > normal
then CS.showCSWithFrequency
else CS.showCSSortedByFrequency
BackjumpLimitReached ->
"Backjump limit reached (" ++ currlimit mbj ++
"change with --max-backjumps or try to run with --reorder-goals).\n"
......
......@@ -140,10 +140,10 @@ showFR _ (GlobalConstraintInstalled src) = " (" ++ constraintSource src ++ " re
showFR _ (GlobalConstraintSource src) = " (" ++ constraintSource src ++ " requires source instance)"
showFR _ (GlobalConstraintFlag src) = " (" ++ constraintSource src ++ " requires opposite flag selection)"
showFR _ ManualFlag = " (manual flag can only be changed explicitly)"
showFR c Backjump = " (backjumping, conflict set: " ++ showCS c ++ ")"
showFR c Backjump = " (backjumping, conflict set: " ++ showConflictSet c ++ ")"
showFR _ MultipleInstances = " (multiple instances)"
showFR c (DependenciesNotLinked msg) = " (dependencies not linked: " ++ msg ++ "; conflict set: " ++ showCS c ++ ")"
showFR c CyclicDependencies = " (cyclic dependencies; conflict set: " ++ showCS c ++ ")"
showFR c (DependenciesNotLinked msg) = " (dependencies not linked: " ++ msg ++ "; conflict set: " ++ showConflictSet c ++ ")"
showFR c CyclicDependencies = " (cyclic dependencies; conflict set: " ++ showConflictSet c ++ ")"
-- The following are internal failures. They should not occur. In the
-- interest of not crashing unnecessarily, we still just print an error
-- message though.
......
......@@ -11,6 +11,7 @@ module Distribution.Solver.Modular.Solver
import Data.Map as M
import Data.List as L
import Data.Set as S
import Distribution.Verbosity
import Distribution.Version
import Distribution.Compiler (CompilerInfo)
......@@ -64,7 +65,8 @@ data SolverConfig = SolverConfig {
maxBackjumps :: Maybe Int,
enableBackjumping :: EnableBackjumping,
solveExecutables :: SolveExecutables,
goalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering)
goalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering),
solverVerbosity :: Verbosity
}
-- | Run all solver phases.
......
......@@ -189,6 +189,12 @@ tests = [
&& length (filter ("trying: A" `isInfixOf`) lg) == 1
in mkTest db "deduplicate targets" ["A", "A"] $
SolverResult p $ Right [("A", 1)]
, runTest $
let db = [Right $ exAv "A" 1 [ExAny "B"]]
msg = "After searching the rest of the dependency tree exhaustively, "
++ "these were the goals I've had most trouble fulfilling: A, B"
in mkTest db "exhaustive search failure message" ["A"] $
solverFailure (isInfixOf msg)
]
]
where
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment