Move smart accessors out of Client.Sandbox into Client.Setup

cabal-install/Distribution/Client/Sandbox.hs

@@ -39,12 +39,13 @@ module Distribution.Client.Sandbox (
     updateSandboxConfigFileFlag,
     updateInstallDirs,
 
-    configPackageDB', configCompilerAux', getPersistOrConfigCompiler
+    getPersistOrConfigCompiler
   ) where
 
 import Distribution.Client.Setup
   ( SandboxFlags(..), ConfigFlags(..), ConfigExFlags(..), InstallFlags(..)
-  , GlobalFlags(..), defaultConfigExFlags, defaultInstallFlags
+  , GlobalFlags(..), configCompilerAux', configPackageDB'
+  , defaultConfigExFlags, defaultInstallFlags
   , defaultSandboxLocation, withRepoContext )
 import Distribution.Client.Sandbox.Timestamp  ( listModifiedDeps
                                               , maybeAddCompilerTimestampRecord
@@ -77,10 +78,8 @@ import Distribution.Client.Utils              ( inDir, tryCanonicalizePath
 import Distribution.PackageDescription.Configuration
                                               ( flattenPackageDescription )
 import Distribution.PackageDescription.Parse  ( readPackageDescription )
-import Distribution.Simple.Compiler           ( Compiler(..), PackageDB(..)
-                                              , PackageDBStack )
+import Distribution.Simple.Compiler           ( Compiler(..), PackageDB(..) )
 import Distribution.Simple.Configure          ( configCompilerAuxEx
-                                              , interpretPackageDbFlags
                                               , getPackageDBContents
                                               , maybeGetPersistBuildConfig
                                               , findDistPrefOrDefault
@@ -98,7 +97,7 @@ import Distribution.Simple.Utils              ( die, debug, notice, info, warn
 import Distribution.Package                   ( Package(..) )
 import Distribution.System                    ( Platform )
 import Distribution.Text                      ( display )
-import Distribution.Verbosity                 ( Verbosity, lessVerbose )
+import Distribution.Verbosity                 ( Verbosity )
 import Distribution.Compat.Environment        ( lookupEnv, setEnv )
 import Distribution.Client.Compat.FilePerms   ( setFileHidden )
 import qualified Distribution.Client.Sandbox.Index as Index
@@ -683,25 +682,25 @@ reinstallAddSourceDeps verbosity configFlags' configExFlags
                          comp platform progdb sandboxDir $ \sandboxPkgInfo ->
     unless (null $ modifiedAddSourceDependencies sandboxPkgInfo) $ do
 
-     withRepoContext verbosity globalFlags $ \repoContext -> do
-      let args :: InstallArgs
-          args = ((configPackageDB' configFlags)
-                 ,repoContext
-                 ,comp, platform, progdb
-                 ,UseSandbox sandboxDir, Just sandboxPkgInfo
-                 ,globalFlags, configFlags, configExFlags, installFlags
-                 ,haddockFlags)
-
-      -- This can actually be replaced by a call to 'install', but we use a
-      -- lower-level API because of layer separation reasons. Additionally, we
-      -- might want to use some lower-level features this in the future.
-      withSandboxBinDirOnSearchPath sandboxDir $ do
-        installContext <- makeInstallContext verbosity args Nothing
-        installPlan    <- foldProgress logMsg die' return =<<
-                          makeInstallPlan verbosity args installContext
-
-        processInstallPlan verbosity args installContext installPlan
-        writeIORef retVal ReinstalledSomeDeps
+      withRepoContext verbosity globalFlags $ \repoContext -> do
+        let args :: InstallArgs
+            args = ((configPackageDB' configFlags)
+                  ,repoContext
+                  ,comp, platform, progdb
+                  ,UseSandbox sandboxDir, Just sandboxPkgInfo
+                  ,globalFlags, configFlags, configExFlags, installFlags
+                  ,haddockFlags)
+
+        -- This can actually be replaced by a call to 'install', but we use a
+        -- lower-level API because of layer separation reasons. Additionally, we
+        -- might want to use some lower-level features this in the future.
+        withSandboxBinDirOnSearchPath sandboxDir $ do
+          installContext <- makeInstallContext verbosity args Nothing
+          installPlan    <- foldProgress logMsg die' return =<<
+                            makeInstallPlan verbosity args installContext
+
+          processInstallPlan verbosity args installContext installPlan
+          writeIORef retVal ReinstalledSomeDeps
 
   readIORef retVal
 
@@ -856,22 +855,6 @@ maybeReinstallAddSourceDeps verbosity numJobsFlag configFlags'
 --
 -- Utils (transitionary)
 --
--- FIXME: configPackageDB' and configCompilerAux' don't really belong in this
--- module
---
-
-configPackageDB' :: ConfigFlags -> PackageDBStack
-configPackageDB' cfg =
-    interpretPackageDbFlags userInstall (configPackageDBs cfg)
-  where
-    userInstall = fromFlagOrDefault True (configUserInstall cfg)
-
-configCompilerAux' :: ConfigFlags
-                   -> IO (Compiler, Platform, ProgramDb)
-configCompilerAux' configFlags =
-  configCompilerAuxEx configFlags
-    --FIXME: make configCompilerAux use a sensible verbosity
-    { configVerbosity = fmap lessVerbose (configVerbosity configFlags) }
 
 -- | Try to read the most recently configured compiler from the
 -- 'localBuildInfoFile', falling back on 'configCompilerAuxEx' if it

cabal-install/Distribution/Client/Setup.hs

@@ -18,6 +18,7 @@ module Distribution.Client.Setup
     ( globalCommand, GlobalFlags(..), defaultGlobalFlags
     , RepoContext(..), withRepoContext
     , configureCommand, ConfigFlags(..), filterConfigureFlags
+    , configPackageDB', configCompilerAux'
     , configureExCommand, ConfigExFlags(..), defaultConfigExFlags
                         , configureExOptions
     , buildCommand, BuildFlags(..), BuildExFlags(..), SkipAddSourceDepsCheck(..)
@@ -70,11 +71,12 @@ import Distribution.Utils.NubList
 import Distribution.Solver.Types.ConstraintSource
 import Distribution.Solver.Types.Settings
 
-import Distribution.Simple.Compiler (PackageDB)
-import Distribution.Simple.Program
-         ( defaultProgramDb )
+import Distribution.Simple.Compiler ( Compiler, PackageDB, PackageDBStack )
+import Distribution.Simple.Program (ProgramDb, defaultProgramDb)
 import Distribution.Simple.Command hiding (boolOpt, boolOpt')
 import qualified Distribution.Simple.Command as Command
+import Distribution.Simple.Configure
+       ( configCompilerAuxEx, interpretPackageDbFlags )
 import qualified Distribution.Simple.Setup as Cabal
 import Distribution.Simple.Setup
          ( ConfigFlags(..), BuildFlags(..), ReplFlags
@@ -94,6 +96,7 @@ import Distribution.Package
          ( PackageIdentifier, packageName, packageVersion, Dependency(..) )
 import Distribution.PackageDescription
          ( BuildType(..), RepoKind(..) )
+import Distribution.System ( Platform )
 import Distribution.Text
          ( Text(..), display )
 import Distribution.ReadE
@@ -102,7 +105,7 @@ import qualified Distribution.Compat.ReadP as Parse
          ( ReadP, char, munch1, pfail,  (+++) )
 import Distribution.Compat.Semigroup
 import Distribution.Verbosity
-         ( Verbosity, normal )
+         ( Verbosity, lessVerbose, normal )
 import Distribution.Simple.Utils
          ( wrapText, wrapLine )
 import Distribution.Client.GlobalFlags
@@ -416,6 +419,18 @@ filterConfigureFlags flags cabalLibVersion
     -- Cabal < 1.3.10 does not grok the '--constraints' flag.
     flags_1_3_10 = flags_1_10_0 { configConstraints = [] }
 
+configPackageDB' :: ConfigFlags -> PackageDBStack
+configPackageDB' cfg =
+    interpretPackageDbFlags userInstall (configPackageDBs cfg)
+  where
+    userInstall = Cabal.fromFlagOrDefault True (configUserInstall cfg)
+
+configCompilerAux' :: ConfigFlags -> IO (Compiler, Platform, ProgramDb)
+configCompilerAux' configFlags =
+  configCompilerAuxEx configFlags
+    --FIXME: make configCompilerAux use a sensible verbosity
+    { configVerbosity = fmap lessVerbose (configVerbosity configFlags) }
+
 -- ------------------------------------------------------------
 -- * Config extra flags
 -- ------------------------------------------------------------

cabal-install/Main.hs

@@ -19,6 +19,7 @@ import Distribution.Client.Setup
          ( GlobalFlags(..), globalCommand, withRepoContext
          , ConfigFlags(..)
          , ConfigExFlags(..), defaultConfigExFlags, configureExCommand
+         , configCompilerAux', configPackageDB'
          , BuildFlags(..), BuildExFlags(..), SkipAddSourceDepsCheck(..)
          , buildCommand, replCommand, testCommand, benchmarkCommand
          , InstallFlags(..), defaultInstallFlags
@@ -107,9 +108,7 @@ import Distribution.Client.Sandbox            (sandboxInit
                                               ,updateSandboxConfigFileFlag
                                               ,updateInstallDirs
 
-                                              ,configCompilerAux'
-                                              ,getPersistOrConfigCompiler
-                                              ,configPackageDB')
+                                              ,getPersistOrConfigCompiler)
 import Distribution.Client.Sandbox.PackageEnvironment
                                               (setPackageDB
                                               ,userPackageEnvironmentFile)