Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/730410ec0b30c0a4fd3a80dd158bff32d7da7522 >--------------------------------------------------------------- commit 730410ec0b30c0a4fd3a80dd158bff32d7da7522 Author: Duncan Coutts <[email protected]> Date: Fri Jun 5 02:34:41 2009 +0000 Fix sdist Fix handling of base dir in tar file creation. >--------------------------------------------------------------- cabal-install/Distribution/Client/Tar.hs | 31 ++++++++++++++++------------- 1 files changed, 17 insertions(+), 14 deletions(-) diff --git a/cabal-install/Distribution/Client/Tar.hs b/cabal-install/Distribution/Client/Tar.hs index 20ff285..9b251f0 100644 --- a/cabal-install/Distribution/Client/Tar.hs +++ b/cabal-install/Distribution/Client/Tar.hs @@ -755,20 +755,23 @@ pack baseDir paths0 = preparePaths baseDir paths0 >>= packPaths baseDir preparePaths :: FilePath -> [FilePath] -> IO [FilePath] preparePaths baseDir paths = fmap concat $ interleave - [ do isDir <- doesDirectoryExist path - if isDir then getDirectoryContentsRecursive (baseDir </> path) - else return [path] + [ do isDir <- doesDirectoryExist (baseDir </> path) + if isDir + then do entries <- getDirectoryContentsRecursive (baseDir </> path) + return (FilePath.Native.addTrailingPathSeparator path + : map (path </>) entries) + else return [path] | path <- paths ] packPaths :: FilePath -> [FilePath] -> IO [Entry] packPaths baseDir paths = interleave - [ do tarpath <- either fail return (toTarPath isDir relPath) + [ do tarpath <- either fail return (toTarPath isDir relpath) if isDir then packDirectoryEntry filepath tarpath else packFileEntry filepath tarpath - | filepath <- paths - , let isDir = FilePath.Native.hasTrailingPathSeparator filepath - relPath = FilePath.Native.makeRelative baseDir filepath ] + | relpath <- paths + , let isDir = FilePath.Native.hasTrailingPathSeparator filepath + filepath = baseDir </> relpath ] interleave :: [IO a] -> IO [a] interleave = unsafeInterleaveIO . go @@ -806,14 +809,14 @@ packDirectoryEntry filepath tarpath = do getDirectoryContentsRecursive :: FilePath -> IO [FilePath] getDirectoryContentsRecursive dir0 = - recurseDirectories [FilePath.Native.addTrailingPathSeparator dir0] + fmap tail (recurseDirectories dir0 [""]) -recurseDirectories :: [FilePath] -> IO [FilePath] -recurseDirectories [] = return [] -recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do - (files, dirs') <- collect [] [] =<< getDirectoryContents dir +recurseDirectories :: FilePath -> [FilePath] -> IO [FilePath] +recurseDirectories _ [] = return [] +recurseDirectories base (dir:dirs) = unsafeInterleaveIO $ do + (files, dirs') <- collect [] [] =<< getDirectoryContents (base </> dir) - files' <- recurseDirectories (dirs' ++ dirs) + files' <- recurseDirectories base (dirs' ++ dirs) return (dir : files ++ files') where @@ -823,7 +826,7 @@ recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do collect files dirs' (entry:entries) = do let dirEntry = dir </> entry dirEntry' = FilePath.Native.addTrailingPathSeparator dirEntry - isDirectory <- doesDirectoryExist dirEntry + isDirectory <- doesDirectoryExist (base </> dirEntry) if isDirectory then collect files (dirEntry':dirs') entries else collect (dirEntry:files) dirs' entries _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
