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