{-# LINE 1 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
-- |
-- Module      : Streamly.Internal.FileSystem.Posix.ReadDir
-- Copyright   : (c) 2024 Composewell Technologies
--
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Portability : GHC

module Streamly.Internal.FileSystem.Posix.ReadDir
    (

{-# LINE 12 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
      readScanWith_
    , readScanWith
    , readPlusScanWith

    , DirStream (..)
    , openDirStream
    , openDirStreamCString
    , closeDirStream
    , readDirStreamEither
    , readEitherChunks
    , readEitherByteChunks
    , readEitherByteChunksAt
    , eitherReader
    , reader

{-# LINE 27 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
    )
where


{-# LINE 31 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
import Control.Monad (unless)
import Control.Monad.Catch (MonadCatch)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Char (ord)
import Foreign
    ( Ptr, Word8, nullPtr, peek, peekByteOff, castPtr, plusPtr, (.&.)
    , allocaBytes
    )
import Foreign.C
    ( resetErrno, throwErrno, throwErrnoIfMinus1Retry_, throwErrnoIfNullRetry
    , Errno(..), getErrno, eINTR, eNOENT, eACCES, eLOOP
    , CInt(..), CString, CChar, CSize(..)
    )
import Foreign.Storable (poke)
import Fusion.Plugin.Types (Fuse(..))
import Streamly.Internal.Data.Array (Array(..))
import Streamly.Internal.Data.MutByteArray (MutByteArray)
import Streamly.Internal.Data.Scanl (Scanl)
import Streamly.Internal.Data.Stream (Stream(..), Step(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.FileSystem.Path (Path)
import Streamly.Internal.FileSystem.Posix.Errno (throwErrnoPathIfNullRetry)
import Streamly.Internal.FileSystem.Posix.File
    (defaultOpenFlags, openAt, close)
import Streamly.Internal.FileSystem.PosixPath (PosixPath(..))
import System.Posix.Types (Fd(..), CMode)

import qualified Streamly.Internal.Data.Array as Array
import qualified Streamly.Internal.Data.MutByteArray as MutByteArray
import qualified Streamly.Internal.Data.Unfold as UF (bracketIO)
import qualified Streamly.Internal.FileSystem.Path.Common as PathC
import qualified Streamly.Internal.FileSystem.PosixPath as Path

import Streamly.Internal.FileSystem.DirOptions




-------------------------------------------------------------------------------

data {-# CTYPE "DIR" #-} CDir
data {-# CTYPE "struct dirent" #-} CDirent
data {-# CTYPE "struct stat" #-} CStat

newtype DirStream = DirStream (Ptr CDir)

-- | Minimal read without any metadata.
{-# INLINE readScanWith_ #-}
readScanWith_ :: -- (MonadIO m, MonadCatch m) =>
       Scanl m (Path, CString) a
    -> (ReadOptions -> ReadOptions)
    -> Path
    -> Stream m a
readScanWith_ :: forall (m :: * -> *) a.
Scanl m (Path, CString) a
-> (ReadOptions -> ReadOptions) -> Path -> Stream m a
readScanWith_ = Scanl m (Path, CString) a
-> (ReadOptions -> ReadOptions) -> Path -> Stream m a
forall a. HasCallStack => a
undefined

-- | Read with essential metadata. The scan takes the parent dir, the child
-- name, the child metadata and produces an output. The scan can do filtering,
-- formatting of the output, colorizing the output etc.
--
-- The options are to ignore errors encountered when reading a path, turn the
-- errors into a nil stream instead.
{-# INLINE readScanWith #-}
readScanWith :: -- (MonadIO m, MonadCatch m) =>
       Scanl m (Path, CString, Ptr CDirent) a
    -> (ReadOptions -> ReadOptions)
    -> Path
    -> Stream m a
readScanWith :: forall (m :: * -> *) a.
Scanl m (Path, CString, Ptr CDirent) a
-> (ReadOptions -> ReadOptions) -> Path -> Stream m a
readScanWith = Scanl m (Path, CString, Ptr CDirent) a
-> (ReadOptions -> ReadOptions) -> Path -> Stream m a
forall a. HasCallStack => a
undefined

-- NOTE: See  https://www.manpagez.com/man/2/getattrlistbulk/ for BSD/macOS.

-- | Read with full metadata.
{-# INLINE readPlusScanWith #-}
readPlusScanWith :: -- (MonadIO m, MonadCatch m) =>
       Scanl m (Path, CString, Ptr CStat) a
    -> (ReadOptions -> ReadOptions)
    -> Path
    -> Stream m a
readPlusScanWith :: forall (m :: * -> *) a.
Scanl m (Path, CString, Ptr CStat) a
-> (ReadOptions -> ReadOptions) -> Path -> Stream m a
readPlusScanWith = Scanl m (Path, CString, Ptr CStat) a
-> (ReadOptions -> ReadOptions) -> Path -> Stream m a
forall a. HasCallStack => a
undefined

-------------------------------------------------------------------------------
-- readdir operations
-------------------------------------------------------------------------------

-- XXX Marking the calls "safe" has significant perf impact because it runs on
-- a separate OS thread. "unsafe" is faster but can block the GC if the system
-- call blocks. The effect could be signifcant if the file system is on NFS. Is
-- it possible to have a faster safe - where we know the function is safe but
-- we run it on the current thread, and if it blocks for longer we can snatch
-- the capability and enable GC?
--
-- IMPORTANT NOTE: Use capi FFI for all readdir APIs. This is required at
-- least on macOS for correctness. We saw random directory entries when ccall
-- was used on macOS 15.3. Looks like it was picking the wrong version of
-- dirent structure. Did not see the problem in CIs on macOS 14.7.2 though.
foreign import capi unsafe "closedir"
   c_closedir :: Ptr CDir -> IO CInt

foreign import capi unsafe "dirent.h opendir"
    c_opendir :: CString  -> IO (Ptr CDir)

foreign import capi unsafe "dirent.h fdopendir"
    c_fdopendir :: CInt  -> IO (Ptr CDir)

-- XXX The "unix" package uses a wrapper over readdir __hscore_readdir (see
-- cbits/HsUnix.c in unix package) which uses readdir_r in some cases where
-- readdir is not known to be re-entrant. We are not doing that here. We are
-- assuming that readdir is re-entrant which may not be the case on some old
-- unix systems.
foreign import capi unsafe "dirent.h readdir"
    c_readdir  :: Ptr CDir -> IO (Ptr CDirent)

--------------------------------------------------------------------------------
-- Stat
--------------------------------------------------------------------------------

foreign import ccall unsafe "stat.h lstat"
    c_lstat :: CString -> Ptr CStat -> IO CInt

foreign import ccall unsafe "stat.h stat"
    c_stat :: CString -> Ptr CStat -> IO CInt

s_IFMT :: CMode
s_IFMT :: CMode
s_IFMT  = CMode
61440
{-# LINE 155 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}

s_IFDIR :: CMode
s_IFDIR :: CMode
s_IFDIR = CMode
16384
{-# LINE 158 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}

{-
s_IFREG :: CMode
s_IFREG = #{const S_IFREG}

s_IFLNK :: CMode
s_IFLNK = #{const S_IFLNK}
-}

-- NOTE: Using fstatat with a dirfd and relative path would be faster.
stat :: Bool -> CString -> IO (Either Errno CMode)
stat :: Bool -> CString -> IO (Either Errno CMode)
stat Bool
followSym CString
cstr =
    Int
-> (Ptr CStat -> IO (Either Errno CMode))
-> IO (Either Errno CMode)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
144) ((Ptr CStat -> IO (Either Errno CMode)) -> IO (Either Errno CMode))
-> (Ptr CStat -> IO (Either Errno CMode))
-> IO (Either Errno CMode)
forall a b. (a -> b) -> a -> b
$ \Ptr CStat
p_stat -> do
{-# LINE 171 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
        IO ()
resetErrno
        CInt
result <-
            if Bool
followSym
            then CString -> Ptr CStat -> IO CInt
c_stat CString
cstr Ptr CStat
p_stat
            else CString -> Ptr CStat -> IO CInt
c_lstat CString
cstr Ptr CStat
p_stat
        if CInt
result CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
        then do
            Errno
errno <- IO Errno
getErrno
            if Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINTR
            then Bool -> CString -> IO (Either Errno CMode)
stat Bool
followSym CString
cstr
            else Either Errno CMode -> IO (Either Errno CMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Errno CMode -> IO (Either Errno CMode))
-> Either Errno CMode -> IO (Either Errno CMode)
forall a b. (a -> b) -> a -> b
$ Errno -> Either Errno CMode
forall a b. a -> Either a b
Left Errno
errno
        else do
            CMode
mode <- (\Ptr CStat
hsc_ptr -> Ptr CStat -> Int -> IO CMode
forall b. Ptr b -> Int -> IO CMode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CStat
hsc_ptr Int
24) Ptr CStat
p_stat
{-# LINE 184 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
            Either Errno CMode -> IO (Either Errno CMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Errno CMode -> IO (Either Errno CMode))
-> Either Errno CMode -> IO (Either Errno CMode)
forall a b. (a -> b) -> a -> b
$ CMode -> Either Errno CMode
forall a b. b -> Either a b
Right (CMode
mode CMode -> CMode -> CMode
forall a. Bits a => a -> a -> a
.&. CMode
s_IFMT)

--------------------------------------------------------------------------------
-- Functions
--------------------------------------------------------------------------------

-- | The CString must be pinned.
{-# INLINE openDirStreamCString #-}
openDirStreamCString :: CString -> IO DirStream
openDirStreamCString :: CString -> IO DirStream
openDirStreamCString CString
s = do
    -- XXX we do not decode the path here, just print it as cstring
    -- XXX pass lazy concat of "openDirStream: " ++ s
    Ptr CDir
dirp <- String -> IO (Ptr CDir) -> IO (Ptr CDir)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNullRetry String
"openDirStream" (IO (Ptr CDir) -> IO (Ptr CDir)) -> IO (Ptr CDir) -> IO (Ptr CDir)
forall a b. (a -> b) -> a -> b
$ CString -> IO (Ptr CDir)
c_opendir CString
s
    DirStream -> IO DirStream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CDir -> DirStream
DirStream Ptr CDir
dirp)

-- XXX Path is not null terminated therefore we need to make a copy even if the
-- array is pinned.
-- {-# INLINE openDirStream #-}
openDirStream :: PosixPath -> IO DirStream
openDirStream :: Path -> IO DirStream
openDirStream Path
p =
    Array Word8 -> (CString -> IO DirStream) -> IO DirStream
forall a b. Array a -> (CString -> IO b) -> IO b
Array.asCStringUnsafe (Path -> Array Word8
Path.toArray Path
p) ((CString -> IO DirStream) -> IO DirStream)
-> (CString -> IO DirStream) -> IO DirStream
forall a b. (a -> b) -> a -> b
$ \CString
s -> do
        -- openDirStreamCString s
        Ptr CDir
dirp <- String -> Path -> IO (Ptr CDir) -> IO (Ptr CDir)
forall a. String -> Path -> IO (Ptr a) -> IO (Ptr a)
throwErrnoPathIfNullRetry String
"openDirStream" Path
p (IO (Ptr CDir) -> IO (Ptr CDir)) -> IO (Ptr CDir) -> IO (Ptr CDir)
forall a b. (a -> b) -> a -> b
$ CString -> IO (Ptr CDir)
c_opendir CString
s
        DirStream -> IO DirStream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CDir -> DirStream
DirStream Ptr CDir
dirp)

-- | Note that the supplied Fd is used by DirStream and when we close the
-- DirStream the fd will be closed.
openDirStreamAt :: Fd -> PosixPath -> IO DirStream
openDirStreamAt :: Fd -> Path -> IO DirStream
openDirStreamAt Fd
fd Path
p = do
    -- XXX can pass O_DIRECTORY here, is O_NONBLOCK useful for dirs?
    -- Note this fd is not automatically closed, we have to take care of
    -- exceptions and closing the fd.
    Fd
fd1 <- Maybe Fd -> Path -> OpenFlags -> Maybe FileMode -> IO Fd
openAt (Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
fd) Path
p OpenFlags
defaultOpenFlags Maybe FileMode
forall a. Maybe a
Nothing
    -- liftIO $ putStrLn $ "opened: " ++ show fd1
    Ptr CDir
dirp <- String -> Path -> IO (Ptr CDir) -> IO (Ptr CDir)
forall a. String -> Path -> IO (Ptr a) -> IO (Ptr a)
throwErrnoPathIfNullRetry String
"openDirStreamAt" Path
p
        (IO (Ptr CDir) -> IO (Ptr CDir)) -> IO (Ptr CDir) -> IO (Ptr CDir)
forall a b. (a -> b) -> a -> b
$ CInt -> IO (Ptr CDir)
c_fdopendir (Fd -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd1)
    -- XXX can we somehow clone fd1 instead of opening again?
    DirStream -> IO DirStream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CDir -> DirStream
DirStream Ptr CDir
dirp)

-- | @closeDirStream dp@ calls @closedir@ to close
--   the directory stream @dp@.
closeDirStream :: DirStream -> IO ()
closeDirStream :: DirStream -> IO ()
closeDirStream (DirStream Ptr CDir
dirp) = do
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"closeDirStream" (Ptr CDir -> IO CInt
c_closedir Ptr CDir
dirp)

-------------------------------------------------------------------------------
-- determining filetype
-------------------------------------------------------------------------------

isMetaDir :: Ptr CChar -> IO Bool
isMetaDir :: CString -> IO Bool
isMetaDir CString
dname = do
    -- XXX Assuming an encoding that maps "." to ".", this is true for
    -- UTF8.
    -- Load as soon as possible to optimize memory accesses
    CChar
c1 <- CString -> IO CChar
forall a. Storable a => Ptr a -> IO a
peek CString
dname
    Word8
c2 :: Word8 <- CString -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff CString
dname Int
1
    if (CChar
c1 CChar -> CChar -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'.'))
    then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    else do
        if (Word8
c2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0)
        then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else do
            if (Word8
c2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'.'))
            then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else do
                Word8
c3 :: Word8 <- CString -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff CString
dname Int
2
                if (Word8
c3 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0)
                then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                else Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

data EntryType = EntryIsDir | EntryIsNotDir | EntryIgnored

{-# NOINLINE statEntryType #-}
statEntryType
    :: ReadOptions -> PosixPath -> Ptr CChar -> IO EntryType
statEntryType :: ReadOptions -> Path -> CString -> IO EntryType
statEntryType ReadOptions
conf Path
parent CString
dname = do
    -- XXX We can create a pinned array right here since the next call pins
    -- it anyway.
    Path
path <- Path -> CString -> IO Path
appendCString Path
parent CString
dname
    Array Word8 -> (CString -> IO EntryType) -> IO EntryType
forall a b. Array a -> (CString -> IO b) -> IO b
Array.asCStringUnsafe (Path -> Array Word8
Path.toArray Path
path) ((CString -> IO EntryType) -> IO EntryType)
-> (CString -> IO EntryType) -> IO EntryType
forall a b. (a -> b) -> a -> b
$ \CString
cStr -> do
        Either Errno CMode
res <- Bool -> CString -> IO (Either Errno CMode)
stat (ReadOptions -> Bool
_followSymlinks ReadOptions
conf) CString
cStr
        case Either Errno CMode
res of
            Right CMode
mode -> EntryType -> IO EntryType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EntryType -> IO EntryType) -> EntryType -> IO EntryType
forall a b. (a -> b) -> a -> b
$
                if (CMode
mode CMode -> CMode -> Bool
forall a. Eq a => a -> a -> Bool
== CMode
s_IFDIR)
                then EntryType
EntryIsDir
                else EntryType
EntryIsNotDir
            Left Errno
errno -> do
                if Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eNOENT
                then Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ReadOptions -> Bool
_ignoreENOENT ReadOptions
conf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                         String -> IO ()
forall a. String -> IO a
throwErrno (Path -> String
errMsg Path
path)
                else if Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eACCES
                then Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ReadOptions -> Bool
_ignoreEACCESS ReadOptions
conf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                         String -> IO ()
forall a. String -> IO a
throwErrno (Path -> String
errMsg Path
path)
                else if Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eLOOP
                then Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ReadOptions -> Bool
_ignoreELOOP ReadOptions
conf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                         String -> IO ()
forall a. String -> IO a
throwErrno (Path -> String
errMsg Path
path)
                else String -> IO ()
forall a. String -> IO a
throwErrno (Path -> String
errMsg Path
path)
                EntryType -> IO EntryType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EntryType -> IO EntryType) -> EntryType -> IO EntryType
forall a b. (a -> b) -> a -> b
$ EntryType
EntryIgnored
    where

    errMsg :: Path -> String
errMsg Path
path =
        let pathStr :: String
pathStr = Path -> String
Path.toString_ Path
path
         in String
"statEntryType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pathStr

-- | Checks if dname is a directory, not dir or should be ignored.
{-# INLINE getEntryType #-}
getEntryType
    :: ReadOptions
    -> PosixPath -> Ptr CChar -> Word8 -> IO EntryType
{-# LINE 293 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
getEntryType conf parent dname dtype = do
    let needStat =

{-# LINE 298 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
            (dtype == (10) && _followSymlinks conf)
{-# LINE 299 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
                || dtype == 0
{-# LINE 300 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}

{-# LINE 301 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}

    if dtype /= (4) && not needStat
{-# LINE 303 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
    then pure EntryIsNotDir
    else do
        isMeta <- liftIO $ isMetaDir dname
        if isMeta
        then pure EntryIgnored
        else if dtype == (4)
{-# LINE 309 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
        then pure EntryIsDir
        else statEntryType conf parent dname

-------------------------------------------------------------------------------
-- streaming reads
-------------------------------------------------------------------------------

-- XXX We can use getdents64 directly so that we can use array slices from the
-- same buffer that we passed to the OS. That way we can also avoid any
-- overhead of bracket.
-- XXX Make this as Unfold to avoid returning Maybe
-- XXX Or NOINLINE some parts and inline the rest to fuse it
-- {-# INLINE readDirStreamEither #-}
readDirStreamEither ::
    -- DirStream -> IO (Either (Rel (Dir Path)) (Rel (File Path)))
    (ReadOptions -> ReadOptions) ->
    (PosixPath, DirStream) -> IO (Maybe (Either PosixPath PosixPath))
readDirStreamEither :: (ReadOptions -> ReadOptions)
-> (Path, DirStream) -> IO (Maybe (Either Path Path))
readDirStreamEither ReadOptions -> ReadOptions
confMod (Path
curdir, (DirStream Ptr CDir
dirp)) = IO (Maybe (Either Path Path))
loop

  where

  conf :: ReadOptions
conf = ReadOptions -> ReadOptions
confMod ReadOptions
defaultReadOptions

  -- mkPath :: IsPath (Rel (a Path)) => Array Word8 -> Rel (a Path)
  -- {-# INLINE mkPath #-}
  mkPath :: Array Word8 -> PosixPath
  mkPath :: Array Word8 -> Path
mkPath = Array Word8 -> Path
Path.unsafeFromArray

  loop :: IO (Maybe (Either Path Path))
loop = do
    IO ()
resetErrno
    Ptr CDirent
ptr <- Ptr CDir -> IO (Ptr CDirent)
c_readdir Ptr CDir
dirp
    if (Ptr CDirent
ptr Ptr CDirent -> Ptr CDirent -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CDirent
forall a. Ptr a
nullPtr)
    then do
        let dname :: Ptr b
dname = (\Ptr CDirent
hsc_ptr -> Ptr CDirent
hsc_ptr Ptr CDirent -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
19) Ptr CDirent
ptr
{-# LINE 343 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
        Word8
dtype :: Word8 <- (\Ptr CDirent
hsc_ptr -> Ptr CDirent -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CDirent
hsc_ptr Int
18) Ptr CDirent
ptr
{-# LINE 344 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
        -- dreclen :: #{type unsigned short} <- #{peek struct dirent, d_reclen} ptr
        -- It is possible to find the name length using dreclen and then use
        -- fromPtrN, but it is not straightforward because the reclen is
        -- padded to 8-byte boundary.
        Array Word8
name <- Ptr Word8 -> IO (Array Word8)
forall (m :: * -> *). MonadIO m => Ptr Word8 -> m (Array Word8)
Array.fromCString (Ptr Any -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
forall a. Ptr a
dname)
        EntryType
etype <- ReadOptions -> Path -> CString -> Word8 -> IO EntryType
getEntryType ReadOptions
conf Path
curdir CString
forall a. Ptr a
dname Word8
dtype
        case EntryType
etype of
            EntryType
EntryIsDir -> Maybe (Either Path Path) -> IO (Maybe (Either Path Path))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Path Path -> Maybe (Either Path Path)
forall a. a -> Maybe a
Just (Path -> Either Path Path
forall a b. a -> Either a b
Left (Array Word8 -> Path
mkPath Array Word8
name)))
            EntryType
EntryIsNotDir -> Maybe (Either Path Path) -> IO (Maybe (Either Path Path))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Path Path -> Maybe (Either Path Path)
forall a. a -> Maybe a
Just (Path -> Either Path Path
forall a b. b -> Either a b
Right (Array Word8 -> Path
mkPath Array Word8
name)))
            EntryType
EntryIgnored -> IO (Maybe (Either Path Path))
loop
    else do
        Errno
errno <- IO Errno
getErrno
        if (Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINTR)
        then IO (Maybe (Either Path Path))
loop
        else do
            let (Errno CInt
n) = Errno
errno
            if (CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
            -- then return (Left (mkPath (Array.fromList [46])))
            then Maybe (Either Path Path) -> IO (Maybe (Either Path Path))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either Path Path)
forall a. Maybe a
Nothing
            else String -> IO (Maybe (Either Path Path))
forall a. String -> IO a
throwErrno String
"readDirStreamEither"

-- XXX We can make this code common with windows, the path argument would be
-- redundant for windows case though.
{-# INLINE streamEitherReader #-}
streamEitherReader :: MonadIO m =>
    (ReadOptions -> ReadOptions) ->
    Unfold m (PosixPath, DirStream) (Either Path Path)
streamEitherReader :: forall (m :: * -> *).
MonadIO m =>
(ReadOptions -> ReadOptions)
-> Unfold m (Path, DirStream) (Either Path Path)
streamEitherReader ReadOptions -> ReadOptions
confMod = ((Path, DirStream)
 -> m (Step (Path, DirStream) (Either Path Path)))
-> ((Path, DirStream) -> m (Path, DirStream))
-> Unfold m (Path, DirStream) (Either Path Path)
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (Path, DirStream) -> m (Step (Path, DirStream) (Either Path Path))
forall {m :: * -> *}.
MonadIO m =>
(Path, DirStream) -> m (Step (Path, DirStream) (Either Path Path))
step (Path, DirStream) -> m (Path, DirStream)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    where

    step :: (Path, DirStream) -> m (Step (Path, DirStream) (Either Path Path))
step (Path, DirStream)
s = do
        Maybe (Either Path Path)
r <- IO (Maybe (Either Path Path)) -> m (Maybe (Either Path Path))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either Path Path)) -> m (Maybe (Either Path Path)))
-> IO (Maybe (Either Path Path)) -> m (Maybe (Either Path Path))
forall a b. (a -> b) -> a -> b
$ (ReadOptions -> ReadOptions)
-> (Path, DirStream) -> IO (Maybe (Either Path Path))
readDirStreamEither ReadOptions -> ReadOptions
confMod (Path, DirStream)
s
        case Maybe (Either Path Path)
r of
            Maybe (Either Path Path)
Nothing -> Step (Path, DirStream) (Either Path Path)
-> m (Step (Path, DirStream) (Either Path Path))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Path, DirStream) (Either Path Path)
forall s a. Step s a
Stop
            Just Either Path Path
x -> Step (Path, DirStream) (Either Path Path)
-> m (Step (Path, DirStream) (Either Path Path))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Path, DirStream) (Either Path Path)
 -> m (Step (Path, DirStream) (Either Path Path)))
-> Step (Path, DirStream) (Either Path Path)
-> m (Step (Path, DirStream) (Either Path Path))
forall a b. (a -> b) -> a -> b
$ Either Path Path
-> (Path, DirStream) -> Step (Path, DirStream) (Either Path Path)
forall s a. a -> s -> Step s a
Yield Either Path Path
x (Path, DirStream)
s

{-# INLINE streamReader #-}
streamReader :: MonadIO m => Unfold m (PosixPath, DirStream) Path
streamReader :: forall (m :: * -> *). MonadIO m => Unfold m (Path, DirStream) Path
streamReader = (Either Path Path -> Path)
-> Unfold m (Path, DirStream) (Either Path Path)
-> Unfold m (Path, DirStream) Path
forall a b.
(a -> b)
-> Unfold m (Path, DirStream) a -> Unfold m (Path, DirStream) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Path -> Path) -> (Path -> Path) -> Either Path Path -> Path
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Path -> Path
forall a. a -> a
id Path -> Path
forall a. a -> a
id) ((ReadOptions -> ReadOptions)
-> Unfold m (Path, DirStream) (Either Path Path)
forall (m :: * -> *).
MonadIO m =>
(ReadOptions -> ReadOptions)
-> Unfold m (Path, DirStream) (Either Path Path)
streamEitherReader ReadOptions -> ReadOptions
forall a. a -> a
id)

{-# INLINE before #-}
before :: PosixPath -> IO (PosixPath, DirStream)
before :: Path -> IO (Path, DirStream)
before Path
parent = (Path
parent,) (DirStream -> (Path, DirStream))
-> IO DirStream -> IO (Path, DirStream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> IO DirStream
openDirStream Path
parent

{-# INLINE after #-}
after :: (PosixPath, DirStream) -> IO ()
after :: (Path, DirStream) -> IO ()
after (Path
_, DirStream
dirStream) = DirStream -> IO ()
closeDirStream DirStream
dirStream

--  | Read a directory emitting a stream with names of the children. Filter out
--  "." and ".." entries.
--
--  /Internal/
--
{-# INLINE reader #-}
reader :: (MonadIO m, MonadCatch m) => Unfold m Path Path
reader :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m Path Path
reader =
    -- XXX Instead of using bracketIO for each iteration of the loop we should
    -- instead yield a buffer of dir entries in each iteration and then use an
    -- unfold and concat to flatten those entries. That should improve the
    -- performance.
    (Path -> IO (Path, DirStream))
-> ((Path, DirStream) -> IO ())
-> Unfold m (Path, DirStream) Path
-> Unfold m Path Path
forall (m :: * -> *) a c d b.
(MonadIO m, MonadCatch m) =>
(a -> IO c) -> (c -> IO d) -> Unfold m c b -> Unfold m a b
UF.bracketIO Path -> IO (Path, DirStream)
before (Path, DirStream) -> IO ()
after (Unfold m (Path, DirStream) Path
forall (m :: * -> *). MonadIO m => Unfold m (Path, DirStream) Path
streamReader)

-- | Read directories as Left and files as Right. Filter out "." and ".."
-- entries.
--
--  /Internal/
--
{-# INLINE eitherReader #-}
eitherReader :: (MonadIO m, MonadCatch m) =>
    (ReadOptions -> ReadOptions) -> Unfold m Path (Either Path Path)
eitherReader :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
(ReadOptions -> ReadOptions) -> Unfold m Path (Either Path Path)
eitherReader ReadOptions -> ReadOptions
confMod =
    -- XXX The measured overhead of bracketIO is not noticeable, if it turns
    -- out to be a problem for small filenames we can use getdents64 to use
    -- chunked read to avoid the overhead.
    (Path -> IO (Path, DirStream))
-> ((Path, DirStream) -> IO ())
-> Unfold m (Path, DirStream) (Either Path Path)
-> Unfold m Path (Either Path Path)
forall (m :: * -> *) a c d b.
(MonadIO m, MonadCatch m) =>
(a -> IO c) -> (c -> IO d) -> Unfold m c b -> Unfold m a b
UF.bracketIO Path -> IO (Path, DirStream)
before (Path, DirStream) -> IO ()
after ((ReadOptions -> ReadOptions)
-> Unfold m (Path, DirStream) (Either Path Path)
forall (m :: * -> *).
MonadIO m =>
(ReadOptions -> ReadOptions)
-> Unfold m (Path, DirStream) (Either Path Path)
streamEitherReader ReadOptions -> ReadOptions
confMod)

{-# INLINE appendCString #-}
appendCString :: PosixPath -> CString -> IO PosixPath
appendCString :: Path -> CString -> IO Path
appendCString (PosixPath Array Word8
a) CString
b = do
    Array Word8
arr <- OS -> Array Word8 -> CString -> IO (Array Word8)
PathC.appendCString OS
PathC.Posix Array Word8
a CString
b
    Path -> IO Path
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> IO Path) -> Path -> IO Path
forall a b. (a -> b) -> a -> b
$ Array Word8 -> Path
PosixPath Array Word8
arr

{-# ANN type ChunkStreamState Fuse #-}
data ChunkStreamState =
      ChunkStreamInit [PosixPath] [PosixPath] Int [PosixPath] Int
    | ChunkStreamLoop
        PosixPath -- current dir path
        [PosixPath]  -- remaining dirs
        (Ptr CDir) -- current dir
        [PosixPath] -- dirs buffered
        Int    -- dir count
        [PosixPath] -- files buffered
        Int -- file count

-- XXX We can use a fold for collecting files and dirs.
-- A fold may be useful to translate the output to whatever format we want, we
-- can add a prefix or we can colorize it. The Right output would be the output
-- of the fold which can be any type not just a Path.

-- XXX We can write a two fold scan to buffer and yield whichever fills first
-- like foldMany, it would be foldEither.
{-# INLINE readEitherChunks #-}
readEitherChunks
    :: MonadIO m
    => (ReadOptions -> ReadOptions)
    -> [PosixPath] -> Stream m (Either [PosixPath] [PosixPath])
readEitherChunks :: forall (m :: * -> *).
MonadIO m =>
(ReadOptions -> ReadOptions)
-> [Path] -> Stream m (Either [Path] [Path])
readEitherChunks ReadOptions -> ReadOptions
confMod [Path]
alldirs =
    (State StreamK m (Either [Path] [Path])
 -> ChunkStreamState
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> ChunkStreamState -> Stream m (Either [Path] [Path])
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m (Either [Path] [Path])
-> ChunkStreamState
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall {m :: * -> *} {p}.
MonadIO m =>
p
-> ChunkStreamState
-> m (Step ChunkStreamState (Either [Path] [Path]))
step ([Path] -> [Path] -> Int -> [Path] -> Int -> ChunkStreamState
ChunkStreamInit [Path]
alldirs [] Int
0 [] Int
0)

    where

    conf :: ReadOptions
conf = ReadOptions -> ReadOptions
confMod ReadOptions
defaultReadOptions

    -- We want to keep the dir batching as low as possible for better
    -- concurrency esp when the number of dirs is low.
    dirMax :: Int
dirMax = Int
4
    fileMax :: Int
fileMax = Int
1000

    step :: p
-> ChunkStreamState
-> m (Step ChunkStreamState (Either [Path] [Path]))
step p
_ (ChunkStreamInit (Path
x:[Path]
xs) [Path]
dirs Int
ndirs [Path]
files Int
nfiles) = do
        DirStream Ptr CDir
dirp <- IO DirStream -> m DirStream
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DirStream -> m DirStream) -> IO DirStream -> m DirStream
forall a b. (a -> b) -> a -> b
$ Path -> IO DirStream
openDirStream Path
x
        Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamState (Either [Path] [Path])
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a b. (a -> b) -> a -> b
$ ChunkStreamState -> Step ChunkStreamState (Either [Path] [Path])
forall s a. s -> Step s a
Skip (Path
-> [Path]
-> Ptr CDir
-> [Path]
-> Int
-> [Path]
-> Int
-> ChunkStreamState
ChunkStreamLoop Path
x [Path]
xs Ptr CDir
dirp [Path]
dirs Int
ndirs [Path]
files Int
nfiles)

    step p
_ (ChunkStreamInit [] [] Int
_ [] Int
_) =
        Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step ChunkStreamState (Either [Path] [Path])
forall s a. Step s a
Stop

    step p
_ (ChunkStreamInit [] [] Int
_ [Path]
files Int
_) =
        Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamState (Either [Path] [Path])
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a b. (a -> b) -> a -> b
$ Either [Path] [Path]
-> ChunkStreamState -> Step ChunkStreamState (Either [Path] [Path])
forall s a. a -> s -> Step s a
Yield ([Path] -> Either [Path] [Path]
forall a b. b -> Either a b
Right [Path]
files) ([Path] -> [Path] -> Int -> [Path] -> Int -> ChunkStreamState
ChunkStreamInit [] [] Int
0 [] Int
0)

    step p
_ (ChunkStreamInit [] [Path]
dirs Int
_ [Path]
files Int
_) =
        Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamState (Either [Path] [Path])
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a b. (a -> b) -> a -> b
$ Either [Path] [Path]
-> ChunkStreamState -> Step ChunkStreamState (Either [Path] [Path])
forall s a. a -> s -> Step s a
Yield ([Path] -> Either [Path] [Path]
forall a b. a -> Either a b
Left [Path]
dirs) ([Path] -> [Path] -> Int -> [Path] -> Int -> ChunkStreamState
ChunkStreamInit [] [] Int
0 [Path]
files Int
0)

    step p
_ st :: ChunkStreamState
st@(ChunkStreamLoop Path
curdir [Path]
xs Ptr CDir
dirp [Path]
dirs Int
ndirs [Path]
files Int
nfiles) = do
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
resetErrno
        Ptr CDirent
dentPtr <- IO (Ptr CDirent) -> m (Ptr CDirent)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CDirent) -> m (Ptr CDirent))
-> IO (Ptr CDirent) -> m (Ptr CDirent)
forall a b. (a -> b) -> a -> b
$ Ptr CDir -> IO (Ptr CDirent)
c_readdir Ptr CDir
dirp
        if (Ptr CDirent
dentPtr Ptr CDirent -> Ptr CDirent -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CDirent
forall a. Ptr a
nullPtr)
        then do
            let dname :: Ptr b
dname = (\Ptr CDirent
hsc_ptr -> Ptr CDirent
hsc_ptr Ptr CDirent -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
19) Ptr CDirent
dentPtr
{-# LINE 481 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
            Word8
dtype :: Word8 <-
{-# LINE 482 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
                IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ (\Ptr CDirent
hsc_ptr -> Ptr CDirent -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CDirent
hsc_ptr Int
18) Ptr CDirent
dentPtr
{-# LINE 483 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}

            EntryType
etype <- IO EntryType -> m EntryType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EntryType -> m EntryType) -> IO EntryType -> m EntryType
forall a b. (a -> b) -> a -> b
$ ReadOptions -> Path -> CString -> Word8 -> IO EntryType
getEntryType ReadOptions
conf Path
curdir CString
forall a. Ptr a
dname Word8
dtype
            case EntryType
etype of
                EntryType
EntryIsDir -> do
                     Path
path <- IO Path -> m Path
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Path -> m Path) -> IO Path -> m Path
forall a b. (a -> b) -> a -> b
$ Path -> CString -> IO Path
appendCString Path
curdir CString
forall a. Ptr a
dname
                     let dirs1 :: [Path]
dirs1 = Path
path Path -> [Path] -> [Path]
forall a. a -> [a] -> [a]
: [Path]
dirs
                         ndirs1 :: Int
ndirs1 = Int
ndirs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                      in if Int
ndirs1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
dirMax
                         then Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamState (Either [Path] [Path])
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a b. (a -> b) -> a -> b
$ Either [Path] [Path]
-> ChunkStreamState -> Step ChunkStreamState (Either [Path] [Path])
forall s a. a -> s -> Step s a
Yield ([Path] -> Either [Path] [Path]
forall a b. a -> Either a b
Left [Path]
dirs1)
                            (Path
-> [Path]
-> Ptr CDir
-> [Path]
-> Int
-> [Path]
-> Int
-> ChunkStreamState
ChunkStreamLoop Path
curdir [Path]
xs Ptr CDir
dirp [] Int
0 [Path]
files Int
nfiles)
                         else Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamState (Either [Path] [Path])
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a b. (a -> b) -> a -> b
$ ChunkStreamState -> Step ChunkStreamState (Either [Path] [Path])
forall s a. s -> Step s a
Skip
                            (Path
-> [Path]
-> Ptr CDir
-> [Path]
-> Int
-> [Path]
-> Int
-> ChunkStreamState
ChunkStreamLoop Path
curdir [Path]
xs Ptr CDir
dirp [Path]
dirs1 Int
ndirs1 [Path]
files Int
nfiles)
                EntryType
EntryIsNotDir -> do
                 Path
path <- IO Path -> m Path
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Path -> m Path) -> IO Path -> m Path
forall a b. (a -> b) -> a -> b
$ Path -> CString -> IO Path
appendCString Path
curdir CString
forall a. Ptr a
dname
                 let files1 :: [Path]
files1 = Path
path Path -> [Path] -> [Path]
forall a. a -> [a] -> [a]
: [Path]
files
                     nfiles1 :: Int
nfiles1 = Int
nfiles Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                  in if Int
nfiles1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fileMax
                     then Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamState (Either [Path] [Path])
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a b. (a -> b) -> a -> b
$ Either [Path] [Path]
-> ChunkStreamState -> Step ChunkStreamState (Either [Path] [Path])
forall s a. a -> s -> Step s a
Yield ([Path] -> Either [Path] [Path]
forall a b. b -> Either a b
Right [Path]
files1)
                        (Path
-> [Path]
-> Ptr CDir
-> [Path]
-> Int
-> [Path]
-> Int
-> ChunkStreamState
ChunkStreamLoop Path
curdir [Path]
xs Ptr CDir
dirp [Path]
dirs Int
ndirs [] Int
0)
                     else Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamState (Either [Path] [Path])
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a b. (a -> b) -> a -> b
$ ChunkStreamState -> Step ChunkStreamState (Either [Path] [Path])
forall s a. s -> Step s a
Skip
                        (Path
-> [Path]
-> Ptr CDir
-> [Path]
-> Int
-> [Path]
-> Int
-> ChunkStreamState
ChunkStreamLoop Path
curdir [Path]
xs Ptr CDir
dirp [Path]
dirs Int
ndirs [Path]
files1 Int
nfiles1)
                EntryType
EntryIgnored -> Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamState (Either [Path] [Path])
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a b. (a -> b) -> a -> b
$ ChunkStreamState -> Step ChunkStreamState (Either [Path] [Path])
forall s a. s -> Step s a
Skip ChunkStreamState
st
        else do
            Errno
errno <- IO Errno -> m Errno
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Errno
getErrno
            if (Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINTR)
            then Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamState (Either [Path] [Path])
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a b. (a -> b) -> a -> b
$ ChunkStreamState -> Step ChunkStreamState (Either [Path] [Path])
forall s a. s -> Step s a
Skip ChunkStreamState
st
            else do
                let (Errno CInt
n) = Errno
errno
                -- XXX Exception safety
                IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DirStream -> IO ()
closeDirStream (Ptr CDir -> DirStream
DirStream Ptr CDir
dirp)
                if (CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
                then Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamState (Either [Path] [Path])
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> Step ChunkStreamState (Either [Path] [Path])
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a b. (a -> b) -> a -> b
$ ChunkStreamState -> Step ChunkStreamState (Either [Path] [Path])
forall s a. s -> Step s a
Skip ([Path] -> [Path] -> Int -> [Path] -> Int -> ChunkStreamState
ChunkStreamInit [Path]
xs [Path]
dirs Int
ndirs [Path]
files Int
nfiles)
                else IO (Step ChunkStreamState (Either [Path] [Path]))
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Step ChunkStreamState (Either [Path] [Path]))
 -> m (Step ChunkStreamState (Either [Path] [Path])))
-> IO (Step ChunkStreamState (Either [Path] [Path]))
-> m (Step ChunkStreamState (Either [Path] [Path]))
forall a b. (a -> b) -> a -> b
$ String -> IO (Step ChunkStreamState (Either [Path] [Path]))
forall a. String -> IO a
throwErrno String
"readEitherChunks"

foreign import ccall unsafe "string.h memcpy" c_memcpy
    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)

-- See also cstringLength# in GHC.CString in ghc-prim
foreign import ccall unsafe "string.h strlen" c_strlen
    :: Ptr CChar -> IO CSize

-- Split a list in half.
splitHalf :: [a] -> ([a], [a])
splitHalf :: forall a. [a] -> ([a], [a])
splitHalf [a]
xxs = [a] -> [a] -> ([a], [a])
forall {a} {a}. [a] -> [a] -> ([a], [a])
split [a]
xxs [a]
xxs

    where

    split :: [a] -> [a] -> ([a], [a])
split (a
x:[a]
xs) (a
_:a
_:[a]
ys) =
        let ([a]
f, [a]
s) = [a] -> [a] -> ([a], [a])
split [a]
xs [a]
ys
         in (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
f, [a]
s)
    split [a]
xs [a]
_ = ([], [a]
xs)

{-# ANN type ChunkStreamByteState Fuse #-}
data ChunkStreamByteState =
      ChunkStreamByteInit
    | ChunkStreamByteStop
    | ChunkStreamByteLoop
        PosixPath -- current dir path
        [PosixPath]  -- remaining dirs
        (Ptr CDir) -- current dir stream
        MutByteArray
        Int
    | ChunkStreamReallocBuf
        (Ptr CChar) -- pending item
        PosixPath -- current dir path
        [PosixPath]  -- remaining dirs
        (Ptr CDir) -- current dir stream
        MutByteArray
        Int
    | ChunkStreamDrainBuf
        MutByteArray
        Int

-- XXX Detect cycles. ELOOP can be used to avoid cycles, but we can also detect
-- them proactively.

-- XXX Since we are separating paths by newlines, it cannot support newlines in
-- paths. Or we can return null separated paths as well. Provide a Mut array
-- API to replace the nulls with newlines in-place.
--
-- We can pass a fold to make this modular, but if we are passing readdir
-- managed memory then we will have to consume it immediately. Otherwise we can
-- use getdents64 directly and use GHC managed memory instead.
--
-- A fold may be useful to translate the output to whatever format we want, we
-- can add a prefix or we can colorize it.
--
-- XXX Use bufSize, recursive traversal, split strategy, output entries
-- separator as config options. When not using concurrently we do not need to
-- split the work at all.
--
-- XXX Currently we are quite aggressive in splitting the work because we have
-- no knowledge of whether we need to or not. But this leads to more overhead.
-- Instead, we can measure the coarse monotonic and process cpu time after
-- every n system calls or n iterations. If the cpu utilization is low then
-- yield the dirs otherwise dont. We can use an async thread for computing cpu
-- utilization periodically and all other threads can just read it from an
-- IORef. So this can be shared across all such consumers.

-- | This function may not traverse all the directories supplied and it may
-- traverse the directories recursively. Left contains those directories that
-- were not traversed by this function, these my be the directories that were
-- supplied as input as well as newly discovered directories during traversal.
-- To traverse the entire tree we have to iterate this function on the Left
-- output.
--
-- Right is a buffer containing directories and files separated by newlines.
--
{-# INLINE readEitherByteChunks #-}
readEitherByteChunks :: MonadIO m =>
    (ReadOptions -> ReadOptions) ->
    [PosixPath] -> Stream m (Either [PosixPath] (Array Word8))
readEitherByteChunks :: forall (m :: * -> *).
MonadIO m =>
(ReadOptions -> ReadOptions)
-> [Path] -> Stream m (Either [Path] (Array Word8))
readEitherByteChunks ReadOptions -> ReadOptions
confMod [Path]
alldirs =
    (State StreamK m (Either [Path] (Array Word8))
 -> ChunkStreamByteState
 -> m (Step ChunkStreamByteState (Either [Path] (Array Word8))))
-> ChunkStreamByteState -> Stream m (Either [Path] (Array Word8))
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m (Either [Path] (Array Word8))
-> ChunkStreamByteState
-> m (Step ChunkStreamByteState (Either [Path] (Array Word8)))
forall {m :: * -> *} {p} {a}.
MonadIO m =>
p
-> ChunkStreamByteState
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
step ChunkStreamByteState
ChunkStreamByteInit

    where

    conf :: ReadOptions
conf = ReadOptions -> ReadOptions
confMod ReadOptions
defaultReadOptions

    -- XXX A single worker may not have enough directories to list at once to
    -- fill up a large buffer. We need to change the concurrency model such
    -- that a worker should be able to pick up another dir from the queue
    -- without emitting an output until the buffer fills.
    --
    -- XXX A worker can also pick up multiple work items in one go. However, we
    -- also need to keep in mind that any kind of batching might have
    -- pathological cases where concurrency may be reduced.
    --
    -- XXX Alternatively, we can distribute the dir stream over multiple
    -- concurrent folds and return (monadic output) a stream of arrays created
    -- from the output channel, then consume that stream by using a monad bind.

    bufSize :: Int
bufSize = Int
32000

    copyToBuf :: MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
copyToBuf MutByteArray
dstArr Int
pos Path
dirPath CString
name = do
        Int
nameLen <- (CSize -> Int) -> m CSize -> m Int
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> m CSize) -> IO CSize -> m CSize
forall a b. (a -> b) -> a -> b
$ CString -> IO CSize
c_strlen CString
name)
        -- We know it is already pinned.
        MutByteArray -> (Ptr Any -> IO (Maybe Int)) -> m (Maybe Int)
forall (m :: * -> *) a b.
MonadIO m =>
MutByteArray -> (Ptr a -> IO b) -> m b
MutByteArray.unsafeAsPtr MutByteArray
dstArr (\Ptr Any
ptr -> IO (Maybe Int) -> IO (Maybe Int)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Int) -> IO (Maybe Int))
-> IO (Maybe Int) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ do
            -- XXX We may need to decode and encode the path if the
            -- output encoding differs from fs encoding.
            let PosixPath (Array MutByteArray
dirArr Int
start Int
end) = Path
dirPath
                dirLen :: Int
dirLen = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
                endDir :: Int
endDir = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dirLen
                endPos :: Int
endPos = Int
endDir Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nameLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 -- sep + newline
                sepOff :: Ptr b
sepOff = Ptr Any
ptr Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
endDir -- separator offset
                nameOff :: Ptr b
nameOff = Ptr Any
forall a. Ptr a
sepOff Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1  -- file name offset
                nlOff :: Ptr b
nlOff = Ptr Any
forall a. Ptr a
nameOff Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
nameLen -- newline offset
                separator :: Word8
separator = Word8
47 :: Word8
                newline :: Word8
newline = Word8
10 :: Word8
            if (Int
endPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bufSize)
            then do
                -- XXX We can keep a trailing separator on the dir itself.
                MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO ()
forall (m :: * -> *).
MonadIO m =>
MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()
MutByteArray.unsafePutSlice MutByteArray
dirArr Int
start MutByteArray
dstArr Int
pos Int
dirLen
                Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
forall a. Ptr a
sepOff Word8
separator
                Ptr Word8
_ <- Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
c_memcpy Ptr Word8
forall a. Ptr a
nameOff (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
name) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nameLen)
                Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
forall a. Ptr a
nlOff Word8
newline
                Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
endPos)
            else Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
            )

    step :: p
-> ChunkStreamByteState
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
step p
_ ChunkStreamByteState
ChunkStreamByteInit = do
        MutByteArray
mbarr <- IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ Int -> IO MutByteArray
MutByteArray.new' Int
bufSize
        case [Path]
alldirs of
            (Path
x:[Path]
xs) -> do
                DirStream Ptr CDir
dirp <- IO DirStream -> m DirStream
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DirStream -> m DirStream) -> IO DirStream -> m DirStream
forall a b. (a -> b) -> a -> b
$ Path -> IO DirStream
openDirStream Path
x
                Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamByteState (Either [Path] (Array a))
 -> m (Step ChunkStreamByteState (Either [Path] (Array a))))
-> Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a b. (a -> b) -> a -> b
$ ChunkStreamByteState
-> Step ChunkStreamByteState (Either [Path] (Array a))
forall s a. s -> Step s a
Skip (ChunkStreamByteState
 -> Step ChunkStreamByteState (Either [Path] (Array a)))
-> ChunkStreamByteState
-> Step ChunkStreamByteState (Either [Path] (Array a))
forall a b. (a -> b) -> a -> b
$ Path
-> [Path]
-> Ptr CDir
-> MutByteArray
-> Int
-> ChunkStreamByteState
ChunkStreamByteLoop Path
x [Path]
xs Ptr CDir
dirp MutByteArray
mbarr Int
0
            [] -> Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step ChunkStreamByteState (Either [Path] (Array a))
forall s a. Step s a
Stop

    step p
_ ChunkStreamByteState
ChunkStreamByteStop = Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step ChunkStreamByteState (Either [Path] (Array a))
forall s a. Step s a
Stop

    step p
_ (ChunkStreamReallocBuf CString
pending Path
curdir [Path]
xs Ptr CDir
dirp MutByteArray
mbarr Int
pos) = do
        MutByteArray
mbarr1 <- IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ Int -> IO MutByteArray
MutByteArray.new' Int
bufSize
        Maybe Int
r1 <- MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
forall {m :: * -> *}.
MonadIO m =>
MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
copyToBuf MutByteArray
mbarr1 Int
0 Path
curdir CString
pending
        case Maybe Int
r1 of
            Just Int
pos2 ->
                Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamByteState (Either [Path] (Array a))
 -> m (Step ChunkStreamByteState (Either [Path] (Array a))))
-> Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a b. (a -> b) -> a -> b
$ Either [Path] (Array a)
-> ChunkStreamByteState
-> Step ChunkStreamByteState (Either [Path] (Array a))
forall s a. a -> s -> Step s a
Yield (Array a -> Either [Path] (Array a)
forall a b. b -> Either a b
Right (MutByteArray -> Int -> Int -> Array a
forall a. MutByteArray -> Int -> Int -> Array a
Array MutByteArray
mbarr Int
0 Int
pos))
                    -- When we come in this state we have emitted dirs
                    (Path
-> [Path]
-> Ptr CDir
-> MutByteArray
-> Int
-> ChunkStreamByteState
ChunkStreamByteLoop Path
curdir [Path]
xs Ptr CDir
dirp MutByteArray
mbarr1 Int
pos2)
            Maybe Int
Nothing -> String -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a. HasCallStack => String -> a
error String
"Dirname too big for bufSize"

    step p
_ (ChunkStreamDrainBuf MutByteArray
mbarr Int
pos) =
        if Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step ChunkStreamByteState (Either [Path] (Array a))
forall s a. Step s a
Stop
        else Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamByteState (Either [Path] (Array a))
 -> m (Step ChunkStreamByteState (Either [Path] (Array a))))
-> Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a b. (a -> b) -> a -> b
$ Either [Path] (Array a)
-> ChunkStreamByteState
-> Step ChunkStreamByteState (Either [Path] (Array a))
forall s a. a -> s -> Step s a
Yield (Array a -> Either [Path] (Array a)
forall a b. b -> Either a b
Right (MutByteArray -> Int -> Int -> Array a
forall a. MutByteArray -> Int -> Int -> Array a
Array MutByteArray
mbarr Int
0 Int
pos)) ChunkStreamByteState
ChunkStreamByteStop

    step p
_ (ChunkStreamByteLoop Path
icurdir [Path]
ixs Ptr CDir
idirp MutByteArray
mbarr Int
ipos) = do
        Path
-> Ptr CDir
-> [Path]
-> Int
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall {m :: * -> *} {a}.
MonadIO m =>
Path
-> Ptr CDir
-> [Path]
-> Int
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
goOuter Path
icurdir Ptr CDir
idirp [Path]
ixs Int
ipos

        where

        -- This is recursed only when we open the next dir
        -- Encapsulates curdir and dirp as static arguments
        goOuter :: Path
-> Ptr CDir
-> [Path]
-> Int
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
goOuter Path
curdir Ptr CDir
dirp = [Path]
-> Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
goInner

            where

            -- This is recursed each time we find a dir
            -- Encapsulates dirs as static argument
            goInner :: [Path]
-> Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
goInner [Path]
dirs = Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
nextEntry

                where

                {-# INLINE nextEntry #-}
                nextEntry :: Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
nextEntry Int
pos = do
                    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
resetErrno
                    Ptr CDirent
dentPtr <- IO (Ptr CDirent) -> m (Ptr CDirent)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CDirent) -> m (Ptr CDirent))
-> IO (Ptr CDirent) -> m (Ptr CDirent)
forall a b. (a -> b) -> a -> b
$ Ptr CDir -> IO (Ptr CDirent)
c_readdir Ptr CDir
dirp
                    if Ptr CDirent
dentPtr Ptr CDirent -> Ptr CDirent -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CDirent
forall a. Ptr a
nullPtr
                    then Int
-> Ptr CDirent
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
handleDentry Int
pos Ptr CDirent
dentPtr
                    else Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
handleErr Int
pos

                openNextDir :: Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
openNextDir Int
pos =
                    case [Path]
dirs of
                        (Path
x:[Path]
xs) -> do
                            DirStream Ptr CDir
dirp1 <- IO DirStream -> m DirStream
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DirStream -> m DirStream) -> IO DirStream -> m DirStream
forall a b. (a -> b) -> a -> b
$ Path -> IO DirStream
openDirStream Path
x
                            Path
-> Ptr CDir
-> [Path]
-> Int
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
goOuter Path
x Ptr CDir
dirp1 [Path]
xs Int
pos
                        [] ->
                            if Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                            then Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step ChunkStreamByteState (Either [Path] (Array a))
forall s a. Step s a
Stop
                            else Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                                    (Step ChunkStreamByteState (Either [Path] (Array a))
 -> m (Step ChunkStreamByteState (Either [Path] (Array a))))
-> Step ChunkStreamByteState (Either [Path] (Array a))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a b. (a -> b) -> a -> b
$ Either [Path] (Array a)
-> ChunkStreamByteState
-> Step ChunkStreamByteState (Either [Path] (Array a))
forall s a. a -> s -> Step s a
Yield
                                        (Array a -> Either [Path] (Array a)
forall a b. b -> Either a b
Right (MutByteArray -> Int -> Int -> Array a
forall a. MutByteArray -> Int -> Int -> Array a
Array MutByteArray
mbarr Int
0 Int
pos))
                                        ChunkStreamByteState
ChunkStreamByteStop

                handleErr :: Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
handleErr Int
pos = do
                    Errno
errno <- IO Errno -> m Errno
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Errno
getErrno
                    if (Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
/= Errno
eINTR)
                    then do
                        let (Errno CInt
n) = Errno
errno
                        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DirStream -> IO ()
closeDirStream (Ptr CDir -> DirStream
DirStream Ptr CDir
dirp)
                        if (CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
                        then Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
openNextDir Int
pos
                        else IO (Step ChunkStreamByteState (Either [Path] (Array a)))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Step ChunkStreamByteState (Either [Path] (Array a)))
 -> m (Step ChunkStreamByteState (Either [Path] (Array a))))
-> IO (Step ChunkStreamByteState (Either [Path] (Array a)))
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a b. (a -> b) -> a -> b
$ String -> IO (Step ChunkStreamByteState (Either [Path] (Array a)))
forall a. String -> IO a
throwErrno String
"readEitherByteChunks"
                    else Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
nextEntry Int
pos

                splitAndRealloc :: Int
-> CString
-> [Path]
-> m (Step ChunkStreamByteState (Either [Path] b))
splitAndRealloc Int
pos CString
dname [Path]
xs =
                    case [Path]
xs of
                        [] ->
                            Step ChunkStreamByteState (Either [Path] b)
-> m (Step ChunkStreamByteState (Either [Path] b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamByteState (Either [Path] b)
 -> m (Step ChunkStreamByteState (Either [Path] b)))
-> Step ChunkStreamByteState (Either [Path] b)
-> m (Step ChunkStreamByteState (Either [Path] b))
forall a b. (a -> b) -> a -> b
$ ChunkStreamByteState -> Step ChunkStreamByteState (Either [Path] b)
forall s a. s -> Step s a
Skip
                                (CString
-> Path
-> [Path]
-> Ptr CDir
-> MutByteArray
-> Int
-> ChunkStreamByteState
ChunkStreamReallocBuf CString
dname Path
curdir
                                    [] Ptr CDir
dirp MutByteArray
mbarr Int
pos)
                        [Path]
_ -> do
                            let ([Path]
h,[Path]
t) = [Path] -> ([Path], [Path])
forall a. [a] -> ([a], [a])
splitHalf [Path]
xs
                            Step ChunkStreamByteState (Either [Path] b)
-> m (Step ChunkStreamByteState (Either [Path] b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ChunkStreamByteState (Either [Path] b)
 -> m (Step ChunkStreamByteState (Either [Path] b)))
-> Step ChunkStreamByteState (Either [Path] b)
-> m (Step ChunkStreamByteState (Either [Path] b))
forall a b. (a -> b) -> a -> b
$ Either [Path] b
-> ChunkStreamByteState
-> Step ChunkStreamByteState (Either [Path] b)
forall s a. a -> s -> Step s a
Yield ([Path] -> Either [Path] b
forall a b. a -> Either a b
Left [Path]
t)
                                (CString
-> Path
-> [Path]
-> Ptr CDir
-> MutByteArray
-> Int
-> ChunkStreamByteState
ChunkStreamReallocBuf CString
dname Path
curdir
                                    [Path]
h Ptr CDir
dirp MutByteArray
mbarr Int
pos)

                {-# INLINE handleFileEnt #-}
                handleFileEnt :: Int
-> CString
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
handleFileEnt Int
pos CString
dname = do
                    Maybe Int
r <- MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
forall {m :: * -> *}.
MonadIO m =>
MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
copyToBuf MutByteArray
mbarr Int
pos Path
curdir CString
dname
                    case Maybe Int
r of
                        Just Int
pos1 -> Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
nextEntry Int
pos1
                        Maybe Int
Nothing -> Int
-> CString
-> [Path]
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall {m :: * -> *} {b}.
Monad m =>
Int
-> CString
-> [Path]
-> m (Step ChunkStreamByteState (Either [Path] b))
splitAndRealloc Int
pos CString
dname [Path]
dirs

                {-# INLINE handleDirEnt #-}
                handleDirEnt :: Int
-> CString
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
handleDirEnt Int
pos CString
dname = do
                    Path
path <- IO Path -> m Path
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Path -> m Path) -> IO Path -> m Path
forall a b. (a -> b) -> a -> b
$ Path -> CString -> IO Path
appendCString Path
curdir CString
dname
                    let dirs1 :: [Path]
dirs1 = Path
path Path -> [Path] -> [Path]
forall a. a -> [a] -> [a]
: [Path]
dirs
                    Maybe Int
r <- MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
forall {m :: * -> *}.
MonadIO m =>
MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
copyToBuf MutByteArray
mbarr Int
pos Path
curdir CString
dname
                    case Maybe Int
r of
                        Just Int
pos1 -> [Path]
-> Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
goInner [Path]
dirs1 Int
pos1
                        Maybe Int
Nothing -> Int
-> CString
-> [Path]
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
forall {m :: * -> *} {b}.
Monad m =>
Int
-> CString
-> [Path]
-> m (Step ChunkStreamByteState (Either [Path] b))
splitAndRealloc Int
pos CString
dname [Path]
dirs1

                handleDentry :: Int
-> Ptr CDirent
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
handleDentry Int
pos Ptr CDirent
dentPtr = do
                    let dname :: Ptr b
dname = (\Ptr CDirent
hsc_ptr -> Ptr CDirent
hsc_ptr Ptr CDirent -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
19) Ptr CDirent
dentPtr
{-# LINE 747 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
                    Word8
dtype :: Word8 <-
{-# LINE 748 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
                        IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ (\Ptr CDirent
hsc_ptr -> Ptr CDirent -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CDirent
hsc_ptr Int
18) Ptr CDirent
dentPtr
{-# LINE 749 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}

                    EntryType
etype <- IO EntryType -> m EntryType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EntryType -> m EntryType) -> IO EntryType -> m EntryType
forall a b. (a -> b) -> a -> b
$ ReadOptions -> Path -> CString -> Word8 -> IO EntryType
getEntryType ReadOptions
conf Path
curdir CString
forall a. Ptr a
dname Word8
dtype
                    case EntryType
etype of
                        EntryType
EntryIsNotDir -> Int
-> CString
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
handleFileEnt Int
pos CString
forall a. Ptr a
dname
                        EntryType
EntryIsDir -> Int
-> CString
-> m (Step ChunkStreamByteState (Either [Path] (Array a)))
handleDirEnt Int
pos CString
forall a. Ptr a
dname
                        EntryType
EntryIgnored -> Int -> m (Step ChunkStreamByteState (Either [Path] (Array a)))
nextEntry Int
pos

{-# ANN type ByteChunksAt Fuse #-}
data ByteChunksAt =
      ByteChunksAtInit0
    | ByteChunksAtInit
        Fd
        [PosixPath] -- input dirs
        -- (Handle, [PosixPath]) -- output dirs
        -- Int -- count of output dirs
        MutByteArray -- output files and dirs
        Int -- position in MutByteArray
    | ByteChunksAtLoop
        Fd
        (Ptr CDir) -- current dir stream
        PosixPath -- current dir path
        [PosixPath]  -- remaining dirs
        [PosixPath] -- output dirs
        Int    -- output dir count
        MutByteArray
        Int
    | ByteChunksAtRealloc
        (Ptr CChar) -- pending item
        Fd
        (Ptr CDir) -- current dir stream
        PosixPath -- current dir path
        [PosixPath]  -- remaining dirs
        [PosixPath] -- output dirs
        Int    -- output dir count
        MutByteArray
        Int

-- The advantage of readEitherByteChunks over readEitherByteChunksAt is that we
-- do not need to open the dir handles and thus requires less open fd.
{-# INLINE readEitherByteChunksAt #-}
readEitherByteChunksAt :: MonadIO m => (ReadOptions -> ReadOptions) ->
       -- (parent dir path, child dir paths rel to parent)
       (PosixPath, [PosixPath])
    -> Stream m (Either (PosixPath, [PosixPath]) (Array Word8))
readEitherByteChunksAt :: forall (m :: * -> *).
MonadIO m =>
(ReadOptions -> ReadOptions)
-> (Path, [Path]) -> Stream m (Either (Path, [Path]) (Array Word8))
readEitherByteChunksAt ReadOptions -> ReadOptions
confMod (Path
ppath, [Path]
alldirs) =
    (State StreamK m (Either (Path, [Path]) (Array Word8))
 -> ByteChunksAt
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array Word8))))
-> ByteChunksAt -> Stream m (Either (Path, [Path]) (Array Word8))
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m (Either (Path, [Path]) (Array Word8))
-> ByteChunksAt
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array Word8)))
forall {m :: * -> *} {p} {a}.
MonadIO m =>
p
-> ByteChunksAt
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
step (ByteChunksAt
ByteChunksAtInit0)

    where
    conf :: ReadOptions
conf = ReadOptions -> ReadOptions
confMod ReadOptions
defaultReadOptions

    bufSize :: Int
bufSize = Int
4000

    copyToBuf :: MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
copyToBuf MutByteArray
dstArr Int
pos Path
dirPath CString
name = do
        Int
nameLen <- (CSize -> Int) -> m CSize -> m Int
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> m CSize) -> IO CSize -> m CSize
forall a b. (a -> b) -> a -> b
$ CString -> IO CSize
c_strlen CString
name)
        -- XXX prepend ppath to dirPath
        let PosixPath (Array MutByteArray
dirArr Int
start Int
end) = Path
dirPath
            dirLen :: Int
dirLen = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
            -- XXX We may need to decode and encode the path if the
            -- output encoding differs from fs encoding.
            --
            -- Account for separator and newline bytes.
            byteCount :: Int
byteCount = Int
dirLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nameLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        if Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
byteCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bufSize
        then do
            -- XXX append a path separator to a dir path
            -- We know it is already pinned.
            MutByteArray -> (Ptr Any -> IO ()) -> m ()
forall (m :: * -> *) a b.
MonadIO m =>
MutByteArray -> (Ptr a -> IO b) -> m b
MutByteArray.unsafeAsPtr MutByteArray
dstArr (\Ptr Any
ptr -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO ()
forall (m :: * -> *).
MonadIO m =>
MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()
MutByteArray.unsafePutSlice  MutByteArray
dirArr Int
start MutByteArray
dstArr Int
pos Int
dirLen
                let ptr1 :: Ptr b
ptr1 = Ptr Any
ptr Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dirLen)
                    separator :: Word8
separator = Word8
47 :: Word8
                Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
forall a. Ptr a
ptr1 Word8
separator
                let ptr2 :: Ptr b
ptr2 = Ptr Any
forall a. Ptr a
ptr1 Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
                Ptr Word8
_ <- Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
c_memcpy Ptr Word8
forall a. Ptr a
ptr2 (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
name) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nameLen)
                let ptr3 :: Ptr b
ptr3 = Ptr Any
forall a. Ptr a
ptr2 Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
nameLen
                    newline :: Word8
newline = Word8
10 :: Word8
                Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
forall a. Ptr a
ptr3 Word8
newline
                )
            Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
byteCount))
        else Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing

    step :: p
-> ByteChunksAt
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
step p
_ ByteChunksAt
ByteChunksAtInit0 = do
        -- Note this fd is not automatically closed, we have to take care of
        -- exceptions and closing the fd.
        Fd
pfd <- IO Fd -> m Fd
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Fd -> m Fd) -> IO Fd -> m Fd
forall a b. (a -> b) -> a -> b
$ Maybe Fd -> Path -> OpenFlags -> Maybe FileMode -> IO Fd
openAt Maybe Fd
forall a. Maybe a
Nothing Path
ppath OpenFlags
defaultOpenFlags Maybe FileMode
forall a. Maybe a
Nothing
        MutByteArray
mbarr <- IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ Int -> IO MutByteArray
MutByteArray.new' Int
bufSize
        Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ ByteChunksAt -> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. s -> Step s a
Skip (Fd -> [Path] -> MutByteArray -> Int -> ByteChunksAt
ByteChunksAtInit Fd
pfd [Path]
alldirs MutByteArray
mbarr Int
0)

    step p
_ (ByteChunksAtInit Fd
ph (Path
x:[Path]
xs) MutByteArray
mbarr Int
pos) = do
        (DirStream Ptr CDir
dirp) <- IO DirStream -> m DirStream
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DirStream -> m DirStream) -> IO DirStream -> m DirStream
forall a b. (a -> b) -> a -> b
$ Fd -> Path -> IO DirStream
openDirStreamAt Fd
ph Path
x
        Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ ByteChunksAt -> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. s -> Step s a
Skip (Fd
-> Ptr CDir
-> Path
-> [Path]
-> [Path]
-> Int
-> MutByteArray
-> Int
-> ByteChunksAt
ByteChunksAtLoop Fd
ph Ptr CDir
dirp Path
x [Path]
xs [] Int
0 MutByteArray
mbarr Int
pos)

    step p
_ (ByteChunksAtInit Fd
pfd [] MutByteArray
_ Int
0) = do
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Fd -> IO ()
close (Fd
pfd)
        Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. Step s a
Stop

    step p
_ (ByteChunksAtInit Fd
pfd [] MutByteArray
mbarr Int
pos) = do
        Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ Either (Path, [Path]) (Array a)
-> ByteChunksAt
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. a -> s -> Step s a
Yield
                (Array a -> Either (Path, [Path]) (Array a)
forall a b. b -> Either a b
Right (MutByteArray -> Int -> Int -> Array a
forall a. MutByteArray -> Int -> Int -> Array a
Array MutByteArray
mbarr Int
0 Int
pos))
                (Fd -> [Path] -> MutByteArray -> Int -> ByteChunksAt
ByteChunksAtInit Fd
pfd [] MutByteArray
mbarr Int
0)

    step p
_ (ByteChunksAtRealloc CString
pending Fd
pfd Ptr CDir
dirp Path
curdir [Path]
xs [Path]
dirs Int
ndirs MutByteArray
mbarr Int
pos) = do
        MutByteArray
mbarr1 <- IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ Int -> IO MutByteArray
MutByteArray.new' Int
bufSize
        Maybe Int
r1 <- MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
forall {m :: * -> *}.
MonadIO m =>
MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
copyToBuf MutByteArray
mbarr1 Int
0 Path
curdir CString
pending
        case Maybe Int
r1 of
            Just Int
pos2 ->
                Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ Either (Path, [Path]) (Array a)
-> ByteChunksAt
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. a -> s -> Step s a
Yield (Array a -> Either (Path, [Path]) (Array a)
forall a b. b -> Either a b
Right (MutByteArray -> Int -> Int -> Array a
forall a. MutByteArray -> Int -> Int -> Array a
Array MutByteArray
mbarr Int
0 Int
pos))
                    (Fd
-> Ptr CDir
-> Path
-> [Path]
-> [Path]
-> Int
-> MutByteArray
-> Int
-> ByteChunksAt
ByteChunksAtLoop Fd
pfd Ptr CDir
dirp Path
curdir [Path]
xs [Path]
dirs Int
ndirs MutByteArray
mbarr1 Int
pos2)
            Maybe Int
Nothing -> String -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. HasCallStack => String -> a
error String
"Dirname too big for bufSize"

    step p
_ st :: ByteChunksAt
st@(ByteChunksAtLoop Fd
pfd Ptr CDir
dirp Path
curdir [Path]
xs [Path]
dirs Int
ndirs MutByteArray
mbarr Int
pos) = do
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
resetErrno
        Ptr CDirent
dentPtr <- IO (Ptr CDirent) -> m (Ptr CDirent)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CDirent) -> m (Ptr CDirent))
-> IO (Ptr CDirent) -> m (Ptr CDirent)
forall a b. (a -> b) -> a -> b
$ Ptr CDir -> IO (Ptr CDirent)
c_readdir Ptr CDir
dirp
        if (Ptr CDirent
dentPtr Ptr CDirent -> Ptr CDirent -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CDirent
forall a. Ptr a
nullPtr)
        then do
            let dname :: Ptr b
dname = (\Ptr CDirent
hsc_ptr -> Ptr CDirent
hsc_ptr Ptr CDirent -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
19) Ptr CDirent
dentPtr
{-# LINE 865 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
            Word8
dtype :: Word8 <-
{-# LINE 866 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}
                IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ (\Ptr CDirent
hsc_ptr -> Ptr CDirent -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CDirent
hsc_ptr Int
18) Ptr CDirent
dentPtr
{-# LINE 867 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}

            -- Keep the file check first as it is more likely
            EntryType
etype <- IO EntryType -> m EntryType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EntryType -> m EntryType) -> IO EntryType -> m EntryType
forall a b. (a -> b) -> a -> b
$ ReadOptions -> Path -> CString -> Word8 -> IO EntryType
getEntryType ReadOptions
conf Path
curdir CString
forall a. Ptr a
dname Word8
dtype
            case EntryType
etype of
                EntryType
EntryIsNotDir -> do
                    Maybe Int
r <- MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
forall {m :: * -> *}.
MonadIO m =>
MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
copyToBuf MutByteArray
mbarr Int
pos Path
curdir CString
forall a. Ptr a
dname
                    case Maybe Int
r of
                        Just Int
pos1 ->
                            Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ ByteChunksAt -> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. s -> Step s a
Skip
                                (Fd
-> Ptr CDir
-> Path
-> [Path]
-> [Path]
-> Int
-> MutByteArray
-> Int
-> ByteChunksAt
ByteChunksAtLoop
                                    Fd
pfd Ptr CDir
dirp Path
curdir [Path]
xs [Path]
dirs Int
ndirs MutByteArray
mbarr Int
pos1)
                        Maybe Int
Nothing ->
                            Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ ByteChunksAt -> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. s -> Step s a
Skip
                                (CString
-> Fd
-> Ptr CDir
-> Path
-> [Path]
-> [Path]
-> Int
-> MutByteArray
-> Int
-> ByteChunksAt
ByteChunksAtRealloc
                                    CString
forall a. Ptr a
dname Fd
pfd Ptr CDir
dirp Path
curdir [Path]
xs [Path]
dirs Int
ndirs MutByteArray
mbarr Int
pos)
                EntryType
EntryIsDir -> do
                    Array Word8
arr <- Ptr Word8 -> m (Array Word8)
forall (m :: * -> *). MonadIO m => Ptr Word8 -> m (Array Word8)
Array.fromCString (Ptr Any -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
forall a. Ptr a
dname)
                    let path :: Path
path = Array Word8 -> Path
Path.unsafeFromArray Array Word8
arr
                    let dirs1 :: [Path]
dirs1 = Path
path Path -> [Path] -> [Path]
forall a. a -> [a] -> [a]
: [Path]
dirs
                        ndirs1 :: Int
ndirs1 = Int
ndirs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    Maybe Int
r <- MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
forall {m :: * -> *}.
MonadIO m =>
MutByteArray -> Int -> Path -> CString -> m (Maybe Int)
copyToBuf MutByteArray
mbarr Int
pos Path
curdir CString
forall a. Ptr a
dname
                    case Maybe Int
r of
                        Just Int
pos1 ->
                            -- XXX When there is less parallelization at the
                            -- top of the tree, we should use smaller chunks.
                            {-
                            if ndirs > 64
                            then do
                                let fpath = Path.unsafeJoin ppath curdir
                                return $ Yield
                                    (Left (fpath, dirs1))
                                    (ByteChunksAtLoop pfd dirp curdir xs [] 0 mbarr pos1)
                            else
                            -}
                                Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ ByteChunksAt -> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. s -> Step s a
Skip
                                    (Fd
-> Ptr CDir
-> Path
-> [Path]
-> [Path]
-> Int
-> MutByteArray
-> Int
-> ByteChunksAt
ByteChunksAtLoop
                                        Fd
pfd Ptr CDir
dirp Path
curdir [Path]
xs [Path]
dirs1 Int
ndirs1 MutByteArray
mbarr Int
pos1)
                        Maybe Int
Nothing -> do
                            Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ ByteChunksAt -> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. s -> Step s a
Skip
                                (CString
-> Fd
-> Ptr CDir
-> Path
-> [Path]
-> [Path]
-> Int
-> MutByteArray
-> Int
-> ByteChunksAt
ByteChunksAtRealloc
                                    CString
forall a. Ptr a
dname Fd
pfd Ptr CDir
dirp Path
curdir [Path]
xs [Path]
dirs1 Int
ndirs1 MutByteArray
mbarr Int
pos)
                EntryType
EntryIgnored ->  Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ ByteChunksAt -> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. s -> Step s a
Skip ByteChunksAt
st
        else do
            Errno
errno <- IO Errno -> m Errno
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Errno
getErrno
            if (Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINTR)
            then Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ ByteChunksAt -> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. s -> Step s a
Skip ByteChunksAt
st
            else do
                let (Errno CInt
n) = Errno
errno
                -- XXX What if an exception occurs in the code before this?
                -- Should we attach a weak IORef to close the fd on GC.
                IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DirStream -> IO ()
closeDirStream (Ptr CDir -> DirStream
DirStream Ptr CDir
dirp)
                if (CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
                then
                    -- XXX Yielding on each dir completion may hurt perf when
                    -- there are many small directories. However, it may also
                    -- help parallelize more in IO bound case.
                    if Int
ndirs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                    then do
                        let fpath :: Path
fpath = Path -> Path -> Path
Path.unsafeJoin Path
ppath Path
curdir
                        Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ Either (Path, [Path]) (Array a)
-> ByteChunksAt
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. a -> s -> Step s a
Yield
                            ((Path, [Path]) -> Either (Path, [Path]) (Array a)
forall a b. a -> Either a b
Left (Path
fpath, [Path]
dirs))
                            (Fd -> [Path] -> MutByteArray -> Int -> ByteChunksAt
ByteChunksAtInit Fd
pfd [Path]
xs MutByteArray
mbarr Int
pos)
                    else Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ByteChunksAt (Either (Path, [Path]) (Array a))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> Step ByteChunksAt (Either (Path, [Path]) (Array a))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ ByteChunksAt -> Step ByteChunksAt (Either (Path, [Path]) (Array a))
forall s a. s -> Step s a
Skip (Fd -> [Path] -> MutByteArray -> Int -> ByteChunksAt
ByteChunksAtInit Fd
pfd [Path]
xs MutByteArray
mbarr Int
pos)
                else IO (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
 -> m (Step ByteChunksAt (Either (Path, [Path]) (Array a))))
-> IO (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
-> m (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a b. (a -> b) -> a -> b
$ String -> IO (Step ByteChunksAt (Either (Path, [Path]) (Array a)))
forall a. String -> IO a
throwErrno String
"readEitherByteChunks"

{-# LINE 932 "src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc" #-}