@@ -82,15 +82,22 @@ module Streamly.Internal.FileSystem.Dir
8282 )
8383where
8484
85+import Control.Monad.Catch (MonadCatch)
8586import Control.Monad.IO.Class (MonadIO(..))
8687import Data.Bifunctor (bimap)
8788import Data.Either (isRight, isLeft, fromLeft, fromRight)
89+import Data.Function ((&))
8890import Streamly.Data.Stream (Stream)
91+import Streamly.Internal.Data.Unfold (Step(..))
8992import Streamly.Internal.Data.Unfold.Type (Unfold(..))
9093import System.FilePath ((</>))
91−
94+#if (defined linux_HOST_OS) || (defined darwin_HOST_OS)
95+import System.Posix (openDirStream, readDirStream, closeDirStream)
96+#elif defined(mingw32_HOST_OS)
97+import qualified System.Win32 as Win32
98+#endif
9299import qualified Streamly.Data.Unfold as UF
93−import qualified Streamly.Internal.Data.Unfold as UF (mapM2)
100+import qualified Streamly.Internal.Data.Unfold as UF (mapM2, bracketIO)
94101import qualified Streamly.Data.Stream as S
95102import qualified System.Directory as Dir
96103
@@ -236,11 +243,50 @@ toStreamWithBufferOf chunkSize h = AS.concat $ toChunksWithBufferOf chunkSize h
236243-- /Internal/
237244--
238245{-# INLINE reader #-}
239−reader :: MonadIO m => Unfold m FilePath FilePath
246+reader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath
240247reader =
241− -- XXX use proper streaming read of the dir
242− UF.filter (\x -> x /= "." && x /= "..")
243− $ UF.lmapM (liftIO . Dir.getDirectoryContents) UF.fromList
248+#if (defined linux_HOST_OS) || (defined darwin_HOST_OS)
249+ UF.bracketIO openDirStream closeDirStream childOf
250+ & UF.filter (\x -> x /= "." && x /= "..")
251+
252+ where
253+
254+ {-# INLINABLE childOf #-}
255+ childOf = Unfold step inject
256+
257+ where
258+
259+ inject = return
260+
261+ step strm = do
262+ file <- liftIO $ readDirStream strm
263+ case file of
264+ [] -> return Stop
265+ _ -> return $ Yield file strm
266+#elif defined(mingw32_HOST_OS)
267+ UF.bracketIO
268+ Win32.findFirstFile
269+ (\(h, _) -> liftIO $ Win32.findClose h)
270+ childOf
271+ & UF.filter (\x -> x /= "." && x /= "..")
272+
273+ where
274+
275+ {-# INLINABLE childOf #-}
276+ childOf = Unfold step inject
277+
278+ where
279+
280+ inject = return
281+
282+ step (h, fdat) = do
283+ more <- liftIO $ Win32.findNextFile h fdat
284+ if more
285+ then do
286+ file <- liftIO $ Win32.getFindDataFileName fdat
287+ return $ Yield file (h, fdat)
288+ else return Stop
289+#endif
244290
245291-- XXX We can use a more general mechanism to filter the contents of a
246292-- directory. We can just stat each child and pass on the stat information. We
@@ -253,7 +299,7 @@ reader =
253299-- /Internal/
254300--
255301{-# INLINE eitherReader #-}
256−eitherReader :: MonadIO m => Unfold m FilePath (Either FilePath FilePath)
302+eitherReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)
257303eitherReader = UF.mapM2 classify reader
258304
259305 where
@@ -263,7 +309,7 @@ eitherReader = UF.mapM2 classify reader
263309 return $ if r then Left x else Right x
264310
265311{-# INLINE eitherReaderPaths #-}
266−eitherReaderPaths :: MonadIO m => Unfold m FilePath (Either FilePath FilePath)
312+eitherReaderPaths ::(MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)
267313eitherReaderPaths =
268314 UF.mapM2 (\dir -> return . bimap (dir </>) (dir </>)) eitherReader
269315
@@ -273,7 +319,7 @@ eitherReaderPaths =
273319-- /Internal/
274320--
275321{-# INLINE fileReader #-}
276−fileReader :: MonadIO m => Unfold m FilePath FilePath
322+fileReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath
277323fileReader = fmap (fromRight undefined) $ UF.filter isRight eitherReader
278324
279325-- | Read directories only. Filter out "." and ".." entries.
@@ -281,19 +327,19 @@ fileReader = fmap (fromRight undefined) $ UF.filter isRight eitherReader
281327-- /Internal/
282328--
283329{-# INLINE dirReader #-}
284−dirReader :: MonadIO m => Unfold m FilePath FilePath
330+dirReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath
285331dirReader = fmap (fromLeft undefined) $ UF.filter isLeft eitherReader
286332
287333-- | Raw read of a directory.
288334--
289335-- /Pre-release/
290336{-# INLINE read #-}
291−read :: MonadIO m => FilePath -> Stream m FilePath
337+read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
292338read = S.unfold reader
293339
294340{-# DEPRECATED toStream "Please use 'read' instead" #-}
295341{-# INLINE toStream #-}
296−toStream :: MonadIO m => String -> Stream m String
342+toStream :: (MonadIO m, MonadCatch m) => String -> Stream m String
297343toStream = read
298344
299345-- | Read directories as Left and files as Right. Filter out "." and ".."
@@ -301,18 +347,18 @@ toStream = read
301347--
302348-- /Pre-release/
303349{-# INLINE readEither #-}
304−readEither :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)
350+readEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)
305351readEither = S.unfold eitherReader
306352
307353-- | Like 'readEither' but prefix the names of the files and directories with
308354-- the supplied directory path.
309355{-# INLINE readEitherPaths #-}
310−readEitherPaths :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)
356+readEitherPaths :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)
311357readEitherPaths dir = fmap (bimap (dir </>) (dir </>)) $ readEither dir
312358
313359{-# DEPRECATED toEither "Please use 'readEither' instead" #-}
314360{-# INLINE toEither #-}
315−toEither :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)
361+toEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)
316362toEither = readEither
317363
318364-- | Read files only.
@@ -320,12 +366,12 @@ toEither = readEither
320366-- /Internal/
321367--
322368{-# INLINE readFiles #-}
323−readFiles :: MonadIO m => FilePath -> Stream m FilePath
369+readFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
324370readFiles = S.unfold fileReader
325371
326372{-# DEPRECATED toFiles "Please use 'readFiles' instead" #-}
327373{-# INLINE toFiles #-}
328−toFiles :: MonadIO m => FilePath -> Stream m FilePath
374+toFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
329375toFiles = readFiles
330376
331377-- | Read directories only.
@@ -333,12 +379,12 @@ toFiles = readFiles
333379-- /Internal/
334380--
335381{-# INLINE readDirs #-}
336−readDirs :: MonadIO m => FilePath -> Stream m FilePath
382+readDirs :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
337383readDirs = S.unfold dirReader
338384
339385{-# DEPRECATED toDirs "Please use 'readDirs' instead" #-}
340386{-# INLINE toDirs #-}
341−toDirs :: MonadIO m => String -> Stream m String
387+toDirs :: (MonadIO m, MonadCatch m) => String -> Stream m String
342388toDirs = readDirs
343389
344390{-