Commit 9e030da8 authored by pcapriotti's avatar pcapriotti
Browse files

Adapt to change in GHC package db flags.

GHC and ghc-pkg package db flags changed from '*-package-conf' to
'*-package-db' in 7.5.  This commit follows the change and introduces a
version check whenever those flags are used.
parent 85f959ab
......@@ -241,7 +241,7 @@ getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
getInstalledPackages verbosity packagedbs conf = do
checkPackageDbStack packagedbs
pkgss <- getInstalledPackages' verbosity packagedbs conf
pkgss <- getInstalledPackages' lhcPkg verbosity packagedbs conf
let indexes = [ PackageIndex.fromList (map (substTopDir topDir) pkgs)
| (_, pkgs) <- pkgss ]
return $! (mconcat indexes)
......@@ -251,6 +251,7 @@ getInstalledPackages verbosity packagedbs conf = do
-- paths. We need to substitute the right value in so that when
-- we, for example, call gcc, we have proper paths to give it
Just ghcProg = lookupProgram lhcProgram conf
Just lhcPkg = lookupProgram lhcPkgProgram conf
compilerDir = takeDirectory (programPath ghcProg)
topDir = takeDirectory compilerDir
......@@ -263,9 +264,10 @@ checkPackageDbStack _ =
-- | Get the packages from specific PackageDBs, not cumulative.
--
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs conf
getInstalledPackages' :: ConfiguredProgram -> Verbosity
-> [PackageDB] -> ProgramConfiguration
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' lhcPkg verbosity packagedbs conf
=
sequence
[ do str <- rawSystemProgramStdoutConf verbosity lhcPkgProgram conf
......@@ -294,7 +296,13 @@ getInstalledPackages' verbosity packagedbs conf
packageDbGhcPkgFlag GlobalPackageDB = "--global"
packageDbGhcPkgFlag UserPackageDB = "--user"
packageDbGhcPkgFlag (SpecificPackageDB path) = "--package-conf=" ++ path
packageDbGhcPkgFlag (SpecificPackageDB path) = "--" ++ packageDbFlag ++ "=" ++ path
packageDbFlag
| programVersion lhcPkg < Just (Version [7,5] [])
= "package-conf"
| otherwise
= "package-db"
substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
......@@ -607,7 +615,7 @@ ghcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> [String]
ghcOptions lbi bi clbi odir
= ["-hide-all-packages"]
++ ghcPackageDbOptions (withPackageDB lbi)
++ ghcPackageDbOptions lbi
++ (if splitObjs lbi then ["-split-objs"] else [])
++ ["-i"]
++ ["-i" ++ odir]
......@@ -643,17 +651,24 @@ ghcPackageFlags lbi clbi
where
ghcVer = compilerVersion (compiler lbi)
ghcPackageDbOptions :: PackageDBStack -> [String]
ghcPackageDbOptions dbstack = case dbstack of
ghcPackageDbOptions :: LocalBuildInfo -> [String]
ghcPackageDbOptions lbi = case dbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
(GlobalPackageDB:dbs) -> "-no-user-package-conf"
(GlobalPackageDB:dbs) -> ("-no-user-" ++ packageDbFlag)
: concatMap specific dbs
_ -> ierror
where
specific (SpecificPackageDB db) = [ "-package-conf", db ]
specific (SpecificPackageDB db) = [ '-':packageDbFlag, db ]
specific _ = ierror
ierror = error ("internal error: unexpected package db stack: " ++ show dbstack)
dbstack = withPackageDB lbi
packageDbFlag
| compilerVersion (compiler lbi) < Version [7,5] []
= "package-conf"
| otherwise
= "package-db"
constructCcCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath -> Verbosity -> (FilePath,[String])
constructCcCmdLine lbi bi clbi pref filename verbosity
......@@ -672,7 +687,7 @@ ghcCcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> [String]
ghcCcOptions lbi bi clbi odir
= ["-I" ++ dir | dir <- PD.includeDirs bi]
++ ghcPackageDbOptions (withPackageDB lbi)
++ ghcPackageDbOptions lbi
++ ghcPackageFlags lbi clbi
++ ["-optc" ++ opt | opt <- PD.ccOptions bi]
++ (case withOptimization lbi of
......
......@@ -205,7 +205,7 @@ ghcInvocation prog@ConfiguredProgram { programVersion = Just ver } opts =
renderGhcOptions :: Version -> GhcOptions -> [String]
renderGhcOptions (Version ver _) opts =
renderGhcOptions version@(Version ver _) opts =
concat
[ case flagToMaybe (ghcOptMode opts) of
Nothing -> []
......@@ -291,7 +291,7 @@ renderGhcOptions (Version ver _) opts =
, [ "-hide-all-packages" | flagBool ghcOptHideAllPackages ]
, [ "-no-auto-link-packages" | flagBool ghcOptNoAutoLinkPackages ]
, packageDbArgs (flags ghcOptPackageDBs)
, packageDbArgs version (flags ghcOptPackageDBs)
, concat $ if ver >= [6,11]
then [ ["-package-id", display ipkgid] | (ipkgid,_) <- flags ghcOptPackages ]
......@@ -343,18 +343,24 @@ verbosityOpts verbosity
| otherwise = ["-w", "-v0"]
packageDbArgs :: PackageDBStack -> [String]
packageDbArgs dbstack = case dbstack of
packageDbArgs :: Version -> PackageDBStack -> [String]
packageDbArgs (Version ver _) dbstack = case dbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
(GlobalPackageDB:dbs) -> "-no-user-package-conf"
(GlobalPackageDB:dbs) -> ("-no-user-" ++ packageDbFlag)
: concatMap specific dbs
_ -> ierror
where
specific (SpecificPackageDB db) = [ "-package-conf", db ]
specific (SpecificPackageDB db) = [ '-':packageDbFlag , db ]
specific _ = ierror
ierror = error $ "internal error: unexpected package db stack: "
++ show dbstack
packageDbFlag
| ver < [7,5]
= "package-conf"
| otherwise
= "package-db"
-- -----------------------------------------------------------------------------
-- Boilerplate Monoid instance for GhcOptions
......
......@@ -64,7 +64,7 @@ import qualified System.FilePath.Posix as FilePath.Posix
-- | Call @hc-pkg@ to register a package.
--
-- > hc-pkg register {filename | -} [--user | --global | --package-conf]
-- > hc-pkg register {filename | -} [--user | --global | --package-db]
--
register :: Verbosity -> ConfiguredProgram -> PackageDBStack
-> Either FilePath
......@@ -77,7 +77,7 @@ register verbosity hcPkg packagedb pkgFile =
-- | Call @hc-pkg@ to re-register a package.
--
-- > hc-pkg register {filename | -} [--user | --global | --package-conf]
-- > hc-pkg register {filename | -} [--user | --global | --package-db]
--
reregister :: Verbosity -> ConfiguredProgram -> PackageDBStack
-> Either FilePath
......@@ -90,7 +90,7 @@ reregister verbosity hcPkg packagedb pkgFile =
-- | Call @hc-pkg@ to unregister a package
--
-- > hc-pkg unregister [pkgid] [--user | --global | --package-conf]
-- > hc-pkg unregister [pkgid] [--user | --global | --package-db]
--
unregister :: Verbosity -> ConfiguredProgram -> PackageDB -> PackageId -> IO ()
unregister verbosity hcPkg packagedb pkgid =
......@@ -100,7 +100,7 @@ unregister verbosity hcPkg packagedb pkgid =
-- | Call @hc-pkg@ to expose a package.
--
-- > hc-pkg expose [pkgid] [--user | --global | --package-conf]
-- > hc-pkg expose [pkgid] [--user | --global | --package-db]
--
expose :: Verbosity -> ConfiguredProgram -> PackageDB -> PackageId -> IO ()
expose verbosity hcPkg packagedb pkgid =
......@@ -110,7 +110,7 @@ expose verbosity hcPkg packagedb pkgid =
-- | Call @hc-pkg@ to expose a package.
--
-- > hc-pkg expose [pkgid] [--user | --global | --package-conf]
-- > hc-pkg expose [pkgid] [--user | --global | --package-db]
--
hide :: Verbosity -> ConfiguredProgram -> PackageDB -> PackageId -> IO ()
hide verbosity hcPkg packagedb pkgid =
......@@ -245,8 +245,8 @@ registerInvocation' cmdname hcPkg verbosity packagedbs (Left pkgFile) =
where
args = [cmdname, pkgFile]
++ (if legacyVersion hcPkg
then [packageDbOpts (last packagedbs)]
else packageDbStackOpts packagedbs)
then [packageDbOpts hcPkg (last packagedbs)]
else packageDbStackOpts hcPkg packagedbs)
++ verbosityOpts hcPkg verbosity
registerInvocation' cmdname hcPkg verbosity packagedbs (Right pkgInfo) =
......@@ -257,8 +257,8 @@ registerInvocation' cmdname hcPkg verbosity packagedbs (Right pkgInfo) =
where
args = [cmdname, "-"]
++ (if legacyVersion hcPkg
then [packageDbOpts (last packagedbs)]
else packageDbStackOpts packagedbs)
then [packageDbOpts hcPkg (last packagedbs)]
else packageDbStackOpts hcPkg packagedbs)
++ verbosityOpts hcPkg verbosity
......@@ -267,7 +267,7 @@ unregisterInvocation :: ConfiguredProgram
-> ProgramInvocation
unregisterInvocation hcPkg verbosity packagedb pkgid =
programInvocation hcPkg $
["unregister", packageDbOpts packagedb, display pkgid]
["unregister", packageDbOpts hcPkg packagedb, display pkgid]
++ verbosityOpts hcPkg verbosity
......@@ -275,7 +275,7 @@ exposeInvocation :: ConfiguredProgram
-> Verbosity -> PackageDB -> PackageId -> ProgramInvocation
exposeInvocation hcPkg verbosity packagedb pkgid =
programInvocation hcPkg $
["expose", packageDbOpts packagedb, display pkgid]
["expose", packageDbOpts hcPkg packagedb, display pkgid]
++ verbosityOpts hcPkg verbosity
......@@ -283,7 +283,7 @@ hideInvocation :: ConfiguredProgram
-> Verbosity -> PackageDB -> PackageId -> ProgramInvocation
hideInvocation hcPkg verbosity packagedb pkgid =
programInvocation hcPkg $
["hide", packageDbOpts packagedb, display pkgid]
["hide", packageDbOpts hcPkg packagedb, display pkgid]
++ verbosityOpts hcPkg verbosity
......@@ -294,31 +294,38 @@ dumpInvocation hcPkg _verbosity packagedb =
progInvokeOutputEncoding = IOEncodingUTF8
}
where
args = ["dump", packageDbOpts packagedb]
args = ["dump", packageDbOpts hcPkg packagedb]
++ verbosityOpts hcPkg silent
-- We use verbosity level 'silent' because it is important that we
-- do not contaminate the output with info/debug messages.
packageDbStackOpts :: PackageDBStack -> [String]
packageDbStackOpts dbstack = case dbstack of
packageDbStackOpts :: ConfiguredProgram -> PackageDBStack -> [String]
packageDbStackOpts hcPkg dbstack = case dbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> "--global"
: "--user"
: map specific dbs
(GlobalPackageDB:dbs) -> "--global"
: "--no-user-package-conf"
: ("--no-user-" ++ packageDbFlag hcPkg)
: map specific dbs
_ -> ierror
where
specific (SpecificPackageDB db) = "--package-conf=" ++ db
specific (SpecificPackageDB db) = "--" ++ packageDbFlag hcPkg ++ "=" ++ db
specific _ = ierror
ierror :: a
ierror = error ("internal error: unexpected package db stack: " ++ show dbstack)
packageDbOpts :: PackageDB -> String
packageDbOpts GlobalPackageDB = "--global"
packageDbOpts UserPackageDB = "--user"
packageDbOpts (SpecificPackageDB db) = "--package-conf=" ++ db
packageDbFlag :: ConfiguredProgram -> String
packageDbFlag hcPkg
| programVersion hcPkg < Just (Version [7,5] [])
= "package-conf"
| otherwise
= "package-db"
packageDbOpts :: ConfiguredProgram -> PackageDB -> String
packageDbOpts _ GlobalPackageDB = "--global"
packageDbOpts _ UserPackageDB = "--user"
packageDbOpts hcPkg (SpecificPackageDB db) = "--" ++ packageDbFlag hcPkg ++ "=" ++ db
verbosityOpts :: ConfiguredProgram -> Verbosity -> [String]
verbosityOpts hcPkg v
......
......@@ -132,7 +132,7 @@ cabal spec cabalArgs = do
r <- run (Just $ directory spec) "ghc"
[ "--make"
, "-fhpc"
, "-package-conf " ++ wd </> "../dist/package.conf.inplace"
, "-package-db " ++ wd </> "../dist/package.conf.inplace"
, "Setup.hs"
]
requireSuccess r
......
......@@ -286,7 +286,7 @@ externalSetupMethod verbosity options pkg bt mkargs = do
let outOfDate = setupHsNewer || cabalVersionNewer
when outOfDate $ do
debug verbosity "Setup script is out of date, compiling..."
(_, conf, _) <- configureCompiler options'
(_, conf, compiler) <- configureCompiler options'
--TODO: get Cabal's GHC module to export a GhcOptions type and render func
rawSystemProgramConf verbosity ghcProgram conf $
ghcVerbosityOptions verbosity
......@@ -300,17 +300,22 @@ externalSetupMethod verbosity options pkg bt mkargs = do
where
cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion
ghcPackageDbOptions :: PackageDBStack -> [String]
ghcPackageDbOptions dbstack = case dbstack of
ghcPackageDbOptions :: Compiler -> PackageDBStack -> [String]
ghcPackageDbOptions compiler dbstack = case dbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
(GlobalPackageDB:dbs) -> "-no-user-package-conf"
(GlobalPackageDB:dbs) -> ("-no-user-" ++ packageDbFlag)
: concatMap specific dbs
_ -> ierror
where
specific (SpecificPackageDB db) = [ "-package-conf", db ]
specific (SpecificPackageDB db) = [ '-':packageDbFlag, db ]
specific _ = ierror
ierror = error "internal error: unexpected package db stack"
packageDbFlag
| compilerVersion compiler < Version [7,5] []
= "package-conf"
| otherwise
= "package-db"
invokeSetupScript :: [String] -> IO ()
invokeSetupScript args = do
......
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