Use directory-ospath-streaming to getDirectoryContentsRecursive

Author: Bodigrim

.github/workflows/emulated.yml

@@ -36,6 +36,7 @@ jobs:
           curl -s https://hackage.haskell.org/package/file-io-0.1.4/file-io-0.1.4.tar.gz | tar xz
           curl -s https://hackage.haskell.org/package/unix-2.8.5.1/unix-2.8.5.1.tar.gz | tar xz
           curl -s https://hackage.haskell.org/package/directory-1.3.8.5/directory-1.3.8.5.tar.gz | tar xz
+          curl -s https://hackage.haskell.org/package/directory-ospath-streaming-0.1.0.3/directory-ospath-streaming-0.1.0.3.tar.gz | tar xz
 
           cd unix-2.8.5.1
           chmod +x configure
@@ -76,5 +77,5 @@ jobs:
           sed -i -e 's/MIN_VERSION_filepath(1, 5, 0)/1/g' file-io-0.1.4/posix/System/File/Platform.hs
           sed -i -e 's/MIN_VERSION_filepath(1, 5, 0)/1/g' file-io-0.1.4/System/File/OsPath/Internal.hs
           ghc --version
-          ghc --make -fPIC -fno-safe-haskell -itest:os-string-2.0.6:filepath-1.5.3.0:file-io-0.1.4:file-io-0.1.4/posix:unix-2.8.5.1:directory-1.3.8.5 -Iunix-2.8.5.1/include:directory-1.3.8.5 -o Main unix-2.8.5.1/cbits/HsUnix.c test/Properties.hs +RTS -s
+          ghc --make -fPIC -fno-safe-haskell -itest:os-string-2.0.6:filepath-1.5.3.0:file-io-0.1.4:file-io-0.1.4/posix:unix-2.8.5.1:directory-1.3.8.5:directory-ospath-streaming-0.1.0.3/src -Iunix-2.8.5.1/include:directory-1.3.8.5 -o Main unix-2.8.5.1/cbits/HsUnix.c test/Properties.hs +RTS -s
           ./Main +RTS -s

Codec/Archive/Tar/Pack.hs

@@ -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
@@ -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

tar.cabal

@@ -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,