Skip to content

Commit

Permalink
Use directory-ospath-streaming to getDirectoryContentsRecursive
Browse files Browse the repository at this point in the history
  • Loading branch information
Bodigrim committed Nov 27, 2024
1 parent 360f634 commit 1299d00
Show file tree
Hide file tree
Showing 2 changed files with 29 additions and 20 deletions.
48 changes: 28 additions & 20 deletions Codec/Archive/Tar/Pack.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,8 @@ import System.Directory.OsPath
( listDirectory, doesDirectoryExist, getModificationTime
, pathIsSymbolicLink, getSymbolicLinkTarget
, Permissions(..), getPermissions, getFileSize )
import System.Directory.OsPath.FileType as FT
import System.Directory.OsPath.Streaming
import Data.Time.Clock
( UTCTime )
import Data.Time.Clock.POSIX
Expand Down Expand Up @@ -242,27 +244,33 @@ packSymlinkEntry' filepath tarpath = do
-- the behaviour is undefined.
--
getDirectoryContentsRecursive :: OsPath -> IO [OsPath]
getDirectoryContentsRecursive dir0 =
fmap (drop 1) (recurseDirectories dir0 [mempty])

recurseDirectories :: OsPath -> [OsPath] -> IO [OsPath]
recurseDirectories _ [] = return []
recurseDirectories base (dir:dirs) = unsafeInterleaveIO $ do
(files, dirs') <- collect [] [] =<< listDirectory (base </> dir)

files' <- recurseDirectories base (dirs' ++ dirs)
return (dir : files ++ files')

getDirectoryContentsRecursive base = recurseDirectories [mempty]
where
collect files dirs' [] = return (reverse files, reverse dirs')
collect files dirs' (entry:entries) = do
let dirEntry = dir </> entry
dirEntry' = FilePath.Native.addTrailingPathSeparator dirEntry
isDirectory <- doesDirectoryExist (base </> dirEntry)
isSymlink <- pathIsSymbolicLink (base </> dirEntry)
if isDirectory && not isSymlink
then collect files (dirEntry':dirs') entries
else collect (dirEntry:files) dirs' entries
recurseDirectories :: [OsPath] -> IO [OsPath]
recurseDirectories [] = pure []
recurseDirectories (path : paths) = do
stream <- openDirStream (base </> path)
recurseStream path stream paths

recurseStream :: OsPath -> DirStream -> [OsPath] -> IO [OsPath]
recurseStream currPath currStream rest = go
where
go = unsafeInterleaveIO $ do
mfn <- readDirStream currStream
case mfn of
Nothing -> do
closeDirStream currStream
recurseDirectories rest
Just fn -> do
ty <- getFileType basePathFn
case ty of
FT.Directory ->
(FilePath.Native.addTrailingPathSeparator pathFn :) <$>
recurseStream currPath currStream (pathFn : rest)
_ -> (pathFn :) <$> go
where
pathFn = currPath </> fn
basePathFn = base </> pathFn

getModTime :: OsPath -> IO EpochTime
getModTime path = do
Expand Down
1 change: 1 addition & 0 deletions tar.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -55,6 +55,7 @@ library tar-internal
containers >= 0.2 && < 0.8,
deepseq >= 1.1 && < 1.6,
directory >= 1.3.1 && < 1.4,
directory-ospath-streaming < 0.2,
file-io < 0.2,
filepath >= 1.4.100 && < 1.6,
os-string >= 2.0 && < 2.1,
Expand Down

0 comments on commit 1299d00

Please sign in to comment.