Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

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.
  • Loading branch information...
commit b7565f941b2dd5d61a77e46826fd256358505de7 1 parent b92cbb0
@dcoutts dcoutts authored
View
17 cabal-install/Distribution/Client/Setup.hs
@@ -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
View
30 cabal-install/Distribution/Client/Unpack.hs
@@ -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
Please sign in to comment.
Something went wrong with that request. Please try again.