Skip to content

Commit 1299d00

Browse files
committed
Use directory-ospath-streaming to getDirectoryContentsRecursive
1 parent 360f634 commit 1299d00

File tree

2 files changed

+29
-20
lines changed

2 files changed

+29
-20
lines changed

Codec/Archive/Tar/Pack.hs

Lines changed: 28 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,8 @@ import System.Directory.OsPath
4747
( listDirectory, doesDirectoryExist, getModificationTime
4848
, pathIsSymbolicLink, getSymbolicLinkTarget
4949
, Permissions(..), getPermissions, getFileSize )
50+
import System.Directory.OsPath.FileType as FT
51+
import System.Directory.OsPath.Streaming
5052
import Data.Time.Clock
5153
( UTCTime )
5254
import Data.Time.Clock.POSIX
@@ -242,27 +244,33 @@ packSymlinkEntry' filepath tarpath = do
242244
-- the behaviour is undefined.
243245
--
244246
getDirectoryContentsRecursive :: OsPath -> IO [OsPath]
245-
getDirectoryContentsRecursive dir0 =
246-
fmap (drop 1) (recurseDirectories dir0 [mempty])
247-
248-
recurseDirectories :: OsPath -> [OsPath] -> IO [OsPath]
249-
recurseDirectories _ [] = return []
250-
recurseDirectories base (dir:dirs) = unsafeInterleaveIO $ do
251-
(files, dirs') <- collect [] [] =<< listDirectory (base </> dir)
252-
253-
files' <- recurseDirectories base (dirs' ++ dirs)
254-
return (dir : files ++ files')
255-
247+
getDirectoryContentsRecursive base = recurseDirectories [mempty]
256248
where
257-
collect files dirs' [] = return (reverse files, reverse dirs')
258-
collect files dirs' (entry:entries) = do
259-
let dirEntry = dir </> entry
260-
dirEntry' = FilePath.Native.addTrailingPathSeparator dirEntry
261-
isDirectory <- doesDirectoryExist (base </> dirEntry)
262-
isSymlink <- pathIsSymbolicLink (base </> dirEntry)
263-
if isDirectory && not isSymlink
264-
then collect files (dirEntry':dirs') entries
265-
else collect (dirEntry:files) dirs' entries
249+
recurseDirectories :: [OsPath] -> IO [OsPath]
250+
recurseDirectories [] = pure []
251+
recurseDirectories (path : paths) = do
252+
stream <- openDirStream (base </> path)
253+
recurseStream path stream paths
254+
255+
recurseStream :: OsPath -> DirStream -> [OsPath] -> IO [OsPath]
256+
recurseStream currPath currStream rest = go
257+
where
258+
go = unsafeInterleaveIO $ do
259+
mfn <- readDirStream currStream
260+
case mfn of
261+
Nothing -> do
262+
closeDirStream currStream
263+
recurseDirectories rest
264+
Just fn -> do
265+
ty <- getFileType basePathFn
266+
case ty of
267+
FT.Directory ->
268+
(FilePath.Native.addTrailingPathSeparator pathFn :) <$>
269+
recurseStream currPath currStream (pathFn : rest)
270+
_ -> (pathFn :) <$> go
271+
where
272+
pathFn = currPath </> fn
273+
basePathFn = base </> pathFn
266274

267275
getModTime :: OsPath -> IO EpochTime
268276
getModTime path = do

tar.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,7 @@ library tar-internal
5555
containers >= 0.2 && < 0.8,
5656
deepseq >= 1.1 && < 1.6,
5757
directory >= 1.3.1 && < 1.4,
58+
directory-ospath-streaming < 0.2,
5859
file-io < 0.2,
5960
filepath >= 1.4.100 && < 1.6,
6061
os-string >= 2.0 && < 2.1,

0 commit comments

Comments
 (0)