diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc
index 0f856c45..5f01c15c 100644
--- a/System/Posix/Directory.hsc
+++ b/System/Posix/Directory.hsc
@@ -48,6 +48,7 @@ module System.Posix.Directory (
changeWorkingDirectoryFd,
) where
+import Control.Monad ((>=>))
import Data.Maybe
import System.Posix.Error
import System.Posix.Types
@@ -84,50 +85,21 @@ foreign import capi unsafe "HsUnix.h opendir"
-- | @readDirStream dp@ calls @readdir@ to obtain the
-- next directory entry (@struct dirent@) for the open directory
-- stream @dp@, and returns the @d_name@ member of that
--- structure.
+-- structure.
--
--- Note that this function returns an empty filepath if the end of the
--- directory stream is reached. For a safer alternative use
--- 'readDirStreamMaybe'.
+-- Note that this function returns an empty filepath if the end of the
+-- directory stream is reached. For a safer alternative use
+-- 'readDirStreamMaybe'.
readDirStream :: DirStream -> IO FilePath
readDirStream = fmap (fromMaybe "") . readDirStreamMaybe
-- | @readDirStreamMaybe dp@ calls @readdir@ to obtain the
-- next directory entry (@struct dirent@) for the open directory
-- stream @dp@. It returns the @d_name@ member of that
--- structure wrapped in a @Just d_name@ if an entry was read and @Nothing@ if
--- the end of the directory stream was reached.
+-- structure wrapped in a @Just d_name@ if an entry was read and @Nothing@ if
+-- the end of the directory stream was reached.
readDirStreamMaybe :: DirStream -> IO (Maybe FilePath)
-readDirStreamMaybe (DirStream dirp) =
- alloca $ \ptr_dEnt -> loop ptr_dEnt
- where
- loop ptr_dEnt = do
- resetErrno
- r <- c_readdir dirp ptr_dEnt
- if (r == 0)
- then do dEnt <- peek ptr_dEnt
- if (dEnt == nullPtr)
- then return Nothing
- else do
- entry <- (d_name dEnt >>= peekFilePath)
- c_freeDirEnt dEnt
- return $ Just entry
- else do errno <- getErrno
- if (errno == eINTR) then loop ptr_dEnt else do
- let (Errno eo) = errno
- if (eo == 0)
- then return Nothing
- else throwErrno "readDirStream"
-
--- traversing directories
-foreign import ccall unsafe "__hscore_readdir"
- c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
-
-foreign import ccall unsafe "__hscore_free_dirent"
- c_freeDirEnt :: Ptr CDirent -> IO ()
-
-foreign import ccall unsafe "__hscore_d_name"
- d_name :: Ptr CDirent -> IO CString
+readDirStreamMaybe = readDirStreamWith (dirEntName >=> peekFilePath)
-- | @getWorkingDirectory@ calls @getcwd@ to obtain the name
diff --git a/System/Posix/Directory/ByteString.hsc b/System/Posix/Directory/ByteString.hsc
index 3d6bbea5..be5cb878 100644
--- a/System/Posix/Directory/ByteString.hsc
+++ b/System/Posix/Directory/ByteString.hsc
@@ -48,6 +48,7 @@ module System.Posix.Directory.ByteString (
changeWorkingDirectoryFd,
) where
+import Control.Monad ((>=>))
import Data.Maybe
import System.Posix.Types
import Foreign
@@ -60,7 +61,7 @@ import System.Posix.ByteString.FilePath
-- | @createDirectory dir mode@ calls @mkdir@ to
-- create a new directory, @dir@, with permissions based on
--- @mode@.
+-- @mode@.
createDirectory :: RawFilePath -> FileMode -> IO ()
createDirectory name mode =
withFilePath name $ \s ->
@@ -85,50 +86,21 @@ foreign import capi unsafe "HsUnix.h opendir"
-- | @readDirStream dp@ calls @readdir@ to obtain the
-- next directory entry (@struct dirent@) for the open directory
-- stream @dp@, and returns the @d_name@ member of that
--- structure.
+-- structure.
--
--- Note that this function returns an empty filepath if the end of the
--- directory stream is reached. For a safer alternative use
--- 'readDirStreamMaybe'.
+-- Note that this function returns an empty filepath if the end of the
+-- directory stream is reached. For a safer alternative use
+-- 'readDirStreamMaybe'.
readDirStream :: DirStream -> IO RawFilePath
readDirStream = fmap (fromMaybe BC.empty) . readDirStreamMaybe
-- | @readDirStreamMaybe dp@ calls @readdir@ to obtain the
-- next directory entry (@struct dirent@) for the open directory
-- stream @dp@. It returns the @d_name@ member of that
--- structure wrapped in a @Just d_name@ if an entry was read and @Nothing@ if
--- the end of the directory stream was reached.
+-- structure wrapped in a @Just d_name@ if an entry was read and @Nothing@ if
+-- the end of the directory stream was reached.
readDirStreamMaybe :: DirStream -> IO (Maybe RawFilePath)
-readDirStreamMaybe (DirStream dirp) =
- alloca $ \ptr_dEnt -> loop ptr_dEnt
- where
- loop ptr_dEnt = do
- resetErrno
- r <- c_readdir dirp ptr_dEnt
- if (r == 0)
- then do dEnt <- peek ptr_dEnt
- if (dEnt == nullPtr)
- then return Nothing
- else do
- entry <- (d_name dEnt >>= peekFilePath)
- c_freeDirEnt dEnt
- return $ Just entry
- else do errno <- getErrno
- if (errno == eINTR) then loop ptr_dEnt else do
- let (Errno eo) = errno
- if (eo == 0)
- then return Nothing
- else throwErrno "readDirStream"
-
--- traversing directories
-foreign import ccall unsafe "__hscore_readdir"
- c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
-
-foreign import ccall unsafe "__hscore_free_dirent"
- c_freeDirEnt :: Ptr CDirent -> IO ()
-
-foreign import ccall unsafe "__hscore_d_name"
- d_name :: Ptr CDirent -> IO CString
+readDirStreamMaybe = readDirStreamWith (dirEntName >=> peekFilePath)
-- | @getWorkingDirectory@ calls @getcwd@ to obtain the name
diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc
index e4aa7656..55dc28d5 100644
--- a/System/Posix/Directory/Common.hsc
+++ b/System/Posix/Directory/Common.hsc
@@ -1,4 +1,4 @@
-{-# LANGUAGE Safe, CApiFFI #-}
+{-# LANGUAGE CPP, Safe, CApiFFI, MultiWayIf, PatternSynonyms #-}
-----------------------------------------------------------------------------
-- |
@@ -15,10 +15,40 @@
-----------------------------------------------------------------------------
#include "HsUnix.h"
+#include "HsUnixConfig.h"
+##include "HsUnixConfig.h"
module System.Posix.Directory.Common (
- DirStream(..), CDir, CDirent, DirStreamOffset(..),
+ DirStream(..),
+ CDir,
+ DirStreamWithPath(..),
+ fromDirStreamWithPath,
+ toDirStreamWithPath,
+
+ DirEnt(..),
+ CDirent,
+ dirEntName,
+ dirEntType,
+ DirType( DirType
+ , UnknownType
+ , NamedPipeType
+ , CharacterDeviceType
+ , DirectoryType
+ , BlockDeviceType
+ , RegularFileType
+ , SymbolicLinkType
+ , SocketType
+ , WhiteoutType
+ ),
+ isUnknownType, isBlockDeviceType, isCharacterDeviceType, isNamedPipeType,
+ isRegularFileType, isDirectoryType, isSymbolicLinkType, isSocketType,
+ isWhiteoutType,
+ getRealDirType,
unsafeOpenDirStreamFd,
+ readDirStreamWith,
+ readDirStreamWithPtr,
+
+ DirStreamOffset(..),
rewindDirStream,
closeDirStream,
#ifdef HAVE_SEEKDIR
@@ -41,11 +71,149 @@ import System.IO.Error ( ioeSetLocation )
import GHC.IO.Exception ( unsupportedOperation )
#endif
+import System.Posix.Files.Common
+
newtype DirStream = DirStream (Ptr CDir)
+newtype DirStreamWithPath a = DirStreamWithPath (a, Ptr CDir)
+
+-- | Convert a 'DirStreamWithPath' to a 'DirStream'.
+-- Note that the underlying pointer is shared by both values, hence any
+-- modification to the resulting 'DirStream' will also modify the original
+-- 'DirStreamWithPath'.
+fromDirStreamWithPath :: DirStreamWithPath a -> DirStream
+fromDirStreamWithPath (DirStreamWithPath (_, ptr)) = DirStream ptr
+
+-- | Construct a 'DirStreamWithPath' from a 'DirStream'.
+-- Note that the underlying pointer is shared by both values, hence any
+-- modification to the pointer of the resulting 'DirStreamWithPath' will also
+-- modify the original 'DirStream'.
+toDirStreamWithPath :: a -> DirStream -> DirStreamWithPath a
+toDirStreamWithPath path (DirStream ptr) = DirStreamWithPath (path, ptr)
+
+newtype DirEnt = DirEnt (Ptr CDirent)
+
+-- We provide a hand-written instance here since GeneralizedNewtypeDeriving and
+-- DerivingVia are not allowed in Safe Haskell.
+instance Storable DirEnt where
+ sizeOf _ = sizeOf (undefined :: Ptr CDirent)
+ {-# INLINE sizeOf #-}
+
+ alignment _ = alignment (undefined :: Ptr CDirent)
+ {-# INLINE alignment #-}
+
+ peek ptr = DirEnt <$> peek (castPtr ptr)
+ {-# INLINE peek #-}
+
+ poke ptr (DirEnt dEnt) = poke (castPtr ptr) dEnt
+ {-# INLINE poke#-}
+
data {-# CTYPE "DIR" #-} CDir
data {-# CTYPE "struct dirent" #-} CDirent
+-- | The value of the @d_type@ field of a @dirent@ struct.
+-- Note that the possible values of that type depend on the filesystem that is
+-- queried. From @readdir(3)@:
+--
+-- > Currently, only some filesystems (among them: Btrfs, ext2, ext3, and ext4)
+-- > have full support for returning the file type in d_type. All applications
+-- > must properly handle a return of DT_UNKNOWN.
+--
+-- For example, JFS is a filesystem that does not support @d_type@;
+-- See https://github.com/haskell/ghcup-hs/issues/766
+--
+-- Furthermore, @dirent@ or the constants represented by the associated pattern
+-- synonyms of this type may not be provided by the underlying platform. In that
+-- case none of those patterns will match and the application must handle that
+-- case accordingly.
+newtype DirType = DirType CChar
+ deriving (Eq, Ord, Show)
+
+-- | The 'DirType' refers to an entry of unknown type.
+pattern UnknownType :: DirType
+pattern UnknownType = DirType (CONST_DT_UNKNOWN)
+
+-- | The 'DirType' refers to an entry that is a named pipe.
+pattern NamedPipeType :: DirType
+pattern NamedPipeType = DirType (CONST_DT_FIFO)
+
+-- | The 'DirType' refers to an entry that is a character device.
+pattern CharacterDeviceType :: DirType
+pattern CharacterDeviceType = DirType (CONST_DT_CHR)
+
+-- | The 'DirType' refers to an entry that is a directory.
+pattern DirectoryType :: DirType
+pattern DirectoryType = DirType (CONST_DT_DIR)
+
+-- | The 'DirType' refers to an entry that is a block device.
+pattern BlockDeviceType :: DirType
+pattern BlockDeviceType = DirType (CONST_DT_BLK)
+
+-- | The 'DirType' refers to an entry that is a regular file.
+pattern RegularFileType :: DirType
+pattern RegularFileType = DirType (CONST_DT_REG)
+
+-- | The 'DirType' refers to an entry that is a symbolic link.
+pattern SymbolicLinkType :: DirType
+pattern SymbolicLinkType = DirType (CONST_DT_LNK)
+
+-- | The 'DirType' refers to an entry that is a socket.
+pattern SocketType :: DirType
+pattern SocketType = DirType (CONST_DT_SOCK)
+
+-- | The 'DirType' refers to an entry that is a whiteout.
+pattern WhiteoutType :: DirType
+pattern WhiteoutType = DirType (CONST_DT_WHT)
+
+-- | Checks if this 'DirType' refers to an entry of unknown type.
+isUnknownType :: DirType -> Bool
+-- | Checks if this 'DirType' refers to a block device entry.
+isBlockDeviceType :: DirType -> Bool
+-- | Checks if this 'DirType' refers to a character device entry.
+isCharacterDeviceType :: DirType -> Bool
+-- | Checks if this 'DirType' refers to a named pipe entry.
+isNamedPipeType :: DirType -> Bool
+-- | Checks if this 'DirType' refers to a regular file entry.
+isRegularFileType :: DirType -> Bool
+-- | Checks if this 'DirType' refers to a directory entry.
+isDirectoryType :: DirType -> Bool
+-- | Checks if this 'DirType' refers to a symbolic link entry.
+isSymbolicLinkType :: DirType -> Bool
+-- | Checks if this 'DirType' refers to a socket entry.
+isSocketType :: DirType -> Bool
+-- | Checks if this 'DirType' refers to a whiteout entry.
+isWhiteoutType :: DirType -> Bool
+
+isUnknownType dtype = dtype == UnknownType
+isBlockDeviceType dtype = dtype == BlockDeviceType
+isCharacterDeviceType dtype = dtype == CharacterDeviceType
+isNamedPipeType dtype = dtype == NamedPipeType
+isRegularFileType dtype = dtype == RegularFileType
+isDirectoryType dtype = dtype == DirectoryType
+isSymbolicLinkType dtype = dtype == SymbolicLinkType
+isSocketType dtype = dtype == SocketType
+isWhiteoutType dtype = dtype == WhiteoutType
+
+getRealDirType :: IO FileStatus -> DirType -> IO DirType
+getRealDirType _ BlockDeviceType = return BlockDeviceType
+getRealDirType _ CharacterDeviceType = return CharacterDeviceType
+getRealDirType _ NamedPipeType = return NamedPipeType
+getRealDirType _ RegularFileType = return RegularFileType
+getRealDirType _ DirectoryType = return DirectoryType
+getRealDirType _ SymbolicLinkType = return SymbolicLinkType
+getRealDirType _ SocketType = return SocketType
+getRealDirType _ WhiteoutType = return WhiteoutType
+getRealDirType getFileStatus _ = do
+ stat <- getFileStatus
+ return $ if | isRegularFile stat -> RegularFileType
+ | isDirectory stat -> DirectoryType
+ | isSymbolicLink stat -> SymbolicLinkType
+ | isBlockDevice stat -> BlockDeviceType
+ | isCharacterDevice stat -> CharacterDeviceType
+ | isNamedPipe stat -> NamedPipeType
+ | isSocket stat -> SocketType
+ | otherwise -> UnknownType
+
-- | Call @fdopendir@ to obtain a directory stream for @fd@. @fd@ must not be
-- otherwise used after this.
--
@@ -78,6 +246,71 @@ foreign import ccall unsafe "HsUnix.h close"
foreign import capi unsafe "dirent.h fdopendir"
c_fdopendir :: CInt -> IO (Ptr CDir)
+
+-- | @readDirStreamWith f dp@ calls @readdir@ to obtain the next directory entry
+-- (@struct dirent@) for the open directory stream @dp@. If an entry is read,
+-- it passes the pointer to that structure to the provided function @f@ for
+-- processing. It returns the result of that function call wrapped in a @Just@
+-- if an entry was read and @Nothing@ if the end of the directory stream was
+-- reached.
+--
+-- __NOTE:__ The lifetime of the pointer wrapped in the `DirEnt` is limited to
+-- invocation of the callback and it will be freed automatically after. Do not
+-- pass it to the outside world!
+readDirStreamWith :: (DirEnt -> IO a) -> DirStream -> IO (Maybe a)
+readDirStreamWith f dstream = alloca
+ (\ptr_dEnt -> readDirStreamWithPtr ptr_dEnt f dstream)
+
+-- | A version of 'readDirStreamWith' that takes a pre-allocated pointer in
+-- addition to the other arguments. This pointer is used to store the pointer
+-- to the next directory entry, if there is any. This function is intended for
+-- use cases where you need to read a lot of directory entries and want to
+-- reuse the pointer for each of them. Using for example 'readDirStream' or
+-- 'readDirStreamWith' in this scenario would allocate a new pointer for each
+-- call of these functions.
+--
+-- __NOTE__: You are responsible for releasing the pointer after you are done.
+readDirStreamWithPtr :: Ptr DirEnt -> (DirEnt -> IO a) -> DirStream -> IO (Maybe a)
+readDirStreamWithPtr ptr_dEnt f dstream@(DirStream dirp) = do
+ resetErrno
+ r <- c_readdir dirp (castPtr ptr_dEnt)
+ if (r == 0)
+ then do dEnt@(DirEnt dEntPtr) <- peek ptr_dEnt
+ if (dEntPtr == nullPtr)
+ then return Nothing
+ else do
+ res <- f dEnt
+ c_freeDirEnt dEntPtr
+ return (Just res)
+ else do errno <- getErrno
+ if (errno == eINTR)
+ then readDirStreamWithPtr ptr_dEnt f dstream
+ else do
+ let (Errno eo) = errno
+ if (eo == 0)
+ then return Nothing
+ else throwErrno "readDirStream"
+
+dirEntName :: DirEnt -> IO CString
+dirEntName (DirEnt dEntPtr) = d_name dEntPtr
+
+foreign import ccall unsafe "__hscore_d_name"
+ d_name :: Ptr CDirent -> IO CString
+
+dirEntType :: DirEnt -> IO DirType
+dirEntType (DirEnt dEntPtr) = DirType <$> d_type dEntPtr
+
+foreign import ccall unsafe "__hscore_d_type"
+ d_type :: Ptr CDirent -> IO CChar
+
+-- traversing directories
+foreign import ccall unsafe "__hscore_readdir"
+ c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
+
+foreign import ccall unsafe "__hscore_free_dirent"
+ c_freeDirEnt :: Ptr CDirent -> IO ()
+
+
-- | @rewindDirStream dp@ calls @rewinddir@ to reposition
-- the directory stream @dp@ at the beginning of the directory.
rewindDirStream :: DirStream -> IO ()
diff --git a/System/Posix/Directory/Internals.hsc b/System/Posix/Directory/Internals.hsc
index 6a7dae62..378a087a 100644
--- a/System/Posix/Directory/Internals.hsc
+++ b/System/Posix/Directory/Internals.hsc
@@ -12,6 +12,40 @@
--
-----------------------------------------------------------------------------
-module System.Posix.Directory.Internals ( DirStream(..), CDir, CDirent, DirStreamOffset(..) ) where
+module System.Posix.Directory.Internals (
+ DirStream(..),
+ CDir,
+ DirStreamWithPath(..),
+ fromDirStreamWithPath,
+ toDirStreamWithPath,
+ DirEnt(..),
+ CDirent,
+ dirEntName,
+ dirEntType,
+ DirType( DirType
+ , UnknownType
+ , NamedPipeType
+ , CharacterDeviceType
+ , DirectoryType
+ , BlockDeviceType
+ , RegularFileType
+ , SymbolicLinkType
+ , SocketType
+ , WhiteoutType
+ ),
+ isUnknownType,
+ isNamedPipeType,
+ isCharacterDeviceType,
+ isDirectoryType,
+ isBlockDeviceType,
+ isRegularFileType,
+ isSymbolicLinkType,
+ isSocketType,
+ isWhiteoutType,
+ getRealDirType,
+ readDirStreamWith,
+ readDirStreamWithPtr,
+ DirStreamOffset(..),
+ ) where
import System.Posix.Directory.Common
diff --git a/System/Posix/Directory/PosixPath.hsc b/System/Posix/Directory/PosixPath.hsc
index 3d3ad612..24570c59 100644
--- a/System/Posix/Directory/PosixPath.hsc
+++ b/System/Posix/Directory/PosixPath.hsc
@@ -27,37 +27,39 @@ module System.Posix.Directory.PosixPath (
createDirectory, removeDirectory,
-- * Reading directories
- DirStream,
+ Common.DirStream,
openDirStream,
readDirStream,
- rewindDirStream,
- closeDirStream,
- DirStreamOffset,
+ readDirStreamMaybe,
+ Common.rewindDirStream,
+ Common.closeDirStream,
+ Common.DirStreamOffset,
#ifdef HAVE_TELLDIR
- tellDirStream,
+ Common.tellDirStream,
#endif
#ifdef HAVE_SEEKDIR
- seekDirStream,
+ Common.seekDirStream,
#endif
-- * The working directory
getWorkingDirectory,
changeWorkingDirectory,
- changeWorkingDirectoryFd,
+ Common.changeWorkingDirectoryFd,
) where
+import Control.Monad ((>=>))
+import Data.Maybe
import System.Posix.Types
import Foreign
import Foreign.C
-import System.OsPath.Types
-import System.Posix.Directory hiding (createDirectory, openDirStream, readDirStream, getWorkingDirectory, changeWorkingDirectory, removeDirectory)
+import System.OsPath.Posix
import qualified System.Posix.Directory.Common as Common
import System.Posix.PosixPath.FilePath
-- | @createDirectory dir mode@ calls @mkdir@ to
-- create a new directory, @dir@, with permissions based on
--- @mode@.
+-- @mode@.
createDirectory :: PosixPath -> FileMode -> IO ()
createDirectory name mode =
withFilePath name $ \s ->
@@ -70,7 +72,7 @@ foreign import ccall unsafe "mkdir"
-- | @openDirStream dir@ calls @opendir@ to obtain a
-- directory stream for @dir@.
-openDirStream :: PosixPath -> IO DirStream
+openDirStream :: PosixPath -> IO Common.DirStream
openDirStream name =
withFilePath name $ \s -> do
dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s
@@ -82,37 +84,22 @@ foreign import capi unsafe "HsUnix.h opendir"
-- | @readDirStream dp@ calls @readdir@ to obtain the
-- next directory entry (@struct dirent@) for the open directory
-- stream @dp@, and returns the @d_name@ member of that
--- structure.
-readDirStream :: DirStream -> IO PosixPath
-readDirStream (Common.DirStream dirp) = alloca $ \ptr_dEnt -> loop ptr_dEnt
- where
- loop ptr_dEnt = do
- resetErrno
- r <- c_readdir dirp ptr_dEnt
- if (r == 0)
- then do dEnt <- peek ptr_dEnt
- if (dEnt == nullPtr)
- then return mempty
- else do
- entry <- (d_name dEnt >>= peekFilePath)
- c_freeDirEnt dEnt
- return entry
- else do errno <- getErrno
- if (errno == eINTR) then loop ptr_dEnt else do
- let (Errno eo) = errno
- if (eo == 0)
- then return mempty
- else throwErrno "readDirStream"
-
--- traversing directories
-foreign import ccall unsafe "__hscore_readdir"
- c_readdir :: Ptr Common.CDir -> Ptr (Ptr Common.CDirent) -> IO CInt
-
-foreign import ccall unsafe "__hscore_free_dirent"
- c_freeDirEnt :: Ptr Common.CDirent -> IO ()
-
-foreign import ccall unsafe "__hscore_d_name"
- d_name :: Ptr Common.CDirent -> IO CString
+-- structure.
+--
+-- Note that this function returns an empty filepath if the end of the
+-- directory stream is reached. For a safer alternative use
+-- 'readDirStreamMaybe'.
+readDirStream :: Common.DirStream -> IO PosixPath
+readDirStream = fmap (fromMaybe mempty) . readDirStreamMaybe
+
+-- | @readDirStreamMaybe dp@ calls @readdir@ to obtain the
+-- next directory entry (@struct dirent@) for the open directory
+-- stream @dp@. It returns the @d_name@ member of that
+-- structure wrapped in a @Just d_name@ if an entry was read and @Nothing@ if
+-- the end of the directory stream was reached.
+readDirStreamMaybe :: Common.DirStream -> IO (Maybe PosixPath)
+readDirStreamMaybe = Common.readDirStreamWith
+ (Common.dirEntName >=> peekFilePath)
-- | @getWorkingDirectory@ calls @getcwd@ to obtain the name
diff --git a/cbits/HsUnix.c b/cbits/HsUnix.c
index 60d259f3..d2d890ef 100644
--- a/cbits/HsUnix.c
+++ b/cbits/HsUnix.c
@@ -104,6 +104,15 @@ char *__hscore_d_name( struct dirent* d )
return (d->d_name);
}
+char __hscore_d_type( struct dirent* d )
+{
+#ifdef HAVE_DIRENT_D_TYPE
+ return (d->d_type);
+#else
+ return CONST_DT_UNKNOWN;
+#endif
+}
+
void __hscore_free_dirent(struct dirent *dEnt)
{
#if HAVE_READDIR_R && USE_READDIR_R
diff --git a/configure.ac b/configure.ac
index 2f36f524..dcd88d34 100644
--- a/configure.ac
+++ b/configure.ac
@@ -27,6 +27,44 @@ AC_CHECK_HEADERS([sys/sysmacros.h])
AC_CHECK_HEADERS([bsd/libutil.h libutil.h pty.h utmp.h])
AC_CHECK_HEADERS([termios.h time.h unistd.h utime.h])
+AC_STRUCT_DIRENT_D_TYPE
+FP_CHECK_CONST([DT_UNKNOWN], [
+#if HAVE_STRUCT_DIRENT_D_TYPE
+#include <dirent.h>
+#endif], [-1])
+FP_CHECK_CONST([DT_FIFO], [
+#if HAVE_STRUCT_DIRENT_D_TYPE
+#include <dirent.h>
+#endif], [-2])
+FP_CHECK_CONST([DT_CHR], [
+#if HAVE_STRUCT_DIRENT_D_TYPE
+#include <dirent.h>
+#endif], [-3])
+FP_CHECK_CONST([DT_DIR], [
+#if HAVE_STRUCT_DIRENT_D_TYPE
+#include <dirent.h>
+#endif], [-4])
+FP_CHECK_CONST([DT_BLK], [
+#if HAVE_STRUCT_DIRENT_D_TYPE
+#include <dirent.h>
+#endif], [-5])
+FP_CHECK_CONST([DT_REG], [
+#if HAVE_STRUCT_DIRENT_D_TYPE
+#include <dirent.h>
+#endif], [-6])
+FP_CHECK_CONST([DT_LNK], [
+#if HAVE_STRUCT_DIRENT_D_TYPE
+#include <dirent.h>
+#endif], [-7])
+FP_CHECK_CONST([DT_SOCK], [
+#if HAVE_STRUCT_DIRENT_D_TYPE
+#include <dirent.h>
+#endif], [-8])
+FP_CHECK_CONST([DT_WHT], [
+#if HAVE_STRUCT_DIRENT_D_TYPE
+#include <dirent.h>
+#endif], [-9])
+
AC_CHECK_FUNCS([getgrgid_r getgrnam_r getpwnam_r getpwuid_r getpwnam getpwuid])
AC_CHECK_FUNCS([getpwent getgrent])
AC_CHECK_FUNCS([lchown setenv sysconf unsetenv clearenv])
diff --git a/tests/ReadDirStream.hs b/tests/ReadDirStream.hs
new file mode 100644
index 00000000..9ba11e5c
--- /dev/null
+++ b/tests/ReadDirStream.hs
@@ -0,0 +1,55 @@
+module ReadDirStream
+ ( emptyDirStream
+ , nonEmptyDirStream
+ ) where
+
+import System.Posix.Files
+import System.Posix.Directory
+import System.Posix.IO
+import Control.Exception as E
+import Test.Tasty.HUnit
+
+emptyDirStream :: IO ()
+emptyDirStream = do
+ cleanup
+ createDirectory dir ownerReadMode
+ dir_p <- openDirStream dir
+ entries <- readDirStreamEntries dir_p
+ closeDirStream dir_p
+ cleanup
+ entries @?= []
+ where
+ dir = "emptyDirStream"
+
+ cleanup = do
+ ignoreIOExceptions $ removeDirectory dir
+
+nonEmptyDirStream :: IO ()
+nonEmptyDirStream = do
+ cleanup
+ createDirectory dir ownerModes
+ _ <- createFile (dir ++ "/file") ownerReadMode
+ dir_p <- openDirStream dir
+ entries <- readDirStreamEntries dir_p
+ closeDirStream dir_p
+ cleanup
+ entries @?= ["file"]
+ where
+ dir = "nonEmptyDirStream"
+
+ cleanup = do
+ ignoreIOExceptions $ removeLink $ dir ++ "/file"
+ ignoreIOExceptions $ removeDirectory dir
+
+readDirStreamEntries :: DirStream -> IO [FilePath]
+readDirStreamEntries dir_p = do
+ ment <- readDirStreamMaybe dir_p
+ case ment of
+ Nothing -> return []
+ Just "." -> readDirStreamEntries dir_p
+ Just ".." -> readDirStreamEntries dir_p
+ Just ent -> (ent :) <$> readDirStreamEntries dir_p
+
+ignoreIOExceptions :: IO () -> IO ()
+ignoreIOExceptions io = io `E.catch`
+ ((\_ -> return ()) :: E.IOException -> IO ())
diff --git a/tests/Test.hsc b/tests/Test.hsc
index f6771cf3..ca85a9b9 100644
--- a/tests/Test.hsc
+++ b/tests/Test.hsc
@@ -29,6 +29,7 @@ import Test.Tasty.QuickCheck
import qualified FileStatus
import qualified FileExtendedStatus
import qualified FileStatusByteString
+import qualified ReadDirStream
import qualified Signals001
main :: IO ()
@@ -59,6 +60,8 @@ main = defaultMain $ testGroup "All"
, posix005 -- JS: missing "environ"
, posix006 -- JS: missing "time"
, posix010 -- JS: missing "sysconf"
+ , emptyDirStream
+ , nonEmptyDirStream
]
#endif
, testWithFilePath
@@ -275,6 +278,12 @@ testWithFilePath =
(\ptr -> (=== ys) <$> Sh.packCString ptr)
]
+emptyDirStream :: TestTree
+emptyDirStream = testCase "emptyDirStream" ReadDirStream.emptyDirStream
+
+nonEmptyDirStream :: TestTree
+nonEmptyDirStream = testCase "nonEmptyDirStream" ReadDirStream.nonEmptyDirStream
+
-------------------------------------------------------------------------------
-- Utils
diff --git a/unix.cabal b/unix.cabal
index 1f37c908..584eac66 100644
--- a/unix.cabal
+++ b/unix.cabal
@@ -179,6 +179,7 @@ test-suite unix-tests
FileExtendedStatus
FileStatusByteString
Signals001
+ ReadDirStream
type: exitcode-stdio-1.0
default-language: Haskell2010
build-depends: base, bytestring, tasty, tasty-hunit, tasty-quickcheck, unix