Remove extreme logging

Author: andreabedini

Cabal/src/Distribution/Simple/Program/Find.hs

@@ -69,7 +69,7 @@ logExtraProgramSearchPath
   -> [FilePath]
   -> IO ()
 logExtraProgramSearchPath verbosity extraPaths =
-  info verbosity . unlines $
+  debug verbosity . unlines $
     "Including the following directories in PATH:"
       : map ("- " ++) extraPaths
 
@@ -78,7 +78,7 @@ logExtraProgramOverrideEnv
   -> [(String, Maybe String)]
   -> IO ()
 logExtraProgramOverrideEnv verbosity extraEnv =
-  info verbosity . unlines $
+  debug verbosity . unlines $
     "Including the following environment variable overrides:"
       : [ "- " ++ case mbVal of
           Nothing -> "unset " ++ var

cabal-install/cabal-install.cabal

@@ -265,7 +265,6 @@ library
       , regex-posix >= 0.96.0.0 && <0.97
       , safe-exceptions >= 0.1.7.0 && < 0.2
       , semaphore-compat >= 1.0.0 && < 1.1
-      , ansi-terminal
 
     if flag(native-dns)
       if os(windows)

cabal-install/src/Distribution/Client/Dependency.hs

@@ -142,7 +142,6 @@ import qualified Distribution.Solver.Types.ComponentDeps as CD
 import Distribution.Solver.Types.ConstraintSource
 import Distribution.Solver.Types.DependencyResolver
 import Distribution.Solver.Types.InstalledPreference as Preference
-import Distribution.Solver.Types.InstSolverPackage (InstSolverPackage(..))
 import Distribution.Solver.Types.LabeledPackageConstraint
 import Distribution.Solver.Types.OptionalStanza
 import Distribution.Solver.Types.PackageConstraint
@@ -169,7 +168,6 @@ import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Text.PrettyPrint hiding ((<>))
 import GHC.Stack (HasCallStack)
-import Distribution.Client.InstallPlan (renderForest')
 
 -- ------------------------------------------------------------
 
@@ -776,7 +774,6 @@ resolveDependencies
   -> DepResolverParams
   -> Progress String String SolverInstallPlan
 resolveDependencies toolchains pkgConfigDB installedPkgIndex params = do
-  step (showDepResolverParams finalparams)
   pkgs <- runSolver
     config
     toolchains
@@ -786,47 +783,7 @@ resolveDependencies toolchains pkgConfigDB installedPkgIndex params = do
     preferences
     constraints
     targets
-  let pkgs' = sortBy (comparing solverId) pkgs
-  step $ render $ vcat
-    [ text "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
-    , text "Solver plan"
-    , text "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
-    ]
-  for_ pkgs' $ \pkg -> do 
-    step $ render $ 
-      hang (pretty (solverQPN pkg) <+> text "->" <+> pretty (solverId pkg)) 4 $ case pkg of
-        PreExisting InstSolverPackage{instSolverPkgExeDeps, instSolverPkgLibDeps} ->
-          vcat
-              [ hang (pretty comp) 2 $ vcat
-                  [ vcat [ hang (text "lib-deps:") 2 (vcat (map pretty libDeps)) | not (null libDeps) ]
-                  , vcat [ hang (text "exe-deps:") 2 (vcat (map pretty exeDeps)) | not (null exeDeps) ]
-                  ]
-              | (comp, (libDeps, exeDeps)) <- CD.toList (CD.zip instSolverPkgLibDeps instSolverPkgExeDeps)
-              ]
-        Configured SolverPackage{solverPkgExeDeps, solverPkgLibDeps} ->
-          vcat
-            [ hang (pretty comp) 2 $ vcat
-                [ vcat [ hang (text "lib-deps:") 2 (vcat (map pretty libDeps)) | not (null libDeps) ]
-                , vcat [ hang (text "exe-deps:") 2 (vcat (map pretty exeDeps)) | not (null exeDeps) ]
-                ]
-            | (comp, (libDeps, exeDeps)) <- CD.toList (CD.zip solverPkgLibDeps solverPkgExeDeps)
-            ]
-
-  step $ render $ vcat
-    [ text "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
-    , text "Scopes"
-    , text "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
-    , renderSolverPlanScopes pkgs'
-    ]
-  
-  step $ render $ vcat
-    [ text "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
-    , text "Dependency tree"
-    , text "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
-    , text (renderForest' (\p -> show (pretty (solverQPN p) <+> text "->" <+> pretty (Graph.nodeKey p))) $ Graph.fromDistinctList pkgs')
-    ]
-
-  validateSolverResult toolchains pkgs'
+  validateSolverResult toolchains $ sortBy (comparing solverId) pkgs
   where
     installedPkgIndex' = Staged $ \case
       Build -> getStage installedPkgIndex Build
@@ -848,7 +805,7 @@ resolveDependencies toolchains pkgConfigDB installedPkgIndex params = do
           verbosity
           (PruneAfterFirstSuccess False)
 
-    finalparams@( DepResolverParams
+    DepResolverParams
                     targets
                     constraints
                     prefs
@@ -869,25 +826,14 @@ resolveDependencies toolchains pkgConfigDB installedPkgIndex params = do
                     solveExes
                     order
                     verbosity
-                  ) =
+                 =
         if asBool (depResolverAllowBootLibInstalls params)
           then params
           else dontInstallNonReinstallablePackages params
 
     preferences :: PackageName -> PackagePreferences
     preferences = interpretPackagesPreference targets defpref prefs
 
-renderSolverPlanScopes :: [SolverInstallPlan.SolverPlanPackage] -> Doc
-renderSolverPlanScopes pkgs = vcat
-  [ vcat [ (pretty pp <+> text "/") $+$ nest 4 (vcat (map pretty (Set.toList sids)))
-         | (pp, sids) <- Map.toList (SolverInstallPlan.qualifications g)
-         ]
-  -- , vcat [ hang (pretty key) 4 (vcat [ text "-" <+> pretty n | n <- neigh]) | (_pkg, key, neigh) <- mapG ]
-  ]
-  where
-    g = Graph.fromDistinctList pkgs
-    -- (_g', mapG, _invG) = Data.Graph.graphFromEdges [ (pkg, Graph.nodeKey pkg,  Graph.nodeNeighbors pkg) | pkg <- pkgs]
-
 -- | Give an interpretation to the global 'PackagesPreference' as
 --  specific per-package 'PackageVersionPreference'.
 interpretPackagesPreference

cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs

@@ -191,34 +191,34 @@ buildAndRegisterUnpackedPackage
     -- Configure phase
     delegate $
       PBConfigurePhase $ do
-        -- annotateFailure mlogFile ConfigureFailed $ do
+        annotateFailure mlogFile ConfigureFailed $ do
           info verbosity $ "--- Configure phase " ++ prettyShow (Graph.nodeKey pkg)
           setup configureCommand Cabal.configCommonFlags configureFlags configureArgs
 
     -- Build phase
     delegate $
       PBBuildPhase $ do
-        -- annotateFailure mlogFile BuildFailed $ do
+        annotateFailure mlogFile BuildFailed $ do
           info verbosity $ "--- Build phase " ++ prettyShow (Graph.nodeKey pkg)
           setup buildCommand Cabal.buildCommonFlags (return . buildFlags) buildArgs
 
     -- Haddock phase
     whenHaddock $
       delegate $
         PBHaddockPhase $ do
-          -- annotateFailure mlogFile HaddocksFailed $ do
+          annotateFailure mlogFile HaddocksFailed $ do
             info verbosity $ "--- Haddock phase " ++ prettyShow (Graph.nodeKey pkg)
             setup haddockCommand Cabal.haddockCommonFlags (return . haddockFlags) haddockArgs
 
     -- Install phase
     delegate $
       PBInstallPhase
         { runCopy = \destdir -> do
-            -- annotateFailure mlogFile InstallFailed $ do
+            annotateFailure mlogFile InstallFailed $ do
               info verbosity $ "--- Install phase, copy " ++ prettyShow (Graph.nodeKey pkg)
               setup Cabal.copyCommand Cabal.copyCommonFlags (return . copyFlags destdir) copyArgs
         , runRegister = \pkgDBStack registerOpts -> do
-            -- annotateFailure mlogFile InstallFailed $ do
+            annotateFailure mlogFile InstallFailed $ do
               info verbosity $ "--- Install phase, register " ++ prettyShow (Graph.nodeKey pkg)
               -- We register ourselves rather than via Setup.hs. We need to
               -- grab and modify the InstalledPackageInfo. We decide what
@@ -241,23 +241,23 @@ buildAndRegisterUnpackedPackage
     whenTest $
       delegate $
         PBTestPhase $ do
-          -- annotateFailure mlogFile TestsFailed $ do
+          annotateFailure mlogFile TestsFailed $ do
             info verbosity $ "--- Test phase " ++ prettyShow (Graph.nodeKey pkg)
             setup testCommand Cabal.testCommonFlags (return . testFlags) testArgs
 
     -- Bench phase
     whenBench $
       delegate $
         PBBenchPhase $ do
-          -- annotateFailure mlogFile BenchFailed $ do
+          annotateFailure mlogFile BenchFailed $ do
             info verbosity $ "--- Benchmark phase " ++ prettyShow (Graph.nodeKey pkg)
             setup benchCommand Cabal.benchmarkCommonFlags (return . benchFlags) benchArgs
 
     -- Repl phase
     whenRepl $
       delegate $
         PBReplPhase $ do
-          -- annotateFailure mlogFile ReplFailed $ do
+          annotateFailure mlogFile ReplFailed $ do
             info verbosity $ "--- Repl phase " ++ prettyShow (Graph.nodeKey pkg)
             setupInteractive replCommand Cabal.replCommonFlags replFlags replArgs
 

cabal-install/src/Distribution/Client/ProjectPlanning.hs

@@ -232,7 +232,7 @@ import qualified Distribution.Compat.Graph as Graph
 import Control.Exception (assert)
 import Control.Monad (sequence)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.State (StateT (..), evalStateT, execStateT, gets, modify, get)
+import Control.Monad.State (StateT (..), execStateT, gets, modify)
 import Data.Foldable (fold)
 import Data.List (deleteBy, groupBy)
 import qualified Data.List.NonEmpty as NE
@@ -246,7 +246,6 @@ import GHC.Stack (HasCallStack)
 import Distribution.Client.InstallPlan (foldPlanPackage)
 import Distribution.Solver.Types.ResolverPackage (solverId)
 import qualified Distribution.Solver.Types.ResolverPackage as ResolverPackage
-import System.Console.ANSI
 
 -- | Check that an 'ElaboratedConfiguredPackage' actually makes
 -- sense under some 'ElaboratedSharedConfig'.
@@ -696,23 +695,6 @@ rebuildInstallPlan
           -- changes, so it's worth caching them separately.
           improvedPlan <- phaseImprovePlan elaboratedPlan elaboratedShared
 
-          let s = flip foldMap (InstallPlan.toList elaboratedPlan) $
-                    foldPlanPackage
-                      (Set.singleton . Graph.nodeKey)
-                      (const Set.empty)
-              badMsg s = Disp.text (setSGRCode [SetColor Foreground Vivid Red] <> s <> setSGRCode [Reset])
-              goodMsg s = Disp.text (setSGRCode [SetColor Foreground Vivid Green] <> s <> setSGRCode [Reset]) 
-          flip evalStateT s $ for_ (InstallPlan.executionOrder elaboratedPlan) $ \(ReadyPackage pkg) -> do
-            s' <- get
-            liftIO $ infoNoWrap verbosity $ show $ 
-              Disp.hang (Disp.text "Elaborated package: " <+> pretty (Graph.nodeKey pkg)) 4 $ vcat
-                [ Disp.hang (text "elabOrderDependencies") 4 $ Disp.vcat
-                    [ pretty dep <+> Disp.parens (if Set.member dep s' then goodMsg "preset" else badMsg "missing")
-                    | dep <- sort (elabOrderDependencies pkg)
-                    ]
-                ]
-            modify (Set.insert (Graph.nodeKey pkg))
- 
           return (improvedPlan, elaboratedPlan, elaboratedShared, totalIndexState, activeRepos)
     where
       fileMonitorSolverPlan = newFileMonitorInCacheDir "solver-plan"
@@ -1628,13 +1610,7 @@ elaborateInstallPlan
 
       elaboratedInstallPlan :: LogProgress ElaboratedInstallPlan
       elaboratedInstallPlan = do
-        infoProgress (Disp.text "elaboratedInstallPlan")
-
-        infoProgress $ hang (Disp.text "pkgsLocalToProject") 4 $ vcat $ map pretty $ Set.toList pkgsLocalToProject
-        infoProgress $ hang (Disp.text "pkgsToBuildInplaceOnly") 4 $ vcat $ map pretty $ Set.toList pkgsToBuildInplaceOnly
-
         flip InstallPlan.fromSolverInstallPlanWithProgress solverPlan $ \mapDep planpkg -> do
-          infoProgress (text "Elaborating" <+> pretty (solverId planpkg))
           case planpkg of
             SolverInstallPlan.PreExisting pkg -> do
               let ipkg = InstallPlan.PreExisting (WithStage (instSolverStage pkg) (instSolverPkgIPI pkg))
@@ -1649,7 +1625,6 @@ elaborateInstallPlan
                         <+> text "package"
                         <+> quotes (pretty (packageId pkg))
                     ) (elaborateSolverToComponents mapDep pkg)
-              infoProgress $ hang (pretty (solverId planpkg) <+> text "->") 4 $ vcat (map pretty elabs)
               return $ map InstallPlan.Configured elabs
 
       -- NB: We don't INSTANTIATE packages at this point.  That's
@@ -2106,7 +2081,7 @@ elaborateInstallPlan
         -> LogProgress ElaboratedConfiguredPackage
       elaborateSolverToPackage
         pkgWhyNotPerComponent
-        pkg@SolverPackage {solverPkgStage, solverPkgSource = SourcePackage {srcpkgPackageId}}
+        pkg@SolverPackage {solverPkgSource = SourcePackage {srcpkgPackageId}}
         compGraph
         comps = do
           infoProgress $ hang (text "[elaborateSolverToPackage]") 4 $ vcat

cabal-install/src/Distribution/Client/SetupWrapper.hs

@@ -156,7 +156,6 @@ import Distribution.Simple.Utils
   , die'
   , dieWithException
   , info
-  , infoNoWrap
   , installExecutableFile
   , maybeExit
   , rawSystemProc
@@ -432,12 +431,6 @@ getSetup verbosity options mpkg = do
         (bt, _) -> bt
   (version, method, options'') <-
     getSetupMethod verbosity options' pkg buildType'
-  info verbosity $ unlines
-    [ "choosen setup method:"
-    , "version: " ++ show version
-    , "method: " ++ show method
-    , show $ hang (text "options:") 4 (pretty options'')
-    ]
   return
     Setup
       { setupMethod = method
@@ -1152,10 +1145,6 @@ getExternalSetupMethod verbosity options pkg bt = do
                         -- when compiling a Simple Setup.hs file.
                   , ghcOptExtensionMap = Map.fromList . Simple.compilerExtensions $ compiler
                   }
-          infoNoWrap verbosity $ prettyShow options'
-          infoNoWrap verbosity $ "maybeCabalLibInstalledPkgId: " ++ show maybeCabalLibInstalledPkgId
-          infoNoWrap verbosity $ "cabalDep: " ++ show cabalDep
-          infoNoWrap verbosity $ "packages: " ++ show selectedDeps
           let ghcCmdLine = renderGhcOptions compiler platform ghcOptions
           when (useVersionMacros options') $
             rewriteFileEx verbosity (i cppMacrosFile) $