15 Commits
0.6.0 ... 0.7.0

Author SHA1 Message Date
908513da2b Prettify doctests 2016-05-23 00:52:27 +02:00
47dd729e8a Small documentation improvements 2016-05-22 13:41:39 +02:00
620550dab4 Minor documentation fixes 2016-05-22 13:28:20 +02:00
ebab5355bc Beautify 2016-05-19 01:29:08 +02:00
8fdf1bf956 Add gitter link 2016-05-19 01:28:11 +02:00
39913faed6 Add hackage icon to README 2016-05-18 15:58:28 +02:00
5ed249f5d6 Fix haddock 2016-05-18 14:03:50 +02:00
a8ccfc2587 Release 0.7.0 2016-05-18 14:02:08 +02:00
8fec862304 Rm redundant import 2016-05-18 13:48:38 +02:00
646fe7cfea Doc update 2016-05-18 13:42:31 +02:00
1bf27258c1 Uhm 2016-05-18 13:33:17 +02:00
797dcaf725 Backport changes from posix-paths PR:
* add isFileName
* add hasParentDir
* add hiddenFile
* add our own openFd version for more control
* small documentation improvements
* add a getDirectoryContents' version that works on Fd
* fix linting warnings
* lift version constraints in benchmark

Also adjust HPath.IO to work with the new API.
2016-05-18 04:11:40 +02:00
0fa66cd581 Use sendfile for copying and read/write as fallback 2016-05-18 03:47:39 +02:00
ee3ace362b HPath.IO: minor doc fix 2016-05-10 12:05:55 +02:00
05fcad14f1 HPath.IO.Errors: minor documentation fix 2016-05-10 02:02:05 +02:00
9 changed files with 276 additions and 190 deletions

View File

@@ -1,3 +1,11 @@
0.7.0:
* use 'sendfile' from 'simple-sendfile' in _copyFile and do read/write as a fallback only
* add isFileName, hasParentDir, hiddenFile to System.Posix.FilePath
* add our own openFd version for more control
* small documentation improvements
* add a getDirectoryContents' version that works on Fd
* lift version constraints in benchmark
* remove fpToString and userStringToFP, use Data.ByteString.UTF8 directly instead
0.6.0: 0.6.0:
* fixes 'throwDestinationInSource' to be more reliable. * fixes 'throwDestinationInSource' to be more reliable.
* removes some unused HPathIOException constructors * removes some unused HPathIOException constructors

View File

@@ -1,6 +1,6 @@
# HPath # HPath
[![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath)
Support for well-typed paths in Haskell. Also provides ByteString based filepath Support for well-typed paths in Haskell. Also provides ByteString based filepath
manipulation. manipulation.

View File

@@ -1,5 +1,5 @@
name: hpath name: hpath
version: 0.6.0 version: 0.7.0
synopsis: Support for well-typed paths synopsis: Support for well-typed paths
description: Support for well-typed paths, utilizing ByteString under the hood. description: Support for well-typed paths, utilizing ByteString under the hood.
license: GPL-2 license: GPL-2
@@ -29,12 +29,14 @@ library
HPath.Internal, HPath.Internal,
System.Posix.Directory.Foreign, System.Posix.Directory.Foreign,
System.Posix.Directory.Traversals, System.Posix.Directory.Traversals,
System.Posix.FD,
System.Posix.FilePath System.Posix.FilePath
build-depends: base >= 4.2 && <5 build-depends: base >= 4.2 && <5
, bytestring >= 0.9.2.0 , bytestring >= 0.9.2.0
, deepseq , deepseq
, exceptions , exceptions
, hspec , hspec
, simple-sendfile >= 0.2.22
, unix >= 2.5 , unix >= 2.5
, unix-bytestring , unix-bytestring
, utf8-string , utf8-string
@@ -110,9 +112,9 @@ benchmark bench.hs
bytestring, bytestring,
unix, unix,
directory >= 1.1 && < 1.3, directory >= 1.1 && < 1.3,
filepath >= 1.2 && < 1.4, filepath >= 1.2 && < 1.5,
process >= 1.0 && < 1.3, process >= 1.0 && < 1.3,
criterion >= 0.6 && < 0.9 criterion >= 0.6 && < 1.2
ghc-options: -O2 ghc-options: -O2
source-repository head source-repository head

View File

@@ -45,9 +45,6 @@ module HPath
,withAbsPath ,withAbsPath
,withRelPath ,withRelPath
,withFnPath ,withFnPath
-- * ByteString operations
,fpToString
,userStringToFP
) )
where where
@@ -109,19 +106,19 @@ pattern Path x <- (MkPath x)
-- --
-- Throws: 'PathParseException' -- Throws: 'PathParseException'
-- --
-- >>> parseAbs "/abc" :: Maybe (Path Abs) -- >>> parseAbs "/abc" :: Maybe (Path Abs)
-- Just "/abc" -- Just "/abc"
-- >>> parseAbs "/" :: Maybe (Path Abs) -- >>> parseAbs "/" :: Maybe (Path Abs)
-- Just "/" -- Just "/"
-- >>> parseAbs "/abc/def" :: Maybe (Path Abs) -- >>> parseAbs "/abc/def" :: Maybe (Path Abs)
-- Just "/abc/def" -- Just "/abc/def"
-- >>> parseAbs "/abc/def/.///" :: Maybe (Path Abs) -- >>> parseAbs "/abc/def/.///" :: Maybe (Path Abs)
-- Just "/abc/def/" -- Just "/abc/def/"
-- >>> parseAbs "abc" :: Maybe (Path Abs) -- >>> parseAbs "abc" :: Maybe (Path Abs)
-- Nothing -- Nothing
-- >>> parseAbs "" :: Maybe (Path Abs) -- >>> parseAbs "" :: Maybe (Path Abs)
-- Nothing -- Nothing
-- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs) -- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs)
-- Nothing -- Nothing
parseAbs :: MonadThrow m parseAbs :: MonadThrow m
=> ByteString -> m (Path Abs) => ByteString -> m (Path Abs)
@@ -141,23 +138,23 @@ parseAbs filepath =
-- --
-- Throws: 'PathParseException' -- Throws: 'PathParseException'
-- --
-- >>> parseRel "abc" :: Maybe (Path Rel) -- >>> parseRel "abc" :: Maybe (Path Rel)
-- Just "abc" -- Just "abc"
-- >>> parseRel "def/" :: Maybe (Path Rel) -- >>> parseRel "def/" :: Maybe (Path Rel)
-- Just "def/" -- Just "def/"
-- >>> parseRel "abc/def" :: Maybe (Path Rel) -- >>> parseRel "abc/def" :: Maybe (Path Rel)
-- Just "abc/def" -- Just "abc/def"
-- >>> parseRel "abc/def/." :: Maybe (Path Rel) -- >>> parseRel "abc/def/." :: Maybe (Path Rel)
-- Just "abc/def/" -- Just "abc/def/"
-- >>> parseRel "/abc" :: Maybe (Path Rel) -- >>> parseRel "/abc" :: Maybe (Path Rel)
-- Nothing -- Nothing
-- >>> parseRel "" :: Maybe (Path Rel) -- >>> parseRel "" :: Maybe (Path Rel)
-- Nothing -- Nothing
-- >>> parseRel "abc/../foo" :: Maybe (Path Rel) -- >>> parseRel "abc/../foo" :: Maybe (Path Rel)
-- Nothing -- Nothing
-- >>> parseRel "." :: Maybe (Path Rel) -- >>> parseRel "." :: Maybe (Path Rel)
-- Nothing -- Nothing
-- >>> parseRel ".." :: Maybe (Path Rel) -- >>> parseRel ".." :: Maybe (Path Rel)
-- Nothing -- Nothing
parseRel :: MonadThrow m parseRel :: MonadThrow m
=> ByteString -> m (Path Rel) => ByteString -> m (Path Rel)
@@ -176,25 +173,25 @@ parseRel filepath =
-- --
-- Throws: 'PathParseException' -- Throws: 'PathParseException'
-- --
-- >>> parseFn "abc" :: Maybe (Path Fn) -- >>> parseFn "abc" :: Maybe (Path Fn)
-- Just "abc" -- Just "abc"
-- >>> parseFn "..." :: Maybe (Path Fn) -- >>> parseFn "..." :: Maybe (Path Fn)
-- Just "..." -- Just "..."
-- >>> parseFn "def/" :: Maybe (Path Fn) -- >>> parseFn "def/" :: Maybe (Path Fn)
-- Nothing -- Nothing
-- >>> parseFn "abc/def" :: Maybe (Path Fn) -- >>> parseFn "abc/def" :: Maybe (Path Fn)
-- Nothing -- Nothing
-- >>> parseFn "abc/def/." :: Maybe (Path Fn) -- >>> parseFn "abc/def/." :: Maybe (Path Fn)
-- Nothing -- Nothing
-- >>> parseFn "/abc" :: Maybe (Path Fn) -- >>> parseFn "/abc" :: Maybe (Path Fn)
-- Nothing -- Nothing
-- >>> parseFn "" :: Maybe (Path Fn) -- >>> parseFn "" :: Maybe (Path Fn)
-- Nothing -- Nothing
-- >>> parseFn "abc/../foo" :: Maybe (Path Fn) -- >>> parseFn "abc/../foo" :: Maybe (Path Fn)
-- Nothing -- Nothing
-- >>> parseFn "." :: Maybe (Path Fn) -- >>> parseFn "." :: Maybe (Path Fn)
-- Nothing -- Nothing
-- >>> parseFn ".." :: Maybe (Path Fn) -- >>> parseFn ".." :: Maybe (Path Fn)
-- Nothing -- Nothing
parseFn :: MonadThrow m parseFn :: MonadThrow m
=> ByteString -> m (Path Fn) => ByteString -> m (Path Fn)
@@ -237,13 +234,13 @@ fromRel = toFilePath
-- because this library is IO-agnostic and makes no assumptions about -- because this library is IO-agnostic and makes no assumptions about
-- file types. -- file types.
-- --
-- >>> (MkPath "/") </> (MkPath "file" :: Path Rel) -- >>> (MkPath "/") </> (MkPath "file" :: Path Rel)
-- "/file" -- "/file"
-- >>> (MkPath "/path/to") </> (MkPath "file" :: Path Rel) -- >>> (MkPath "/path/to") </> (MkPath "file" :: Path Rel)
-- "/path/to/file" -- "/path/to/file"
-- >>> (MkPath "/") </> (MkPath "file/lal" :: Path Rel) -- >>> (MkPath "/") </> (MkPath "file/lal" :: Path Rel)
-- "/file/lal" -- "/file/lal"
-- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel) -- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel)
-- "/file/" -- "/file/"
(</>) :: RelC r => Path b -> Path r -> Path b (</>) :: RelC r => Path b -> Path r -> Path b
(</>) (MkPath a) (MkPath b) = MkPath (a' `BS.append` b) (</>) (MkPath a) (MkPath b) = MkPath (a' `BS.append` b)
@@ -257,15 +254,15 @@ fromRel = toFilePath
-- --
-- The bases must match. -- The bases must match.
-- --
-- >>> (MkPath "/lal/lad") `stripDir` (MkPath "/lal/lad/fad") :: Maybe (Path Rel) -- >>> (MkPath "/lal/lad") `stripDir` (MkPath "/lal/lad/fad") :: Maybe (Path Rel)
-- Just "fad" -- Just "fad"
-- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel) -- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel)
-- Just "fad" -- Just "fad"
-- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel) -- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel)
-- Nothing -- Nothing
-- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel) -- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel)
-- Nothing -- Nothing
-- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel) -- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel)
-- Nothing -- Nothing
stripDir :: MonadThrow m stripDir :: MonadThrow m
=> Path b -> Path b -> m (Path Rel) => Path b -> Path b -> m (Path Rel)
@@ -281,15 +278,15 @@ stripDir (MkPath p) (MkPath l) =
-- | Is p a parent of the given location? Implemented in terms of -- | Is p a parent of the given location? Implemented in terms of
-- 'stripDir'. The bases must match. -- 'stripDir'. The bases must match.
-- --
-- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad") -- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad")
-- True -- True
-- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad") -- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad")
-- True -- True
-- >>> (MkPath "/") `isParentOf` (MkPath "/") -- >>> (MkPath "/") `isParentOf` (MkPath "/")
-- False -- False
-- >>> (MkPath "/lal/lad/fad") `isParentOf` (MkPath "/lal/lad") -- >>> (MkPath "/lal/lad/fad") `isParentOf` (MkPath "/lal/lad")
-- False -- False
-- >>> (MkPath "fad") `isParentOf` (MkPath "fad") -- >>> (MkPath "fad") `isParentOf` (MkPath "fad")
-- False -- False
isParentOf :: Path b -> Path b -> Bool isParentOf :: Path b -> Path b -> Bool
isParentOf p l = isJust (stripDir p l :: Maybe (Path Rel)) isParentOf p l = isJust (stripDir p l :: Maybe (Path Rel))
@@ -333,7 +330,7 @@ dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)
-- --
-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn) -- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn)
-- Just "dod" -- Just "dod"
-- >>> basename (MkPath "/") :: Maybe (Path Fn) -- >>> basename (MkPath "/") :: Maybe (Path Fn)
-- Nothing -- Nothing
basename :: MonadThrow m => Path b -> m (Path Fn) basename :: MonadThrow m => Path b -> m (Path Fn)
basename (MkPath l) basename (MkPath l)

View File

@@ -80,7 +80,6 @@ import Control.Applicative
import Control.Exception import Control.Exception
( (
bracket bracket
, bracketOnError
, throwIO , throwIO
) )
import Control.Monad import Control.Monad
@@ -107,6 +106,8 @@ import Data.Word
import Foreign.C.Error import Foreign.C.Error
( (
eEXIST eEXIST
, eINVAL
, eNOSYS
, eNOTEMPTY , eNOTEMPTY
, eXDEV , eXDEV
) )
@@ -136,6 +137,14 @@ import System.IO.Error
catchIOError catchIOError
, ioeGetErrorType , ioeGetErrorType
) )
import System.Linux.Sendfile
(
sendfileFd
)
import Network.Sendfile
(
FileRange(..)
)
import System.Posix.ByteString import System.Posix.ByteString
( (
exclusive exclusive
@@ -172,6 +181,10 @@ import System.Posix.Files.ByteString
import qualified System.Posix.Files.ByteString as PF import qualified System.Posix.Files.ByteString as PF
import qualified "unix" System.Posix.IO.ByteString as SPI import qualified "unix" System.Posix.IO.ByteString as SPI
import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
import System.Posix.FD
(
openFd
)
import qualified System.Posix.Directory.Traversals as SPDT import qualified System.Posix.Directory.Traversals as SPDT
import qualified System.Posix.Directory.Foreign as SPDF import qualified System.Posix.Directory.Foreign as SPDF
import qualified System.Posix.Process.ByteString as SPP import qualified System.Posix.Process.ByteString as SPP
@@ -229,8 +242,8 @@ data FileType = Directory
-- - `PermissionDenied` if source directory can't be opened -- - `PermissionDenied` if source directory can't be opened
-- - `InvalidArgument` if source directory is wrong type (symlink) -- - `InvalidArgument` if source directory is wrong type (symlink)
-- - `InvalidArgument` if source directory is wrong type (regular file) -- - `InvalidArgument` if source directory is wrong type (regular file)
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `AlreadyExists` if destination already exists -- - `AlreadyExists` if destination already exists
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `DestinationInSource` if destination is contained in source (`HPathIOException`) -- - `DestinationInSource` if destination is contained in source (`HPathIOException`)
copyDirRecursive :: Path Abs -- ^ source dir copyDirRecursive :: Path Abs -- ^ source dir
-> Path Abs -- ^ full destination -> Path Abs -- ^ full destination
@@ -338,10 +351,10 @@ recreateSymlink symsource newsym
-- - `PermissionDenied` if source directory can't be opened -- - `PermissionDenied` if source directory can't be opened
-- - `InvalidArgument` if source file is wrong type (symlink) -- - `InvalidArgument` if source file is wrong type (symlink)
-- - `InvalidArgument` if source file is wrong type (directory) -- - `InvalidArgument` if source file is wrong type (directory)
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `AlreadyExists` if destination already exists -- - `AlreadyExists` if destination already exists
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- --
-- Note: calls `sendfile` -- Note: calls `sendfile` and possibly `read`/`write` as fallback
copyFile :: Path Abs -- ^ source file copyFile :: Path Abs -- ^ source file
-> Path Abs -- ^ destination file -> Path Abs -- ^ destination file
-> IO () -> IO ()
@@ -358,8 +371,7 @@ copyFile from to = do
-- --
-- Safety/reliability concerns: -- Safety/reliability concerns:
-- --
-- * not atomic -- * not atomic, since it uses read/write
-- * falls back to delete-copy method with explicit checks
-- --
-- Throws: -- Throws:
-- --
@@ -370,7 +382,7 @@ copyFile from to = do
-- - `InvalidArgument` if source file is wrong type (directory) -- - `InvalidArgument` if source file is wrong type (directory)
-- - `SameFile` if source and destination are the same file (`HPathIOException`) -- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- --
-- Note: calls `sendfile` -- Note: calls `sendfile` and possibly `read`/`write` as fallback
copyFileOverwrite :: Path Abs -- ^ source file copyFileOverwrite :: Path Abs -- ^ source file
-> Path Abs -- ^ destination file -> Path Abs -- ^ destination file
-> IO () -> IO ()
@@ -398,24 +410,35 @@ _copyFile :: [SPDF.Flags]
-> IO () -> IO ()
_copyFile sflags dflags from to _copyFile sflags dflags from to
= =
-- TODO: add sendfile support -- from sendfile(2) manpage:
void $ readWriteCopy (fromAbs from) (fromAbs to) -- Applications may wish to fall back to read(2)/write(2) in the case
-- where sendfile() fails with EINVAL or ENOSYS.
withAbsPath to $ \to' -> withAbsPath from $ \from' ->
catchErrno [eINVAL, eNOSYS]
(sendFileCopy from' to')
(void $ readWriteCopy from' to')
where where
-- low-level copy operation utilizing read(2)/write(2) copyWith copyAction source dest =
-- in case `sendFileCopy` fails/is unsupported bracket (openFd source SPI.ReadOnly sflags Nothing)
readWriteCopy :: ByteString -> ByteString -> IO Int
readWriteCopy source dest =
bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
SPI.closeFd SPI.closeFd
$ \sfd -> do $ \sfd -> do
fileM <- System.Posix.Files.ByteString.fileMode fileM <- System.Posix.Files.ByteString.fileMode
<$> getFdStatus sfd <$> getFdStatus sfd
bracketeer (SPDT.openFd dest SPI.WriteOnly bracketeer (openFd dest SPI.WriteOnly
dflags $ Just fileM) dflags $ Just fileM)
SPI.closeFd SPI.closeFd
(\fd -> SPI.closeFd fd >> deleteFile to) (\fd -> SPI.closeFd fd >> deleteFile to)
$ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf -> $ \dfd -> copyAction sfd dfd
write' sfd dfd buf 0 -- this is low-level stuff utilizing sendfile(2) for speed
sendFileCopy :: ByteString -> ByteString -> IO ()
sendFileCopy = copyWith
(\sfd dfd -> sendfileFd dfd sfd EntireFile $ return ())
-- low-level copy operation utilizing read(2)/write(2)
-- in case `sendFileCopy` fails/is unsupported
readWriteCopy :: ByteString -> ByteString -> IO Int
readWriteCopy = copyWith
(\sfd dfd -> allocaBytes (fromIntegral bufSize)
$ \buf -> write' sfd dfd buf 0)
where where
bufSize :: CSize bufSize :: CSize
bufSize = 8192 bufSize = 8192
@@ -473,7 +496,7 @@ easyCopyOverwrite from to = do
--------------------- ---------------------
-- |Deletes the given file, does not follow symlinks. Raises `eISDIR` -- |Deletes the given file. Raises `eISDIR`
-- if run on a directory. Does not follow symbolic links. -- if run on a directory. Does not follow symbolic links.
-- --
-- Throws: -- Throws:
@@ -628,8 +651,8 @@ createDir dest = createDirectory (fromAbs dest) newDirPerms
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened -- - `PermissionDenied` if source directory cannot be opened
-- - `UnsupportedOperation` if source and destination are on different devices -- - `UnsupportedOperation` if source and destination are on different devices
-- - `FileDoesExist` if destination file already exists -- - `FileDoesExist` if destination file already exists (`HPathIOException`)
-- - `DirDoesExist` if destination directory already exists -- - `DirDoesExist` if destination directory already exists (`HPathIOException`)
-- - `SameFile` if destination and source are the same file (`HPathIOException`) -- - `SameFile` if destination and source are the same file (`HPathIOException`)
-- --
-- Note: calls `rename` (but does not allow to rename over existing files) -- Note: calls `rename` (but does not allow to rename over existing files)
@@ -655,8 +678,8 @@ renameFile fromf tof = do
-- - `NoSuchThing` if source file does not exist -- - `NoSuchThing` if source file does not exist
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened -- - `PermissionDenied` if source directory cannot be opened
-- - `FileDoesExist` if destination file already exists -- - `FileDoesExist` if destination file already exists (`HPathIOException`)
-- - `DirDoesExist` if destination directory already exists -- - `DirDoesExist` if destination directory already exists (`HPathIOException`)
-- - `SameFile` if destination and source are the same file (`HPathIOException`) -- - `SameFile` if destination and source are the same file (`HPathIOException`)
-- --
-- Note: calls `rename` (but does not allow to rename over existing files) -- Note: calls `rename` (but does not allow to rename over existing files)
@@ -755,14 +778,12 @@ newDirPerms
getDirsFiles :: Path Abs -- ^ dir to read getDirsFiles :: Path Abs -- ^ dir to read
-> IO [Path Abs] -> IO [Path Abs]
getDirsFiles p = getDirsFiles p =
withAbsPath p $ \fp -> withAbsPath p $ \fp -> do
bracketOnError (SPDT.openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing) fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing
SPI.closeFd return
$ \fd -> . catMaybes
return . fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))
. catMaybes =<< getDirectoryContents' fd
. fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))
=<< getDirectoryContents' fd
where where
parseMaybe :: ByteString -> Maybe (Path Fn) parseMaybe :: ByteString -> Maybe (Path Fn)
parseMaybe = parseFn parseMaybe = parseFn

View File

@@ -66,6 +66,10 @@ import Data.ByteString
( (
ByteString ByteString
) )
import Data.ByteString.UTF8
(
toString
)
import Data.Data import Data.Data
( (
Data(..) Data(..)
@@ -114,20 +118,20 @@ data HPathIOException = FileDoesNotExist ByteString
instance Show HPathIOException where instance Show HPathIOException where
show (FileDoesNotExist fp) = "File does not exist:" ++ fpToString fp show (FileDoesNotExist fp) = "File does not exist:" ++ toString fp
show (DirDoesNotExist fp) = "Directory does not exist: " show (DirDoesNotExist fp) = "Directory does not exist: "
++ fpToString fp ++ toString fp
show (SameFile fp1 fp2) = fpToString fp1 show (SameFile fp1 fp2) = toString fp1
++ " and " ++ fpToString fp2 ++ " and " ++ toString fp2
++ " are the same file!" ++ " are the same file!"
show (DestinationInSource fp1 fp2) = fpToString fp1 show (DestinationInSource fp1 fp2) = toString fp1
++ " is contained in " ++ " is contained in "
++ fpToString fp2 ++ toString fp2
show (FileDoesExist fp) = "File does exist: " ++ fpToString fp show (FileDoesExist fp) = "File does exist: " ++ toString fp
show (DirDoesExist fp) = "Directory does exist: " ++ fpToString fp show (DirDoesExist fp) = "Directory does exist: " ++ toString fp
show (InvalidOperation str) = "Invalid operation: " ++ str show (InvalidOperation str) = "Invalid operation: " ++ str
show (Can'tOpenDirectory fp) = "Can't open directory: " show (Can'tOpenDirectory fp) = "Can't open directory: "
++ fpToString fp ++ toString fp
show (CopyFailed str) = "Copying failed: " ++ str show (CopyFailed str) = "Copying failed: " ++ str
@@ -214,7 +218,7 @@ sameFile fp1 fp2 =
-- source directory with all device+file IDs of the parent directories -- source directory with all device+file IDs of the parent directories
-- of the destination. -- of the destination.
throwDestinationInSource :: Path Abs -- ^ source dir throwDestinationInSource :: Path Abs -- ^ source dir
-> Path Abs -- ^ full destination, `dirname dest` -> Path Abs -- ^ full destination, @dirname dest@
-- must exist -- must exist
-> IO () -> IO ()
throwDestinationInSource source dest = do throwDestinationInSource source dest = do
@@ -266,7 +270,7 @@ canOpenDirectory fp =
return True return True
-- |Throws a `Can'tOpenDirectory` FmIOException if the directory at the given -- |Throws a `Can'tOpenDirectory` HPathIOException if the directory at the given
-- path cannot be opened. -- path cannot be opened.
throwCantOpenDirectory :: Path Abs -> IO () throwCantOpenDirectory :: Path Abs -> IO ()
throwCantOpenDirectory fp = throwCantOpenDirectory fp =
@@ -332,8 +336,8 @@ bracketeer before after afterEx thing =
reactOnError :: IO a reactOnError :: IO a
-> [(IOErrorType, IO a)] -- ^ reaction on IO errors -> [(IOErrorType, IO a)] -- ^ reaction on IO errors
-> [(HPathIOException, IO a)] -- ^ reaction on FmIOException -> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException
-> IO a -> IO a
reactOnError a ios fmios = reactOnError a ios fmios =
a `catches` [iohandler, fmiohandler] a `catches` [iohandler, fmiohandler]

View File

@@ -1,9 +1,24 @@
-- |
-- Module : System.Posix.Directory.Traversals
-- Copyright : © 2016 Julian Ospald
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
-- Portability : portable
--
-- Traversal and read operations on directories.
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Wall #-}
module System.Posix.Directory.Traversals ( module System.Posix.Directory.Traversals (
getDirectoryContents getDirectoryContents
@@ -17,7 +32,7 @@ module System.Posix.Directory.Traversals (
, readDirEnt , readDirEnt
, packDirStream , packDirStream
, unpackDirStream , unpackDirStream
, openFd , fdOpendir
, realpath , realpath
) where ) where
@@ -36,6 +51,7 @@ import System.Posix.Directory.ByteString as PosixBS
import System.Posix.Files.ByteString import System.Posix.Files.ByteString
import System.IO.Unsafe import System.IO.Unsafe
import "unix" System.Posix.IO.ByteString (closeFd)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Foreign.C.Error import Foreign.C.Error
import Foreign.C.String import Foreign.C.String
@@ -54,6 +70,8 @@ import Foreign.Storable
-- Upon entering a directory, 'allDirectoryContents' will get all entries -- Upon entering a directory, 'allDirectoryContents' will get all entries
-- strictly. However the returned list is lazy in that directories will only -- strictly. However the returned list is lazy in that directories will only
-- be accessed on demand. -- be accessed on demand.
--
-- Follows symbolic links for the input dir.
allDirectoryContents :: RawFilePath -> IO [RawFilePath] allDirectoryContents :: RawFilePath -> IO [RawFilePath]
allDirectoryContents topdir = do allDirectoryContents topdir = do
namesAndTypes <- getDirectoryContents topdir namesAndTypes <- getDirectoryContents topdir
@@ -71,6 +89,8 @@ allDirectoryContents topdir = do
return (topdir : concat paths) return (topdir : concat paths)
-- | Get all files from a directory and its subdirectories strictly. -- | Get all files from a directory and its subdirectories strictly.
--
-- Follows symbolic links for the input dir.
allDirectoryContents' :: RawFilePath -> IO [RawFilePath] allDirectoryContents' :: RawFilePath -> IO [RawFilePath]
allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) [] allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) []
-- this uses traverseDirectory because it's more efficient than forcing the -- this uses traverseDirectory because it's more efficient than forcing the
@@ -80,6 +100,8 @@ allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:
-- files/subdirectories. -- files/subdirectories.
-- --
-- This function allows for memory-efficient traversals. -- This function allows for memory-efficient traversals.
--
-- Follows symbolic links for the input dir.
traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s
traverseDirectory act s0 topdir = toploop traverseDirectory act s0 topdir = toploop
where where
@@ -103,17 +125,17 @@ actOnDirContents :: RawFilePath
-> IO b -> IO b
actOnDirContents pathRelToTop b f = actOnDirContents pathRelToTop b f =
modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) . modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) .
(`ioeSetLocation` "findBSTypRel")) $ do (`ioeSetLocation` "findBSTypRel")) $
bracket bracket
(openDirStream pathRelToTop) (openDirStream pathRelToTop)
(Posix.closeDirStream) Posix.closeDirStream
(\dirp -> loop dirp b) (\dirp -> loop dirp b)
where where
loop dirp b' = do loop dirp b' = do
(typ,e) <- readDirEnt dirp (typ,e) <- readDirEnt dirp
if (e == "") if (e == "")
then return b' then return b'
else do else
if (e == "." || e == "..") if (e == "." || e == "..")
then loop dirp b' then loop dirp b'
else f typ (pathRelToTop </> e) b' >>= loop dirp else f typ (pathRelToTop </> e) b' >>= loop dirp
@@ -154,9 +176,6 @@ foreign import ccall "realpath"
foreign import ccall unsafe "fdopendir" foreign import ccall unsafe "fdopendir"
c_fdopendir :: Posix.Fd -> IO (Ptr ()) c_fdopendir :: Posix.Fd -> IO (Ptr ())
foreign import ccall unsafe "open"
c_open :: CString -> CInt -> Posix.CMode -> IO CInt
---------------------------------------------------------- ----------------------------------------------------------
-- less dodgy but still lower-level -- less dodgy but still lower-level
@@ -189,81 +208,53 @@ readDirEnt (unpackDirStream -> dirp) =
else throwErrno "readDirEnt" else throwErrno "readDirEnt"
-- |Gets all directory contents (not recursively).
getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)] getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)]
getDirectoryContents path = getDirectoryContents path =
modifyIOError ((`ioeSetFileName` (BS.unpack path)) . modifyIOError ((`ioeSetFileName` (BS.unpack path)) .
(`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $ do (`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $
bracket bracket
(PosixBS.openDirStream path) (PosixBS.openDirStream path)
PosixBS.closeDirStream PosixBS.closeDirStream
loop _dirloop
where
loop dirp = do
t@(_typ,e) <- readDirEnt dirp
if BS.null e then return [] else do
es <- loop dirp
return (t:es)
-- |Binding to @fdopendir(3)@.
fdOpendir :: Posix.Fd -> IO DirStream fdOpendir :: Posix.Fd -> IO DirStream
fdOpendir fd = fdOpendir fd =
packDirStream <$> throwErrnoIfNull "fdOpendir" (c_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' :: Posix.Fd -> IO [(DirType, RawFilePath)]
getDirectoryContents' fd = getDirectoryContents' fd = do
bracket dirstream <- fdOpendir fd `catchIOError` \e -> do
(fdOpendir fd) closeFd fd
PosixBS.closeDirStream ioError e
loop -- closeDirStream closes the filedescriptor
where finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream)
loop dirp = do
t@(_typ,e) <- readDirEnt dirp
if BS.null e then return [] else do
es <- loop dirp
return (t:es)
open_ :: CString _dirloop :: DirStream -> IO [(DirType, RawFilePath)]
-> Posix.OpenMode {-# INLINE _dirloop #-}
-> [Flags] _dirloop dirp = do
-> Maybe Posix.FileMode t@(_typ,e) <- readDirEnt dirp
-> IO Posix.Fd if BS.null e then return [] else do
open_ str how optional_flags maybe_mode = do es <- _dirloop dirp
fd <- c_open str all_flags mode_w return (t:es)
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.
openFd :: RawFilePath
-> Posix.OpenMode
-> [Flags]
-> Maybe Posix.FileMode
-> IO Posix.Fd
openFd name how optional_flags maybe_mode =
withFilePath name $ \str ->
throwErrnoPathIfMinus1Retry "openFd" name $
open_ str how optional_flags maybe_mode
-- | return the canonicalized absolute pathname -- | return the canonicalized absolute pathname
-- --
-- like canonicalizePath, but uses realpath(3) -- like canonicalizePath, but uses @realpath(3)@
realpath :: RawFilePath -> IO RawFilePath realpath :: RawFilePath -> IO RawFilePath
realpath inp = do realpath inp =
allocaBytes pathMax $ \tmp -> do allocaBytes pathMax $ \tmp -> do
void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp
BS.packCString tmp BS.packCString tmp

75
src/System/Posix/FD.hs Normal file
View File

@@ -0,0 +1,75 @@
-- |
-- Module : System.Posix.FD
-- Copyright : © 2016 Julian Ospald
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- 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.Directory.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

View File

@@ -11,6 +11,7 @@
-- --
-- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute! -- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute!
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Wall #-}
@@ -72,16 +73,11 @@ module System.Posix.FilePath (
, equalFilePath , equalFilePath
, hiddenFile , hiddenFile
-- * Type conversion
, fpToString
, userStringToFP
, module System.Posix.ByteString.FilePath , module System.Posix.ByteString.FilePath
) where ) where
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (fromString, toString)
import System.Posix.ByteString.FilePath import System.Posix.ByteString.FilePath
import Data.Maybe (isJust) import Data.Maybe (isJust)
@@ -94,7 +90,6 @@ import Control.Arrow (second)
-- >>> import Test.QuickCheck -- >>> import Test.QuickCheck
-- >>> import Control.Applicative -- >>> import Control.Applicative
-- >>> import qualified Data.ByteString as BS -- >>> import qualified Data.ByteString as BS
-- >>> import Data.ByteString (ByteString)
-- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary -- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary
-- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack -- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack
-- --
@@ -441,7 +436,6 @@ normalise filepath =
dropDots :: [ByteString] -> [ByteString] dropDots :: [ByteString] -> [ByteString]
dropDots = filter (BS.singleton _period /=) dropDots = filter (BS.singleton _period /=)
------------------------ ------------------------
-- trailing path separators -- trailing path separators
@@ -524,7 +518,8 @@ isValid filepath
| _nul `BS.elem` filepath = False | _nul `BS.elem` filepath = False
| otherwise = True | otherwise = True
-- | Is the given filename a valid filename? -- | Is the given path a valid filename? This includes
-- "." and "..".
-- --
-- >>> isFileName "lal" -- >>> isFileName "lal"
-- True -- True
@@ -538,13 +533,13 @@ isValid filepath
-- False -- False
-- >>> isFileName "/random_ path:*" -- >>> isFileName "/random_ path:*"
-- False -- False
isFileName :: ByteString -> Bool isFileName :: RawFilePath -> Bool
isFileName filepath = isFileName filepath =
not (BS.singleton pathSeparator `BS.isInfixOf` filepath) && not (BS.singleton pathSeparator `BS.isInfixOf` filepath) &&
not (BS.null filepath) && not (BS.null filepath) &&
not (_nul `BS.elem` filepath) not (_nul `BS.elem` filepath)
-- | Helper function: check if the filepath has any parent directories in it. -- | Check if the filepath has any parent directories in it.
-- --
-- >>> hasParentDir "/.." -- >>> hasParentDir "/.."
-- True -- True
@@ -560,19 +555,18 @@ isFileName filepath =
-- False -- False
-- >>> hasParentDir ".." -- >>> hasParentDir ".."
-- False -- False
hasParentDir :: ByteString -> Bool hasParentDir :: RawFilePath -> Bool
hasParentDir filepath = hasParentDir filepath =
((pathSeparator `BS.cons` pathDoubleDot) (pathSeparator `BS.cons` pathDoubleDot)
`BS.isSuffixOf` filepath `BS.isSuffixOf` filepath
) || ||
((BS.singleton pathSeparator (BS.singleton pathSeparator
`BS.append` pathDoubleDot `BS.append` pathDoubleDot
`BS.append` BS.singleton pathSeparator `BS.append` BS.singleton pathSeparator)
) `BS.isInfixOf` filepath `BS.isInfixOf` filepath
) || ||
((pathDoubleDot `BS.append` BS.singleton pathSeparator (pathDoubleDot `BS.append` BS.singleton pathSeparator)
) `BS.isPrefixOf` filepath `BS.isPrefixOf` filepath
)
where where
pathDoubleDot = BS.pack [_period, _period] pathDoubleDot = BS.pack [_period, _period]
@@ -605,32 +599,26 @@ equalFilePath p1 p2 = f p1 == f p2
-- True -- True
-- >>> hiddenFile "..foo.bar" -- >>> hiddenFile "..foo.bar"
-- True -- True
-- >>> hiddenFile "some/path/.bar"
-- True
-- >>> hiddenFile "..." -- >>> hiddenFile "..."
-- True -- True
-- >>> hiddenFile "dod"
-- False
-- >>> hiddenFile "dod.bar" -- >>> hiddenFile "dod.bar"
-- False -- False
-- >>> hiddenFile "."
-- False
-- >>> hiddenFile ".."
-- False
-- >>> hiddenFile ""
-- False
hiddenFile :: RawFilePath -> Bool hiddenFile :: RawFilePath -> Bool
hiddenFile fp hiddenFile fp
| fp == BS.pack [_period, _period] = False | fn == BS.pack [_period, _period] = False
| fp == BS.pack [_period] = False | fn == BS.pack [_period] = False
| otherwise = BS.pack [extSeparator] | otherwise = BS.pack [extSeparator]
`BS.isPrefixOf` fp `BS.isPrefixOf` fn
where
------------------------ fn = takeFileName fp
-- conversion
-- |Uses UTF-8 decoding to convert the bytestring into a String.
fpToString :: ByteString -> String
fpToString = toString
-- |Uses UTF-8 encoding to convert a user provided String into
-- a ByteString, which represents a filepath.
userStringToFP :: String -> ByteString
userStringToFP = fromString
------------------------ ------------------------
-- internal stuff -- internal stuff
@@ -638,7 +626,7 @@ userStringToFP = fromString
-- Just split the input FileName without adding/normalizing or changing -- Just split the input FileName without adding/normalizing or changing
-- anything. -- anything.
splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath) splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath)
splitFileNameRaw x = BS.breakEnd isPathSeparator x splitFileNameRaw = BS.breakEnd isPathSeparator
-- | Combine two paths, assuming rhs is NOT absolute. -- | Combine two paths, assuming rhs is NOT absolute.
combineRaw :: RawFilePath -> RawFilePath -> RawFilePath combineRaw :: RawFilePath -> RawFilePath -> RawFilePath