Commit 2b108699 authored by TillmannRendel's avatar TillmannRendel Committed by Duncan Coutts
Browse files

Capture installed package information.

The goal is to learn the installed package id of the package we just
installed, as necessary for #1860. We achieve this by inserting an
additional call to "setup register" that produces the installed package
information in a file. We read and parse that file and could now return
the installed package id, but it is not clear what interface would be
parent 6002f623
......@@ -112,7 +112,8 @@ import qualified Distribution.Simple.Setup as Cabal
, registerCommand, RegisterFlags(..), emptyRegisterFlags
, testCommand, TestFlags(..), emptyTestFlags )
import Distribution.Simple.Utils
( rawSystemExit, comparing, writeFileAtomic )
( rawSystemExit, comparing, writeFileAtomic
, withTempFile , withFileContents )
import Distribution.Simple.InstallDirs as InstallDirs
( PathTemplate, fromPathTemplate, toPathTemplate, substPathTemplate
, initialPathTemplateEnv, installDirsTemplateEnv )
......@@ -1225,7 +1226,24 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
| otherwise = TestsNotTried
-- Install phase
onFailure InstallFailed $ criticalSection installLock $
onFailure InstallFailed $ criticalSection installLock $ do
-- Capture installed package configuration file
maybePkgConf <-
if shouldRegister then do
tmp <- getTemporaryDirectory
withTempFile tmp (tempTemplate "pkgConf") $ \pkgConfFile handle -> do
hClose handle
let registerFlags' version = (registerFlags version) {
Cabal.regGenPkgConf = toFlag (Just pkgConfFile)
setup Cabal.registerCommand registerFlags'
withFileContents pkgConfFile $ \pkgConfText ->
case Installed.parseInstalledPackageInfo pkgConfText of
Installed.ParseFailed perror -> error (show perror)
Installed.ParseOk warnings pkgConf -> return (Just pkgConf)
else return Nothing
-- Actual installation
withWin32SelfUpgrade verbosity configFlags compid platform pkg $ do
case rootCmd miscOptions of
(Just cmd) -> reexec cmd
......@@ -1233,7 +1251,7 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
setup Cabal.copyCommand copyFlags
when shouldRegister $ do
setup Cabal.registerCommand registerFlags
return (Right (BuildOk docsResult testsResult))
return (Right (BuildOk docsResult testsResult))
pkgid = packageId pkg
......@@ -1262,6 +1280,7 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
Cabal.regVerbosity = toFlag verbosity'
verbosity' = maybe verbosity snd useLogFile
tempTemplate name = name ++ "-" ++ display pkgid
addDefaultInstallDirs :: ConfigFlags -> IO ConfigFlags
addDefaultInstallDirs configFlags' = do
Supports Markdown
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