Commit 12b222af authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Extend HcPkg.init support for dir-style package dbs

The HcPkgInfo useSingleFileDb is split into two: supportsDirDbs and
requiresDirDbs. Then rather than HcPkg.init callers having to do the
writeFile [] thing, HcPkg.init does it itself automatically based on the
HcPkgInfo. In the case that supportsDirDbs is True but requiresDirDbs is
False then we have a choice, to use dir style or file style. For
compatability reasons, when using ghc/ghc-pkg for the inplace package db
we want to use the old file style, even though dir style is supported.
However in other circumstances (e.g. in places in cabal-install) we
would like to use the dir style if it's supported, and there are no
backwards compat issues. So HcPkg.init gains a new Bool arg to request
using the file style if it's still supported. Only this mode is used
within Cabal itself, but the non-compat mode is available for other
users.

The compiler-independent initPackageDB is left with the same old
behaviour, but a new createPackageDB has the extra compat argument
(which is only passed to hc-pkg for ghc-pkg).
parent dee7e0a5
......@@ -486,9 +486,7 @@ createInternalPackageDB verbosity lbi distPref = do
then removeDirectoryRecursive dbPath
else do file_exists <- doesFileExist dbPath
when file_exists $ removeFile dbPath
if HcPkg.useSingleFileDb hpi
then writeFile dbPath "[]"
else HcPkg.init hpi verbosity dbPath
HcPkg.init hpi verbosity True dbPath
return packageDB
addInternalBuildTools :: PackageDescription -> LocalBuildInfo -> BuildInfo
......
......@@ -1119,7 +1119,8 @@ hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcPkgProg
, HcPkg.noPkgDbStack = v < [6,9]
, HcPkg.noVerboseFlag = v < [6,11]
, HcPkg.flagPackageConf = v < [7,5]
, HcPkg.useSingleFileDb = v < [7,9]
, HcPkg.supportsDirDbs = v >= [6,8]
, HcPkg.requiresDirDbs = v >= [7,10]
}
where
v = versionBranch ver
......
......@@ -869,7 +869,8 @@ hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcjsPkgProg
, HcPkg.noPkgDbStack = False
, HcPkg.noVerboseFlag = False
, HcPkg.flagPackageConf = False
, HcPkg.useSingleFileDb = v < [7,9]
, HcPkg.supportsDirDbs = True
, HcPkg.requiresDirDbs = v >= [7,10]
}
where
v = versionBranch ver
......
......@@ -787,7 +787,8 @@ hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = lhcPkgProg
, HcPkg.noPkgDbStack = False
, HcPkg.noVerboseFlag = False
, HcPkg.flagPackageConf = False
, HcPkg.useSingleFileDb = True
, HcPkg.supportsDirDbs = True
, HcPkg.requiresDirDbs = True
}
where
Just lhcPkgProg = lookupProgram lhcPkgProgram conf
......@@ -75,16 +75,22 @@ data HcPkgInfo = HcPkgInfo
, noPkgDbStack :: Bool -- ^ no package DB stack supported
, noVerboseFlag :: Bool -- ^ hc-pkg does not support verbosity flags
, flagPackageConf :: Bool -- ^ use package-conf option instead of package-db
, useSingleFileDb :: Bool -- ^ requires single file package database
, supportsDirDbs :: Bool -- ^ supports directory style package databases
, requiresDirDbs :: Bool -- ^ requires directory style package databases
}
-- | Call @hc-pkg@ to initialise a package database at the location {path}.
--
-- > hc-pkg init {path}
--
init :: HcPkgInfo -> Verbosity -> FilePath -> IO ()
init hpi verbosity path =
runProgramInvocation verbosity (initInvocation hpi verbosity path)
init :: HcPkgInfo -> Verbosity -> Bool -> FilePath -> IO ()
init hpi verbosity preferCompat path
| not (supportsDirDbs hpi)
|| (not (requiresDirDbs hpi) && preferCompat)
= writeFile path "[]"
| otherwise
= runProgramInvocation verbosity (initInvocation hpi verbosity path)
-- | Run @hc-pkg@ using a given package DB stack, directly forwarding the
-- provided command-line arguments to it.
......
......@@ -208,15 +208,23 @@ relocRegistrationInfo verbosity pkg lib lbi clbi abi_hash packageDb =
_ -> die "Distribution.Simple.Register.relocRegistrationInfo: \
\not implemented for this compiler"
initPackageDB :: Verbosity -> Compiler -> ProgramConfiguration -> FilePath -> IO ()
initPackageDB verbosity comp progdb dbPath =
createPackageDB verbosity comp progdb True dbPath
-- | Create an empty package DB at the specified location.
initPackageDB :: Verbosity -> Compiler -> ProgramConfiguration -> FilePath
-> IO ()
initPackageDB verbosity comp conf dbPath =
createPackageDB :: Verbosity -> Compiler -> ProgramConfiguration -> Bool
-> FilePath -> IO ()
createPackageDB verbosity comp progdb preferCompat dbPath =
case compilerFlavor comp of
HaskellSuite {} -> HaskellSuite.initPackageDB verbosity conf dbPath
_ -> withHcPkg "Distribution.Simple.Register.initPackageDB: \
\not implemented for this compiler" comp conf
(\hpi -> HcPkg.init hpi verbosity dbPath)
GHC -> HcPkg.init (GHC.hcPkgInfo progdb) verbosity preferCompat dbPath
GHCJS -> HcPkg.init (GHCJS.hcPkgInfo progdb) verbosity False dbPath
LHC -> HcPkg.init (LHC.hcPkgInfo progdb) verbosity False dbPath
UHC -> return ()
HaskellSuite _ -> HaskellSuite.initPackageDB verbosity progdb dbPath
_ -> die $ "Distribution.Simple.Register.createPackageDB: "
++ "not implemented for this compiler"
-- | Run @hc-pkg@ using a given package DB stack, directly forwarding the
-- provided command-line arguments to it.
......
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