Commit 007ad5c7 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Use the PackageDbStack in the local build info and compiler modules

This lets us pass a whole stack of package databases to the compiler.
This is more flexible than passing just one and working out what
other dbs that implies. This also lets us us more than one specific
package db, which we need for the inplace package db use case.
parent 0a0ff024
......@@ -56,6 +56,7 @@ module Distribution.Simple.Compiler (
-- * Support for package databases
PackageDB(..),
PackageDBStack,
registrationPackageDB,
-- * Support for optimisation levels
OptimisationLevel(..),
......@@ -124,6 +125,13 @@ data PackageDB = GlobalPackageDB
--
type PackageDBStack = [PackageDB]
-- | Return the package that we should register into. This is the package db at
-- the top of the stack.
--
registrationPackageDB :: PackageDBStack -> PackageDB
registrationPackageDB [] = error "internal error: empty package db set"
registrationPackageDB dbs = last dbs
-- ------------------------------------------------------------
-- * Optimisation levels
-- ------------------------------------------------------------
......
......@@ -280,10 +280,8 @@ configure (e_pkg_descr, pbi) cfg
. userSpecifyPaths (configProgramPaths cfg)
$ configPrograms cfg
userInstall = fromFlag (configUserInstall cfg)
defaultPackageDB | userInstall = UserPackageDB
| otherwise = GlobalPackageDB
packageDb = fromFlagOrDefault defaultPackageDB
(configPackageDB cfg)
packageDbs = implicitPackageDbStack userInstall
(flagToMaybe $ configPackageDB cfg)
-- detect compiler
(comp, programsConfig') <- configCompiler
......@@ -312,7 +310,7 @@ configure (e_pkg_descr, pbi) cfg
Installed.package = package pkg_descr0
} ]
maybeInstalledPackageSet <- getInstalledPackages (lessVerbose verbosity) comp
(implicitPackageDbStack packageDb) programsConfig'
packageDbs programsConfig'
-- The merge of the internal and installed packages
let maybePackageSet = (`PackageIndex.merge` internalPackageSet)
`fmap` maybeInstalledPackageSet
......@@ -480,7 +478,7 @@ configure (e_pkg_descr, pbi) cfg
withGHCiLib = fromFlag $ configGHCiLib cfg,
splitObjs = split_objs,
stripExes = fromFlag $ configStripExes cfg,
withPackageDB = packageDb,
withPackageDB = packageDbs,
progPrefix = fromFlag $ configProgPrefix cfg,
progSuffix = fromFlag $ configProgSuffix cfg
}
......@@ -607,11 +605,14 @@ getInstalledPackages verbosity comp packageDBs progconf = do
-- stack of 'PackageDB's explictly as a list. This function converts encodes
-- the package db stack implicit in a single packagedb.
--
implicitPackageDbStack :: PackageDB -> PackageDBStack
implicitPackageDbStack packageDB = case packageDB of
GlobalPackageDB -> [GlobalPackageDB]
UserPackageDB -> [GlobalPackageDB, UserPackageDB]
SpecificPackageDB p -> [GlobalPackageDB, SpecificPackageDB p]
implicitPackageDbStack :: Bool -> Maybe PackageDB -> PackageDBStack
implicitPackageDbStack userInstall maybePackageDB
| userInstall = GlobalPackageDB : UserPackageDB : extra
| otherwise = GlobalPackageDB : extra
where
extra = case maybePackageDB of
Just (SpecificPackageDB db) -> [SpecificPackageDB db]
_ -> []
newPackageDepsBehaviourMinVersion :: Version
newPackageDepsBehaviourMinVersion = Version { versionBranch = [1,7,1], versionTags = [] }
......
......@@ -743,11 +743,7 @@ ghcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> [String]
ghcOptions lbi bi clbi odir
= ["-hide-all-packages"]
++ (case withPackageDB lbi of
GlobalPackageDB -> ["-no-user-package-conf"]
UserPackageDB -> []
SpecificPackageDB db -> ["-no-user-package-conf"
,"-package-conf", db])
++ ghcPackageDbOptions (withPackageDB lbi)
++ (if splitObjs lbi then ["-split-objs"] else [])
++ ["-i"]
++ ["-i" ++ odir]
......@@ -771,6 +767,17 @@ ghcOptions lbi bi clbi odir
++ extensionsToFlags c (extensions bi)
where c = compiler lbi
ghcPackageDbOptions :: PackageDBStack -> [String]
ghcPackageDbOptions dbstack = case dbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
(GlobalPackageDB:dbs) -> "-no-user-package-conf"
: concatMap specific dbs
_ -> ierror
where
specific (SpecificPackageDB db) = [ "-package-conf", db ]
specific _ = ierror
ierror = error "internal error: unexpected package db stack"
constructCcCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath -> Verbosity -> (FilePath,[String])
constructCcCmdLine lbi bi clbi pref filename verbosity
......@@ -789,9 +796,7 @@ ghcCcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> [String]
ghcCcOptions lbi bi clbi odir
= ["-I" ++ dir | dir <- PD.includeDirs bi]
++ (case withPackageDB lbi of
SpecificPackageDB db -> ["-package-conf", db]
_ -> [])
++ ghcPackageDbOptions (withPackageDB lbi)
++ concat [ ["-package", display pkg] | pkg <- componentPackageDeps clbi ]
++ ["-optc" ++ opt | opt <- PD.ccOptions bi]
++ (case withOptimization lbi of
......
......@@ -608,11 +608,7 @@ ghcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> [String]
ghcOptions lbi bi clbi odir
= ["-hide-all-packages"]
++ (case withPackageDB lbi of
GlobalPackageDB -> ["-no-user-package-conf"]
UserPackageDB -> []
SpecificPackageDB db -> ["-no-user-package-conf"
,"-package-conf", db])
++ ghcPackageDbOptions (withPackageDB lbi)
++ (if splitObjs lbi then ["-split-objs"] else [])
++ ["-i"]
++ ["-i" ++ odir]
......@@ -636,6 +632,17 @@ ghcOptions lbi bi clbi odir
++ extensionsToFlags c (extensions bi)
where c = compiler lbi
ghcPackageDbOptions :: PackageDBStack -> [String]
ghcPackageDbOptions dbstack = case dbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
(GlobalPackageDB:dbs) -> "-no-user-package-conf"
: concatMap specific dbs
_ -> ierror
where
specific (SpecificPackageDB db) = [ "-package-conf", db ]
specific _ = ierror
ierror = error "internal error: unexpected package db stack"
constructCcCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath -> Verbosity -> (FilePath,[String])
constructCcCmdLine lbi bi clbi pref filename verbosity
......@@ -654,9 +661,7 @@ ghcCcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> [String]
ghcCcOptions lbi bi clbi odir
= ["-I" ++ dir | dir <- PD.includeDirs bi]
++ (case withPackageDB lbi of
SpecificPackageDB db -> ["-package-conf", db]
_ -> [])
++ ghcPackageDbOptions (withPackageDB lbi)
++ concat [ ["-package", display pkg] | pkg <- componentPackageDeps clbi ]
++ ["-optc" ++ opt | opt <- PD.ccOptions bi]
++ (case withOptimization lbi of
......
......@@ -69,7 +69,7 @@ import Distribution.PackageDescription
, Executable(exeName) )
import Distribution.Package (PackageId, Package(..))
import Distribution.Simple.Compiler
( Compiler(..), PackageDB, OptimisationLevel )
( Compiler(..), PackageDBStack, OptimisationLevel )
import Distribution.Simple.PackageIndex (PackageIndex)
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import Distribution.Simple.Utils
......@@ -99,7 +99,7 @@ data LocalBuildInfo = LocalBuildInfo {
-- ^ The resolved package description, that does not contain
-- any conditionals.
withPrograms :: ProgramConfiguration, -- ^Location and args for all programs
withPackageDB :: PackageDB, -- ^What package database to use, global\/user
withPackageDB :: PackageDBStack, -- ^What package database to use, global\/user
withVanillaLib:: Bool, -- ^Whether to build normal libs.
withProfLib :: Bool, -- ^Whether to build profiling versions of libs.
withSharedLib :: Bool, -- ^Whether to build shared versions of libs.
......
......@@ -66,7 +66,8 @@ import Distribution.Simple.LocalBuildInfo
, InstallDirs(..), absoluteInstallDirs )
import Distribution.Simple.BuildPaths (haddockName)
import Distribution.Simple.Compiler
( CompilerFlavor(..), compilerFlavor, PackageDB(..) )
( CompilerFlavor(..), compilerFlavor
, PackageDB(..), registrationPackageDB )
import Distribution.Simple.Program (ConfiguredProgram, programPath,
programArgs, rawSystemProgram,
lookupProgram, ghcPkgProgram, lhcPkgProgram)
......@@ -129,7 +130,8 @@ register pkg_descr lbi regFlags
genPkgConfigFile = fromMaybe genPkgConfigDefault
(fromFlag (regGenPkgConf regFlags))
verbosity = fromFlag (regVerbosity regFlags)
packageDB = fromFlagOrDefault (withPackageDB lbi) (regPackageDB regFlags)
packageDB = fromFlagOrDefault (registrationPackageDB (withPackageDB lbi))
(regPackageDB regFlags)
inplace = fromFlag (regInPlace regFlags)
message | genPkgConf = "Writing package registration file: "
++ genPkgConfigFile ++ " for"
......@@ -334,7 +336,8 @@ unregister :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
unregister pkg_descr lbi regFlags = do
let genScript = fromFlag (regGenScript regFlags)
verbosity = fromFlag (regVerbosity regFlags)
packageDB = fromFlagOrDefault (withPackageDB lbi) (regPackageDB regFlags)
packageDB = fromFlagOrDefault (registrationPackageDB (withPackageDB lbi))
(regPackageDB regFlags)
installDirs = absoluteInstallDirs (packageId pkg_descr) lbi NoCopyDest
setupMessage verbosity "Unregistering" (packageId pkg_descr)
case compilerFlavor (compiler lbi) of
......
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