Commit b92cbb04 authored by Duncan Coutts's avatar Duncan Coutts

On install, update the .cabal file with the one from the index

This allows us to make minor changes to packages after they have been
released, without changing the package .tar.gz file. We already keep
the .cabal file outsite the package in the index and use it for
dependency planning. This already lets us do fixes such as making
dependency constraints tighter. Currently we cannot make dep
constraints more relaxed however, since the original .cabal file is
the one used when we get to the actual configure step.

So with this change, we now use the updated .cabal file for the
configure and build too. So there's more fixes we can do post-release.
In particlar, in combination with easier editing on hackage, this
should help us address the problems around the PVP and open or closed
version constraints. It should allow a system of conservative upper
bounds, but allow editing them when new versions of deps are released
and we find that they happen to work fine.
parent e1d0d855
......@@ -82,7 +82,7 @@ configure verbosity packageDBs repos comp conf
configureCommand (const configFlags) extraArgs
Right installPlan -> case InstallPlan.ready installPlan of
[pkg@(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _)) _ _ _)] ->
[pkg@(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _) _) _ _ _)] ->
configurePackage verbosity
(InstallPlan.planPlatform installPlan)
(InstallPlan.planCompiler installPlan)
......@@ -138,7 +138,8 @@ planLocalPackage verbosity comp configFlags configExFlags installedPkgIndex
localPkg = SourcePackage {
packageInfoId = packageId pkg,
Source.packageDescription = pkg,
packageSource = LocalUnpackedPackage "."
packageSource = LocalUnpackedPackage ".",
packageDescrOverride = Nothing
}
testsEnabled = fromFlagOrDefault False $ configTests configFlags
......@@ -194,7 +195,7 @@ configurePackage :: Verbosity
-> [String]
-> IO ()
configurePackage verbosity platform comp scriptOptions configFlags
(ConfiguredPackage (SourcePackage _ gpkg _) flags stanzas deps) extraArgs =
(ConfiguredPackage (SourcePackage _ gpkg _ _) flags stanzas deps) extraArgs =
setupWrapper verbosity
scriptOptions (Just pkg) configureCommand configureFlags extraArgs
......
......@@ -92,7 +92,7 @@ convSPI os arch cid = mkIndex . convSPI' os arch cid
-- | Convert a single source package into the solver-specific format.
convSP :: OS -> Arch -> CompilerId -> SourcePackage -> (PN, I, PInfo)
convSP os arch cid (SourcePackage (PackageIdentifier pn pv) gpd _pl) =
convSP os arch cid (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
let i = I pv InRepo
in (pn, i, convGPD os arch cid (PI pn i) gpd)
......
......@@ -368,7 +368,7 @@ pruneBottomUp platform comp constraints =
[ (dep, Constraints.conflicting cs dep)
| dep <- missing ]
configure cs (UnconfiguredPackage (SourcePackage _ pkg _) _ flags stanzas) =
configure cs (UnconfiguredPackage (SourcePackage _ pkg _ _) _ flags stanzas) =
finalizePackageDescription flags (dependencySatisfiable cs)
platform comp [] (enableStanzas stanzas pkg)
dependencySatisfiable cs =
......@@ -397,7 +397,7 @@ configurePackage platform comp available spkg = case spkg of
InstalledAndSource ipkg apkg -> fmap (InstalledAndSource ipkg)
(configure apkg)
where
configure (UnconfiguredPackage apkg@(SourcePackage _ p _) _ flags stanzas) =
configure (UnconfiguredPackage apkg@(SourcePackage _ p _ _) _ flags stanzas) =
case finalizePackageDescription flags dependencySatisfiable
platform comp [] (enableStanzas stanzas p) of
Left missing -> Left missing
......@@ -481,7 +481,7 @@ topologicalSortNumbering installedPkgIndex sourcePkgIndex =
++ [ ((), packageName pkg, nub deps)
| pkgs@(pkg:_) <- PackageIndex.allPackagesByName sourcePkgIndex
, let deps = [ depName
| SourcePackage _ pkg' _ <- pkgs
| SourcePackage _ pkg' _ _ <- pkgs
, Dependency depName _ <-
buildDepends (flattenPackageDescription pkg') ] ]
......@@ -517,7 +517,7 @@ selectNeededSubset installedPkgIndex sourcePkgIndex = select mempty mempty
| pkg <- moreInstalled
, dep <- depends pkg ]
++ [ name
| SourcePackage _ pkg _ <- moreSource
| SourcePackage _ pkg _ _ <- moreSource
, Dependency name _ <-
buildDepends (flattenPackageDescription pkg) ]
installedPkgIndex'' = foldl' (flip PackageIndex.insert)
......
......@@ -175,8 +175,11 @@ readRepoIndex verbosity repo =
packageInfoId = pkgid,
packageDescription = packageDesc pkgEntry,
packageSource = case pkgEntry of
NormalPackage _ _ _ -> RepoTarballPackage repo pkgid Nothing
BuildTreeRef _ path _ _ -> LocalUnpackedPackage path
NormalPackage _ _ _ _ -> RepoTarballPackage repo pkgid Nothing
BuildTreeRef _ _ path _ -> LocalUnpackedPackage path,
packageDescrOverride = case pkgEntry of
NormalPackage _ _ pkgtxt _ -> Just pkgtxt
_ -> Nothing
}
where
pkgid = packageId pkgEntry
......@@ -231,19 +234,18 @@ whenCacheOutOfDate origFile cacheFile action = do
--
-- | An index entry is either a normal package, or a local build tree reference.
data PackageEntry = NormalPackage PackageId GenericPackageDescription BlockNo
| BuildTreeRef PackageId FilePath GenericPackageDescription
BlockNo
data PackageEntry = NormalPackage PackageId GenericPackageDescription ByteString BlockNo
| BuildTreeRef PackageId GenericPackageDescription FilePath BlockNo
type MkPackageEntry = IO PackageEntry
instance Package PackageEntry where
packageId (NormalPackage pkgid _ _ ) = pkgid
packageId (BuildTreeRef pkgid _ _ _ ) = pkgid
packageId (NormalPackage pkgid _ _ _) = pkgid
packageId (BuildTreeRef pkgid _ _ _) = pkgid
packageDesc :: PackageEntry -> GenericPackageDescription
packageDesc (NormalPackage _ descr _ ) = descr
packageDesc (BuildTreeRef _ _ descr _ ) = descr
packageDesc (NormalPackage _ descr _ _) = descr
packageDesc (BuildTreeRef _ descr _ _) = descr
-- | Read a compressed \"00-index.tar.gz\" file into a 'PackageIndex'.
--
......@@ -302,7 +304,7 @@ extractPkg entry blockNo = case Tar.entryContent entry of
| takeExtension fileName == ".cabal"
-> case splitDirectories (normalise fileName) of
[pkgname,vers,_] -> case simpleParse vers of
Just ver -> Just $ return (NormalPackage pkgid descr blockNo)
Just ver -> Just $ return (NormalPackage pkgid descr content blockNo)
where
pkgid = PackageIdentifier (PackageName pkgname) ver
parsed = parsePackageDescription . fromUTF8 . BS.Char8.unpack
......@@ -320,7 +322,7 @@ extractPkg entry blockNo = case Tar.entryContent entry of
let path = byteStringToFilePath content
cabalFile <- findPackageDesc path
descr <- PackageDesc.Parse.readPackageDescription normal cabalFile
return $ BuildTreeRef (packageId descr) path descr blockNo
return $ BuildTreeRef (packageId descr) descr path blockNo
_ -> Nothing
......@@ -358,7 +360,7 @@ updatePackageIndexCacheFile indexFile cacheFile = do
mkCache pkgs prefs =
[ CachePreference pref | pref <- prefs ]
++ [ CachePackageId pkgid blockNo
| (NormalPackage pkgid _ blockNo) <- pkgs ]
| (NormalPackage pkgid _ _ blockNo) <- pkgs ]
++ [ CacheBuildTreeRef blockNo
| (BuildTreeRef _ _ _ blockNo) <- pkgs]
......@@ -392,9 +394,11 @@ packageIndexFromCache mkPkg hnd = accum mempty []
-- The magic here is that we use lazy IO to read the .cabal file
-- from the index tarball if it turns out that we need it.
-- Most of the time we only need the package id.
pkg <- unsafeInterleaveIO $ do
getEntryContent blockno >>= readPackageDescription
let srcpkg = mkPkg (NormalPackage pkgid pkg blockno)
~(pkg, pkgtxt) <- unsafeInterleaveIO $ do
pkgtxt <- getEntryContent blockno
pkg <- readPackageDescription pkgtxt
return (pkg, pkgtxt)
let srcpkg = mkPkg (NormalPackage pkgid pkg pkgtxt blockno)
accum (srcpkg:srcpkgs) prefs entries
accum srcpkgs prefs (CacheBuildTreeRef blockno : entries) = do
......@@ -404,7 +408,7 @@ packageIndexFromCache mkPkg hnd = accum mempty []
path <- liftM byteStringToFilePath . getEntryContent $ blockno
pkg <- do cabalFile <- findPackageDesc path
PackageDesc.Parse.readPackageDescription normal cabalFile
let srcpkg = mkPkg (BuildTreeRef (packageId pkg) path pkg blockno)
let srcpkg = mkPkg (BuildTreeRef (packageId pkg) pkg path blockno)
accum (srcpkg:srcpkgs) prefs entries
accum srcpkgs prefs (CachePreference pref : entries) =
......
......@@ -96,7 +96,7 @@ import qualified Distribution.Simple.Setup as Cabal
( installCommand, InstallFlags(..), emptyInstallFlags
, emptyTestFlags, testCommand, Flag(..) )
import Distribution.Simple.Utils
( rawSystemExit, comparing )
( rawSystemExit, comparing, writeFileAtomic )
import Distribution.Simple.InstallDirs as InstallDirs
( PathTemplate, fromPathTemplate, toPathTemplate, substPathTemplate
, initialPathTemplateEnv, installDirsTemplateEnv )
......@@ -781,13 +781,13 @@ performInstallations verbosity
executeInstallPlan verbosity jobControl useLogFile installPlan $ \cpkg ->
installConfiguredPackage platform compid configFlags
cpkg $ \configFlags' src pkg ->
cpkg $ \configFlags' src pkg pkgoverride ->
fetchSourcePackage verbosity fetchLimit src $ \src' ->
installLocalPackage verbosity buildLimit (packageId pkg) src' $ \mpath ->
installUnpackedPackage verbosity buildLimit installLock numJobs
(setupScriptOptions installedPkgIndex cacheLock)
miscOptions configFlags' installFlags haddockFlags
compid pkg mpath useLogFile
compid pkg pkgoverride mpath useLogFile
where
platform = InstallPlan.planPlatform installPlan
......@@ -956,16 +956,17 @@ executeInstallPlan verbosity jobCtl useLogFile plan0 installPkg =
installConfiguredPackage :: Platform -> CompilerId
-> ConfigFlags -> ConfiguredPackage
-> (ConfigFlags -> PackageLocation (Maybe FilePath)
-> PackageDescription -> a)
-> PackageDescription
-> PackageDescriptionOverride -> a)
-> a
installConfiguredPackage platform comp configFlags
(ConfiguredPackage (SourcePackage _ gpkg source) flags stanzas deps)
(ConfiguredPackage (SourcePackage _ gpkg source pkgoverride) flags stanzas deps)
installPkg = installPkg configFlags {
configConfigurationsFlags = flags,
configConstraints = map thisPackageVersion deps,
configBenchmarks = toFlag False,
configTests = toFlag (TestStanzas `elem` stanzas)
} source pkg
} source pkg pkgoverride
where
pkg = case finalizePackageDescription flags
(const True)
......@@ -1051,13 +1052,25 @@ installUnpackedPackage
-> HaddockFlags
-> CompilerId
-> PackageDescription
-> PackageDescriptionOverride
-> Maybe FilePath -- ^ Directory to change to before starting the installation.
-> UseLogFile -- ^ File to log output to (if any)
-> IO BuildResult
installUnpackedPackage verbosity buildLimit installLock numJobs
scriptOptions miscOptions
configFlags installConfigFlags haddockFlags
compid pkg workingDir useLogFile =
compid pkg pkgoverride workingDir useLogFile = do
-- Override the .cabal file if necessary
case pkgoverride of
Nothing -> return ()
Just pkgtxt -> do
let descFilePath = fromMaybe "." workingDir
</> display (packageName pkgid) <.> "cabal"
info verbosity $
"Updating " ++ display (packageName pkgid) <.> "cabal"
++ " with the latest revision from the index."
writeFileAtomic descFilePath pkgtxt
-- Configure phase
onFailure ConfigureFailed $ withJobLimit buildLimit $ do
......
......@@ -133,7 +133,7 @@ symlinkBinaries configFlags installFlags plan =
, PackageDescription.buildable (PackageDescription.buildInfo exe) ]
pkgDescription :: ConfiguredPackage -> PackageDescription
pkgDescription (ConfiguredPackage (SourcePackage _ pkg _) flags stanzas _) =
pkgDescription (ConfiguredPackage (SourcePackage _ pkg _ _) flags stanzas _) =
case finalizePackageDescription flags
(const True)
platform compilerId [] (enableStanzas stanzas pkg) of
......
......@@ -472,9 +472,10 @@ readPackageTarget verbosity target = case target of
pkg <- readPackageDescription verbosity =<< findPackageDesc dir
return $ PackageTargetLocation $
SourcePackage {
packageInfoId = packageId pkg,
packageDescription = pkg,
packageSource = fmap Just location
packageInfoId = packageId pkg,
packageDescription = pkg,
packageSource = fmap Just location,
packageDescrOverride = Nothing
}
LocalTarballPackage tarballFile ->
......@@ -497,9 +498,10 @@ readPackageTarget verbosity target = case target of
Just pkg ->
return $ PackageTargetLocation $
SourcePackage {
packageInfoId = packageId pkg,
packageDescription = pkg,
packageSource = fmap Just location
packageInfoId = packageId pkg,
packageDescription = pkg,
packageSource = fmap Just location,
packageDescrOverride = Nothing
}
extractTarballPackageCabalFile :: FilePath -> String
......
......@@ -29,6 +29,7 @@ import Distribution.Version
import Data.Map (Map)
import Network.URI (URI)
import Data.ByteString.Lazy (ByteString)
import Distribution.Compat.Exception
( SomeException )
......@@ -94,12 +95,17 @@ instance PackageFixedDeps ConfiguredPackage where
-- | A package description along with the location of the package sources.
--
data SourcePackage = SourcePackage {
packageInfoId :: PackageId,
packageDescription :: GenericPackageDescription,
packageSource :: PackageLocation (Maybe FilePath)
packageInfoId :: PackageId,
packageDescription :: GenericPackageDescription,
packageSource :: PackageLocation (Maybe FilePath),
packageDescrOverride :: PackageDescriptionOverride
}
deriving Show
-- | We sometimes need to override the .cabal file in the tarball with
-- the newer one from the package index.
type PackageDescriptionOverride = Maybe ByteString
instance Package SourcePackage where packageId = packageInfoId
data OptionalStanza
......
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