Commit 864ddbbd authored by ttuegel's avatar ttuegel

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

parent 3f3cb7a8
......@@ -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
......
......@@ -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
-- ------------------------------------------------------------
......
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment