[commit: Cabal] master: Fix sdist (730410e)

[Ian Lynagh]

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 <duncan at haskell.org>
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