Skip to content

Commit

Permalink
Correctly handle internal libraries in new-build.
Browse files Browse the repository at this point in the history 
Signed-off-by: Edward Z. Yang <[email protected]>
  • Loading branch information
@ezyang
ezyang committed Apr 20, 2016
1 parent c4e4aed commit 0047e06
Show file tree
Hide file tree
Showing 5 changed files with 142 additions and 68 deletions.
203 changes: 136 additions & 67 deletions cabal-install/Distribution/Client/ProjectBuilding.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -151,7 +151,7 @@ data BuildStatus =
-- | The package exists in a local dir already, and is fully up to date.
-- So this package can be put into the 'InstallPlan.Installed' state
-- and it does not need to be built.
| BuildStatusUpToDate (Maybe InstalledPackageInfo) BuildSuccess
| BuildStatusUpToDate [InstalledPackageInfo] BuildSuccess

-- | For a package that is going to be built or rebuilt, the state it's in now.
--
Expand All @@ -171,7 +171,7 @@ 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.
--
| BuildStatusBuild (Maybe (Maybe InstalledPackageInfo)) BuildReason
| BuildStatusBuild (Maybe [InstalledPackageInfo]) BuildReason

data BuildReason =
-- | The depencencies of this package have been (re)built so the build
Expand Down Expand Up @@ -298,8 +298,8 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} = \installPlan -> do
return (BuildStatusRebuild srcdir rebuild)

-- No changes, the package is up to date. Use the saved build results.
Right (mipkg, buildSuccess) ->
return (BuildStatusUpToDate mipkg buildSuccess)
Right (ipkgs, buildSuccess) ->
return (BuildStatusUpToDate ipkgs buildSuccess)
where
packageFileMonitor =
newPackageFileMonitor distDirLayout (packageId pkg)
Expand Down Expand Up @@ -346,17 +346,19 @@ improveInstallPlanWithUpToDatePackages :: ElaboratedInstallPlan
-> ElaboratedInstallPlan
improveInstallPlanWithUpToDatePackages installPlan pkgsBuildStatus =
replaceWithPreInstalled installPlan
[ (installedPackageId pkg, mipkg, buildSuccess)
[ (installedPackageId pkg, ipkgs, buildSuccess)
| InstallPlan.Configured pkg
<- InstallPlan.reverseTopologicalOrder installPlan
, let ipkgid = installedPackageId pkg
Just pkgBuildStatus = Map.lookup ipkgid pkgsBuildStatus
, BuildStatusUpToDate mipkg buildSuccess <- [pkgBuildStatus]
, BuildStatusUpToDate ipkgs buildSuccess <- [pkgBuildStatus]
]
where
replaceWithPreInstalled =
foldl' (\plan (ipkgid, mipkg, buildSuccess) ->
InstallPlan.preinstalled ipkgid mipkg buildSuccess plan)
foldl' (\plan (ipkgid, ipkgs, buildSuccess) ->
InstallPlan.preinstalled ipkgid
(find (\ipkg -> installedPackageId ipkg == ipkgid) ipkgs)
buildSuccess plan)


-----------------------------
Expand All @@ -376,7 +378,7 @@ improveInstallPlanWithUpToDatePackages installPlan pkgsBuildStatus =
data PackageFileMonitor = PackageFileMonitor {
pkgFileMonitorConfig :: FileMonitor ElaboratedConfiguredPackage (),
pkgFileMonitorBuild :: FileMonitor (Set ComponentName) BuildSuccess,
pkgFileMonitorReg :: FileMonitor () (Maybe InstalledPackageInfo)
pkgFileMonitorReg :: FileMonitor () [InstalledPackageInfo]
}

newPackageFileMonitor :: DistDirLayout -> PackageId -> PackageFileMonitor
Expand Down Expand Up @@ -435,7 +437,7 @@ checkPackageFileMonitorChanged :: PackageFileMonitor
-> FilePath
-> ComponentDeps [BuildStatus]
-> IO (Either BuildStatusRebuild
(Maybe InstalledPackageInfo,
([InstalledPackageInfo],
BuildSuccess))
checkPackageFileMonitorChanged PackageFileMonitor{..}
pkg srcdir depsBuildStatus = do
Expand Down Expand Up @@ -490,8 +492,8 @@ checkPackageFileMonitorChanged PackageFileMonitor{..}
where
buildReason = BuildReasonEphemeralTargets

(MonitorUnchanged buildSuccess _, MonitorUnchanged mipkg _) ->
return (Right (mipkg, buildSuccess))
(MonitorUnchanged buildSuccess _, MonitorUnchanged ipkgs _) ->
return (Right (ipkgs, buildSuccess))
where
(pkgconfig, buildComponents) = packageFileMonitorKeyValues pkg
changedToMaybe (MonitorChanged _) = Nothing
Expand Down Expand Up @@ -541,12 +543,12 @@ updatePackageBuildFileMonitor PackageFileMonitor{pkgFileMonitorBuild}

updatePackageRegFileMonitor :: PackageFileMonitor
-> FilePath
-> Maybe InstalledPackageInfo
-> [InstalledPackageInfo]
-> IO ()
updatePackageRegFileMonitor PackageFileMonitor{pkgFileMonitorReg}
srcdir mipkg =
srcdir ipkgs =
updateFileMonitor pkgFileMonitorReg srcdir Nothing
[] () mipkg
[] () ipkgs

invalidatePackageRegFileMonitor :: PackageFileMonitor -> IO ()
invalidatePackageRegFileMonitor PackageFileMonitor{pkgFileMonitorReg} =
Expand Down Expand Up @@ -818,8 +820,10 @@ executeInstallPlan verbosity jobCtl plan0 installPkg =
-> GenericBuildResult ipkg iresult BuildFailure
-> GenericInstallPlan ipkg srcpkg iresult BuildFailure
-> GenericInstallPlan ipkg srcpkg iresult BuildFailure
updatePlan pkg (BuildSuccess mipkg buildSuccess) =
InstallPlan.completed (installedPackageId pkg) mipkg buildSuccess
updatePlan pkg (BuildSuccess ipkgs buildSuccess) =
InstallPlan.completed (installedPackageId pkg)
(find (\ipkg -> installedPackageId ipkg == installedPackageId pkg) ipkgs)
buildSuccess

updatePlan pkg (BuildFailure buildFailure) =
InstallPlan.failed (installedPackageId pkg) buildFailure depsFailure
Expand Down Expand Up @@ -1008,20 +1012,25 @@ buildAndInstallUnpackedPackage verbosity
-- then when it's done, move it to its final location, to reduce problems
-- with installs failing half-way. Could also register and then move.

-- For libraries, grab the package configuration file
-- and register it ourselves
if pkgRequiresRegistration pkg
then do
ipkg <- generateInstalledPackageInfo
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.
let ipkg' = ipkg { Installed.installedUnitId = ipkgid }
Cabal.registerPackage verbosity compiler progdb
HcPkg.MultiInstance
(pkgRegisterPackageDBStack pkg) ipkg'
return (Just ipkg')
else return Nothing

-- See Note [Updating installedUnitId]
let ipkgs' = case ipkgs of
-- Case A and B
[ipkg] -> [ipkg { Installed.installedUnitId = ipkgid }]
-- Case C
_ -> ipkgs
forM_ ipkgs' $ \ipkg' ->
Cabal.registerPackage verbosity compiler progdb
HcPkg.MultiInstance
(pkgRegisterPackageDBStack pkg) ipkg'
return ipkgs
else return []

--TODO: [required feature] docs and test phases
let docsResult = DocsNotTried
Expand All @@ -1043,16 +1052,14 @@ buildAndInstallUnpackedPackage verbosity
buildCommand = Cabal.buildCommand defaultProgramConfiguration
buildFlags _ = setupHsBuildFlags pkg pkgshared verbosity builddir

generateInstalledPackageInfo :: IO InstalledPackageInfo
generateInstalledPackageInfo =
withTempInstalledPackageInfoFile
verbosity distTempDirectory $ \pkgConfFile -> do
-- make absolute since setup changes dir
pkgConfFile' <- canonicalizePath pkgConfFile
generateInstalledPackageInfos :: IO [InstalledPackageInfo]
generateInstalledPackageInfos =
withTempInstalledPackageInfoFiles
verbosity distTempDirectory $ \pkgConfDest -> do
let registerFlags _ = setupHsRegisterFlags
pkg pkgshared
verbosity builddir
pkgConfFile'
pkgConfDest
setup Cabal.registerCommand registerFlags

copyFlags _ = setupHsCopyFlags pkg pkgshared verbosity builddir
Expand Down Expand Up @@ -1145,24 +1152,75 @@ buildInplaceUnpackedPackage verbosity
pkg buildStatus
allSrcFiles buildSuccess

mipkg <- whenReRegister $ do
ipkgs <- whenReRegister $ do
-- Register locally
mipkg <- if pkgRequiresRegistration pkg
ipkgs <- if pkgRequiresRegistration pkg
then do
ipkg <- generateInstalledPackageInfo
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.
let ipkg' = ipkg { Installed.installedUnitId = ipkgid }
Cabal.registerPackage verbosity compiler progdb HcPkg.NoMultiInstance
(pkgRegisterPackageDBStack pkg)
ipkg'
return (Just ipkg')

else return Nothing

updatePackageRegFileMonitor packageFileMonitor srcdir mipkg
return mipkg
-- 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
_ -> ipkgs
forM_ ipkgs' $ \ipkg' ->
Cabal.registerPackage verbosity compiler progdb HcPkg.NoMultiInstance
(pkgRegisterPackageDBStack pkg)
ipkg'
return ipkgs'

else return []

updatePackageRegFileMonitor packageFileMonitor srcdir ipkgs
return ipkgs

-- Repl phase
--
Expand All @@ -1173,7 +1231,7 @@ buildInplaceUnpackedPackage verbosity
whenHaddock $
setup haddockCommand haddockFlags []

return (BuildSuccess mipkg buildSuccess)
return (BuildSuccess ipkgs buildSuccess)

where
pkgid = packageId rpkg
Expand Down Expand Up @@ -1202,7 +1260,7 @@ buildInplaceUnpackedPackage verbosity
whenReRegister action = case buildStatus of
BuildStatusConfigure _ -> action
BuildStatusBuild Nothing _ -> action
BuildStatusBuild (Just mipkg) _ -> return mipkg
BuildStatusBuild (Just ipkgs) _ -> return ipkgs

configureCommand = Cabal.configureCommand defaultProgramConfiguration
configureFlags v = flip filterConfigureFlags v $
Expand Down Expand Up @@ -1234,16 +1292,14 @@ buildInplaceUnpackedPackage verbosity
(Just (pkgDescription pkg))
cmd flags args

generateInstalledPackageInfo :: IO InstalledPackageInfo
generateInstalledPackageInfo =
withTempInstalledPackageInfoFile
verbosity distTempDirectory $ \pkgConfFile -> do
-- make absolute since setup changes dir
pkgConfFile' <- canonicalizePath pkgConfFile
generateInstalledPackageInfos :: IO [InstalledPackageInfo]
generateInstalledPackageInfos =
withTempInstalledPackageInfoFiles
verbosity distTempDirectory $ \pkgConfDest -> do
let registerFlags _ = setupHsRegisterFlags
pkg pkgshared
verbosity builddir
pkgConfFile'
pkgConfDest
setup Cabal.registerCommand registerFlags []


Expand All @@ -1260,15 +1316,33 @@ annotateFailure annotate action =
--TODO: [nice to have] use displayException when available


withTempInstalledPackageInfoFile :: Verbosity -> FilePath
-> (FilePath -> IO ())
-> IO InstalledPackageInfo
withTempInstalledPackageInfoFile verbosity tempdir action =
withTempFile tempdir "package-registration-" $ \pkgConfFile hnd -> do
hClose hnd
action pkgConfFile
withTempInstalledPackageInfoFiles :: Verbosity -> FilePath
-> (FilePath -> IO ())
-> IO [InstalledPackageInfo]
withTempInstalledPackageInfoFiles verbosity tempdir action =
withTempDirectory verbosity tempdir "package-registration-" $ \dir -> do
-- make absolute since @action@ will often change directory
abs_dir <- canonicalizePath dir

let pkgConfDest = abs_dir </> "pkgConf"
action pkgConfDest

is_dir <- doesDirectoryExist pkgConfDest

(warns, ipkg) <- withUTF8FileContents pkgConfFile $ \pkgConfStr ->
let notHidden = not . isHidden
isHidden name = "." `isPrefixOf` name
if is_dir
then mapM (readPkgConf pkgConfDest) . sort . filter notHidden
=<< getDirectoryContents pkgConfDest
else fmap (:[]) $ readPkgConf "." pkgConfDest
where
pkgConfParseFailed :: Installed.PError -> IO a
pkgConfParseFailed perror =
die $ "Couldn't parse the output of 'setup register --gen-pkg-config':"
++ show perror

readPkgConf pkgConfDir pkgConfFile = do
(warns, ipkg) <- withUTF8FileContents (pkgConfDir </> pkgConfFile) $ \pkgConfStr ->
case Installed.parseInstalledPackageInfo pkgConfStr of
Installed.ParseFailed perror -> pkgConfParseFailed perror
Installed.ParseOk warns ipkg -> return (warns, ipkg)
Expand All @@ -1277,9 +1351,4 @@ withTempInstalledPackageInfoFile verbosity tempdir action =
warn verbosity $ unlines (map (showPWarning pkgConfFile) warns)

return ipkg
where
pkgConfParseFailed :: Installed.PError -> IO a
pkgConfParseFailed perror =
die $ "Couldn't parse the output of 'setup register --gen-pkg-config':"
++ show perror

2 changes: 1 addition & 1 deletion cabal-install/Distribution/Client/ProjectPlanning/Types.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -276,7 +276,7 @@ type ElaboratedReadyPackage = GenericReadyPackage ElaboratedConfiguredPackage

data GenericBuildResult ipkg iresult ifailure
= BuildFailure ifailure
| BuildSuccess (Maybe ipkg) iresult
| BuildSuccess [ipkg] iresult
deriving (Eq, Show, Generic)

instance (Binary ipkg, Binary iresult, Binary ifailure) =>
Expand Down
1 change: 1 addition & 0 deletions cabal-install/cabal-install.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,6 +64,7 @@ Extra-Source-Files:
tests/IntegrationTests/freeze/runs_without_error.sh
tests/IntegrationTests/internal-libs/internal_lib_basic.sh
tests/IntegrationTests/internal-libs/internal_lib_shadow.sh
tests/IntegrationTests/internal-libs/new_build.sh
tests/IntegrationTests/internal-libs/p/Foo.hs
tests/IntegrationTests/internal-libs/p/p.cabal
tests/IntegrationTests/internal-libs/p/p/P.hs
Expand Down
1 change: 1 addition & 0 deletions cabal-install/tests/IntegrationTests/internal-libs/cabal.project
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
packages: p q
3 changes: 3 additions & 0 deletions cabal-install/tests/IntegrationTests/internal-libs/new_build.sh
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
. ./common.sh

cabal new-build p

0 comments on commit 0047e06

Please sign in to comment.