[commit: Cabal] master: Simplify the tar code a bit more (66909cd)
Paolo Capriotti
p.capriotti at gmail.com
Tue May 8 00:00:30 CEST 2012
Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/66909cd61a042626107d1f619db525541024e0a9
>---------------------------------------------------------------
commit 66909cd61a042626107d1f619db525541024e0a9
Author: Duncan Coutts <duncan at haskell.org>
Date: Wed Mar 19 01:52:43 2008 +0000
Simplify the tar code a bit more
We always know the base path for construction or extraction so don't
bother using Maybe FilePath. Also use GZip qualified.
>---------------------------------------------------------------
cabal-install/Hackage/Install.hs | 4 +-
cabal-install/Hackage/SrcDist.hs | 2 +-
cabal-install/Hackage/Tar.hs | 42 +++++++++++++++----------------------
cabal-install/Hackage/Update.hs | 16 +++++++-------
4 files changed, 28 insertions(+), 36 deletions(-)
diff --git a/cabal-install/Hackage/Install.hs b/cabal-install/Hackage/Install.hs
index 661c3f3..d3ab255 100644
--- a/cabal-install/Hackage/Install.hs
+++ b/cabal-install/Hackage/Install.hs
@@ -242,7 +242,7 @@ installPkg verbosity configFlags rootCmd pkg flags
bracket_ (createDirectoryIfMissing True tmpDirPath)
(removeDirectoryRecursive tmpDirPath)
(do info verbosity $ "Extracting " ++ pkgPath ++ " to " ++ tmpDirPath ++ "..."
- extractTarGzFile (Just tmpDirPath) pkgPath
+ extractTarGzFile tmpDirPath pkgPath
let descFilePath = tmpDirPath </> showPackageId p </> pkgName p <.> "cabal"
e <- doesFileExist descFilePath
when (not e) $ die $ "Package .cabal file not found: " ++ show descFilePath
@@ -286,4 +286,4 @@ installUnpackedPkg verbosity configFlags mpath rootCmd
-- helper
onFailure :: a -> IO a -> IO a
-onFailure result = Exception.handle (\_ -> return result)
\ No newline at end of file
+onFailure result = Exception.handle (\_ -> return result)
diff --git a/cabal-install/Hackage/SrcDist.hs b/cabal-install/Hackage/SrcDist.hs
index 01bba4f..dfd394d 100644
--- a/cabal-install/Hackage/SrcDist.hs
+++ b/cabal-install/Hackage/SrcDist.hs
@@ -70,5 +70,5 @@ createArchive :: Verbosity
createArchive _verbosity pkg tmpDir targetPref = do
let tarBallName = showPackageId (packageId pkg)
tarBallFilePath = targetPref </> tarBallName <.> "tar.gz"
- createTarGzFile tarBallFilePath (Just tmpDir) tarBallName
+ createTarGzFile tarBallFilePath tmpDir tarBallName
return tarBallFilePath
diff --git a/cabal-install/Hackage/Tar.hs b/cabal-install/Hackage/Tar.hs
index 8452673..fca5be0 100644
--- a/cabal-install/Hackage/Tar.hs
+++ b/cabal-install/Hackage/Tar.hs
@@ -17,10 +17,7 @@ module Hackage.Tar (
TarHeader(..),
TarFileType(..),
readTarArchive,
- extractTarArchive,
extractTarGzFile,
- gunzip,
- gzip,
createTarGzFile
) where
@@ -50,17 +47,12 @@ import Control.Monad (liftM,when)
import Distribution.Simple.Utils (die)
-- GNU gzip
-import Codec.Compression.GZip (decompress,compress)
+import qualified Codec.Compression.GZip as GZip
+ ( decompress, compress )
-- Or use Ian's gunzip:
-- import Codec.Compression.GZip.GUnZip (gunzip)
-gunzip :: ByteString -> ByteString
-gunzip = decompress
-
-gzip :: ByteString -> ByteString
-gzip = compress
-
data TarHeader = TarHeader {
tarFileName :: FilePath,
tarFileMode :: FileMode,
@@ -78,29 +70,29 @@ data TarFileType = TarNormalFile
readTarArchive :: ByteString -> [(TarHeader,ByteString)]
readTarArchive = catMaybes . unfoldr getTarEntry
-extractTarArchive :: Maybe FilePath -> [(TarHeader,ByteString)] -> IO ()
-extractTarArchive mdir tar = extract files >> extract links
+extractTarArchive :: FilePath -> [(TarHeader,ByteString)] -> IO ()
+extractTarArchive dir tar = extract files >> extract links
where
- extract = mapM_ (uncurry (extractEntry mdir))
+ extract = mapM_ (uncurry (extractEntry dir))
-- TODO: does this cause a memory leak?
(files, links) = partition (not . isLink . tarFileType . fst) tar
isLink TarHardLink = True
isLink TarSymbolicLink = True
isLink _ = False
-extractTarGzFile :: Maybe FilePath -- ^ Destination directory
- -> FilePath -- ^ Tarball
- -> IO ()
-extractTarGzFile mdir file =
- BS.readFile file >>= extractTarArchive mdir . readTarArchive . decompress {- gunzip -}
+extractTarGzFile :: FilePath -- ^ Destination directory
+ -> FilePath -- ^ Tarball
+ -> IO ()
+extractTarGzFile dir file =
+ extractTarArchive dir . readTarArchive . GZip.decompress =<< BS.readFile file
--
-- * Extracting
--
-extractEntry :: Maybe FilePath -> TarHeader -> ByteString -> IO ()
-extractEntry mdir hdr cnt
- = do path <- relativizePath mdir (tarFileName hdr)
+extractEntry :: FilePath -> TarHeader -> ByteString -> IO ()
+extractEntry dir hdr cnt
+ = do path <- relativizePath dir (tarFileName hdr)
let setPerms = setPermissions path (fileModeToPermissions (tarFileMode hdr))
copyLinked =
let (base, _) = splitFileName path
@@ -113,11 +105,11 @@ extractEntry mdir hdr cnt
TarDirectory -> createDirectoryIfMissing False path >> setPerms
TarOther _ -> return () -- FIXME: warning?
-relativizePath :: Monad m => Maybe FilePath -> FilePath -> m FilePath
-relativizePath mdir file
+relativizePath :: Monad m => FilePath -> FilePath -> m FilePath
+relativizePath dir file
| isAbsolute file = fail $ "Absolute file name in TAR archive: " ++ show file
| not (isValid file) = fail $ "Invalid file name in TAR archive: " ++ show file
- | otherwise = return $ maybe file (</> file) mdir
+ | otherwise = return $ dir </> file
fileModeToPermissions :: FileMode -> Permissions
fileModeToPermissions m =
@@ -225,7 +217,7 @@ createTarGzFile tarFile baseDir sourceDir = do
. createTarEntry baseDir
. makeRelative baseDir)
=<< recurseDirectories [baseDir </> sourceDir]
- BS.writeFile tarFile . gzip . entries2Archive $ entries
+ BS.writeFile tarFile . GZip.compress . entries2Archive $ entries
mapM_ hClose (catMaybes hs) -- TODO: the handles are explicitly closed because of a bug in bytestring-0.9.0.1,
-- once we depend on a later version we can avoid this hack.
diff --git a/cabal-install/Hackage/Update.hs b/cabal-install/Hackage/Update.hs
index 1216249..30bd5e3 100644
--- a/cabal-install/Hackage/Update.hs
+++ b/cabal-install/Hackage/Update.hs
@@ -16,22 +16,22 @@ module Hackage.Update
import Hackage.Types
import Hackage.Fetch
-import Hackage.Tar
import Distribution.Simple.Utils (notice)
import Distribution.Verbosity (Verbosity)
import qualified Data.ByteString.Lazy as BS
+import qualified Codec.Compression.GZip as GZip (decompress)
import System.FilePath (dropExtension)
-- | 'update' downloads the package list from all known servers
update :: Verbosity -> [Repo] -> IO ()
update verbosity = mapM_ (updateRepo verbosity)
-updateRepo :: Verbosity
- -> Repo
- -> IO ()
-updateRepo verbosity repo =
- do notice verbosity $ "Downloading package list from server '" ++ repoURL repo ++ "'"
- indexPath <- downloadIndex verbosity repo
- BS.readFile indexPath >>= BS.writeFile (dropExtension indexPath) . gunzip
+updateRepo :: Verbosity -> Repo -> IO ()
+updateRepo verbosity repo = do
+ notice verbosity $ "Downloading package list from server '"
+ ++ repoURL repo ++ "'"
+ indexPath <- downloadIndex verbosity repo
+ BS.writeFile (dropExtension indexPath) . GZip.decompress
+ =<< BS.readFile indexPath
More information about the Cvs-libraries
mailing list