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
    (
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
      readScanWith_
    , readScanWith
    , readPlusScanWith

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

#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
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

#include <dirent.h>
#include <sys/stat.h>

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

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_ = 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 = 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 = 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  = #{const S_IFMT}

s_IFDIR :: CMode
s_IFDIR = #{const S_IFDIR}

{-
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 followSym cstr =
    allocaBytes #{size struct stat} $ \p_stat -> do
        resetErrno
        result <-
            if followSym
            then c_stat cstr p_stat
            else c_lstat cstr p_stat
        if result /= 0
        then do
            errno <- getErrno
            if errno == eINTR
            then stat followSym cstr
            else pure $ Left errno
        else do
            mode <- #{peek struct stat, st_mode} p_stat
            pure $ Right (mode .&. s_IFMT)

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

-- | The CString must be pinned.
{-# INLINE openDirStreamCString #-}
openDirStreamCString :: CString -> IO DirStream
openDirStreamCString s = do
    -- XXX we do not decode the path here, just print it as cstring
    -- XXX pass lazy concat of "openDirStream: " ++ s
    dirp <- throwErrnoIfNullRetry "openDirStream" $ c_opendir s
    return (DirStream 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 p =
    Array.asCStringUnsafe (Path.toArray p) $ \s -> do
        -- openDirStreamCString s
        dirp <- throwErrnoPathIfNullRetry "openDirStream" p $ c_opendir s
        return (DirStream 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 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.
    fd1 <- openAt (Just fd) p defaultOpenFlags Nothing
    -- liftIO $ putStrLn $ "opened: " ++ show fd1
    dirp <- throwErrnoPathIfNullRetry "openDirStreamAt" p
        $ c_fdopendir (fromIntegral fd1)
    -- XXX can we somehow clone fd1 instead of opening again?
    return (DirStream dirp)

-- | @closeDirStream dp@ calls @closedir@ to close
--   the directory stream @dp@.
closeDirStream :: DirStream -> IO ()
closeDirStream (DirStream dirp) = do
  throwErrnoIfMinus1Retry_ "closeDirStream" (c_closedir dirp)

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

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

data EntryType = EntryIsDir | EntryIsNotDir | EntryIgnored

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

    errMsg path =
        let pathStr = Path.toString_ path
         in "statEntryType: " ++ pathStr

-- | Checks if dname is a directory, not dir or should be ignored.
{-# INLINE getEntryType #-}
getEntryType
    :: ReadOptions
    -> PosixPath -> Ptr CChar -> #{type unsigned char} -> IO EntryType
getEntryType conf parent dname dtype = do
    let needStat =
#ifdef FORCE_LSTAT_READDIR
            True
#else
            (dtype == (#const DT_LNK) && _followSymlinks conf)
                || dtype == #const DT_UNKNOWN
#endif

    if dtype /= (#const DT_DIR) && not needStat
    then pure EntryIsNotDir
    else do
        isMeta <- liftIO $ isMetaDir dname
        if isMeta
        then pure EntryIgnored
        else if dtype == (#const DT_DIR)
        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 confMod (curdir, (DirStream dirp)) = loop

  where

  conf = confMod defaultReadOptions

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

  loop = do
    resetErrno
    ptr <- c_readdir dirp
    if (ptr /= nullPtr)
    then do
        let dname = #{ptr struct dirent, d_name} ptr
        dtype :: #{type unsigned char} <- #{peek struct dirent, d_type} ptr
        -- 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.
        name <- Array.fromCString (castPtr dname)
        etype <- getEntryType conf curdir dname dtype
        case etype of
            EntryIsDir -> return (Just (Left (mkPath name)))
            EntryIsNotDir -> return (Just (Right (mkPath name)))
            EntryIgnored -> loop
    else do
        errno <- getErrno
        if (errno == eINTR)
        then loop
        else do
            let (Errno n) = errno
            if (n == 0)
            -- then return (Left (mkPath (Array.fromList [46])))
            then return Nothing
            else throwErrno "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 confMod = Unfold step return
    where

    step s = do
        r <- liftIO $ readDirStreamEither confMod s
        case r of
            Nothing -> return Stop
            Just x -> return $ Yield x s

{-# INLINE streamReader #-}
streamReader :: MonadIO m => Unfold m (PosixPath, DirStream) Path
streamReader = fmap (either id id) (streamEitherReader id)

{-# INLINE before #-}
before :: PosixPath -> IO (PosixPath, DirStream)
before parent = (parent,) <$> openDirStream parent

{-# INLINE after #-}
after :: (PosixPath, DirStream) -> IO ()
after (_, dirStream) = closeDirStream 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 =
    -- 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.
    UF.bracketIO before after (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 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.
    UF.bracketIO before after (streamEitherReader confMod)

{-# INLINE appendCString #-}
appendCString :: PosixPath -> CString -> IO PosixPath
appendCString (PosixPath a) b = do
    arr <- PathC.appendCString PathC.Posix a b
    pure $ PosixPath 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 confMod alldirs =
    Stream step (ChunkStreamInit alldirs [] 0 [] 0)

    where

    conf = confMod defaultReadOptions

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

    step _ (ChunkStreamInit (x:xs) dirs ndirs files nfiles) = do
        DirStream dirp <- liftIO $ openDirStream x
        return $ Skip (ChunkStreamLoop x xs dirp dirs ndirs files nfiles)

    step _ (ChunkStreamInit [] [] _ [] _) =
        return Stop

    step _ (ChunkStreamInit [] [] _ files _) =
        return $ Yield (Right files) (ChunkStreamInit [] [] 0 [] 0)

    step _ (ChunkStreamInit [] dirs _ files _) =
        return $ Yield (Left dirs) (ChunkStreamInit [] [] 0 files 0)

    step _ st@(ChunkStreamLoop curdir xs dirp dirs ndirs files nfiles) = do
        liftIO resetErrno
        dentPtr <- liftIO $ c_readdir dirp
        if (dentPtr /= nullPtr)
        then do
            let dname = #{ptr struct dirent, d_name} dentPtr
            dtype :: #{type unsigned char} <-
                liftIO $ #{peek struct dirent, d_type} dentPtr

            etype <- liftIO $ getEntryType conf curdir dname dtype
            case etype of
                EntryIsDir -> do
                     path <- liftIO $ appendCString curdir dname
                     let dirs1 = path : dirs
                         ndirs1 = ndirs + 1
                      in if ndirs1 >= dirMax
                         then return $ Yield (Left dirs1)
                            (ChunkStreamLoop curdir xs dirp [] 0 files nfiles)
                         else return $ Skip
                            (ChunkStreamLoop curdir xs dirp dirs1 ndirs1 files nfiles)
                EntryIsNotDir -> do
                 path <- liftIO $ appendCString curdir dname
                 let files1 = path : files
                     nfiles1 = nfiles + 1
                  in if nfiles1 >= fileMax
                     then return $ Yield (Right files1)
                        (ChunkStreamLoop curdir xs dirp dirs ndirs [] 0)
                     else return $ Skip
                        (ChunkStreamLoop curdir xs dirp dirs ndirs files1 nfiles1)
                EntryIgnored -> return $ Skip st
        else do
            errno <- liftIO getErrno
            if (errno == eINTR)
            then return $ Skip st
            else do
                let (Errno n) = errno
                -- XXX Exception safety
                liftIO $ closeDirStream (DirStream dirp)
                if (n == 0)
                then return $ Skip (ChunkStreamInit xs dirs ndirs files nfiles)
                else liftIO $ throwErrno "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 xxs = split xxs xxs

    where

    split (x:xs) (_:_:ys) =
        let (f, s) = split xs ys
         in (x:f, s)
    split xs _ = ([], 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 confMod alldirs =
    Stream step ChunkStreamByteInit

    where

    conf = confMod 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 = 32000

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

    step _ ChunkStreamByteInit = do
        mbarr <- liftIO $ MutByteArray.new' bufSize
        case alldirs of
            (x:xs) -> do
                DirStream dirp <- liftIO $ openDirStream x
                return $ Skip $ ChunkStreamByteLoop x xs dirp mbarr 0
            [] -> return Stop

    step _ ChunkStreamByteStop = return Stop

    step _ (ChunkStreamReallocBuf pending curdir xs dirp mbarr pos) = do
        mbarr1 <- liftIO $ MutByteArray.new' bufSize
        r1 <- copyToBuf mbarr1 0 curdir pending
        case r1 of
            Just pos2 ->
                return $ Yield (Right (Array mbarr 0 pos))
                    -- When we come in this state we have emitted dirs
                    (ChunkStreamByteLoop curdir xs dirp mbarr1 pos2)
            Nothing -> error "Dirname too big for bufSize"

    step _ (ChunkStreamDrainBuf mbarr pos) =
        if pos == 0
        then return Stop
        else return $ Yield (Right (Array mbarr 0 pos)) ChunkStreamByteStop

    step _ (ChunkStreamByteLoop icurdir ixs idirp mbarr ipos) = do
        goOuter icurdir idirp ixs ipos

        where

        -- This is recursed only when we open the next dir
        -- Encapsulates curdir and dirp as static arguments
        goOuter curdir dirp = goInner

            where

            -- This is recursed each time we find a dir
            -- Encapsulates dirs as static argument
            goInner dirs = nextEntry

                where

                {-# INLINE nextEntry #-}
                nextEntry pos = do
                    liftIO resetErrno
                    dentPtr <- liftIO $ c_readdir dirp
                    if dentPtr /= nullPtr
                    then handleDentry pos dentPtr
                    else handleErr pos

                openNextDir pos =
                    case dirs of
                        (x:xs) -> do
                            DirStream dirp1 <- liftIO $ openDirStream x
                            goOuter x dirp1 xs pos
                        [] ->
                            if pos == 0
                            then return Stop
                            else return
                                    $ Yield
                                        (Right (Array mbarr 0 pos))
                                        ChunkStreamByteStop

                handleErr pos = do
                    errno <- liftIO getErrno
                    if (errno /= eINTR)
                    then do
                        let (Errno n) = errno
                        liftIO $ closeDirStream (DirStream dirp)
                        if (n == 0)
                        then openNextDir pos
                        else liftIO $ throwErrno "readEitherByteChunks"
                    else nextEntry pos

                splitAndRealloc pos dname xs =
                    case xs of
                        [] ->
                            return $ Skip
                                (ChunkStreamReallocBuf dname curdir
                                    [] dirp mbarr pos)
                        _ -> do
                            let (h,t) = splitHalf xs
                            return $ Yield (Left t)
                                (ChunkStreamReallocBuf dname curdir
                                    h dirp mbarr pos)

                {-# INLINE handleFileEnt #-}
                handleFileEnt pos dname = do
                    r <- copyToBuf mbarr pos curdir dname
                    case r of
                        Just pos1 -> nextEntry pos1
                        Nothing -> splitAndRealloc pos dname dirs

                {-# INLINE handleDirEnt #-}
                handleDirEnt pos dname = do
                    path <- liftIO $ appendCString curdir dname
                    let dirs1 = path : dirs
                    r <- copyToBuf mbarr pos curdir dname
                    case r of
                        Just pos1 -> goInner dirs1 pos1
                        Nothing -> splitAndRealloc pos dname dirs1

                handleDentry pos dentPtr = do
                    let dname = #{ptr struct dirent, d_name} dentPtr
                    dtype :: #{type unsigned char} <-
                        liftIO $ #{peek struct dirent, d_type} dentPtr

                    etype <- liftIO $ getEntryType conf curdir dname dtype
                    case etype of
                        EntryIsNotDir -> handleFileEnt pos dname
                        EntryIsDir -> handleDirEnt pos dname
                        EntryIgnored -> nextEntry 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 confMod (ppath, alldirs) =
    Stream step (ByteChunksAtInit0)

    where
    conf = confMod defaultReadOptions

    bufSize = 4000

    copyToBuf dstArr pos dirPath name = do
        nameLen <- fmap fromIntegral (liftIO $ c_strlen name)
        -- XXX prepend ppath to dirPath
        let PosixPath (Array dirArr start end) = dirPath
            dirLen = end - 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 = dirLen + nameLen + 2
        if pos + byteCount <= bufSize
        then do
            -- XXX append a path separator to a dir path
            -- We know it is already pinned.
            MutByteArray.unsafeAsPtr dstArr (\ptr -> liftIO $ do
                MutByteArray.unsafePutSlice  dirArr start dstArr pos dirLen
                let ptr1 = ptr `plusPtr` (pos + dirLen)
                    separator = 47 :: Word8
                poke ptr1 separator
                let ptr2 = ptr1 `plusPtr` 1
                _ <- c_memcpy ptr2 (castPtr name) (fromIntegral nameLen)
                let ptr3 = ptr2 `plusPtr` nameLen
                    newline = 10 :: Word8
                poke ptr3 newline
                )
            return (Just (pos + byteCount))
        else return Nothing

    step _ ByteChunksAtInit0 = do
        -- Note this fd is not automatically closed, we have to take care of
        -- exceptions and closing the fd.
        pfd <- liftIO $ openAt Nothing ppath defaultOpenFlags Nothing
        mbarr <- liftIO $ MutByteArray.new' bufSize
        return $ Skip (ByteChunksAtInit pfd alldirs mbarr 0)

    step _ (ByteChunksAtInit ph (x:xs) mbarr pos) = do
        (DirStream dirp) <- liftIO $ openDirStreamAt ph x
        return $ Skip (ByteChunksAtLoop ph dirp x xs [] 0 mbarr pos)

    step _ (ByteChunksAtInit pfd [] _ 0) = do
        liftIO $ close (pfd)
        return Stop

    step _ (ByteChunksAtInit pfd [] mbarr pos) = do
        return
            $ Yield
                (Right (Array mbarr 0 pos))
                (ByteChunksAtInit pfd [] mbarr 0)

    step _ (ByteChunksAtRealloc pending pfd dirp curdir xs dirs ndirs mbarr pos) = do
        mbarr1 <- liftIO $ MutByteArray.new' bufSize
        r1 <- copyToBuf mbarr1 0 curdir pending
        case r1 of
            Just pos2 ->
                return $ Yield (Right (Array mbarr 0 pos))
                    (ByteChunksAtLoop pfd dirp curdir xs dirs ndirs mbarr1 pos2)
            Nothing -> error "Dirname too big for bufSize"

    step _ st@(ByteChunksAtLoop pfd dirp curdir xs dirs ndirs mbarr pos) = do
        liftIO resetErrno
        dentPtr <- liftIO $ c_readdir dirp
        if (dentPtr /= nullPtr)
        then do
            let dname = #{ptr struct dirent, d_name} dentPtr
            dtype :: #{type unsigned char} <-
                liftIO $ #{peek struct dirent, d_type} dentPtr

            -- Keep the file check first as it is more likely
            etype <- liftIO $ getEntryType conf curdir dname dtype
            case etype of
                EntryIsNotDir -> do
                    r <- copyToBuf mbarr pos curdir dname
                    case r of
                        Just pos1 ->
                            return $ Skip
                                (ByteChunksAtLoop
                                    pfd dirp curdir xs dirs ndirs mbarr pos1)
                        Nothing ->
                            return $ Skip
                                (ByteChunksAtRealloc
                                    dname pfd dirp curdir xs dirs ndirs mbarr pos)
                EntryIsDir -> do
                    arr <- Array.fromCString (castPtr dname)
                    let path = Path.unsafeFromArray arr
                    let dirs1 = path : dirs
                        ndirs1 = ndirs + 1
                    r <- copyToBuf mbarr pos curdir dname
                    case r of
                        Just 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
                            -}
                                return $ Skip
                                    (ByteChunksAtLoop
                                        pfd dirp curdir xs dirs1 ndirs1 mbarr pos1)
                        Nothing -> do
                            return $ Skip
                                (ByteChunksAtRealloc
                                    dname pfd dirp curdir xs dirs1 ndirs1 mbarr pos)
                EntryIgnored ->  return $ Skip st
        else do
            errno <- liftIO getErrno
            if (errno == eINTR)
            then return $ Skip st
            else do
                let (Errno n) = errno
                -- XXX What if an exception occurs in the code before this?
                -- Should we attach a weak IORef to close the fd on GC.
                liftIO $ closeDirStream (DirStream dirp)
                if (n == 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 ndirs > 0
                    then do
                        let fpath = Path.unsafeJoin ppath curdir
                        return $ Yield
                            (Left (fpath, dirs))
                            (ByteChunksAtInit pfd xs mbarr pos)
                    else return $ Skip (ByteChunksAtInit pfd xs mbarr pos)
                else liftIO $ throwErrno "readEitherByteChunks"
#endif