Permalink
Browse files

Merge branch 'master' of github.com:haskell/cabal

  • Loading branch information...
2 parents 8c46dbf + b7565f9 commit e9a826a120a99d813e82c59dc6e495f730d81d61 @igfoo igfoo committed Oct 3, 2012
@@ -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
@@ -491,13 +491,15 @@ instance Monoid ReportFlags where
data UnpackFlags = UnpackFlags {
unpackDestDir :: Flag FilePath,
- unpackVerbosity :: Flag Verbosity
+ unpackVerbosity :: Flag Verbosity,
+ unpackPristine :: Flag Bool
}
defaultUnpackFlags :: UnpackFlags
defaultUnpackFlags = UnpackFlags {
unpackDestDir = mempty,
- unpackVerbosity = toFlag normal
+ unpackVerbosity = toFlag normal,
+ unpackPristine = toFlag False
}
unpackCommand :: CommandUI UnpackFlags
@@ -514,14 +516,21 @@ unpackCommand = CommandUI {
"where to unpack the packages, defaults to the current directory."
unpackDestDir (\v flags -> flags { unpackDestDir = v })
(reqArgFlag "PATH")
+
+ , option [] ["pristine"]
+ ("Unpack the original pristine tarball, rather than updating the "
+ ++ ".cabal file with the latest revision from the package archive.")
+ unpackPristine (\v flags -> flags { unpackPristine = v })
+ trueArg
]
}
instance Monoid UnpackFlags where
mempty = defaultUnpackFlags
mappend a b = UnpackFlags {
- unpackDestDir = combine unpackDestDir
- ,unpackVerbosity = combine unpackVerbosity
+ unpackDestDir = combine unpackDestDir,
+ unpackVerbosity = combine unpackVerbosity,
+ unpackPristine = combine unpackPristine
}
where combine field = field a `mappend` field b
@@ -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
Oops, something went wrong.

0 comments on commit e9a826a

Please sign in to comment.