Refactor generation of the solver's error message.

This commit generates the solver's final error message in a separate function,
which is more flexible when the solver is run multiple times.

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  = ""

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