Commit 841dc4e6 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Registering packages needs all the package dbs listed

Important for the case of registering inplace when we're using a
specific package db, e.g. when doing isolated builds.
parent 2d625f40
......@@ -123,7 +123,8 @@ build pkg_descr lbi flags suffixes = do
-- Register the library in-place, so exes can depend
-- on internally defined libraries.
registerPackage verbosity
installedPkgInfo pkg_descr lbi True{-inplace-} internalPackageDB
installedPkgInfo pkg_descr lbi True -- True meaning inplace
(withPackageDB lbi ++ [internalPackageDB])
-- Use the internal package db for the exes.
let lbi' = lbi { withPackageDB = withPackageDB lbi ++ [internalPackageDB] }
......
......@@ -105,7 +105,7 @@ compilerVersion = (\(CompilerId _ v) -> v) . compilerId
data PackageDB = GlobalPackageDB
| UserPackageDB
| SpecificPackageDB FilePath
deriving (Eq, Show, Read)
deriving (Eq, Ord, Show, Read)
-- | We typically get packages from several databases, and stack them
-- together. This type lets us be explicit about that stacking. For example
......
......@@ -66,7 +66,8 @@ module Distribution.Simple.GHC (
installLib, installExe,
libAbiHash,
ghcOptions,
ghcVerbosityOptions
ghcVerbosityOptions,
ghcPackageDbOptions,
) where
import qualified Distribution.Simple.GHC.IPI641 as IPI641
......@@ -795,15 +796,14 @@ ghcPackageFlags lbi clbi
ghcPackageDbOptions :: PackageDBStack -> [String]
ghcPackageDbOptions dbstack = case dbstack of
(GlobalPackageDB:dbs)
| UserPackageDB `elem` dbs -> concatMap specific dbs
| otherwise -> "-no-user-package-conf"
: concatMap specific dbs
_ -> ierror
where
(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 = error "internal error: unexpected package db stack"
specific _ = ierror
ierror = error "internal error: unexpected package db stack"
constructCcCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath -> Verbosity -> Bool
......
......@@ -34,7 +34,7 @@ import Distribution.InstalledPackageInfo
import Distribution.ParseUtils
( ParseResult(..) )
import Distribution.Simple.Compiler
( PackageDB(..) )
( PackageDB(..), PackageDBStack )
import Distribution.Simple.Program.Types
( ConfiguredProgram(programId, programVersion) )
import Distribution.Simple.Program.Run
......@@ -58,7 +58,7 @@ import Control.Monad
--
-- > hc-pkg register {filename | -} [--user | --global | --package-conf]
--
register :: Verbosity -> ConfiguredProgram -> PackageDB
register :: Verbosity -> ConfiguredProgram -> PackageDBStack
-> Either FilePath
InstalledPackageInfo
-> IO ()
......@@ -71,7 +71,7 @@ register verbosity hcPkg packagedb pkgFile =
--
-- > hc-pkg register {filename | -} [--user | --global | --package-conf]
--
reregister :: Verbosity -> ConfiguredProgram -> PackageDB
reregister :: Verbosity -> ConfiguredProgram -> PackageDBStack
-> Either FilePath
InstalledPackageInfo
-> IO ()
......@@ -164,7 +164,7 @@ setInstalledPackageId pkginfo = pkginfo
--
registerInvocation, reregisterInvocation
:: ConfiguredProgram -> Verbosity -> PackageDB
:: ConfiguredProgram -> Verbosity -> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> ProgramInvocation
registerInvocation = registerInvocation' "register"
......@@ -172,22 +172,22 @@ reregisterInvocation = registerInvocation' "update"
registerInvocation' :: String
-> ConfiguredProgram -> Verbosity -> PackageDB
-> ConfiguredProgram -> Verbosity -> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> ProgramInvocation
registerInvocation' cmdname hcPkg verbosity packagedb (Left pkgFile) =
registerInvocation' cmdname hcPkg verbosity packagedbs (Left pkgFile) =
programInvocation hcPkg args
where
args = [cmdname, pkgFile, packageDbOpts packagedb]
args = [cmdname, pkgFile] ++ packageDbStackOpts packagedbs
++ verbosityOpts hcPkg verbosity
registerInvocation' cmdname hcPkg verbosity packagedb (Right pkgInfo) =
registerInvocation' cmdname hcPkg verbosity packagedbs (Right pkgInfo) =
(programInvocation hcPkg args) {
progInvokeInput = Just (showInstalledPackageInfo pkgInfo),
progInvokeInputEncoding = IOEncodingUTF8
}
where
args = [cmdname, "-", packageDbOpts packagedb]
args = [cmdname, "-"] ++ packageDbStackOpts packagedbs
++ verbosityOpts hcPkg verbosity
......@@ -227,6 +227,20 @@ dumpInvocation hcPkg verbosity packagedb =
++ verbosityOpts hcPkg verbosity
packageDbStackOpts :: PackageDBStack -> [String]
packageDbStackOpts dbstack = case dbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> "--global"
: "--user"
: map specific dbs
(GlobalPackageDB:dbs) -> "--global"
: "--no-user-package-conf"
: map specific dbs
_ -> ierror
where
specific (SpecificPackageDB db) = "--package-conf=" ++ db
specific _ = ierror
ierror = error "internal error: unexpected package db stack"
packageDbOpts :: PackageDB -> String
packageDbOpts GlobalPackageDB = "--global"
packageDbOpts UserPackageDB = "--user"
......
......@@ -71,7 +71,7 @@ import Distribution.Simple.BuildPaths (haddockName)
import qualified Distribution.Simple.GHC as GHC
import Distribution.Simple.Compiler
( compilerVersion, CompilerFlavor(..), compilerFlavor
, PackageDB(..), registrationPackageDB )
, PackageDBStack, registrationPackageDB )
import Distribution.Simple.Program
( ConfiguredProgram, runProgramInvocation
, requireProgram, lookupProgram, ghcPkgProgram, lhcPkgProgram )
......@@ -109,7 +109,7 @@ import System.IO.Error (try)
import Control.Monad (when)
import Data.Maybe
( isJust, fromMaybe )
( isJust, fromMaybe, maybeToList )
import Data.List (partition)
......@@ -131,7 +131,7 @@ register pkg@PackageDescription { library = Just lib }
_ | modeGenerateRegFile -> writeRegistrationFile installedPkgInfo
| modeGenerateRegScript -> writeRegisterScript installedPkgInfo
| otherwise -> registerPackage verbosity
installedPkgInfo pkg lbi inplace packageDb
installedPkgInfo pkg lbi inplace packageDbs
where
modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))
......@@ -141,8 +141,8 @@ register pkg@PackageDescription { library = Just lib }
modeGenerateRegScript = fromFlag (regGenScript regFlags)
inplace = fromFlag (regInPlace regFlags)
packageDb = fromFlagOrDefault (registrationPackageDB (withPackageDB lbi))
(regPackageDB regFlags)
packageDbs = withPackageDB lbi
++ maybeToList (flagToMaybe (regPackageDB regFlags))
distPref = fromFlag (regDistPref regFlags)
verbosity = fromFlag (regVerbosity regFlags)
......@@ -153,9 +153,9 @@ register pkg@PackageDescription { library = Just lib }
writeRegisterScript installedPkgInfo =
case compilerFlavor (compiler lbi) of
GHC -> do (ghcPkg, _) <- requireProgram verbosity ghcPkgProgram (withPrograms lbi)
writeHcPkgRegisterScript verbosity installedPkgInfo ghcPkg packageDb
writeHcPkgRegisterScript verbosity installedPkgInfo ghcPkg packageDbs
LHC -> do (lhcPkg, _) <- requireProgram verbosity lhcPkgProgram (withPrograms lbi)
writeHcPkgRegisterScript verbosity installedPkgInfo lhcPkg packageDb
writeHcPkgRegisterScript verbosity installedPkgInfo lhcPkg packageDbs
Hugs -> notice verbosity "Registration scripts not needed for hugs"
JHC -> notice verbosity "Registration scripts not needed for jhc"
NHC -> notice verbosity "Registration scripts not needed for nhc98"
......@@ -203,14 +203,14 @@ registerPackage :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDB
-> PackageDBStack
-> IO ()
registerPackage verbosity installedPkgInfo pkg lbi inplace packageDb = do
registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs = do
setupMessage verbosity "Registering" (packageId pkg)
case compilerFlavor (compiler lbi) of
GHC -> registerPackageGHC verbosity installedPkgInfo pkg lbi inplace packageDb
LHC -> registerPackageLHC verbosity installedPkgInfo pkg lbi inplace packageDb
Hugs -> registerPackageHugs verbosity installedPkgInfo pkg lbi inplace packageDb
GHC -> registerPackageGHC verbosity installedPkgInfo pkg lbi inplace packageDbs
LHC -> registerPackageLHC verbosity installedPkgInfo pkg lbi inplace packageDbs
Hugs -> registerPackageHugs verbosity installedPkgInfo pkg lbi inplace packageDbs
JHC -> notice verbosity "Registering for jhc (nothing to do)"
NHC -> notice verbosity "Registering for nhc98 (nothing to do)"
_ -> die "Registering is not implemented for this compiler"
......@@ -222,17 +222,17 @@ registerPackageGHC, registerPackageLHC, registerPackageHugs
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDB
-> PackageDBStack
-> IO ()
registerPackageGHC verbosity installedPkgInfo _pkg lbi _inplace packageDb = do
registerPackageGHC verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi)
HcPkg.reregister verbosity ghcPkg packageDb (Right installedPkgInfo)
HcPkg.reregister verbosity ghcPkg packageDbs (Right installedPkgInfo)
registerPackageLHC verbosity installedPkgInfo _pkg lbi _inplace packageDb = do
registerPackageLHC verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
let Just lhcPkg = lookupProgram lhcPkgProgram (withPrograms lbi)
HcPkg.reregister verbosity lhcPkg packageDb (Right installedPkgInfo)
HcPkg.reregister verbosity lhcPkg packageDbs (Right installedPkgInfo)
registerPackageHugs verbosity installedPkgInfo pkg lbi inplace _packageDb = do
registerPackageHugs verbosity installedPkgInfo pkg lbi inplace _packageDbs = do
when inplace $ die "--inplace is not supported with Hugs"
let installDirs = absoluteInstallDirs pkg lbi NoCopyDest
createDirectoryIfMissingVerbose verbosity True (libdir installDirs)
......@@ -243,11 +243,11 @@ registerPackageHugs verbosity installedPkgInfo pkg lbi inplace _packageDb = do
writeHcPkgRegisterScript :: Verbosity
-> InstalledPackageInfo
-> ConfiguredProgram
-> PackageDB
-> PackageDBStack
-> IO ()
writeHcPkgRegisterScript verbosity installedPkgInfo hcPkg packageDb = do
writeHcPkgRegisterScript verbosity installedPkgInfo hcPkg packageDbs = do
let invocation = HcPkg.reregisterInvocation hcPkg Verbosity.normal
packageDb (Right installedPkgInfo)
packageDbs (Right installedPkgInfo)
regScript = invocationAsSystemScript buildOS invocation
notice verbosity ("Creating package registration script: " ++ regScriptFileName)
......
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