From 12af33fccbdf75eb88880c70c991e30afe83a60e Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Sat, 1 Oct 2022 14:57:34 +0200 Subject: [PATCH 01/15] Added tests for ReadDirStream --- tests/ReadDirStream.hs | 49 ++++++++++++++++++++++++++++++++++++++++++ tests/Test.hsc | 13 +++++++++++ unix.cabal | 1 + 3 files changed, 63 insertions(+) create mode 100644 tests/ReadDirStream.hs diff --git a/tests/ReadDirStream.hs b/tests/ReadDirStream.hs new file mode 100644 index 00000000..de2b76b9 --- /dev/null +++ b/tests/ReadDirStream.hs @@ -0,0 +1,49 @@ +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 + +dir :: FilePath +dir = "dir" + +emptyDirStream :: IO () +emptyDirStream = do + cleanup + createDirectory dir ownerReadMode + dir_p <- openDirStream dir + _ <- readDirStreamMaybe dir_p -- Just "." + _ <- readDirStreamMaybe dir_p -- Just ".." + ment <- readDirStreamMaybe dir_p + closeDirStream dir_p + cleanup + ment @?= Nothing + +nonEmptyDirStream :: IO () +nonEmptyDirStream = do + cleanup + createDirectory dir ownerModes + _ <- createFile (dir ++ "/file") ownerReadMode + dir_p <- openDirStream dir + -- We read three entries here since "." and "." are included in the dirstream + one <- readDirStreamMaybe dir_p + two <- readDirStreamMaybe dir_p + three <- readDirStreamMaybe dir_p + let ment = maximum [one, two, three] + closeDirStream dir_p + cleanup + ment @?= Just "file" + +cleanup :: IO () +cleanup = do + ignoreIOExceptions $ removeLink $ dir ++ "/file" + ignoreIOExceptions $ removeDirectory dir + +ignoreIOExceptions :: IO () -> IO () +ignoreIOExceptions io = io `E.catch` + ((\_ -> return ()) :: E.IOException -> IO ()) diff --git a/tests/Test.hsc b/tests/Test.hsc index f6771cf3..0c6f1c35 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,9 @@ main = defaultMain $ testGroup "All" , posix005 -- JS: missing "environ" , posix006 -- JS: missing "time" , posix010 -- JS: missing "sysconf" + , emptyDirStream + , nonEmptyDirStream + , dirStreamWithTypes ] #endif , testWithFilePath @@ -275,6 +279,15 @@ testWithFilePath = (\ptr -> (=== ys) <$> Sh.packCString ptr) ] +emptyDirStream :: TestTree +emptyDirStream = testCase "emptyDirStream" ReadDirStream.emptyDirStream + +nonEmptyDirStream :: TestTree +nonEmptyDirStream = testCase "nonEmptyDirStream" ReadDirStream.nonEmptyDirStream + +dirStreamWithTypes :: TestTree +dirStreamWithTypes = testCase "dirStreamWithTypes" ReadDirStream.dirStreamWithTypes + ------------------------------------------------------------------------------- -- 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 From 87f189db6358af3b2240b4e482d88401fa046f3a Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Sat, 15 May 2021 15:55:46 +0200 Subject: [PATCH 02/15] Expose dirent pointer and added readDirStreamWith This commit exposes the dirent pointer used in the directory stream functions wrapped in a newtype called `DirEnt`. It also adds a new function `readDirStreamWith` that takes a callback that is used to obtain the result from the pointer to the directory entry. --- System/Posix/Directory.hsc | 26 +++++++++++++++++++++----- System/Posix/Directory/Common.hsc | 4 +++- 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc index 0f856c45..dd8f7956 100644 --- a/System/Posix/Directory.hsc +++ b/System/Posix/Directory.hsc @@ -29,9 +29,11 @@ module System.Posix.Directory ( -- * Reading directories DirStream, + DirEnt(..), openDirStream, readDirStream, readDirStreamMaybe, + readDirStreamWith, rewindDirStream, closeDirStream, DirStreamOffset, @@ -95,10 +97,24 @@ 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) = +readDirStreamMaybe = readDirStreamWith + (\(DirEnt dEnt) -> d_name dEnt >>= peekFilePath) + +-- | @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 (DirStream dirp) = alloca $ \ptr_dEnt -> loop ptr_dEnt where loop ptr_dEnt = do @@ -109,9 +125,9 @@ readDirStreamMaybe (DirStream dirp) = if (dEnt == nullPtr) then return Nothing else do - entry <- (d_name dEnt >>= peekFilePath) + res <- f (DirEnt dEnt) c_freeDirEnt dEnt - return $ Just entry + return (Just res) else do errno <- getErrno if (errno == eINTR) then loop ptr_dEnt else do let (Errno eo) = errno diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index e4aa7656..dce031ba 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -17,7 +17,7 @@ #include "HsUnix.h" module System.Posix.Directory.Common ( - DirStream(..), CDir, CDirent, DirStreamOffset(..), + DirStream(..), DirEnt(..), CDir, CDirent, DirStreamOffset(..), unsafeOpenDirStreamFd, rewindDirStream, closeDirStream, @@ -43,6 +43,8 @@ import GHC.IO.Exception ( unsupportedOperation ) newtype DirStream = DirStream (Ptr CDir) +newtype DirEnt = DirEnt (Ptr CDirent) + data {-# CTYPE "DIR" #-} CDir data {-# CTYPE "struct dirent" #-} CDirent From 40640a034de11f67a4370825cf6cbe1a35b2128c Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Sun, 2 Oct 2022 14:34:43 +0200 Subject: [PATCH 03/15] Added readDirStreamWithPtr This version of `readDirStreamWith` takes a pre-allocated pointer as an additional argument that is used to store the pointer to the dirent. It is useful when you want to read a lot of entries and want to safe a few allocations since you can reuse the pointer for each call to `readDirStreamWithPtr`. --- System/Posix/Directory.hsc | 53 +++++++++++++++++++------------ System/Posix/Directory/Common.hsc | 15 +++++++++ 2 files changed, 48 insertions(+), 20 deletions(-) diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc index dd8f7956..b6dc7b09 100644 --- a/System/Posix/Directory.hsc +++ b/System/Posix/Directory.hsc @@ -34,6 +34,7 @@ module System.Posix.Directory ( readDirStream, readDirStreamMaybe, readDirStreamWith, + readDirStreamWithPtr, rewindDirStream, closeDirStream, DirStreamOffset, @@ -114,26 +115,38 @@ readDirStreamMaybe = readDirStreamWith -- 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 (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 - res <- f (DirEnt dEnt) - c_freeDirEnt dEnt - return (Just res) - 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" +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 +-- usecases 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" -- traversing directories foreign import ccall unsafe "__hscore_readdir" diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index dce031ba..71f0e0e3 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -45,6 +45,21 @@ newtype DirStream = DirStream (Ptr CDir) 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 From 83eb15821f72415b4b1d1e5cc94d859144f1569e Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 4 Oct 2022 04:20:24 +0200 Subject: [PATCH 04/15] Applied suggestions for ReadDirStream tests --- tests/ReadDirStream.hs | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/tests/ReadDirStream.hs b/tests/ReadDirStream.hs index de2b76b9..e0d99774 100644 --- a/tests/ReadDirStream.hs +++ b/tests/ReadDirStream.hs @@ -17,12 +17,10 @@ emptyDirStream = do cleanup createDirectory dir ownerReadMode dir_p <- openDirStream dir - _ <- readDirStreamMaybe dir_p -- Just "." - _ <- readDirStreamMaybe dir_p -- Just ".." - ment <- readDirStreamMaybe dir_p + entries <- readDirStreamEntries dir_p closeDirStream dir_p cleanup - ment @?= Nothing + entries @?= [] nonEmptyDirStream :: IO () nonEmptyDirStream = do @@ -30,14 +28,19 @@ nonEmptyDirStream = do createDirectory dir ownerModes _ <- createFile (dir ++ "/file") ownerReadMode dir_p <- openDirStream dir - -- We read three entries here since "." and "." are included in the dirstream - one <- readDirStreamMaybe dir_p - two <- readDirStreamMaybe dir_p - three <- readDirStreamMaybe dir_p - let ment = maximum [one, two, three] + entries <- readDirStreamEntries dir_p closeDirStream dir_p cleanup - ment @?= Just "file" + entries @?= ["file"] + +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 cleanup :: IO () cleanup = do From d446fdff86156d0551ea8cea2697eb1f5cbf610f Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 20 Dec 2022 17:47:21 +0100 Subject: [PATCH 05/15] Added `readDirStream` version that returns the entry type as well. * Added `readDirStream`/`readDirStream` for ByteString, PosixPath * Removed `DirEnt`, `readDirStreamWith`, `readDirStreamWithPtr` from public API --- System/Posix/Directory.hsc | 103 +++++++++---------- System/Posix/Directory/ByteString.hsc | 86 +++++++++------- System/Posix/Directory/Common.hsc | 139 +++++++++++++++++++++++++- System/Posix/Directory/Internals.hsc | 6 +- System/Posix/Directory/PosixPath.hsc | 108 +++++++++++++------- cbits/HsUnix.c | 9 ++ configure.ac | 6 ++ 7 files changed, 326 insertions(+), 131 deletions(-) diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc index b6dc7b09..9c21c654 100644 --- a/System/Posix/Directory.hsc +++ b/System/Posix/Directory.hsc @@ -29,12 +29,36 @@ module System.Posix.Directory ( -- * Reading directories DirStream, - DirEnt(..), + DirType( DtUnknown +#ifdef CONST_DT_FIFO + , DtFifo +#endif +#ifdef CONST_DT_CHR + , DtChr +#endif +#ifdef CONST_DT_DIR + , DtDir +#endif +#ifdef CONST_DT_BLK + , DtBlk +#endif +#ifdef CONST_DT_REG + , DtReg +#endif +#ifdef CONST_DT_LNK + , DtLnk +#endif +#ifdef CONST_DT_SOCK + , DtSock +#endif +#ifdef CONST_DT_WHT + , DtWht +#endif + ), openDirStream, readDirStream, readDirStreamMaybe, - readDirStreamWith, - readDirStreamWithPtr, + readDirStreamWithType, rewindDirStream, closeDirStream, DirStreamOffset, @@ -87,11 +111,11 @@ 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 @@ -104,60 +128,25 @@ readDirStreamMaybe :: DirStream -> IO (Maybe FilePath) readDirStreamMaybe = readDirStreamWith (\(DirEnt dEnt) -> d_name dEnt >>= peekFilePath) --- | @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 --- usecases 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" - --- 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 () +-- | @readDirStreamWithType 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 together with the entry's type (@d_type@) wrapped in a +-- @Just (d_name, d_type)@ if an entry was read and @Nothing@ if +-- the end of the directory stream was reached. +readDirStreamWithType :: DirStream -> IO (Maybe (FilePath, DirType)) +readDirStreamWithType = readDirStreamWith + (\(DirEnt dEnt) -> (,) + <$> (d_name dEnt >>= peekFilePath) + <*> (DirType <$> d_type dEnt) + ) foreign import ccall unsafe "__hscore_d_name" d_name :: Ptr CDirent -> IO CString +foreign import ccall unsafe "__hscore_d_type" + d_type :: Ptr CDirent -> IO CChar + -- | @getWorkingDirectory@ calls @getcwd@ to obtain the name -- of the current working directory. diff --git a/System/Posix/Directory/ByteString.hsc b/System/Posix/Directory/ByteString.hsc index 3d6bbea5..61a734b4 100644 --- a/System/Posix/Directory/ByteString.hsc +++ b/System/Posix/Directory/ByteString.hsc @@ -29,9 +29,36 @@ module System.Posix.Directory.ByteString ( -- * Reading directories DirStream, + DirType( DtUnknown +#ifdef CONST_DT_FIFO + , DtFifo +#endif +#ifdef CONST_DT_CHR + , DtChr +#endif +#ifdef CONST_DT_DIR + , DtDir +#endif +#ifdef CONST_DT_BLK + , DtBlk +#endif +#ifdef CONST_DT_REG + , DtReg +#endif +#ifdef CONST_DT_LNK + , DtLnk +#endif +#ifdef CONST_DT_SOCK + , DtSock +#endif +#ifdef CONST_DT_WHT + , DtWht +#endif + ), openDirStream, readDirStream, readDirStreamMaybe, + readDirStreamWithType, rewindDirStream, closeDirStream, DirStreamOffset, @@ -60,7 +87,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,51 +112,42 @@ 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 () +readDirStreamMaybe = readDirStreamWith + (\(DirEnt dEnt) -> d_name dEnt >>= peekFilePath) + +-- | @readDirStreamWithType 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 together with the entry's type (@d_type@) wrapped in a +-- @Just (d_name, d_type)@ if an entry was read and @Nothing@ if +-- the end of the directory stream was reached. +readDirStreamWithType :: DirStream -> IO (Maybe (RawFilePath, DirType)) +readDirStreamWithType = readDirStreamWith + (\(DirEnt dEnt) -> (,) + <$> (d_name dEnt >>= peekFilePath) + <*> (DirType <$> d_type dEnt) + ) foreign import ccall unsafe "__hscore_d_name" d_name :: Ptr CDirent -> IO CString +foreign import ccall unsafe "__hscore_d_type" + d_type :: Ptr CDirent -> IO CChar + -- | @getWorkingDirectory@ calls @getcwd@ to obtain the name -- of the current working directory. diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index 71f0e0e3..3206b4c0 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -1,4 +1,4 @@ -{-# LANGUAGE Safe, CApiFFI #-} +{-# LANGUAGE CPP, Safe, CApiFFI, PatternSynonyms #-} ----------------------------------------------------------------------------- -- | @@ -15,10 +15,41 @@ ----------------------------------------------------------------------------- #include "HsUnix.h" +#include "HsUnixConfig.h" +##include "HsUnixConfig.h" module System.Posix.Directory.Common ( DirStream(..), DirEnt(..), CDir, CDirent, DirStreamOffset(..), + DirType( DirType + , DtUnknown +#ifdef CONST_DT_FIFO + , DtFifo +#endif +#ifdef CONST_DT_CHR + , DtChr +#endif +#ifdef CONST_DT_DIR + , DtDir +#endif +#ifdef CONST_DT_BLK + , DtBlk +#endif +#ifdef CONST_DT_REG + , DtReg +#endif +#ifdef CONST_DT_LNK + , DtLnk +#endif +#ifdef CONST_DT_SOCK + , DtSock +#endif +#ifdef CONST_DT_WHT + , DtWht +#endif + ), unsafeOpenDirStreamFd, + readDirStreamWith, + readDirStreamWithPtr, rewindDirStream, closeDirStream, #ifdef HAVE_SEEKDIR @@ -63,6 +94,55 @@ instance Storable DirEnt where data {-# CTYPE "DIR" #-} CDir data {-# CTYPE "struct dirent" #-} CDirent +newtype DirType = DirType CChar + +pattern DtUnknown :: DirType +#ifdef CONST_DT_UNKNOWN +pattern DtUnknown = DirType CONST_DT_UNKNOWN +#else +pattern DtUnknown = DirType 0 +#endif + +#ifdef CONST_DT_FIFO +pattern DtFifo :: DirType +pattern DtFifo = DirType CONST_DT_FIFO +#endif + +#ifdef CONST_DT_CHR +pattern DtChr :: DirType +pattern DtChr = DirType CONST_DT_CHR +#endif + +#ifdef CONST_DT_DIR +pattern DtDir :: DirType +pattern DtDir = DirType CONST_DT_DIR +#endif + +#ifdef CONST_DT_BLK +pattern DtBlk :: DirType +pattern DtBlk = DirType CONST_DT_BLK +#endif + +#ifdef CONST_DT_REG +pattern DtReg :: DirType +pattern DtReg = DirType CONST_DT_REG +#endif + +#ifdef CONST_DT_LNK +pattern DtLnk :: DirType +pattern DtLnk = DirType CONST_DT_LNK +#endif + +#ifdef CONST_DT_SOCK +pattern DtSock :: DirType +pattern DtSock = DirType CONST_DT_SOCK +#endif + +#ifdef CONST_DT_WHT +pattern DtWht :: DirType +pattern DtWht = DirType CONST_DT_WHT +#endif + -- | Call @fdopendir@ to obtain a directory stream for @fd@. @fd@ must not be -- otherwise used after this. -- @@ -95,6 +175,63 @@ 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 +-- usecases 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" + +-- 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 + +foreign import ccall unsafe "__hscore_d_type" + d_type :: Ptr CDirent -> IO CChar + -- | @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..61056b2c 100644 --- a/System/Posix/Directory/Internals.hsc +++ b/System/Posix/Directory/Internals.hsc @@ -12,6 +12,10 @@ -- ----------------------------------------------------------------------------- -module System.Posix.Directory.Internals ( DirStream(..), CDir, CDirent, DirStreamOffset(..) ) where +module System.Posix.Directory.Internals ( + DirStream(..), DirEnt(..), DirType(..), CDir, CDirent, DirStreamOffset(..), + readDirStreamWith, + readDirStreamWithPtr, + ) where import System.Posix.Directory.Common diff --git a/System/Posix/Directory/PosixPath.hsc b/System/Posix/Directory/PosixPath.hsc index 3d3ad612..fb1a5f41 100644 --- a/System/Posix/Directory/PosixPath.hsc +++ b/System/Posix/Directory/PosixPath.hsc @@ -27,37 +27,65 @@ module System.Posix.Directory.PosixPath ( createDirectory, removeDirectory, -- * Reading directories - DirStream, + Common.DirStream, + Common.DirType( DtUnknown +#ifdef CONST_DT_FIFO + , DtFifo +#endif +#ifdef CONST_DT_CHR + , DtChr +#endif +#ifdef CONST_DT_DIR + , DtDir +#endif +#ifdef CONST_DT_BLK + , DtBlk +#endif +#ifdef CONST_DT_REG + , DtReg +#endif +#ifdef CONST_DT_LNK + , DtLnk +#endif +#ifdef CONST_DT_SOCK + , DtSock +#endif +#ifdef CONST_DT_WHT + , DtWht +#endif + ), openDirStream, readDirStream, - rewindDirStream, - closeDirStream, - DirStreamOffset, + readDirStreamMaybe, + readDirStreamWithType, + 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 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 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 +98,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,38 +110,42 @@ 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 () +-- 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.DirEnt dEnt) -> d_name dEnt >>= peekFilePath) + +-- | @readDirStreamWithType 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 together with the entry's type (@d_type@) wrapped in a +-- @Just (d_name, d_type)@ if an entry was read and @Nothing@ if +-- the end of the directory stream was reached. +readDirStreamWithType :: Common.DirStream -> IO (Maybe (PosixPath, Common.DirType)) +readDirStreamWithType = Common.readDirStreamWith + (\(Common.DirEnt dEnt) -> (,) + <$> (d_name dEnt >>= peekFilePath) + <*> (Common.DirType <$> d_type dEnt) + ) foreign import ccall unsafe "__hscore_d_name" d_name :: Ptr Common.CDirent -> IO CString +foreign import ccall unsafe "__hscore_d_type" + d_type :: Ptr Common.CDirent -> IO CChar + -- | @getWorkingDirectory@ calls @getcwd@ to obtain the name -- of the current working directory. diff --git a/cbits/HsUnix.c b/cbits/HsUnix.c index 60d259f3..56c381b3 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 0; +#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..786cf493 100644 --- a/configure.ac +++ b/configure.ac @@ -27,6 +27,12 @@ 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_CONSTS([DT_UNKNOWN DT_FIFO DT_CHR DT_DIR DT_BLK DT_REG DT_LNK DT_SOCK DT_WHT], [ +#if HAVE_STRUCT_DIRENT_D_TYPE +#include +#endif]) + 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]) From dc863dc1539c7a84d2abd866f0b47ff84cd9a345 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 20 Dec 2022 18:50:50 +0100 Subject: [PATCH 06/15] Removed superfluous d_name, d_type --- System/Posix/Directory/Common.hsc | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index 3206b4c0..2309eded 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -175,6 +175,7 @@ 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 @@ -226,11 +227,6 @@ foreign import ccall unsafe "__hscore_readdir" 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 - -foreign import ccall unsafe "__hscore_d_type" - d_type :: Ptr CDirent -> IO CChar -- | @rewindDirStream dp@ calls @rewinddir@ to reposition -- the directory stream @dp@ at the beginning of the directory. From 49dc4981e40de19b5539933f2d6f07abe56fe3a1 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 20 Dec 2022 19:03:33 +0100 Subject: [PATCH 07/15] Removed unnecessary CPP --- System/Posix/Directory.hsc | 16 --------- System/Posix/Directory/ByteString.hsc | 16 --------- System/Posix/Directory/Common.hsc | 52 +++++---------------------- System/Posix/Directory/PosixPath.hsc | 34 +++++------------- 4 files changed, 17 insertions(+), 101 deletions(-) diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc index 9c21c654..5e2f6218 100644 --- a/System/Posix/Directory.hsc +++ b/System/Posix/Directory.hsc @@ -30,30 +30,14 @@ module System.Posix.Directory ( -- * Reading directories DirStream, DirType( DtUnknown -#ifdef CONST_DT_FIFO , DtFifo -#endif -#ifdef CONST_DT_CHR , DtChr -#endif -#ifdef CONST_DT_DIR , DtDir -#endif -#ifdef CONST_DT_BLK , DtBlk -#endif -#ifdef CONST_DT_REG , DtReg -#endif -#ifdef CONST_DT_LNK , DtLnk -#endif -#ifdef CONST_DT_SOCK , DtSock -#endif -#ifdef CONST_DT_WHT , DtWht -#endif ), openDirStream, readDirStream, diff --git a/System/Posix/Directory/ByteString.hsc b/System/Posix/Directory/ByteString.hsc index 61a734b4..875124ec 100644 --- a/System/Posix/Directory/ByteString.hsc +++ b/System/Posix/Directory/ByteString.hsc @@ -30,30 +30,14 @@ module System.Posix.Directory.ByteString ( -- * Reading directories DirStream, DirType( DtUnknown -#ifdef CONST_DT_FIFO , DtFifo -#endif -#ifdef CONST_DT_CHR , DtChr -#endif -#ifdef CONST_DT_DIR , DtDir -#endif -#ifdef CONST_DT_BLK , DtBlk -#endif -#ifdef CONST_DT_REG , DtReg -#endif -#ifdef CONST_DT_LNK , DtLnk -#endif -#ifdef CONST_DT_SOCK , DtSock -#endif -#ifdef CONST_DT_WHT , DtWht -#endif ), openDirStream, readDirStream, diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index 2309eded..1dba7c6f 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -22,30 +22,14 @@ module System.Posix.Directory.Common ( DirStream(..), DirEnt(..), CDir, CDirent, DirStreamOffset(..), DirType( DirType , DtUnknown -#ifdef CONST_DT_FIFO , DtFifo -#endif -#ifdef CONST_DT_CHR , DtChr -#endif -#ifdef CONST_DT_DIR , DtDir -#endif -#ifdef CONST_DT_BLK , DtBlk -#endif -#ifdef CONST_DT_REG , DtReg -#endif -#ifdef CONST_DT_LNK , DtLnk -#endif -#ifdef CONST_DT_SOCK , DtSock -#endif -#ifdef CONST_DT_WHT , DtWht -#endif ), unsafeOpenDirStreamFd, readDirStreamWith, @@ -97,51 +81,31 @@ data {-# CTYPE "struct dirent" #-} CDirent newtype DirType = DirType CChar pattern DtUnknown :: DirType -#ifdef CONST_DT_UNKNOWN pattern DtUnknown = DirType CONST_DT_UNKNOWN -#else -pattern DtUnknown = DirType 0 -#endif -#ifdef CONST_DT_FIFO pattern DtFifo :: DirType -pattern DtFifo = DirType CONST_DT_FIFO -#endif +pattern DtFifo = DirType (CONST_DT_FIFO) -#ifdef CONST_DT_CHR pattern DtChr :: DirType -pattern DtChr = DirType CONST_DT_CHR -#endif +pattern DtChr = DirType (CONST_DT_CHR) -#ifdef CONST_DT_DIR pattern DtDir :: DirType -pattern DtDir = DirType CONST_DT_DIR -#endif +pattern DtDir = DirType (CONST_DT_DIR) -#ifdef CONST_DT_BLK pattern DtBlk :: DirType -pattern DtBlk = DirType CONST_DT_BLK -#endif +pattern DtBlk = DirType (CONST_DT_BLK) -#ifdef CONST_DT_REG pattern DtReg :: DirType -pattern DtReg = DirType CONST_DT_REG -#endif +pattern DtReg = DirType (CONST_DT_REG) -#ifdef CONST_DT_LNK pattern DtLnk :: DirType -pattern DtLnk = DirType CONST_DT_LNK -#endif +pattern DtLnk = DirType (CONST_DT_LNK) -#ifdef CONST_DT_SOCK pattern DtSock :: DirType -pattern DtSock = DirType CONST_DT_SOCK -#endif +pattern DtSock = DirType (CONST_DT_SOCK) -#ifdef CONST_DT_WHT pattern DtWht :: DirType -pattern DtWht = DirType CONST_DT_WHT -#endif +pattern DtWht = DirType (CONST_DT_WHT) -- | Call @fdopendir@ to obtain a directory stream for @fd@. @fd@ must not be -- otherwise used after this. diff --git a/System/Posix/Directory/PosixPath.hsc b/System/Posix/Directory/PosixPath.hsc index fb1a5f41..12b54d11 100644 --- a/System/Posix/Directory/PosixPath.hsc +++ b/System/Posix/Directory/PosixPath.hsc @@ -29,31 +29,15 @@ module System.Posix.Directory.PosixPath ( -- * Reading directories Common.DirStream, Common.DirType( DtUnknown -#ifdef CONST_DT_FIFO - , DtFifo -#endif -#ifdef CONST_DT_CHR - , DtChr -#endif -#ifdef CONST_DT_DIR - , DtDir -#endif -#ifdef CONST_DT_BLK - , DtBlk -#endif -#ifdef CONST_DT_REG - , DtReg -#endif -#ifdef CONST_DT_LNK - , DtLnk -#endif -#ifdef CONST_DT_SOCK - , DtSock -#endif -#ifdef CONST_DT_WHT - , DtWht -#endif - ), + , DtFifo + , DtChr + , DtDir + , DtBlk + , DtReg + , DtLnk + , DtSock + , DtWht + ), openDirStream, readDirStream, readDirStreamMaybe, From e9554c05d29cf392feee5e41c7cb0305a37682a0 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Thu, 9 Feb 2023 01:34:27 +0100 Subject: [PATCH 08/15] Renamed pattern synonyms and added some more Haddocks --- System/Posix/Directory.hsc | 24 +++-- System/Posix/Directory/ByteString.hsc | 24 +++-- System/Posix/Directory/Common.hsc | 129 +++++++++++++++++++------- System/Posix/Directory/PosixPath.hsc | 24 +++-- 4 files changed, 138 insertions(+), 63 deletions(-) diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc index 5e2f6218..4aeedfb4 100644 --- a/System/Posix/Directory.hsc +++ b/System/Posix/Directory.hsc @@ -29,16 +29,19 @@ module System.Posix.Directory ( -- * Reading directories DirStream, - DirType( DtUnknown - , DtFifo - , DtChr - , DtDir - , DtBlk - , DtReg - , DtLnk - , DtSock - , DtWht + DirType( UnknownType + , NamedPipeType + , CharacterDeviceType + , DirectoryType + , BlockDeviceType + , RegularFileType + , SymbolicLinkType + , SocketType + , WhiteoutType ), + isUnknownType, isBlockDeviceType, isCharacterDeviceType, isNamedPipeType, + isRegularFileType, isDirectoryType, isSymbolicLinkType, isSocketType, + isWhiteoutType, openDirStream, readDirStream, readDirStreamMaybe, @@ -118,6 +121,9 @@ readDirStreamMaybe = readDirStreamWith -- structure together with the entry's type (@d_type@) wrapped in a -- @Just (d_name, d_type)@ if an entry was read and @Nothing@ if -- the end of the directory stream was reached. +-- +-- __Note__: The returned 'DirType' has some limitations; Please see its +-- documentation. readDirStreamWithType :: DirStream -> IO (Maybe (FilePath, DirType)) readDirStreamWithType = readDirStreamWith (\(DirEnt dEnt) -> (,) diff --git a/System/Posix/Directory/ByteString.hsc b/System/Posix/Directory/ByteString.hsc index 875124ec..83fa09bc 100644 --- a/System/Posix/Directory/ByteString.hsc +++ b/System/Posix/Directory/ByteString.hsc @@ -29,16 +29,19 @@ module System.Posix.Directory.ByteString ( -- * Reading directories DirStream, - DirType( DtUnknown - , DtFifo - , DtChr - , DtDir - , DtBlk - , DtReg - , DtLnk - , DtSock - , DtWht + DirType( UnknownType + , NamedPipeType + , CharacterDeviceType + , DirectoryType + , BlockDeviceType + , RegularFileType + , SymbolicLinkType + , SocketType + , WhiteoutType ), + isUnknownType, isBlockDeviceType, isCharacterDeviceType, isNamedPipeType, + isRegularFileType, isDirectoryType, isSymbolicLinkType, isSocketType, + isWhiteoutType, openDirStream, readDirStream, readDirStreamMaybe, @@ -119,6 +122,9 @@ readDirStreamMaybe = readDirStreamWith -- structure together with the entry's type (@d_type@) wrapped in a -- @Just (d_name, d_type)@ if an entry was read and @Nothing@ if -- the end of the directory stream was reached. +-- +-- __Note__: The returned 'DirType' has some limitations; Please see its +-- documentation. readDirStreamWithType :: DirStream -> IO (Maybe (RawFilePath, DirType)) readDirStreamWithType = readDirStreamWith (\(DirEnt dEnt) -> (,) diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index 1dba7c6f..b025bc84 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -21,16 +21,19 @@ module System.Posix.Directory.Common ( DirStream(..), DirEnt(..), CDir, CDirent, DirStreamOffset(..), DirType( DirType - , DtUnknown - , DtFifo - , DtChr - , DtDir - , DtBlk - , DtReg - , DtLnk - , DtSock - , DtWht + , UnknownType + , NamedPipeType + , CharacterDeviceType + , DirectoryType + , BlockDeviceType + , RegularFileType + , SymbolicLinkType + , SocketType + , WhiteoutType ), + isUnknownType, isBlockDeviceType, isCharacterDeviceType, isNamedPipeType, + isRegularFileType, isDirectoryType, isSymbolicLinkType, isSocketType, + isWhiteoutType, unsafeOpenDirStreamFd, readDirStreamWith, readDirStreamWithPtr, @@ -78,34 +81,88 @@ instance Storable DirEnt where 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 - -pattern DtUnknown :: DirType -pattern DtUnknown = DirType CONST_DT_UNKNOWN - -pattern DtFifo :: DirType -pattern DtFifo = DirType (CONST_DT_FIFO) - -pattern DtChr :: DirType -pattern DtChr = DirType (CONST_DT_CHR) - -pattern DtDir :: DirType -pattern DtDir = DirType (CONST_DT_DIR) - -pattern DtBlk :: DirType -pattern DtBlk = DirType (CONST_DT_BLK) - -pattern DtReg :: DirType -pattern DtReg = DirType (CONST_DT_REG) - -pattern DtLnk :: DirType -pattern DtLnk = DirType (CONST_DT_LNK) - -pattern DtSock :: DirType -pattern DtSock = DirType (CONST_DT_SOCK) - -pattern DtWht :: DirType -pattern DtWht = DirType (CONST_DT_WHT) + deriving Eq + +-- | 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 -- | Call @fdopendir@ to obtain a directory stream for @fd@. @fd@ must not be -- otherwise used after this. diff --git a/System/Posix/Directory/PosixPath.hsc b/System/Posix/Directory/PosixPath.hsc index 12b54d11..dcd69e4c 100644 --- a/System/Posix/Directory/PosixPath.hsc +++ b/System/Posix/Directory/PosixPath.hsc @@ -28,16 +28,19 @@ module System.Posix.Directory.PosixPath ( -- * Reading directories Common.DirStream, - Common.DirType( DtUnknown - , DtFifo - , DtChr - , DtDir - , DtBlk - , DtReg - , DtLnk - , DtSock - , DtWht + Common.DirType( UnknownType + , NamedPipeType + , CharacterDeviceType + , DirectoryType + , BlockDeviceType + , RegularFileType + , SymbolicLinkType + , SocketType + , WhiteoutType ), + Common.isUnknownType, Common.isBlockDeviceType, Common.isCharacterDeviceType, + Common.isNamedPipeType, Common.isRegularFileType, Common.isDirectoryType, + Common.isSymbolicLinkType, Common.isSocketType, Common.isWhiteoutType, openDirStream, readDirStream, readDirStreamMaybe, @@ -117,6 +120,9 @@ readDirStreamMaybe = Common.readDirStreamWith -- structure together with the entry's type (@d_type@) wrapped in a -- @Just (d_name, d_type)@ if an entry was read and @Nothing@ if -- the end of the directory stream was reached. +-- +-- __Note__: The returned 'DirType' has some limitations; Please see its +-- documentation. readDirStreamWithType :: Common.DirStream -> IO (Maybe (PosixPath, Common.DirType)) readDirStreamWithType = Common.readDirStreamWith (\(Common.DirEnt dEnt) -> (,) From ad01ec758c2de2eca8486a7cf5e54d42b75da41a Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Thu, 9 Feb 2023 01:43:50 +0100 Subject: [PATCH 09/15] Added parentheses to avoid parse errors --- System/Posix/Directory/Common.hsc | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index b025bc84..f47b1f38 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -101,39 +101,39 @@ newtype DirType = DirType CChar -- | The 'DirType' refers to an entry of unknown type. pattern UnknownType :: DirType -pattern UnknownType = DirType CONST_DT_UNKNOWN +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 +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 +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 +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 +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 +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 +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 +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 +pattern WhiteoutType = DirType (CONST_DT_WHT) -- | Checks if this 'DirType' refers to an entry of unknown type. isUnknownType :: DirType -> Bool From 3bca37ca7ecc6316b31a73aab14731c1e45d3d1b Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Thu, 9 Feb 2023 11:18:25 +0100 Subject: [PATCH 10/15] Added fallback behavior to 'readDirStreamWithType' * Changed the assignment of values for missing DT_* constants. Since the 'd_type' field is of type 'unsigned char' we assign a negative number for each missing DT_* constant so they are distinguishable but do not collide with the values from the libc implementation. * Added a new 'DirStreamWithPath' that contains the path of the directory the directory stream belongs to. * 'readDirStreamWithType' falls back to a 'stat' if the 'd_type' is unknown or undetermined. * Added some tests for 'readDirStreamWithType'. --- System/Posix/Directory.hsc | 24 ++++++++++---- System/Posix/Directory/ByteString.hsc | 24 ++++++++++---- System/Posix/Directory/Common.hsc | 47 +++++++++++++++++++++++++-- System/Posix/Directory/PosixPath.hsc | 25 ++++++++++---- configure.ac | 36 ++++++++++++++++++-- tests/ReadDirStream.hs | 23 +++++++++++++ 6 files changed, 155 insertions(+), 24 deletions(-) diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc index 4aeedfb4..bc63558a 100644 --- a/System/Posix/Directory.hsc +++ b/System/Posix/Directory.hsc @@ -28,7 +28,8 @@ module System.Posix.Directory ( createDirectory, removeDirectory, -- * Reading directories - DirStream, + DirStream, DirStreamWithPath, + fromDirStreamWithPath, DirType( UnknownType , NamedPipeType , CharacterDeviceType @@ -43,6 +44,7 @@ module System.Posix.Directory ( isRegularFileType, isDirectoryType, isSymbolicLinkType, isSocketType, isWhiteoutType, openDirStream, + openDirStreamWithPath, readDirStream, readDirStreamMaybe, readDirStreamWithType, @@ -63,12 +65,14 @@ module System.Posix.Directory ( ) where import Data.Maybe +import System.FilePath (()) import System.Posix.Error import System.Posix.Types import Foreign import Foreign.C import System.Posix.Directory.Common +import System.Posix.Files import System.Posix.Internals (withFilePath, peekFilePath) -- | @createDirectory dir mode@ calls @mkdir@ to @@ -92,6 +96,11 @@ openDirStream name = dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s return (DirStream dirp) +-- | A version of 'openDirStream' where the path of the directory is stored in +-- the returned 'DirStreamWithPath'. +openDirStreamWithPath :: FilePath -> IO (DirStreamWithPath FilePath) +openDirStreamWithPath name = toDirStreamWithPath name <$> openDirStream name + foreign import capi unsafe "HsUnix.h opendir" c_opendir :: CString -> IO (Ptr CDir) @@ -124,12 +133,15 @@ readDirStreamMaybe = readDirStreamWith -- -- __Note__: The returned 'DirType' has some limitations; Please see its -- documentation. -readDirStreamWithType :: DirStream -> IO (Maybe (FilePath, DirType)) -readDirStreamWithType = readDirStreamWith - (\(DirEnt dEnt) -> (,) - <$> (d_name dEnt >>= peekFilePath) - <*> (DirType <$> d_type dEnt) +readDirStreamWithType :: DirStreamWithPath FilePath -> IO (Maybe (FilePath, DirType)) +readDirStreamWithType (DirStreamWithPath (base, ptr)) = readDirStreamWith + (\(DirEnt dEnt) -> do + name <- d_name dEnt >>= peekFilePath + let getStat = getFileStatus (base name) + dtype <- d_type dEnt >>= getRealDirType getStat . DirType + return (name, dtype) ) + (DirStream ptr) foreign import ccall unsafe "__hscore_d_name" d_name :: Ptr CDirent -> IO CString diff --git a/System/Posix/Directory/ByteString.hsc b/System/Posix/Directory/ByteString.hsc index 83fa09bc..ef1a2902 100644 --- a/System/Posix/Directory/ByteString.hsc +++ b/System/Posix/Directory/ByteString.hsc @@ -1,5 +1,6 @@ {-# LANGUAGE CApiFFI #-} {-# LANGUAGE NondecreasingIndentation #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- @@ -28,7 +29,8 @@ module System.Posix.Directory.ByteString ( createDirectory, removeDirectory, -- * Reading directories - DirStream, + DirStream, DirStreamWithPath, + fromDirStreamWithPath, DirType( UnknownType , NamedPipeType , CharacterDeviceType @@ -43,6 +45,7 @@ module System.Posix.Directory.ByteString ( isRegularFileType, isDirectoryType, isSymbolicLinkType, isSocketType, isWhiteoutType, openDirStream, + openDirStreamWithPath, readDirStream, readDirStreamMaybe, readDirStreamWithType, @@ -70,6 +73,7 @@ import Foreign.C import Data.ByteString.Char8 as BC import System.Posix.Directory.Common +import System.Posix.Files.ByteString import System.Posix.ByteString.FilePath -- | @createDirectory dir mode@ calls @mkdir@ to @@ -93,6 +97,11 @@ openDirStream name = dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s return (DirStream dirp) +-- | A version of 'openDirStream' where the path of the directory is stored in +-- the returned 'DirStreamWithPath'. +openDirStreamWithPath :: RawFilePath -> IO (DirStreamWithPath RawFilePath) +openDirStreamWithPath name = toDirStreamWithPath name <$> openDirStream name + foreign import capi unsafe "HsUnix.h opendir" c_opendir :: CString -> IO (Ptr CDir) @@ -125,12 +134,15 @@ readDirStreamMaybe = readDirStreamWith -- -- __Note__: The returned 'DirType' has some limitations; Please see its -- documentation. -readDirStreamWithType :: DirStream -> IO (Maybe (RawFilePath, DirType)) -readDirStreamWithType = readDirStreamWith - (\(DirEnt dEnt) -> (,) - <$> (d_name dEnt >>= peekFilePath) - <*> (DirType <$> d_type dEnt) +readDirStreamWithType :: DirStreamWithPath RawFilePath -> IO (Maybe (RawFilePath, DirType)) +readDirStreamWithType (DirStreamWithPath (base, ptr)) = readDirStreamWith + (\(DirEnt dEnt) -> do + name <- d_name dEnt >>= peekFilePath + let getStat = getFileStatus (base <> "/" <> name) + dtype <- d_type dEnt >>= getRealDirType getStat . DirType + return (name, dtype) ) + (DirStream ptr) foreign import ccall unsafe "__hscore_d_name" d_name :: Ptr CDirent -> IO CString diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index f47b1f38..d54c5825 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, Safe, CApiFFI, PatternSynonyms #-} +{-# LANGUAGE CPP, Safe, CApiFFI, MultiWayIf, PatternSynonyms #-} ----------------------------------------------------------------------------- -- | @@ -19,7 +19,9 @@ ##include "HsUnixConfig.h" module System.Posix.Directory.Common ( - DirStream(..), DirEnt(..), CDir, CDirent, DirStreamOffset(..), + DirStream(..), DirStreamWithPath(..), + fromDirStreamWithPath, toDirStreamWithPath, + DirEnt(..), CDir, CDirent, DirStreamOffset(..), DirType( DirType , UnknownType , NamedPipeType @@ -34,6 +36,7 @@ module System.Posix.Directory.Common ( isUnknownType, isBlockDeviceType, isCharacterDeviceType, isNamedPipeType, isRegularFileType, isDirectoryType, isSymbolicLinkType, isSocketType, isWhiteoutType, + getRealDirType, unsafeOpenDirStreamFd, readDirStreamWith, readDirStreamWithPtr, @@ -59,8 +62,26 @@ 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 @@ -97,7 +118,7 @@ data {-# CTYPE "struct dirent" #-} CDirent -- case none of those patterns will match and the application must handle that -- case accordingly. newtype DirType = DirType CChar - deriving Eq + deriving (Eq, Ord, Show) -- | The 'DirType' refers to an entry of unknown type. pattern UnknownType :: DirType @@ -164,6 +185,26 @@ 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 | isBlockDevice stat -> BlockDeviceType + | isCharacterDevice stat -> CharacterDeviceType + | isNamedPipe stat -> NamedPipeType + | isRegularFile stat -> RegularFileType + | isDirectory stat -> DirectoryType + | isSymbolicLink stat -> SymbolicLinkType + | isSocket stat -> SocketType + | otherwise -> UnknownType + -- | Call @fdopendir@ to obtain a directory stream for @fd@. @fd@ must not be -- otherwise used after this. -- diff --git a/System/Posix/Directory/PosixPath.hsc b/System/Posix/Directory/PosixPath.hsc index dcd69e4c..655bca1b 100644 --- a/System/Posix/Directory/PosixPath.hsc +++ b/System/Posix/Directory/PosixPath.hsc @@ -27,7 +27,8 @@ module System.Posix.Directory.PosixPath ( createDirectory, removeDirectory, -- * Reading directories - Common.DirStream, + Common.DirStream, Common.DirStreamWithPath, + Common.fromDirStreamWithPath, Common.DirType( UnknownType , NamedPipeType , CharacterDeviceType @@ -42,6 +43,7 @@ module System.Posix.Directory.PosixPath ( Common.isNamedPipeType, Common.isRegularFileType, Common.isDirectoryType, Common.isSymbolicLinkType, Common.isSocketType, Common.isWhiteoutType, openDirStream, + openDirStreamWithPath, readDirStream, readDirStreamMaybe, readDirStreamWithType, @@ -66,8 +68,9 @@ import System.Posix.Types import Foreign import Foreign.C -import System.OsPath.Types +import System.OsPath.Posix import qualified System.Posix.Directory.Common as Common +import System.Posix.Files.PosixString import System.Posix.PosixPath.FilePath -- | @createDirectory dir mode@ calls @mkdir@ to @@ -91,6 +94,11 @@ openDirStream name = dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s return (Common.DirStream dirp) +-- | A version of 'openDirStream' where the path of the directory is stored in +-- the returned 'DirStreamWithPath'. +openDirStreamWithPath :: PosixPath -> IO (Common.DirStreamWithPath PosixPath) +openDirStreamWithPath name = Common.toDirStreamWithPath name <$> openDirStream name + foreign import capi unsafe "HsUnix.h opendir" c_opendir :: CString -> IO (Ptr Common.CDir) @@ -123,12 +131,15 @@ readDirStreamMaybe = Common.readDirStreamWith -- -- __Note__: The returned 'DirType' has some limitations; Please see its -- documentation. -readDirStreamWithType :: Common.DirStream -> IO (Maybe (PosixPath, Common.DirType)) -readDirStreamWithType = Common.readDirStreamWith - (\(Common.DirEnt dEnt) -> (,) - <$> (d_name dEnt >>= peekFilePath) - <*> (Common.DirType <$> d_type dEnt) +readDirStreamWithType :: Common.DirStreamWithPath PosixPath -> IO (Maybe (PosixPath, Common.DirType)) +readDirStreamWithType (Common.DirStreamWithPath (base, ptr))= Common.readDirStreamWith + (\(Common.DirEnt dEnt) -> do + name <- d_name dEnt >>= peekFilePath + let getStat = getFileStatus (base name) + dtype <- d_type dEnt >>= Common.getRealDirType getStat . Common.DirType + return (name, dtype) ) + (Common.DirStream ptr) foreign import ccall unsafe "__hscore_d_name" d_name :: Ptr Common.CDirent -> IO CString diff --git a/configure.ac b/configure.ac index 786cf493..dcd88d34 100644 --- a/configure.ac +++ b/configure.ac @@ -28,10 +28,42 @@ 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_CONSTS([DT_UNKNOWN DT_FIFO DT_CHR DT_DIR DT_BLK DT_REG DT_LNK DT_SOCK DT_WHT], [ +FP_CHECK_CONST([DT_UNKNOWN], [ #if HAVE_STRUCT_DIRENT_D_TYPE #include -#endif]) +#endif], [-1]) +FP_CHECK_CONST([DT_FIFO], [ +#if HAVE_STRUCT_DIRENT_D_TYPE +#include +#endif], [-2]) +FP_CHECK_CONST([DT_CHR], [ +#if HAVE_STRUCT_DIRENT_D_TYPE +#include +#endif], [-3]) +FP_CHECK_CONST([DT_DIR], [ +#if HAVE_STRUCT_DIRENT_D_TYPE +#include +#endif], [-4]) +FP_CHECK_CONST([DT_BLK], [ +#if HAVE_STRUCT_DIRENT_D_TYPE +#include +#endif], [-5]) +FP_CHECK_CONST([DT_REG], [ +#if HAVE_STRUCT_DIRENT_D_TYPE +#include +#endif], [-6]) +FP_CHECK_CONST([DT_LNK], [ +#if HAVE_STRUCT_DIRENT_D_TYPE +#include +#endif], [-7]) +FP_CHECK_CONST([DT_SOCK], [ +#if HAVE_STRUCT_DIRENT_D_TYPE +#include +#endif], [-8]) +FP_CHECK_CONST([DT_WHT], [ +#if HAVE_STRUCT_DIRENT_D_TYPE +#include +#endif], [-9]) AC_CHECK_FUNCS([getgrgid_r getgrnam_r getpwnam_r getpwuid_r getpwnam getpwuid]) AC_CHECK_FUNCS([getpwent getgrent]) diff --git a/tests/ReadDirStream.hs b/tests/ReadDirStream.hs index e0d99774..4e39352b 100644 --- a/tests/ReadDirStream.hs +++ b/tests/ReadDirStream.hs @@ -1,8 +1,10 @@ module ReadDirStream ( emptyDirStream , nonEmptyDirStream + , dirStreamWithTypes ) where +import qualified Data.List import System.Posix.Files import System.Posix.Directory import System.Posix.IO @@ -33,6 +35,18 @@ nonEmptyDirStream = do cleanup entries @?= ["file"] +dirStreamWithTypes :: IO () +dirStreamWithTypes = do + cleanup + createDirectory dir ownerModes + createDirectory (dir ++ "/somedir") ownerModes + _ <- createFile (dir ++ "/somefile") ownerReadMode + dir_p <- openDirStreamWithPath dir + entries <- readDirStreamEntriesWithTypes dir_p + closeDirStream (fromDirStreamWithPath dir_p) + cleanup + Data.List.sort entries @?= [("somedir", DirectoryType), ("somefile", RegularFileType)] + readDirStreamEntries :: DirStream -> IO [FilePath] readDirStreamEntries dir_p = do ment <- readDirStreamMaybe dir_p @@ -42,6 +56,15 @@ readDirStreamEntries dir_p = do Just ".." -> readDirStreamEntries dir_p Just ent -> (ent :) <$> readDirStreamEntries dir_p +readDirStreamEntriesWithTypes :: DirStreamWithPath FilePath -> IO [(FilePath, DirType)] +readDirStreamEntriesWithTypes dir_p = do + ment <- readDirStreamWithType dir_p + case ment of + Nothing -> return [] + Just (".", _) -> readDirStreamEntriesWithTypes dir_p + Just ("..", _) -> readDirStreamEntriesWithTypes dir_p + Just ent -> (ent :) <$> readDirStreamEntriesWithTypes dir_p + cleanup :: IO () cleanup = do ignoreIOExceptions $ removeLink $ dir ++ "/file" From b0040468f23437e406e9e8c5662366230da8ae2e Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Thu, 9 Feb 2023 12:15:30 +0100 Subject: [PATCH 11/15] Fixed tests for ReadDirStream --- tests/ReadDirStream.hs | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/tests/ReadDirStream.hs b/tests/ReadDirStream.hs index 4e39352b..73921f27 100644 --- a/tests/ReadDirStream.hs +++ b/tests/ReadDirStream.hs @@ -11,9 +11,6 @@ import System.Posix.IO import Control.Exception as E import Test.Tasty.HUnit -dir :: FilePath -dir = "dir" - emptyDirStream :: IO () emptyDirStream = do cleanup @@ -23,6 +20,11 @@ emptyDirStream = do closeDirStream dir_p cleanup entries @?= [] + where + dir = "emptyDirStream" + + cleanup = do + ignoreIOExceptions $ removeDirectory dir nonEmptyDirStream :: IO () nonEmptyDirStream = do @@ -34,6 +36,12 @@ nonEmptyDirStream = do closeDirStream dir_p cleanup entries @?= ["file"] + where + dir = "nonEmptyDirStream" + + cleanup = do + ignoreIOExceptions $ removeLink $ dir ++ "/file" + ignoreIOExceptions $ removeDirectory dir dirStreamWithTypes :: IO () dirStreamWithTypes = do @@ -46,6 +54,13 @@ dirStreamWithTypes = do closeDirStream (fromDirStreamWithPath dir_p) cleanup Data.List.sort entries @?= [("somedir", DirectoryType), ("somefile", RegularFileType)] + where + dir = "dirStreamWithTypes" + + cleanup = do + ignoreIOExceptions $ removeDirectory $ dir ++ "/somedir" + ignoreIOExceptions $ removeLink $ dir ++ "/somefile" + ignoreIOExceptions $ removeDirectory dir readDirStreamEntries :: DirStream -> IO [FilePath] readDirStreamEntries dir_p = do @@ -65,11 +80,6 @@ readDirStreamEntriesWithTypes dir_p = do Just ("..", _) -> readDirStreamEntriesWithTypes dir_p Just ent -> (ent :) <$> readDirStreamEntriesWithTypes dir_p -cleanup :: IO () -cleanup = do - ignoreIOExceptions $ removeLink $ dir ++ "/file" - ignoreIOExceptions $ removeDirectory dir - ignoreIOExceptions :: IO () -> IO () ignoreIOExceptions io = io `E.catch` ((\_ -> return ()) :: E.IOException -> IO ()) From 2bf23f4199097b9b6ee9ecc5206e159065ef6c16 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 14 Feb 2023 11:46:49 +0100 Subject: [PATCH 12/15] Fixed: Missing import for ghc<8.4.1 --- System/Posix/Directory/ByteString.hsc | 3 +++ 1 file changed, 3 insertions(+) diff --git a/System/Posix/Directory/ByteString.hsc b/System/Posix/Directory/ByteString.hsc index ef1a2902..ab67b7bc 100644 --- a/System/Posix/Directory/ByteString.hsc +++ b/System/Posix/Directory/ByteString.hsc @@ -71,6 +71,9 @@ import Foreign import Foreign.C import Data.ByteString.Char8 as BC +#if !MIN_VERSION_base(4,11,0) +import Data.Monoid ((<>)) +#endif import System.Posix.Directory.Common import System.Posix.Files.ByteString From 7ab0172cbdeb9e9c05de35580801c8211af759a7 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Sun, 26 Feb 2023 16:34:52 +0100 Subject: [PATCH 13/15] Applied suggestions from code review --- System/Posix/Directory/Common.hsc | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index d54c5825..731d3d38 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -196,12 +196,12 @@ getRealDirType _ SocketType = return SocketType getRealDirType _ WhiteoutType = return WhiteoutType getRealDirType getFileStatus _ = do stat <- getFileStatus - return $ if | isBlockDevice stat -> BlockDeviceType - | isCharacterDevice stat -> CharacterDeviceType - | isNamedPipe stat -> NamedPipeType - | isRegularFile stat -> RegularFileType + 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 @@ -255,7 +255,7 @@ readDirStreamWith f dstream = alloca -- | 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 --- usecases where you need to read a lot of directory entries and want to +-- 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. From cd600def5c70ecff4ccb165bff0aef757cc16df3 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Sun, 26 Feb 2023 16:42:02 +0100 Subject: [PATCH 14/15] Fixed: Return DT_UNKNOWN if dirent does not support d_type --- cbits/HsUnix.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cbits/HsUnix.c b/cbits/HsUnix.c index 56c381b3..d2d890ef 100644 --- a/cbits/HsUnix.c +++ b/cbits/HsUnix.c @@ -109,7 +109,7 @@ char __hscore_d_type( struct dirent* d ) #ifdef HAVE_DIRENT_D_TYPE return (d->d_type); #else - return 0; + return CONST_DT_UNKNOWN; #endif } From 3e2aecdf6388faacbde255b5e3b5fd9e4de1db85 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Thu, 30 May 2024 20:18:11 +0200 Subject: [PATCH 15/15] Moved changes to System.Posix.Directory.Internals --- System/Posix/Directory.hsc | 54 ++----------------------- System/Posix/Directory/ByteString.hsc | 57 ++------------------------- System/Posix/Directory/Common.hsc | 27 +++++++++++-- System/Posix/Directory/Internals.hsc | 36 +++++++++++++++-- System/Posix/Directory/PosixPath.hsc | 52 ++---------------------- tests/ReadDirStream.hs | 30 -------------- tests/Test.hsc | 4 -- 7 files changed, 66 insertions(+), 194 deletions(-) diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc index bc63558a..5f01c15c 100644 --- a/System/Posix/Directory.hsc +++ b/System/Posix/Directory.hsc @@ -28,26 +28,10 @@ module System.Posix.Directory ( createDirectory, removeDirectory, -- * Reading directories - DirStream, DirStreamWithPath, - fromDirStreamWithPath, - DirType( UnknownType - , NamedPipeType - , CharacterDeviceType - , DirectoryType - , BlockDeviceType - , RegularFileType - , SymbolicLinkType - , SocketType - , WhiteoutType - ), - isUnknownType, isBlockDeviceType, isCharacterDeviceType, isNamedPipeType, - isRegularFileType, isDirectoryType, isSymbolicLinkType, isSocketType, - isWhiteoutType, + DirStream, openDirStream, - openDirStreamWithPath, readDirStream, readDirStreamMaybe, - readDirStreamWithType, rewindDirStream, closeDirStream, DirStreamOffset, @@ -64,15 +48,14 @@ module System.Posix.Directory ( changeWorkingDirectoryFd, ) where +import Control.Monad ((>=>)) import Data.Maybe -import System.FilePath (()) import System.Posix.Error import System.Posix.Types import Foreign import Foreign.C import System.Posix.Directory.Common -import System.Posix.Files import System.Posix.Internals (withFilePath, peekFilePath) -- | @createDirectory dir mode@ calls @mkdir@ to @@ -96,11 +79,6 @@ openDirStream name = dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s return (DirStream dirp) --- | A version of 'openDirStream' where the path of the directory is stored in --- the returned 'DirStreamWithPath'. -openDirStreamWithPath :: FilePath -> IO (DirStreamWithPath FilePath) -openDirStreamWithPath name = toDirStreamWithPath name <$> openDirStream name - foreign import capi unsafe "HsUnix.h opendir" c_opendir :: CString -> IO (Ptr CDir) @@ -121,33 +99,7 @@ readDirStream = fmap (fromMaybe "") . readDirStreamMaybe -- 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 = readDirStreamWith - (\(DirEnt dEnt) -> d_name dEnt >>= peekFilePath) - --- | @readDirStreamWithType 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 together with the entry's type (@d_type@) wrapped in a --- @Just (d_name, d_type)@ if an entry was read and @Nothing@ if --- the end of the directory stream was reached. --- --- __Note__: The returned 'DirType' has some limitations; Please see its --- documentation. -readDirStreamWithType :: DirStreamWithPath FilePath -> IO (Maybe (FilePath, DirType)) -readDirStreamWithType (DirStreamWithPath (base, ptr)) = readDirStreamWith - (\(DirEnt dEnt) -> do - name <- d_name dEnt >>= peekFilePath - let getStat = getFileStatus (base name) - dtype <- d_type dEnt >>= getRealDirType getStat . DirType - return (name, dtype) - ) - (DirStream ptr) - -foreign import ccall unsafe "__hscore_d_name" - d_name :: Ptr CDirent -> IO CString - -foreign import ccall unsafe "__hscore_d_type" - d_type :: Ptr CDirent -> IO CChar +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 ab67b7bc..be5cb878 100644 --- a/System/Posix/Directory/ByteString.hsc +++ b/System/Posix/Directory/ByteString.hsc @@ -1,6 +1,5 @@ {-# LANGUAGE CApiFFI #-} {-# LANGUAGE NondecreasingIndentation #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- @@ -29,26 +28,10 @@ module System.Posix.Directory.ByteString ( createDirectory, removeDirectory, -- * Reading directories - DirStream, DirStreamWithPath, - fromDirStreamWithPath, - DirType( UnknownType - , NamedPipeType - , CharacterDeviceType - , DirectoryType - , BlockDeviceType - , RegularFileType - , SymbolicLinkType - , SocketType - , WhiteoutType - ), - isUnknownType, isBlockDeviceType, isCharacterDeviceType, isNamedPipeType, - isRegularFileType, isDirectoryType, isSymbolicLinkType, isSocketType, - isWhiteoutType, + DirStream, openDirStream, - openDirStreamWithPath, readDirStream, readDirStreamMaybe, - readDirStreamWithType, rewindDirStream, closeDirStream, DirStreamOffset, @@ -65,18 +48,15 @@ module System.Posix.Directory.ByteString ( changeWorkingDirectoryFd, ) where +import Control.Monad ((>=>)) import Data.Maybe import System.Posix.Types import Foreign import Foreign.C import Data.ByteString.Char8 as BC -#if !MIN_VERSION_base(4,11,0) -import Data.Monoid ((<>)) -#endif import System.Posix.Directory.Common -import System.Posix.Files.ByteString import System.Posix.ByteString.FilePath -- | @createDirectory dir mode@ calls @mkdir@ to @@ -100,11 +80,6 @@ openDirStream name = dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s return (DirStream dirp) --- | A version of 'openDirStream' where the path of the directory is stored in --- the returned 'DirStreamWithPath'. -openDirStreamWithPath :: RawFilePath -> IO (DirStreamWithPath RawFilePath) -openDirStreamWithPath name = toDirStreamWithPath name <$> openDirStream name - foreign import capi unsafe "HsUnix.h opendir" c_opendir :: CString -> IO (Ptr CDir) @@ -125,33 +100,7 @@ readDirStream = fmap (fromMaybe BC.empty) . readDirStreamMaybe -- 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 = readDirStreamWith - (\(DirEnt dEnt) -> d_name dEnt >>= peekFilePath) - --- | @readDirStreamWithType 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 together with the entry's type (@d_type@) wrapped in a --- @Just (d_name, d_type)@ if an entry was read and @Nothing@ if --- the end of the directory stream was reached. --- --- __Note__: The returned 'DirType' has some limitations; Please see its --- documentation. -readDirStreamWithType :: DirStreamWithPath RawFilePath -> IO (Maybe (RawFilePath, DirType)) -readDirStreamWithType (DirStreamWithPath (base, ptr)) = readDirStreamWith - (\(DirEnt dEnt) -> do - name <- d_name dEnt >>= peekFilePath - let getStat = getFileStatus (base <> "/" <> name) - dtype <- d_type dEnt >>= getRealDirType getStat . DirType - return (name, dtype) - ) - (DirStream ptr) - -foreign import ccall unsafe "__hscore_d_name" - d_name :: Ptr CDirent -> IO CString - -foreign import ccall unsafe "__hscore_d_type" - d_type :: Ptr CDirent -> IO CChar +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 731d3d38..55dc28d5 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -19,9 +19,16 @@ ##include "HsUnixConfig.h" module System.Posix.Directory.Common ( - DirStream(..), DirStreamWithPath(..), - fromDirStreamWithPath, toDirStreamWithPath, - DirEnt(..), CDir, CDirent, DirStreamOffset(..), + DirStream(..), + CDir, + DirStreamWithPath(..), + fromDirStreamWithPath, + toDirStreamWithPath, + + DirEnt(..), + CDirent, + dirEntName, + dirEntType, DirType( DirType , UnknownType , NamedPipeType @@ -40,6 +47,8 @@ module System.Posix.Directory.Common ( unsafeOpenDirStreamFd, readDirStreamWith, readDirStreamWithPtr, + + DirStreamOffset(..), rewindDirStream, closeDirStream, #ifdef HAVE_SEEKDIR @@ -282,6 +291,18 @@ readDirStreamWithPtr ptr_dEnt f dstream@(DirStream dirp) = do 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 diff --git a/System/Posix/Directory/Internals.hsc b/System/Posix/Directory/Internals.hsc index 61056b2c..378a087a 100644 --- a/System/Posix/Directory/Internals.hsc +++ b/System/Posix/Directory/Internals.hsc @@ -13,9 +13,39 @@ ----------------------------------------------------------------------------- module System.Posix.Directory.Internals ( - DirStream(..), DirEnt(..), DirType(..), CDir, CDirent, DirStreamOffset(..), - readDirStreamWith, - readDirStreamWithPtr, + 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 655bca1b..24570c59 100644 --- a/System/Posix/Directory/PosixPath.hsc +++ b/System/Posix/Directory/PosixPath.hsc @@ -27,26 +27,10 @@ module System.Posix.Directory.PosixPath ( createDirectory, removeDirectory, -- * Reading directories - Common.DirStream, Common.DirStreamWithPath, - Common.fromDirStreamWithPath, - Common.DirType( UnknownType - , NamedPipeType - , CharacterDeviceType - , DirectoryType - , BlockDeviceType - , RegularFileType - , SymbolicLinkType - , SocketType - , WhiteoutType - ), - Common.isUnknownType, Common.isBlockDeviceType, Common.isCharacterDeviceType, - Common.isNamedPipeType, Common.isRegularFileType, Common.isDirectoryType, - Common.isSymbolicLinkType, Common.isSocketType, Common.isWhiteoutType, + Common.DirStream, openDirStream, - openDirStreamWithPath, readDirStream, readDirStreamMaybe, - readDirStreamWithType, Common.rewindDirStream, Common.closeDirStream, Common.DirStreamOffset, @@ -63,6 +47,7 @@ module System.Posix.Directory.PosixPath ( Common.changeWorkingDirectoryFd, ) where +import Control.Monad ((>=>)) import Data.Maybe import System.Posix.Types import Foreign @@ -70,7 +55,6 @@ import Foreign.C import System.OsPath.Posix import qualified System.Posix.Directory.Common as Common -import System.Posix.Files.PosixString import System.Posix.PosixPath.FilePath -- | @createDirectory dir mode@ calls @mkdir@ to @@ -94,11 +78,6 @@ openDirStream name = dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s return (Common.DirStream dirp) --- | A version of 'openDirStream' where the path of the directory is stored in --- the returned 'DirStreamWithPath'. -openDirStreamWithPath :: PosixPath -> IO (Common.DirStreamWithPath PosixPath) -openDirStreamWithPath name = Common.toDirStreamWithPath name <$> openDirStream name - foreign import capi unsafe "HsUnix.h opendir" c_opendir :: CString -> IO (Ptr Common.CDir) @@ -120,32 +99,7 @@ readDirStream = fmap (fromMaybe mempty) . readDirStreamMaybe -- the end of the directory stream was reached. readDirStreamMaybe :: Common.DirStream -> IO (Maybe PosixPath) readDirStreamMaybe = Common.readDirStreamWith - (\(Common.DirEnt dEnt) -> d_name dEnt >>= peekFilePath) - --- | @readDirStreamWithType 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 together with the entry's type (@d_type@) wrapped in a --- @Just (d_name, d_type)@ if an entry was read and @Nothing@ if --- the end of the directory stream was reached. --- --- __Note__: The returned 'DirType' has some limitations; Please see its --- documentation. -readDirStreamWithType :: Common.DirStreamWithPath PosixPath -> IO (Maybe (PosixPath, Common.DirType)) -readDirStreamWithType (Common.DirStreamWithPath (base, ptr))= Common.readDirStreamWith - (\(Common.DirEnt dEnt) -> do - name <- d_name dEnt >>= peekFilePath - let getStat = getFileStatus (base name) - dtype <- d_type dEnt >>= Common.getRealDirType getStat . Common.DirType - return (name, dtype) - ) - (Common.DirStream ptr) - -foreign import ccall unsafe "__hscore_d_name" - d_name :: Ptr Common.CDirent -> IO CString - -foreign import ccall unsafe "__hscore_d_type" - d_type :: Ptr Common.CDirent -> IO CChar + (Common.dirEntName >=> peekFilePath) -- | @getWorkingDirectory@ calls @getcwd@ to obtain the name diff --git a/tests/ReadDirStream.hs b/tests/ReadDirStream.hs index 73921f27..9ba11e5c 100644 --- a/tests/ReadDirStream.hs +++ b/tests/ReadDirStream.hs @@ -1,10 +1,8 @@ module ReadDirStream ( emptyDirStream , nonEmptyDirStream - , dirStreamWithTypes ) where -import qualified Data.List import System.Posix.Files import System.Posix.Directory import System.Posix.IO @@ -43,25 +41,6 @@ nonEmptyDirStream = do ignoreIOExceptions $ removeLink $ dir ++ "/file" ignoreIOExceptions $ removeDirectory dir -dirStreamWithTypes :: IO () -dirStreamWithTypes = do - cleanup - createDirectory dir ownerModes - createDirectory (dir ++ "/somedir") ownerModes - _ <- createFile (dir ++ "/somefile") ownerReadMode - dir_p <- openDirStreamWithPath dir - entries <- readDirStreamEntriesWithTypes dir_p - closeDirStream (fromDirStreamWithPath dir_p) - cleanup - Data.List.sort entries @?= [("somedir", DirectoryType), ("somefile", RegularFileType)] - where - dir = "dirStreamWithTypes" - - cleanup = do - ignoreIOExceptions $ removeDirectory $ dir ++ "/somedir" - ignoreIOExceptions $ removeLink $ dir ++ "/somefile" - ignoreIOExceptions $ removeDirectory dir - readDirStreamEntries :: DirStream -> IO [FilePath] readDirStreamEntries dir_p = do ment <- readDirStreamMaybe dir_p @@ -71,15 +50,6 @@ readDirStreamEntries dir_p = do Just ".." -> readDirStreamEntries dir_p Just ent -> (ent :) <$> readDirStreamEntries dir_p -readDirStreamEntriesWithTypes :: DirStreamWithPath FilePath -> IO [(FilePath, DirType)] -readDirStreamEntriesWithTypes dir_p = do - ment <- readDirStreamWithType dir_p - case ment of - Nothing -> return [] - Just (".", _) -> readDirStreamEntriesWithTypes dir_p - Just ("..", _) -> readDirStreamEntriesWithTypes dir_p - Just ent -> (ent :) <$> readDirStreamEntriesWithTypes 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 0c6f1c35..ca85a9b9 100644 --- a/tests/Test.hsc +++ b/tests/Test.hsc @@ -62,7 +62,6 @@ main = defaultMain $ testGroup "All" , posix010 -- JS: missing "sysconf" , emptyDirStream , nonEmptyDirStream - , dirStreamWithTypes ] #endif , testWithFilePath @@ -285,9 +284,6 @@ emptyDirStream = testCase "emptyDirStream" ReadDirStream.emptyDirStream nonEmptyDirStream :: TestTree nonEmptyDirStream = testCase "nonEmptyDirStream" ReadDirStream.nonEmptyDirStream -dirStreamWithTypes :: TestTree -dirStreamWithTypes = testCase "dirStreamWithTypes" ReadDirStream.dirStreamWithTypes - ------------------------------------------------------------------------------- -- Utils