Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
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
dcoutts committed Sep 29, 2012
1 parent b92cbb0 commit b7565f9
Show file tree
Hide file tree
Showing 2 changed files with 35 additions and 12 deletions.
17 changes: 13 additions & 4 deletions cabal-install/Distribution/Client/Setup.hs
Expand Up @@ -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
Expand All @@ -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

Expand Down
30 changes: 22 additions & 8 deletions cabal-install/Distribution/Client/Unpack.hs
Expand Up @@ -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)
Expand All @@ -45,7 +45,7 @@ import Control.Monad
import Data.Monoid
( mempty )
import System.FilePath
( (</>), addTrailingPathSeparator )
( (</>), (<.>), addTrailingPathSeparator )


unpack :: Verbosity
Expand Down Expand Up @@ -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."
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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

0 comments on commit b7565f9

Please sign in to comment.