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 <[email protected]> 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
