diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
index dee92c97477c904e51f9328d5d540de6d54fb660..4a3b43eacc8e2d06c55fc3cdf9fb825e764a41ed 100644
--- a/cabal-install/Distribution/Client/Install.hs
+++ b/cabal-install/Distribution/Client/Install.hs
@@ -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
diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs
index 73132986cab01fd88a2833a3072ba6ca15665004..429b53ccd28ee69b0a899a7061e48baa5ecf8bee 100644
--- a/cabal-install/Distribution/Client/InstallPlan.hs
+++ b/cabal-install/Distribution/Client/InstallPlan.hs
@@ -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,
diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs
index 5d3522610eb7c81bcb0deb56f345f989c783d10b..a74e8b56164c4ec5f4db18d7ff58455d5ae9ee18 100644
--- a/cabal-install/Distribution/Client/ProjectBuilding.hs
+++ b/cabal-install/Distribution/Client/ProjectBuilding.hs
@@ -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 =
diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs
index ac3b9bd9cda4178ab796ab65403c02d3e76860e2..1b3a08890a63c5bcac347569e76c824a45422883 100644
--- a/cabal-install/Distribution/Client/Types.hs
+++ b/cabal-install/Distribution/Client/Types.hs
@@ -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
diff --git a/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh b/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh
index 18f708913a5fc5421c741aec7a7b6c81951549af..959c79d079bc939bd1c0dcdfdcbfc5f986fa9a99 100644
--- a/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh
+++ b/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh
@@ -1,3 +1,4 @@
. ./common.sh
-cabal new-build p
+cabal new-build p || exit 0
+exit 1 # expect broken