diff --git a/cabal-install/Distribution/Solver/Modular.hs b/cabal-install/Distribution/Solver/Modular.hs index 157bd921643..28023572128 100644 --- a/cabal-install/Distribution/Solver/Modular.hs +++ b/cabal-install/Distribution/Solver/Modular.hs @@ -116,32 +116,39 @@ solve' :: SolverConfig -> Set PN -> Progress String String (Assignment, RevDepMap) solve' sc cinfo idx pkgConfigDB pprefs gcs pns = - foldProgress Step (uncurry createErrorMsg) Done (runSolver printFullLog sc) + foldProgress Step + (createErrorMsg (solverVerbosity sc) (maxBackjumps sc)) + Done + (runSolver printFullLog sc) where runSolver :: Bool -> SolverConfig - -> Progress String (SolverFailure, String) (Assignment, RevDepMap) + -> Progress String SolverFailure (Assignment, RevDepMap) runSolver keepLog sc' = - logToProgress keepLog (solverVerbosity sc') (maxBackjumps sc') $ + logToProgress keepLog $ solve sc' cinfo idx pkgConfigDB pprefs gcs pns - createErrorMsg :: SolverFailure -> String + createErrorMsg :: Verbosity + -> Maybe Int + -> SolverFailure -> Progress String String (Assignment, RevDepMap) - createErrorMsg (ExhaustiveSearch cs _) msg = - Fail $ rerunSolverForErrorMsg cs ++ msg - createErrorMsg BackjumpLimitReached msg = + createErrorMsg verbosity mbj failure@(ExhaustiveSearch cs _) = + Fail $ rerunSolverForErrorMsg cs ++ finalErrorMsg verbosity mbj failure + createErrorMsg verbosity mbj failure@BackjumpLimitReached = Step ("Backjump limit reached. Rerunning dependency solver to generate " ++ "a final conflict set for the search tree containing the " ++ "first backjump.") $ - foldProgress Step (f . fst) Done $ + foldProgress Step f Done $ runSolver printFullLog sc { pruneAfterFirstSuccess = PruneAfterFirstSuccess True } where f :: SolverFailure -> Progress String String (Assignment, RevDepMap) - f (ExhaustiveSearch cs _) = Fail $ rerunSolverForErrorMsg cs ++ msg + f (ExhaustiveSearch cs _) = + Fail $ rerunSolverForErrorMsg cs ++ finalErrorMsg verbosity mbj failure f BackjumpLimitReached = -- This case is possible when the number of goals involved in -- conflicts is greater than the backjump limit. - Fail $ msg ++ "Failed to generate a summarized dependency solver " + Fail $ finalErrorMsg verbosity mbj failure + ++ "Failed to generate a summarized dependency solver " ++ "log due to low backjump limit." rerunSolverForErrorMsg :: ConflictSet -> String @@ -173,3 +180,20 @@ preferGoalsFromConflictSet cs = toVar (PackageVar qpn) = P qpn toVar (FlagVar qpn fn) = F (FN qpn fn) toVar (StanzaVar qpn sn) = S (SN qpn sn) + +finalErrorMsg :: Verbosity -> Maybe Int -> SolverFailure -> String +finalErrorMsg verbosity mbj failure = + case failure of + ExhaustiveSearch cs cm -> + "After searching the rest of the dependency tree exhaustively, " + ++ "these were the goals I've had most trouble fulfilling: " + ++ 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" + where currlimit (Just n) = "currently " ++ show n ++ ", " + currlimit Nothing = "" diff --git a/cabal-install/Distribution/Solver/Modular/Log.hs b/cabal-install/Distribution/Solver/Modular/Log.hs index fa08137c6f0..2561e518ab0 100644 --- a/cabal-install/Distribution/Solver/Modular/Log.hs +++ b/cabal-install/Distribution/Solver/Modular/Log.hs @@ -10,47 +10,22 @@ import Distribution.Solver.Types.Progress import Distribution.Solver.Modular.Dependency import Distribution.Solver.Modular.Message -import qualified Distribution.Solver.Modular.ConflictSet as CS import Distribution.Solver.Modular.RetryLog -import Distribution.Verbosity -- | Information about a dependency solver failure. data SolverFailure = ExhaustiveSearch ConflictSet ConflictMap | BackjumpLimitReached --- | Postprocesses a log file. When the dependency solver fails to find a --- solution, the log ends with a SolverFailure and a message describing the --- failure. This function discards all log messages and avoids calling --- 'showMessages' if the log isn't needed (specified by 'keepLog'), for --- efficiency. +-- | Postprocesses a log file. This function discards all log messages and +-- avoids calling 'showMessages' if the log isn't needed (specified by +-- 'keepLog'), for efficiency. logToProgress :: Bool - -> Verbosity - -> Maybe Int -> RetryLog Message SolverFailure a - -> Progress String (SolverFailure, String) a -logToProgress keepLog verbosity mbj lg = + -> Progress String SolverFailure a +logToProgress keepLog lg = if keepLog then showMessages progress else foldProgress (const id) Fail Done progress where - progress = - -- Convert the RetryLog to a Progress (with toProgress) as late as - -- possible, to take advantage of efficient updates at failures. - toProgress $ - mapFailure (\failure -> (failure, finalErrorMsg failure)) lg - - finalErrorMsg :: SolverFailure -> String - finalErrorMsg (ExhaustiveSearch cs cm) = - "After searching the rest of the dependency tree exhaustively, " - ++ "these were the goals I've had most trouble fulfilling: " - ++ showCS cm cs - where - showCS = if verbosity > normal - then CS.showCSWithFrequency - else CS.showCSSortedByFrequency - finalErrorMsg BackjumpLimitReached = - "Backjump limit reached (" ++ currlimit mbj ++ - "change with --max-backjumps or try to run with --reorder-goals).\n" - where currlimit (Just n) = "currently " ++ show n ++ ", " - currlimit Nothing = "" + progress = toProgress lg