diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for hpath-directory +## 0.13.1 -- 2020-01-29 + +* Split some functionality out into 'hpath-posix' + ## 0.1.0.0 -- 2020-01-26 * First version. Released on an unsuspecting world. diff --git a/cbits/dirutils.c b/cbits/dirutils.c deleted file mode 100644 --- a/cbits/dirutils.c +++ /dev/null @@ -1,7 +0,0 @@ -#include "dirutils.h" -unsigned int - __posixdir_d_type(struct dirent* d) - { - return(d -> d_type); - } - diff --git a/cbits/dirutils.h b/cbits/dirutils.h deleted file mode 100644 --- a/cbits/dirutils.h +++ /dev/null @@ -1,13 +0,0 @@ -#ifndef POSIXPATHS_CBITS_DIRUTILS_H -#define POSIXPATHS_CBITS_DIRUTILS_H - -#include -#include -#include -#include -#include - -extern unsigned int - __posixdir_d_type(struct dirent* d) - ; -#endif diff --git a/hpath-directory.cabal b/hpath-directory.cabal --- a/hpath-directory.cabal +++ b/hpath-directory.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.10 name: hpath-directory -version: 0.13.0 +version: 0.13.1 synopsis: Alternative to 'directory' package with ByteString based filepaths description: This provides a safer alternative to the 'directory' package. FilePaths are ByteString based, so this @@ -20,7 +20,6 @@ category: Filesystem build-type: Simple extra-source-files: CHANGELOG.md - cbits/dirutils.h tested-with: GHC==7.10.3 , GHC==8.0.2 , GHC==8.2.2 @@ -34,20 +33,17 @@ buildable: False exposed-modules: System.Posix.RawFilePath.Directory System.Posix.RawFilePath.Directory.Errors - System.Posix.RawFilePath.Directory.Traversals - System.Posix.Foreign, - System.Posix.FD -- other-modules: -- other-extensions: - c-sources: cbits/dirutils.c build-depends: base >= 4.8 && <5 , IfElse , bytestring >= 0.10 , exceptions >= 0.10 , hpath-filepath >= 0.10.3 + , hpath-posix >= 0.13 , safe-exceptions >= 0.1 , streamly >= 0.7 - , streamly-bytestring >= 0.1 + , streamly-bytestring >= 0.1.0.1 , time >= 1.8 , unix >= 2.5 , unix-bytestring >= 0.3 @@ -104,6 +100,7 @@ , bytestring >= 0.10.0.0 , hpath-directory , hpath-filepath >= 0.10 + , hpath-posix >= 0.13 , hspec >= 1.3 , process , time >= 1.8 diff --git a/src/System/Posix/FD.hs b/src/System/Posix/FD.hs deleted file mode 100644 --- a/src/System/Posix/FD.hs +++ /dev/null @@ -1,75 +0,0 @@ --- | --- Module : System.Posix.FD --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- Provides an alternative for `System.Posix.IO.ByteString.openFd` --- which gives us more control on what status flags to pass to the --- low-level @open(2)@ call, in contrast to the unix package. - - -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} - -{-# OPTIONS_GHC -Wall #-} - - -module System.Posix.FD ( - openFd -) where - - -import Foreign.C.String -import Foreign.C.Types -import System.Posix.Foreign -import qualified System.Posix as Posix -import System.Posix.ByteString.FilePath - - -foreign import ccall unsafe "open" - c_open :: CString -> CInt -> Posix.CMode -> IO CInt - - -open_ :: CString - -> Posix.OpenMode - -> [Flags] - -> Maybe Posix.FileMode - -> IO Posix.Fd -open_ str how optional_flags maybe_mode = do - fd <- c_open str all_flags mode_w - return (Posix.Fd fd) - where - all_flags = unionFlags $ optional_flags ++ [open_mode] ++ creat - - - (creat, mode_w) = case maybe_mode of - Nothing -> ([],0) - Just x -> ([oCreat], x) - - open_mode = case how of - Posix.ReadOnly -> oRdonly - Posix.WriteOnly -> oWronly - Posix.ReadWrite -> oRdwr - - --- |Open and optionally create this file. See 'System.Posix.Files' --- for information on how to use the 'FileMode' type. --- --- Note that passing @Just x@ as the 4th argument triggers the --- `oCreat` status flag, which must be set when you pass in `oExcl` --- to the status flags. Also see the manpage for @open(2)@. -openFd :: RawFilePath - -> Posix.OpenMode - -> [Flags] -- ^ status flags of @open(2)@ - -> Maybe Posix.FileMode -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist. - -> IO Posix.Fd -openFd name how optional_flags maybe_mode = - withFilePath name $ \str -> - throwErrnoPathIfMinus1Retry "openFd" name $ - open_ str how optional_flags maybe_mode - diff --git a/src/System/Posix/Foreign.hsc b/src/System/Posix/Foreign.hsc deleted file mode 100644 --- a/src/System/Posix/Foreign.hsc +++ /dev/null @@ -1,55 +0,0 @@ -module System.Posix.Foreign where - -import Data.Bits -import Data.List (foldl') -import Foreign.C.Types - -#include -#include -#include -#include -#include -#include - -newtype DirType = DirType Int deriving (Eq, Show) -data Flags = Flags Int | UnsupportedFlag String deriving (Eq, Show) - -unFlags :: Flags -> Int -unFlags (Flags i) = i -unFlags (UnsupportedFlag name) = error (name ++ " is not supported on this platform") - --- |Returns @True@ if posix-paths was compiled with support for the provided --- flag. (As of this writing, the only flag for which this check may be --- necessary is 'oCloexec'; all other flags will always yield @True@.) -isSupported :: Flags -> Bool -isSupported (Flags _) = True -isSupported _ = False - --- |@O_CLOEXEC@ is not supported on every POSIX platform. Use --- @'isSupported' oCloexec@ to determine if support for @O_CLOEXEC@ was --- compiled into your version of posix-paths. (If not, using @oCloexec@ will --- throw an exception.) -oCloexec :: Flags -#ifdef O_CLOEXEC -oCloexec = Flags #{const O_CLOEXEC} -#else -{-# WARNING oCloexec - "This version of posix-paths was compiled without @O_CLOEXEC@ support." #-} -oCloexec = UnsupportedFlag "O_CLOEXEC" -#endif - - - --- If these enum declarations occur earlier in the file, haddock --- gets royally confused about the above doc comments. --- Probably http://trac.haskell.org/haddock/ticket/138 - -#{enum DirType, DirType, DT_BLK, DT_CHR, DT_DIR, DT_FIFO, DT_LNK, DT_REG, DT_SOCK, DT_UNKNOWN} - -#{enum Flags, Flags, O_APPEND, O_ASYNC, O_CREAT, O_DIRECTORY, O_EXCL, O_NOCTTY, O_NOFOLLOW, O_NONBLOCK, O_RDONLY, O_WRONLY, O_RDWR, O_SYNC, O_TRUNC} - -pathMax :: Int -pathMax = #{const PATH_MAX} - -unionFlags :: [Flags] -> CInt -unionFlags = fromIntegral . foldl' ((. unFlags) . (.|.)) 0 diff --git a/src/System/Posix/RawFilePath/Directory.hs b/src/System/Posix/RawFilePath/Directory.hs --- a/src/System/Posix/RawFilePath/Directory.hs +++ b/src/System/Posix/RawFilePath/Directory.hs @@ -891,7 +891,7 @@ --- | Open the given file as a filestream. Once the filestream +-- | Open the given file as a filestream. Once the filestream is -- exits, the filehandle is cleaned up. -- -- Throws: @@ -905,7 +905,7 @@ fd <- openFd fp SPI.ReadOnly [] Nothing handle <- SPI.fdToHandle fd let stream = - fmap fromArray (S.unfold (SU.finally (\h -> putStrLn "lol" >> SIO.hClose h) FH.readChunks) handle) + fmap fromArray (S.unfold (SU.finally SIO.hClose FH.readChunks) handle) pure stream diff --git a/src/System/Posix/RawFilePath/Directory/Traversals.hs b/src/System/Posix/RawFilePath/Directory/Traversals.hs deleted file mode 100644 --- a/src/System/Posix/RawFilePath/Directory/Traversals.hs +++ /dev/null @@ -1,263 +0,0 @@ --- | --- Module : System.Posix.RawFilePath.Directory.Traversals --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- Traversal and read operations on directories. - - -{-# LANGUAGE CPP #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} - -{-# OPTIONS_GHC -Wall #-} - - -module System.Posix.RawFilePath.Directory.Traversals ( - - getDirectoryContents -, getDirectoryContents' - -, allDirectoryContents -, allDirectoryContents' -, traverseDirectory - --- lower-level stuff -, readDirEnt -, packDirStream -, unpackDirStream -, fdOpendir - -, realpath -) where - - -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative ((<$>)) -#endif -import Control.Monad -import System.Posix.FilePath (()) -import System.Posix.Foreign - -import qualified System.Posix as Posix -import System.IO.Error -import Control.Exception -import qualified Data.ByteString.Char8 as BS -import System.Posix.ByteString.FilePath -import System.Posix.Directory.ByteString as PosixBS -import System.Posix.Files.ByteString - -import System.IO.Unsafe -import "unix" System.Posix.IO.ByteString (closeFd) -import Unsafe.Coerce (unsafeCoerce) -import Foreign.C.Error -import Foreign.C.String -import Foreign.C.Types -import Foreign.Marshal.Alloc (alloca,allocaBytes) -import Foreign.Ptr -import Foreign.Storable - - - - ----------------------------------------------------------- - --- | Get all files from a directory and its subdirectories. --- --- Upon entering a directory, 'allDirectoryContents' will get all entries --- strictly. However the returned list is lazy in that directories will only --- be accessed on demand. --- --- Follows symbolic links for the input dir. -allDirectoryContents :: RawFilePath -> IO [RawFilePath] -allDirectoryContents topdir = do - namesAndTypes <- getDirectoryContents topdir - let properNames = filter ((`notElem` [".", ".."]) . snd) namesAndTypes - paths <- forM properNames $ \(typ,name) -> unsafeInterleaveIO $ do - let path = topdir name - case () of - () | typ == dtDir -> allDirectoryContents path - | typ == dtUnknown -> do - isDir <- isDirectory <$> getFileStatus path - if isDir - then allDirectoryContents path - else return [path] - | otherwise -> return [path] - return (topdir : concat paths) - --- | Get all files from a directory and its subdirectories strictly. --- --- Follows symbolic links for the input dir. -allDirectoryContents' :: RawFilePath -> IO [RawFilePath] -allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) [] --- this uses traverseDirectory because it's more efficient than forcing the --- lazy version. - --- | Recursively apply the 'action' to the parent directory and all --- files/subdirectories. --- --- This function allows for memory-efficient traversals. --- --- Follows symbolic links for the input dir. -traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s -traverseDirectory act s0 topdir = toploop - where - toploop = do - isDir <- isDirectory <$> getFileStatus topdir - s' <- act s0 topdir - if isDir then actOnDirContents topdir s' loop - else return s' - loop typ path acc = do - isDir <- case () of - () | typ == dtDir -> return True - | typ == dtUnknown -> isDirectory <$> getFileStatus path - | otherwise -> return False - if isDir - then act acc path >>= \acc' -> actOnDirContents path acc' loop - else act acc path - -actOnDirContents :: RawFilePath - -> b - -> (DirType -> RawFilePath -> b -> IO b) - -> IO b -actOnDirContents pathRelToTop b f = - modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) . - (`ioeSetLocation` "findBSTypRel")) $ - bracket - (openDirStream pathRelToTop) - Posix.closeDirStream - (\dirp -> loop dirp b) - where - loop dirp b' = do - (typ,e) <- readDirEnt dirp - if (e == "") - then return b' - else - if (e == "." || e == "..") - then loop dirp b' - else f typ (pathRelToTop e) b' >>= loop dirp - - ----------------------------------------------------------- --- dodgy stuff - -type CDir = () -type CDirent = () - --- Posix doesn't export DirStream, so to re-use that type we need to use --- unsafeCoerce. It's just a newtype, so this is a legitimate usage. --- ugly trick. -unpackDirStream :: DirStream -> Ptr CDir -unpackDirStream = unsafeCoerce - -packDirStream :: Ptr CDir -> DirStream -packDirStream = unsafeCoerce - --- the __hscore_* functions are defined in the unix package. We can import them and let --- the linker figure it out. -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" - c_name :: Ptr CDirent -> IO CString - -foreign import ccall unsafe "__posixdir_d_type" - c_type :: Ptr CDirent -> IO DirType - -foreign import ccall "realpath" - c_realpath :: CString -> CString -> IO CString - -foreign import ccall unsafe "fdopendir" - c_fdopendir :: Posix.Fd -> IO (Ptr ()) - ----------------------------------------------------------- --- less dodgy but still lower-level - - -readDirEnt :: DirStream -> IO (DirType, RawFilePath) -readDirEnt (unpackDirStream -> 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 (dtUnknown,BS.empty) - else do - dName <- c_name dEnt >>= peekFilePath - dType <- c_type dEnt - c_freeDirEnt dEnt - return (dType, dName) - else do - errno <- getErrno - if (errno == eINTR) - then loop ptr_dEnt - else do - let (Errno eo) = errno - if (eo == 0) - then return (dtUnknown,BS.empty) - else throwErrno "readDirEnt" - - --- |Gets all directory contents (not recursively). -getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)] -getDirectoryContents path = - modifyIOError ((`ioeSetFileName` (BS.unpack path)) . - (`ioeSetLocation` "System.Posix.RawFilePath.Directory.Traversals.getDirectoryContents")) $ - bracket - (PosixBS.openDirStream path) - PosixBS.closeDirStream - _dirloop - - --- |Binding to @fdopendir(3)@. -fdOpendir :: Posix.Fd -> IO DirStream -fdOpendir fd = - packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd) - - --- |Like `getDirectoryContents` except for a file descriptor. --- --- To avoid complicated error checks, the file descriptor is --- __always__ closed, even if `fdOpendir` fails. Usually, this --- only happens on successful `fdOpendir` and after the directory --- stream is closed. Also see the manpage of @fdopendir(3)@ for --- more details. -getDirectoryContents' :: Posix.Fd -> IO [(DirType, RawFilePath)] -getDirectoryContents' fd = do - dirstream <- fdOpendir fd `catchIOError` \e -> do - closeFd fd - ioError e - -- closeDirStream closes the filedescriptor - finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream) - - -_dirloop :: DirStream -> IO [(DirType, RawFilePath)] -{-# INLINE _dirloop #-} -_dirloop dirp = do - t@(_typ,e) <- readDirEnt dirp - if BS.null e then return [] else do - es <- _dirloop dirp - return (t:es) - - --- | return the canonicalized absolute pathname --- --- like canonicalizePath, but uses @realpath(3)@ -realpath :: RawFilePath -> IO RawFilePath -realpath inp = - allocaBytes pathMax $ \tmp -> do - void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp - BS.packCString tmp