Commit e6b6167d authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Undo new-build support for convenience libraries.



The previous approach I took, though correct, was quite
confusing.  If I refactor InstallPlan to operate on a
per-component basis, then we'll automatically get support
for convenience libraries, which will ultimately cleaner.
(While we won't be able to get rid of support for whole
package installs, it will be safe to assume packages
using convenience libraries also support one-shot
configure.)

I didn't revert the support in cabal install; I'm not
planning on componentizing it.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 05899742
......@@ -32,7 +32,7 @@ module Distribution.Client.Install (
import Data.Foldable
( traverse_ )
import Data.List
( isPrefixOf, nub, sort, (\\) )
( isPrefixOf, nub, sort, (\\), find )
import qualified Data.Map as Map
import qualified Data.Set as S
import Data.Maybe
......@@ -1422,9 +1422,6 @@ installUnpackedPackage verbosity installLock numJobs
-- Capture installed package configuration file, so that
-- it can be incorporated into the final InstallPlan
-- TODO: This is duplicated with
-- Distribution/Client/ProjectBuilding.hs, search for
-- the Note [Updating installedUnitId].
ipkgs <- genPkgConfs mLogPath
let ipkgs' = case ipkgs of
[ipkg] -> [ipkg { Installed.installedUnitId = ipid }]
......@@ -1439,7 +1436,7 @@ installUnpackedPackage verbosity installLock numJobs
NoMultiInstance
packageDBs ipkg'
return (Right (BuildResult docsResult testsResult ipkgs'))
return (Right (BuildResult docsResult testsResult (find ((==uid).installedUnitId) ipkgs')))
where
pkgid = packageId pkg
......
......@@ -42,6 +42,7 @@ module Distribution.Client.InstallPlan (
-- ** Traversal helpers
-- $traversal
Processing,
-- NB: these functions are only used by the legacy install-path
ready,
completed,
failed,
......
......@@ -179,8 +179,10 @@ data BuildStatusRebuild =
--
-- The optional registration info here tells us if we've registered the
-- package already, or if we stil need to do that after building.
-- @Just Nothing@ indicates that we know that no registration is
-- necessary (e.g., executable.)
--
| BuildStatusBuild (Maybe [InstalledPackageInfo]) BuildReason
| BuildStatusBuild (Maybe (Maybe InstalledPackageInfo)) BuildReason
data BuildReason =
-- | The depencencies of this package have been (re)built so the build
......@@ -349,22 +351,23 @@ improveInstallPlanWithUpToDatePackages :: ElaboratedInstallPlan
-> ElaboratedInstallPlan
improveInstallPlanWithUpToDatePackages installPlan pkgsBuildStatus =
replaceWithPrePreExisting installPlan
[ (installedPackageId pkg, ipkgs)
[ (installedPackageId pkg, mipkg)
| InstallPlan.Configured pkg
<- InstallPlan.reverseTopologicalOrder installPlan
, let ipkgid = installedPackageId pkg
Just pkgBuildStatus = Map.lookup ipkgid pkgsBuildStatus
, BuildStatusUpToDate (BuildResult { buildResultLibInfo = ipkgs })
, BuildStatusUpToDate (BuildResult { buildResultLibInfo = mipkg })
<- [pkgBuildStatus]
]
where
replaceWithPrePreExisting =
foldl' (\plan (ipkgid, ipkgs) ->
case find (\ipkg -> installedPackageId ipkg == ipkgid) ipkgs of
foldl' (\plan (ipkgid, mipkg) ->
case mipkg of
Just ipkg -> InstallPlan.preexisting ipkgid ipkg plan
Nothing -> unexpected)
unexpected =
error "improveInstallPlanWithUpToDatePackages: dep on non lib package"
-- TODO: Maybe this is a little wrong, because
-- pre-installed executables show up in the
-- InstallPlan as source packages.
Nothing -> plan)
-----------------------------
......@@ -384,7 +387,7 @@ improveInstallPlanWithUpToDatePackages installPlan pkgsBuildStatus =
data PackageFileMonitor = PackageFileMonitor {
pkgFileMonitorConfig :: FileMonitor ElaboratedConfiguredPackage (),
pkgFileMonitorBuild :: FileMonitor (Set ComponentName) BuildResultMisc,
pkgFileMonitorReg :: FileMonitor () [InstalledPackageInfo]
pkgFileMonitorReg :: FileMonitor () (Maybe InstalledPackageInfo)
}
-- | This is all the components of the 'BuildResult' other than the
......@@ -504,12 +507,12 @@ checkPackageFileMonitorChanged PackageFileMonitor{..}
where
buildReason = BuildReasonEphemeralTargets
(MonitorUnchanged buildResult _, MonitorUnchanged ipkgs _) ->
(MonitorUnchanged buildResult _, MonitorUnchanged mipkg _) ->
return $ Right BuildResult {
buildResultDocs = docsResult,
buildResultTests = testsResult,
buildResultLogFile = Nothing,
buildResultLibInfo = ipkgs
buildResultLibInfo = mipkg
}
where
(docsResult, testsResult) = buildResult
......@@ -562,12 +565,12 @@ updatePackageBuildFileMonitor PackageFileMonitor{pkgFileMonitorBuild}
updatePackageRegFileMonitor :: PackageFileMonitor
-> FilePath
-> [InstalledPackageInfo]
-> Maybe InstalledPackageInfo
-> IO ()
updatePackageRegFileMonitor PackageFileMonitor{pkgFileMonitorReg}
srcdir ipkgs =
srcdir mipkg =
updateFileMonitor pkgFileMonitorReg srcdir Nothing
[] () ipkgs
[] () mipkg
invalidatePackageRegFileMonitor :: PackageFileMonitor -> IO ()
invalidatePackageRegFileMonitor PackageFileMonitor{pkgFileMonitorReg} =
......@@ -593,7 +596,7 @@ data BuildResult = BuildResult {
buildResultDocs :: DocsResult,
buildResultTests :: TestsResult,
buildResultLogFile :: Maybe FilePath,
buildResultLibInfo :: [InstalledPackageInfo]
buildResultLibInfo :: Maybe InstalledPackageInfo
}
deriving Show
......@@ -987,7 +990,7 @@ buildAndInstallUnpackedPackage verbosity
setup buildCommand buildFlags
-- Install phase
ipkgs <-
mipkg <-
annotateFailure mlogFile InstallFailed $ do
--TODO: [required eventually] need to lock installing this ipkig so other processes don't
-- stomp on our files, since we don't have ABI compat, not safe to replace
......@@ -1013,30 +1016,18 @@ buildAndInstallUnpackedPackage verbosity
if pkgRequiresRegistration pkg
then do
ipkgs <- generateInstalledPackageInfos
-- We register ourselves rather than via Setup.hs. We need to
-- grab and modify the InstalledPackageInfo. We decide what
-- the installed package id is, not the build system.
ipkg0 <- generateInstalledPackageInfo
let ipkg = ipkg0 { Installed.installedUnitId = ipkgid }
-- See Note [Updating installedUnitId]
let ipkgs' = case ipkgs of
-- Case A and B
[ipkg] -> [ipkg { Installed.installedUnitId = ipkgid }]
-- Case C
_ -> ipkgs
unless (any ((== ipkgid) . Installed.installedUnitId) ipkgs') $
die $ "the package " ++ display (packageId pkg) ++ " was expected "
++ " to produce registeration info for the unit Id "
++ display ipkgid ++ " but it actually produced info for "
++ intercalate ", "
(map (display . Installed.installedUnitId) ipkgs')
criticalSection registerLock $
forM_ ipkgs' $ \ipkg' ->
Cabal.registerPackage verbosity compiler progdb
HcPkg.MultiInstance
(pkgRegisterPackageDBStack pkg) ipkg'
return ipkgs'
else return []
(pkgRegisterPackageDBStack pkg) ipkg
return (Just ipkg)
else return Nothing
--TODO: [required feature] docs and test phases
let docsResult = DocsNotTried
......@@ -1046,7 +1037,7 @@ buildAndInstallUnpackedPackage verbosity
buildResultDocs = docsResult,
buildResultTests = testsResult,
buildResultLogFile = mlogFile,
buildResultLibInfo = ipkgs
buildResultLibInfo = mipkg
}
where
......@@ -1063,9 +1054,9 @@ buildAndInstallUnpackedPackage verbosity
buildCommand = Cabal.buildCommand defaultProgramConfiguration
buildFlags _ = setupHsBuildFlags pkg pkgshared verbosity builddir
generateInstalledPackageInfos :: IO [InstalledPackageInfo]
generateInstalledPackageInfos =
withTempInstalledPackageInfoFiles
generateInstalledPackageInfo :: IO InstalledPackageInfo
generateInstalledPackageInfo =
withTempInstalledPackageInfoFile
verbosity distTempDirectory $ \pkgConfDest -> do
let registerFlags _ = setupHsRegisterFlags
pkg pkgshared
......@@ -1165,78 +1156,26 @@ buildInplaceUnpackedPackage verbosity
pkg buildStatus
allSrcFiles buildResult
ipkgs <- whenReRegister $
mipkg <- whenReRegister $
annotateFailureNoLog InstallFailed $ do
-- Register locally
ipkgs <- if pkgRequiresRegistration pkg
mipkg <- if pkgRequiresRegistration pkg
then do
ipkgs <- generateInstalledPackageInfos
ipkg0 <- generateInstalledPackageInfo
-- We register ourselves rather than via Setup.hs. We need to
-- grab and modify the InstalledPackageInfo. We decide what
-- the installed package id is, not the build system.
-- Note [Updating installedUnitId]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- This is a bit tricky. There are three variables we
-- care about:
--
-- 1. Does the Setup script we're interfacing with
-- support --ipid? (Only if version >= 1.23)
-- If not, we have to explicitly update the
-- the UID that was recorded.
--
-- 2. Does the Setup script we're interfacing with
-- support internal libraries? (Only if
-- version >= 1.25). If so, there may be
-- multiple IPIs... and it would be wrong to
-- update them all to the same UID (you need
-- to generate derived UIDs for each
-- subcomponent.)
--
-- 3. Does GHC require that the IPID be input at
-- configure time? (Only if GHC >= 8.0, which
-- also implies Cabal version >= 1.23, as earlier
-- Cabal's don't know how to do this properly).
-- If so, it is IMPERMISSIBLE to update the
-- UID that was recorded.
--
-- This means that there are three situations:
--
-- A. Cabal < 1.23
-- B. Cabal >= 1.23 && < 1.25
-- C. Cabal >= 1.25
--
-- We consider each in turn:
--
-- A. There is only ever one IPI, and we must
-- update it.
--
-- B. There is only ever one IPI, but because
-- --ipid is supported, the installedUnitId of
-- this IPI is ipkgid (so it's harmless to
-- overwrite).
--
-- C. There may be multiple IPIs, but because
-- --ipid is supported they always have the
-- right installedUnitIds.
--
let ipkgs' = case ipkgs of
-- Case A and B
[ipkg] -> [ipkg { Installed.installedUnitId = ipkgid }]
-- Case C
_ -> assert (any ((== ipkgid) . Installed.installedUnitId)
ipkgs) ipkgs
let ipkg = ipkg0 { Installed.installedUnitId = ipkgid }
criticalSection registerLock $
forM_ ipkgs' $ \ipkg' ->
Cabal.registerPackage verbosity compiler progdb HcPkg.NoMultiInstance
(pkgRegisterPackageDBStack pkg)
ipkg'
return ipkgs'
ipkg
return (Just ipkg)
else return []
else return Nothing
updatePackageRegFileMonitor packageFileMonitor srcdir ipkgs
return ipkgs
updatePackageRegFileMonitor packageFileMonitor srcdir mipkg
return mipkg
-- Repl phase
--
......@@ -1253,7 +1192,7 @@ buildInplaceUnpackedPackage verbosity
buildResultDocs = docsResult,
buildResultTests = testsResult,
buildResultLogFile = Nothing,
buildResultLibInfo = ipkgs
buildResultLibInfo = mipkg
}
where
......@@ -1283,7 +1222,7 @@ buildInplaceUnpackedPackage verbosity
whenReRegister action = case buildStatus of
BuildStatusConfigure _ -> action
BuildStatusBuild Nothing _ -> action
BuildStatusBuild (Just ipkgs) _ -> return ipkgs
BuildStatusBuild (Just mipkg) _ -> return mipkg
configureCommand = Cabal.configureCommand defaultProgramConfiguration
configureFlags v = flip filterConfigureFlags v $
......@@ -1315,9 +1254,9 @@ buildInplaceUnpackedPackage verbosity
(Just (pkgDescription pkg))
cmd flags args
generateInstalledPackageInfos :: IO [InstalledPackageInfo]
generateInstalledPackageInfos =
withTempInstalledPackageInfoFiles
generateInstalledPackageInfo :: IO InstalledPackageInfo
generateInstalledPackageInfo =
withTempInstalledPackageInfoFile
verbosity distTempDirectory $ \pkgConfDest -> do
let registerFlags _ = setupHsRegisterFlags
pkg pkgshared
......@@ -1353,10 +1292,10 @@ annotateFailure mlogFile annotate action =
handler = throwIO . BuildFailure mlogFile . annotate . toException
withTempInstalledPackageInfoFiles :: Verbosity -> FilePath
withTempInstalledPackageInfoFile :: Verbosity -> FilePath
-> (FilePath -> IO ())
-> IO [InstalledPackageInfo]
withTempInstalledPackageInfoFiles verbosity tempdir action =
-> IO InstalledPackageInfo
withTempInstalledPackageInfoFile verbosity tempdir action =
withTempDirectory verbosity tempdir "package-registration-" $ \dir -> do
-- make absolute since @action@ will often change directory
abs_dir <- canonicalizePath dir
......@@ -1364,14 +1303,7 @@ withTempInstalledPackageInfoFiles verbosity tempdir action =
let pkgConfDest = abs_dir </> "pkgConf"
action pkgConfDest
is_dir <- doesDirectoryExist pkgConfDest
let notHidden = not . isHidden
isHidden name = "." `isPrefixOf` name
if is_dir
then mapM (readPkgConf pkgConfDest) . sort . filter notHidden
=<< getDirectoryContents pkgConfDest
else fmap (:[]) $ readPkgConf "." pkgConfDest
readPkgConf "." pkgConfDest
where
pkgConfParseFailed :: Installed.PError -> IO a
pkgConfParseFailed perror =
......
......@@ -288,7 +288,7 @@ data BuildFailure = PlanningFailed
instance Exception BuildFailure
data BuildResult = BuildResult DocsResult TestsResult
[InstalledPackageInfo]
(Maybe InstalledPackageInfo)
deriving (Show, Generic)
data DocsResult = DocsNotTried | DocsFailed | DocsOk
......
. ./common.sh
cabal new-build p
cabal new-build p || exit 0
exit 1 # expect broken
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