Skip processing the solver log when the log isn't needed.

I tested this change by comparing performance with both
c01d92f (before any refactoring needed to
implement this change) and 4d28102 (the
previous commit), using hackage-benchmark.  Since the refactoring changed the
meaning of the backjump count, I only timed "install" commands that didn't reach
the backjump limit.  I chose several commands that ran for different amounts of
time, including the long running example from issue haskell#4976.

Comparing c01d92f (cabal1) and this commit (cabal2):

compiler: GHC 8.2.1
index state: 2018-02-16T02:47:32Z
extra hackage-benchmark flags:
--packages="aeson yesod wolf" --pvalue=0.01 --trials=50 --print-skipped-packages

package result1       result2             mean1       mean2     stddev1     stddev2     speedup
aeson   (not significant)
yesod   Solution      Solution           2.270s      2.258s      0.027s      0.031s      1.005
wolf    Solution      Solution           7.337s      7.234s      0.056s      0.047s      1.014

Comparing 4d28102 (cabal1) and this commit (cabal2) with the same environment
and flags as above:

package result1       result2             mean1       mean2     stddev1     stddev2     speedup
aeson   (not significant)
yesod   (not significant)
wolf    Solution      Solution           7.297s      7.245s      0.045s      0.048s      1.007

hackage-benchmark currently doesn't print the results when they aren't
significant, so I reran "cabal install --dry-run aeson", and it ran for about
1.6 seconds and found a solution.

Comparing c01d92f (cabal1) and this commit (cabal2) on issue haskell#4976:

compiler: GHC 7.10.3
extra hackage-benchmark flags:
--cabal1-flags="--index-state='2017-12-25T17:31:19Z' --enable-tests --max-backjumps=-1"
--cabal2-flags="--index-state='2017-12-25T17:31:19Z' --enable-tests --max-backjumps=-1"
--packages=servant-mock --pvalue=0.01 --trials=50 --print-skipped-packages --print-trials

trial/summary    package      result1       result2             mean1       mean2     stddev1     stddev2     speedup
...
summary          servant-mock Solution      Solution          39.693s     38.863s      0.181s      0.174s      1.021

Comparing 4d28102 (cabal1) and this commit (cabal2) on issue haskell#4976 with the
same environment and flags as above:

trial/summary    package      result1       result2             mean1       mean2     stddev1     stddev2     speedup
...
summary          servant-mock Solution      Solution          39.659s     38.960s      0.195s      0.162s      1.018

Overall, this seems like a very small performance improvement.

cabal-install/Distribution/Solver/Modular.hs

@@ -48,6 +48,7 @@ import Distribution.System
          ( Platform(..) )
 import Distribution.Simple.Utils
          ( ordNubBy )
+import Distribution.Verbosity
 
 
 -- | Ties the two worlds together: classic cabal-install vs. the modular
@@ -115,12 +116,12 @@ solve' :: SolverConfig
        -> Set PN
        -> Progress String String (Assignment, RevDepMap)
 solve' sc cinfo idx pkgConfigDB pprefs gcs pns =
-    foldProgress Step (uncurry createErrorMsg) Done (runSolver sc)
+    foldProgress Step (uncurry createErrorMsg) Done (runSolver printFullLog sc)
   where
-    runSolver :: SolverConfig
+    runSolver :: Bool -> SolverConfig
               -> Progress String (SolverFailure, String) (Assignment, RevDepMap)
-    runSolver sc' =
-        logToProgress (solverVerbosity sc') (maxBackjumps sc') $ -- convert log format into progress format
+    runSolver keepLog sc' =
+        logToProgress keepLog (solverVerbosity sc') (maxBackjumps sc') $
         solve sc' cinfo idx pkgConfigDB pprefs gcs pns
 
     createErrorMsg :: SolverFailure -> String
@@ -132,7 +133,8 @@ solve' sc cinfo idx pkgConfigDB pprefs gcs pns =
               ++ "a final conflict set for the search tree containing the "
               ++ "first backjump.") $
         foldProgress Step (f . fst) Done $
-        runSolver sc { pruneAfterFirstSuccess = PruneAfterFirstSuccess True }
+        runSolver printFullLog
+                  sc { pruneAfterFirstSuccess = PruneAfterFirstSuccess True }
       where
         f :: SolverFailure -> Progress String String (Assignment, RevDepMap)
         f (ExhaustiveSearch cs _) = Fail $ rerunSolverForErrorMsg cs ++ msg
@@ -153,7 +155,9 @@ solve' sc cinfo idx pkgConfigDB pprefs gcs pns =
           -- original goal order.
           goalOrder' = preferGoalsFromConflictSet cs <> fromMaybe mempty (goalOrder sc)
 
-      in unlines ("Could not resolve dependencies:" : messages (runSolver sc'))
+      in unlines ("Could not resolve dependencies:" : messages (runSolver True sc'))
+
+    printFullLog = solverVerbosity sc >= verbose
 
     messages :: Progress step fail done -> [step]
     messages = foldProgress (:) (const []) (const [])

cabal-install/Distribution/Solver/Modular/Log.hs

@@ -21,19 +21,25 @@ data SolverFailure =
 
 -- | 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.
-logToProgress :: Verbosity
+-- failure. 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 verbosity mbj lg =
-    showMessages $
-
-    -- 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
+logToProgress keepLog verbosity mbj 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, "

cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs

@@ -78,7 +78,8 @@ constraints cs test = test { testConstraints = cs }
 preferences :: [ExPreference] -> SolverTest -> SolverTest
 preferences prefs test = test { testSoftConstraints = prefs }
 
--- | Increase the solver's verbosity.
+-- | Increase the solver's verbosity. This is necessary for test cases that
+-- check the contents of the verbose log.
 setVerbose :: SolverTest -> SolverTest
 setVerbose test = test { testVerbosity = verbose }
 

cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs

@@ -63,7 +63,8 @@ tests = [
 
         , let checkFullLog =
                   any $ isInfixOf "rejecting: pkg:-flag (manual flag can only be changed explicitly)"
-          in runTest $ constraints [ExVersionConstraint (ScopeAnyQualifier "true-dep") V.noVersion] $
+          in runTest $ setVerbose $
+             constraints [ExVersionConstraint (ScopeAnyQualifier "true-dep") V.noVersion] $
              mkTest dbManualFlags "Don't toggle manual flag to avoid conflict" ["pkg"] $
              -- TODO: We should check the summarized log instead of the full log
              -- for the manual flags error message, but it currently only
@@ -110,7 +111,7 @@ tests = [
                   all (\msg -> any (msg `isInfixOf`) lns)
                   [ "rejecting: B:-flag "         ++ failureReason
                   , "rejecting: A:setup.B:+flag " ++ failureReason ]
-          in runTest $ constraints cs $
+          in runTest $ constraints cs $ setVerbose $
              mkTest dbLinkedSetupDepWithManualFlag name ["A"] $
              SolverResult checkFullLog (Left $ const True)
         ]
@@ -339,7 +340,7 @@ tests = [
                   p :: [String] -> Bool
                   p lg =    elem "targets: A" lg
                          && length (filter ("trying: A" `isInfixOf`) lg) == 1
-              in mkTest db "deduplicate targets" ["A", "A"] $
+              in setVerbose $ mkTest db "deduplicate targets" ["A", "A"] $
                  SolverResult p $ Right [("A", 1)]
         , runTest $
               let db = [Right $ exAv "A" 1 [ExAny "B"]]
@@ -814,7 +815,7 @@ db15 = [
 -- package and then choose a different version for the setup dependency.
 issue4161 :: String -> SolverTest
 issue4161 name =
-    mkTest db name ["target"] $
+    setVerbose $ mkTest db name ["target"] $
     SolverResult checkFullLog $ Right [("target", 1), ("time", 1), ("time", 2)]
   where
     db :: ExampleDb