on 63407dc help sign in
510 lines 18 kB history raw
1#include "inline.hs"
3-- |
4-- Module : Streamly.Internal.FileSystem.Dir
5-- Copyright : (c) 2018 Composewell Technologies
6--
7-- License : BSD3
8-- Maintainer : streamly@composewell.com
9-- Portability : GHC
11module Streamly.Internal.FileSystem.Dir
12 (
13 -- * Streams
14 read
16 -- read not just the names but also the inode attrs of the children. This
17 -- abstraction makes sense because when we read the dir contents we also
18 -- get the inodes, and it is cheaper to get the attrs from the inodes
19 -- instead of resolving the paths and get those. This abstraction may be
20 -- less portable as different platforms may have different attrs. To
21 -- optimize, we can also add a filter/pattern/parser on the names of the
22 -- children that we want to read. We can call that readAttrsWith? Or just
23 -- have the default readAttrs do that? Usually we won't need that, so it
24 -- may be better to keep that a separate API.
25 -- , readAttrs
27 -- recursive read requires us to read the attributes of the children to
28 -- determine if something is a dirctory or not. Therefore, it may be a good
29 -- idea to have a low level routine that also spits out the attributes of
30 -- the files, we get that for free. We can also add a filter/pattern/parser
31 -- on the names of the children that we want to read.
32 --, readAttrsRecursive -- Options: acyclic, follow symlinks
33 , readFiles
34 , readDirs
35 , readEither
36 , readEitherPaths
38 -- We can implement this in terms of readAttrsRecursive without losing
39 -- perf.
40 -- , readEitherRecursive -- Options: acyclic, follow symlinks
41 -- , readAncestors -- read the parent chain using the .. entry.
42 -- , readAncestorsAttrs
44 -- * Unfolds
45 -- | Use the more convenient stream APIs instead of unfolds where possible.
46 , reader
47 , fileReader
48 , dirReader
49 , eitherReader
50 , eitherReaderPaths
52 {-
53 , toStreamWithBufferOf
55 , readChunks
56 , readChunksWithBufferOf
58 , toChunksWithBufferOf
59 , toChunks
61 , write
62 , writeWithBufferOf
64 -- Byte stream write (Streams)
65 , fromStream
66 , fromStreamWithBufferOf
68 -- -- * Array Write
69 , writeArray
70 , writeChunks
71 , writeChunksWithBufferOf
73 -- -- * Array stream Write
74 , fromChunks
75 , fromChunksWithBufferOf
76 -}
77 -- * Deprecated
78 , toStream
79 , toEither
80 , toFiles
81 , toDirs
82 )
83where
85import Control.Monad.Catch (MonadCatch)
86import Control.Monad.IO.Class (MonadIO(..))
87import Data.Bifunctor (bimap)
88import Data.Either (isRight, isLeft, fromLeft, fromRight)
89import Data.Function ((&))
90import Streamly.Data.Stream (Stream)
91import Streamly.Internal.Data.Unfold (Step(..))
92import Streamly.Internal.Data.Unfold.Type (Unfold(..))
93import System.FilePath ((</>))
94#if (defined linux_HOST_OS) || (defined darwin_HOST_OS)
95import System.Posix (DirStream, openDirStream, readDirStream, closeDirStream)
96#elif defined(mingw32_HOST_OS)
97import qualified System.Win32 as Win32
98#else
99#error "Unsupported architecture"
100#endif
101import qualified Streamly.Data.Unfold as UF
102import qualified Streamly.Internal.Data.Unfold as UF (mapM2, bracketIO)
103import qualified Streamly.Data.Stream as S
104import qualified System.Directory as Dir
106import Prelude hiding (read)
108{-
109{-# INLINABLE readArrayUpto #-}
110readArrayUpto :: Int -> Handle -> IO (Array Word8)
111readArrayUpto size h = do
112 ptr <- mallocPlainForeignPtrBytes size
113 -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))
114 withForeignPtr ptr $ \p -> do
115 n <- hGetBufSome h p size
116 let v = Array
117 { aStart = ptr
118 , arrEnd = p `plusPtr` n
119 , arrBound = p `plusPtr` size
120 }
121 -- XXX shrink only if the diff is significant
122 shrinkToFit v
124-------------------------------------------------------------------------------
125-- Stream of Arrays IO
126-------------------------------------------------------------------------------
128-- | @toChunksWithBufferOf size h@ reads a stream of arrays from file handle @h@.
129-- The maximum size of a single array is specified by @size@. The actual size
130-- read may be less than or equal to @size@.
131{-# INLINE _toChunksWithBufferOf #-}
132_toChunksWithBufferOf :: MonadIO m => Int -> Handle -> Stream m (Array Word8)
133_toChunksWithBufferOf size h = go
134 where
135 -- XXX use cons/nil instead
136 go = mkStream $ \_ yld _ stp -> do
137 arr <- liftIO $ readArrayUpto size h
138 if A.length arr == 0
139 then stp
140 else yld arr go
142-- | @toChunksWithBufferOf size handle@ reads a stream of arrays from the file
143-- handle @handle@. The maximum size of a single array is limited to @size@.
144-- The actual size read may be less than or equal to @size@.
145--
146-- @since 0.7.0
147{-# INLINE_NORMAL toChunksWithBufferOf #-}
148toChunksWithBufferOf :: MonadIO m => Int -> Handle -> Stream m (Array Word8)
149toChunksWithBufferOf size h = D.fromStreamD (D.Stream step ())
150 where
151 {-# INLINE_LATE step #-}
152 step _ _ = do
153 arr <- liftIO $ readArrayUpto size h
154 return $
155 case A.length arr of
156 0 -> D.Stop
157 _ -> D.Yield arr ()
159-- | Unfold the tuple @(bufsize, handle)@ into a stream of 'Word8' arrays.
160-- Read requests to the IO device are performed using a buffer of size
161-- @bufsize@. The size of an array in the resulting stream is always less than
162-- or equal to @bufsize@.
163--
164-- @since 0.7.0
165{-# INLINE_NORMAL readChunksWithBufferOf #-}
166readChunksWithBufferOf :: MonadIO m => Unfold m (Int, Handle) (Array Word8)
167readChunksWithBufferOf = Unfold step return
168 where
169 {-# INLINE_LATE step #-}
170 step (size, h) = do
171 arr <- liftIO $ readArrayUpto size h
172 return $
173 case A.length arr of
174 0 -> D.Stop
175 _ -> D.Yield arr (size, h)
177-- XXX read 'Array a' instead of Word8
178--
179-- | @toChunks handle@ reads a stream of arrays from the specified file
180-- handle. The maximum size of a single array is limited to
181-- @defaultChunkSize@. The actual size read may be less than or equal to
182-- @defaultChunkSize@.
183--
184-- > toChunks = toChunksWithBufferOf defaultChunkSize
185--
186-- @since 0.7.0
187{-# INLINE toChunks #-}
188toChunks :: MonadIO m => Handle -> Stream m (Array Word8)
189toChunks = toChunksWithBufferOf defaultChunkSize
191-- | Unfolds a handle into a stream of 'Word8' arrays. Requests to the IO
192-- device are performed using a buffer of size
193-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'. The
194-- size of arrays in the resulting stream are therefore less than or equal to
195-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'.
196--
197-- @since 0.7.0
198{-# INLINE readChunks #-}
199readChunks :: MonadIO m => Unfold m Handle (Array Word8)
200readChunks = UF.first readChunksWithBufferOf defaultChunkSize
202-------------------------------------------------------------------------------
203-- Read a Directory to Stream
204-------------------------------------------------------------------------------
206-- TODO for concurrent streams implement readahead IO. We can send multiple
207-- read requests at the same time. For serial case we can use async IO. We can
208-- also control the read throughput in mbps or IOPS.
210-- | Unfolds the tuple @(bufsize, handle)@ into a byte stream, read requests
211-- to the IO device are performed using buffers of @bufsize@.
212--
213-- @since 0.7.0
214{-# INLINE readWithBufferOf #-}
215readWithBufferOf :: MonadIO m => Unfold m (Int, Handle) Word8
216readWithBufferOf = UF.many readChunksWithBufferOf A.read
218-- | @toStreamWithBufferOf bufsize handle@ reads a byte stream from a file
219-- handle, reads are performed in chunks of up to @bufsize@.
220--
221-- /Pre-release/
222{-# INLINE toStreamWithBufferOf #-}
223toStreamWithBufferOf :: MonadIO m => Int -> Handle -> Stream m Word8
224toStreamWithBufferOf chunkSize h = AS.concat $ toChunksWithBufferOf chunkSize h
225-}
227-- read child node names from a dir filtering out . and ..
228--
229-- . and .. are an implementation artifact, and should probably not be used in
230-- user level abstractions.
231--
232-- . does not seem to have any useful purpose. If we have the path of the dir
233-- then we will resolve it to get the inode of the dir so the . entry would be
234-- redundant. If we have the inode of the dir to read the dir then it is
235-- redundant. Is this for cross check when doing fsck?
236--
237-- For .. we have the readAncestors API, we should not have this in the
238-- readChildren API.
240-- XXX exception handling
242#if (defined linux_HOST_OS) || (defined darwin_HOST_OS)
243{-# INLINE streamReader #-}
244streamReader :: MonadIO m => Unfold m DirStream FilePath
245streamReader = Unfold step return
247 where
249 step strm = do
250 -- XXX Use readDirStreamMaybe
251 file <- liftIO $ readDirStream strm
252 case file of
253 [] -> return Stop
254 _ -> return $ Yield file strm
256#elif defined(mingw32_HOST_OS)
257openDirStream :: String -> IO (Win32.HANDLE, Win32.FindData)
258openDirStream = Win32.findFirstFile
260closeDirStream :: (Win32.HANDLE, Win32.FindData) -> IO ()
261closeDirStream (h, _) = Win32.findClose h
263{-# INLINE streamReader #-}
264streamReader :: MonadIO m => Unfold m (Win32.HANDLE, Win32.FindData) FilePath
265streamReader = Unfold step return
267 where
269 step (h, fdat) = do
270 more <- liftIO $ Win32.findNextFile h fdat
271 if more
272 then do
273 file <- liftIO $ Win32.getFindDataFileName fdat
274 return $ Yield file (h, fdat)
275 else return Stop
276#endif
278-- | Read a directory emitting a stream with names of the children. Filter out
279-- "." and ".." entries.
280--
281-- /Internal/
282--
283{-# INLINE reader #-}
284reader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath
285reader =
286-- XXX Instead of using bracketIO for each iteration of the loop we should
287-- instead yield a buffer of dir entries in each iteration and then use an
288-- unfold and concat to flatten those entries. That should improve the
289-- performance.
290 UF.bracketIO openDirStream closeDirStream streamReader
291 & UF.filter (\x -> x /= "." && x /= "..")
293-- XXX We can use a more general mechanism to filter the contents of a
294-- directory. We can just stat each child and pass on the stat information. We
295-- can then use that info to do a general filtering. "find" like filters can be
296-- created.
298-- | Read directories as Left and files as Right. Filter out "." and ".."
299-- entries.
300--
301-- /Internal/
302--
303{-# INLINE eitherReader #-}
304eitherReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)
305eitherReader = UF.mapM2 classify reader
307 where
309 classify dir x = do
310 r <- liftIO $ Dir.doesDirectoryExist (dir ++ "/" ++ x)
311 return $ if r then Left x else Right x
313{-# INLINE eitherReaderPaths #-}
314eitherReaderPaths ::(MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)
315eitherReaderPaths =
316 UF.mapM2 (\dir -> return . bimap (dir </>) (dir </>)) eitherReader
318--
319-- | Read files only.
320--
321-- /Internal/
322--
323{-# INLINE fileReader #-}
324fileReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath
325fileReader = fmap (fromRight undefined) $ UF.filter isRight eitherReader
327-- | Read directories only. Filter out "." and ".." entries.
328--
329-- /Internal/
330--
331{-# INLINE dirReader #-}
332dirReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath
333dirReader = fmap (fromLeft undefined) $ UF.filter isLeft eitherReader
335-- | Raw read of a directory.
336--
337-- /Pre-release/
338{-# INLINE read #-}
339read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
340read = S.unfold reader
342{-# DEPRECATED toStream "Please use 'read' instead" #-}
343{-# INLINE toStream #-}
344toStream :: (MonadIO m, MonadCatch m) => String -> Stream m String
345toStream = read
347-- | Read directories as Left and files as Right. Filter out "." and ".."
348-- entries. The output contains the names of the directories and files.
349--
350-- /Pre-release/
351{-# INLINE readEither #-}
352readEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)
353readEither = S.unfold eitherReader
355-- | Like 'readEither' but prefix the names of the files and directories with
356-- the supplied directory path.
357{-# INLINE readEitherPaths #-}
358readEitherPaths :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)
359readEitherPaths dir = fmap (bimap (dir </>) (dir </>)) $ readEither dir
361{-# DEPRECATED toEither "Please use 'readEither' instead" #-}
362{-# INLINE toEither #-}
363toEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)
364toEither = readEither
366-- | Read files only.
367--
368-- /Internal/
369--
370{-# INLINE readFiles #-}
371readFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
372readFiles = S.unfold fileReader
374{-# DEPRECATED toFiles "Please use 'readFiles' instead" #-}
375{-# INLINE toFiles #-}
376toFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
377toFiles = readFiles
379-- | Read directories only.
380--
381-- /Internal/
382--
383{-# INLINE readDirs #-}
384readDirs :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
385readDirs = S.unfold dirReader
387{-# DEPRECATED toDirs "Please use 'readDirs' instead" #-}
388{-# INLINE toDirs #-}
389toDirs :: (MonadIO m, MonadCatch m) => String -> Stream m String
390toDirs = readDirs
392{-
393-------------------------------------------------------------------------------
394-- Writing
395-------------------------------------------------------------------------------
397-------------------------------------------------------------------------------
398-- Array IO (output)
399-------------------------------------------------------------------------------
401-- | Write an 'Array' to a file handle.
402--
403-- @since 0.7.0
404{-# INLINABLE writeArray #-}
405writeArray :: Storable a => Handle -> Array a -> IO ()
406writeArray _ arr | A.length arr == 0 = return ()
407writeArray h Array{..} = withForeignPtr aStart $ \p -> hPutBuf h p aLen
408 where
409 aLen =
410 let p = unsafeForeignPtrToPtr aStart
411 in arrEnd `minusPtr` p
413-------------------------------------------------------------------------------
414-- Stream of Arrays IO
415-------------------------------------------------------------------------------
417-------------------------------------------------------------------------------
418-- Writing
419-------------------------------------------------------------------------------
421-- | Write a stream of arrays to a handle.
422--
423-- @since 0.7.0
424{-# INLINE fromChunks #-}
425fromChunks :: (MonadIO m, Storable a)
426 => Handle -> Stream m (Array a) -> m ()
427fromChunks h m = S.mapM_ (liftIO . writeArray h) m
429-- | @fromChunksWithBufferOf bufsize handle stream@ writes a stream of arrays
430-- to @handle@ after coalescing the adjacent arrays in chunks of @bufsize@.
431-- The chunk size is only a maximum and the actual writes could be smaller as
432-- we do not split the arrays to fit exactly to the specified size.
433--
434-- @since 0.7.0
435{-# INLINE fromChunksWithBufferOf #-}
436fromChunksWithBufferOf :: (MonadIO m, Storable a)
437 => Int -> Handle -> Stream m (Array a) -> m ()
438fromChunksWithBufferOf n h xs = fromChunks h $ AS.compact n xs
440-- | @fromStreamWithBufferOf bufsize handle stream@ writes @stream@ to @handle@
441-- in chunks of @bufsize@. A write is performed to the IO device as soon as we
442-- collect the required input size.
443--
444-- @since 0.7.0
445{-# INLINE fromStreamWithBufferOf #-}
446fromStreamWithBufferOf :: MonadIO m => Int -> Handle -> Stream m Word8 -> m ()
447fromStreamWithBufferOf n h m = fromChunks h $ S.pinnedChunksOf n m
448-- fromStreamWithBufferOf n h m = fromChunks h $ AS.chunksOf n m
450-- > write = 'writeWithBufferOf' A.defaultChunkSize
451--
452-- | Write a byte stream to a file handle. Accumulates the input in chunks of
453-- up to 'Streamly.Internal.Data.Array.Type.defaultChunkSize' before writing.
454--
455-- NOTE: This may perform better than the 'write' fold, you can try this if you
456-- need some extra perf boost.
457--
458-- @since 0.7.0
459{-# INLINE fromStream #-}
460fromStream :: MonadIO m => Handle -> Stream m Word8 -> m ()
461fromStream = fromStreamWithBufferOf defaultChunkSize
463-- | Write a stream of arrays to a handle. Each array in the stream is written
464-- to the device as a separate IO request.
465--
466-- @since 0.7.0
467{-# INLINE writeChunks #-}
468writeChunks :: (MonadIO m, Storable a) => Handle -> Fold m (Array a) ()
469writeChunks h = FL.drainBy (liftIO . writeArray h)
471-- | @writeChunksWithBufferOf bufsize handle@ writes a stream of arrays
472-- to @handle@ after coalescing the adjacent arrays in chunks of @bufsize@.
473-- We never split an array, if a single array is bigger than the specified size
474-- it emitted as it is. Multiple arrays are coalesed as long as the total size
475-- remains below the specified size.
476--
477-- @since 0.7.0
478{-# INLINE writeChunksWithBufferOf #-}
479writeChunksWithBufferOf :: (MonadIO m, Storable a)
480 => Int -> Handle -> Fold m (Array a) ()
481writeChunksWithBufferOf n h = lpackArraysChunksOf n (writeChunks h)
483-- GHC buffer size dEFAULT_FD_BUFFER_SIZE=8192 bytes.
484--
485-- XXX test this
486-- Note that if you use a chunk size less than 8K (GHC's default buffer
487-- size) then you are advised to use 'NOBuffering' mode on the 'Handle' in case you
488-- do not want buffering to occur at GHC level as well. Same thing applies to
489-- writes as well.
491-- | @writeWithBufferOf reqSize handle@ writes the input stream to @handle@.
492-- Bytes in the input stream are collected into a buffer until we have a chunk
493-- of @reqSize@ and then written to the IO device.
494--
495-- @since 0.7.0
496{-# INLINE writeWithBufferOf #-}
497writeWithBufferOf :: MonadIO m => Int -> Handle -> Fold m Word8 ()
498writeWithBufferOf n h = FL.groupsOf n (pinnedWriteNUnsafe n) (writeChunks h)
500-- > write = 'writeWithBufferOf' A.defaultChunkSize
501--
502-- | Write a byte stream to a file handle. Accumulates the input in chunks of
503-- up to 'Streamly.Internal.Data.Array.Type.defaultChunkSize' before writing
504-- to the IO device.
505--
506-- @since 0.7.0
507{-# INLINE write #-}
508write :: MonadIO m => Handle -> Fold m Word8 ()
509write = writeWithBufferOf defaultChunkSize
510-}