Parametrizing verbosity for dependencies function

haskell · May 14, 2021 · 582d4c3 · 582d4c3
1 parent 7d91d3c
commit 582d4c3
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 11 deletions.
diff --git a/cabal-install/src/Distribution/Client/Init/Interactive/Command.hs b/cabal-install/src/Distribution/Client/Init/Interactive/Command.hs
@@ -58,6 +58,7 @@ import Distribution.Simple.Setup (Flag(..))
 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 import Distribution.Client.Types (SourcePackageDb(..))
 import Distribution.Solver.Types.PackageIndex (elemByPackageName)
+import Distribution.Verbosity
 
 import Language.Haskell.Extension (Language(..))
 
@@ -455,4 +456,4 @@ dependenciesPrompt
     -> InitFlags
     -> m [Dependency]
 dependenciesPrompt pkgIx flags = getDependencies flags $
-    retrieveDependencies flags [(fromString "Prelude", fromString "Prelude")] pkgIx
+    retrieveDependencies silent flags [(fromString "Prelude", fromString "Prelude")] pkgIx
diff --git a/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs b/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs
@@ -51,11 +51,12 @@ import Distribution.Client.Init.Defaults
 import Distribution.Client.Init.NonInteractive.Heuristics
 import Distribution.Client.Init.Utils
 import Distribution.Client.Init.FlagExtractors
-import Distribution.Simple.Setup (Flag(..))
+import Distribution.Simple.Setup (Flag(..), fromFlagOrDefault)
 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 import Distribution.Client.Types (SourcePackageDb(..))
 import Distribution.Solver.Types.PackageIndex (elemByPackageName)
 import Distribution.Utils.Generic (safeHead)
+import Distribution.Verbosity
 
 import Language.Haskell.Extension (Language(..), Extension(..))
 
@@ -446,7 +447,7 @@ dependenciesHeuristics flags fp pkgIx = getDependencies flags $ do
       filteredDeps = filter ((`notElem` mods) . snd) groupedDeps
       preludeNub   = nubBy (\a b -> snd a == snd b) $ (fromString "Prelude", fromString "Prelude") : filteredDeps
 
-  retrieveDependencies flags preludeNub pkgIx
+  retrieveDependencies (fromFlagOrDefault silent $ initVerbosity flags) flags preludeNub pkgIx
 
 -- | Retrieve the list of extensions
 otherExtsHeuristics :: Interactive m => InitFlags -> FilePath -> m [Extension]

diff --git a/cabal-install/src/Distribution/Client/Init/Utils.hs b/cabal-install/src/Distribution/Client/Init/Utils.hs
@@ -213,8 +213,8 @@ isSourceFile :: Maybe [FilePath] -> SourceFileEntry -> Bool
 isSourceFile Nothing        sf = isSourceFile (Just ["."]) sf
 isSourceFile (Just srcDirs) sf = any (equalFilePath (relativeSourcePath sf)) srcDirs
 
-retrieveDependencies :: Interactive m => InitFlags -> [(ModuleName, ModuleName)] -> InstalledPackageIndex -> m [P.Dependency]
-retrieveDependencies flags mods' pkgIx = do
+retrieveDependencies :: Interactive m => Verbosity -> InitFlags -> [(ModuleName, ModuleName)] -> InstalledPackageIndex -> m [P.Dependency]
+retrieveDependencies v flags mods' pkgIx = do
   let mods = mods'
 
       modMap :: M.Map ModuleName [InstalledPackageInfo]
@@ -224,18 +224,19 @@ retrieveDependencies flags mods' pkgIx = do
       modDeps = map (\(mn, ds) -> (mn, ds, M.lookup ds modMap)) mods
       -- modDeps = map (id &&& flip M.lookup modMap) mods
 
-  message (fromFlagOrDefault silent $ initVerbosity flags) "\nGuessing dependencies..."
-  nub . catMaybes <$> traverse (chooseDep flags) modDeps
+  message v "\nGuessing dependencies..."
+  nub . catMaybes <$> traverse (chooseDep v flags) modDeps
 
 -- Given a module and a list of installed packages providing it,
 -- choose a dependency (i.e. package + version range) to use for that
 -- module.
 chooseDep
   :: Interactive m
-  => InitFlags
+  => Verbosity
+  -> InitFlags
   -> (ModuleName, ModuleName, Maybe [InstalledPackageInfo])
   -> m (Maybe P.Dependency)
-chooseDep flags (importer, m, mipi) = case mipi of
+chooseDep v flags (importer, m, mipi) = case mipi of
   -- We found some packages: group them by name.
   Just ps@(_:_) ->
     case NE.groupBy (\x y -> P.pkgName x == P.pkgName y) $ map P.packageId ps of
@@ -272,8 +273,6 @@ chooseDep flags (importer, m, mipi) = case mipi of
     return Nothing
 
   where
-    v = fromFlagOrDefault normal (initVerbosity flags)
-
     -- desugar if cabal version lower than 2.0
     desugar = case cabalVersion flags of
       Flag x -> x                   < CabalSpecV2_0