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