Commit b7565f94 authored by Duncan Coutts's avatar Duncan Coutts

Extend the unpack command for the .cabal file updating

By default, "cabal unpack blah" will also update the .cabal file with
the one from the index, so it's consistent with what you get via
cabal install. Also added a --pristine flag so you can get the original
tarball without the updated .cabal file.
parent b92cbb04
......@@ -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
......
......@@ -19,11 +19,11 @@ module Distribution.Client.Unpack (
) where
import Distribution.Package
( PackageId, packageId )
( PackageId, packageId, packageName )
import Distribution.Simple.Setup
( fromFlag, fromFlagOrDefault )
import Distribution.Simple.Utils
( notice, die )
( notice, die, info, writeFileAtomic )
import Distribution.Verbosity
( Verbosity )
import Distribution.Text(display)
......@@ -45,7 +45,7 @@ import Control.Monad
import Data.Monoid
( mempty )
import System.FilePath
( (</>), addTrailingPathSeparator )
( (</>), (<.>), addTrailingPathSeparator )
unpack :: Verbosity
......@@ -77,15 +77,17 @@ unpack verbosity repos globalFlags unpackFlags userTargets = do
flip mapM_ pkgs $ \pkg -> do
location <- fetchPackage verbosity (packageSource pkg)
let pkgid = packageId pkg
descOverride | usePristine = Nothing
| otherwise = packageDescrOverride pkg
case location of
LocalTarballPackage tarballPath ->
unpackPackage verbosity prefix pkgid tarballPath
unpackPackage verbosity prefix pkgid descOverride tarballPath
RemoteTarballPackage _tarballURL tarballPath ->
unpackPackage verbosity prefix pkgid tarballPath
unpackPackage verbosity prefix pkgid descOverride tarballPath
RepoTarballPackage _repo _pkgid tarballPath ->
unpackPackage verbosity prefix pkgid tarballPath
unpackPackage verbosity prefix pkgid descOverride tarballPath
LocalUnpackedPackage _ ->
error "Distribution.Client.Unpack.unpack: the impossible happened."
......@@ -97,6 +99,7 @@ unpack verbosity repos globalFlags unpackFlags userTargets = do
standardInstallPolicy mempty sourcePkgDb pkgSpecifiers
prefix = fromFlagOrDefault "" (unpackDestDir unpackFlags)
usePristine = fromFlagOrDefault False (unpackPristine unpackFlags)
checkTarget :: UserTarget -> IO ()
checkTarget target = case target of
......@@ -108,8 +111,10 @@ checkTarget target = case target of
"The 'unpack' command is for tarball packages. "
++ "The target '" ++ t ++ "' is not a tarball."
unpackPackage :: Verbosity -> FilePath -> PackageId -> FilePath -> IO ()
unpackPackage verbosity prefix pkgid pkgPath = do
unpackPackage :: Verbosity -> FilePath -> PackageId
-> PackageDescriptionOverride
-> FilePath -> IO ()
unpackPackage verbosity prefix pkgid descOverride pkgPath = do
let pkgdirname = display pkgid
pkgdir = prefix </> pkgdirname
pkgdir' = addTrailingPathSeparator pkgdir
......@@ -121,3 +126,12 @@ unpackPackage verbosity prefix pkgid pkgPath = do
"A file \"" ++ pkgdir ++ "\" is in the way, not unpacking."
notice verbosity $ "Unpacking to " ++ pkgdir'
Tar.extractTarGzFile prefix pkgdirname pkgPath
case descOverride of
Nothing -> return ()
Just pkgtxt -> do
let descFilePath = pkgdir </> display (packageName pkgid) <.> "cabal"
info verbosity $
"Updating " ++ descFilePath
++ " with the latest revision from the index."
writeFileAtomic descFilePath pkgtxt
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