diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,6 @@ +0.7.1: + * various cleanups and documentation improvements + * added the following functions to System.Posix.FilePath: splitSearchPath, getSearchPath, stripExtension, makeRelative, makeValid 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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # 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 manipulation. @@ -43,9 +43,20 @@ ## Differences to 'posix-paths' -* `hasTrailingPathSeparator` behaves in the same way as `System.FilePath` -* `dropTrailingPathSeparator` behaves in the same way as `System.FilePath` -* added various functions like `isValid`, `normalise` and `equalFilePath` * uses the `word8` package for save word8 literals instead of `OverloadedStrings` -* has custom versions of `openFd` and `getDirectoryContents` +* `hasTrailingPathSeparator` and `dropTrailingPathSeparator` behave in the same way as their `System.FilePath` counterpart +* added various functions: + * `equalFilePath` + * `getSearchPath` + * `hasParentDir` + * `hiddenFile` + * `isFileName` + * `isValid` + * `makeRelative` + * `makeValid` + * `normalise` + * `splitSearchPath` + * `stripExtension` +* has a custom versions of `openFd` which allows more control over the flags than its unix package counterpart +* adds a `getDirectoryContents'` version that works on Fd diff --git a/hpath.cabal b/hpath.cabal --- a/hpath.cabal +++ b/hpath.cabal @@ -1,5 +1,5 @@ name: hpath -version: 0.7.0 +version: 0.7.1 synopsis: Support for well-typed paths description: Support for well-typed paths, utilizing ByteString under the hood. license: GPL-2 @@ -36,7 +36,7 @@ , deepseq , exceptions , hspec - , simple-sendfile >= 0.2.22 + , simple-sendfile >= 0.2.24 , unix >= 2.5 , unix-bytestring , utf8-string diff --git a/src/HPath.hs b/src/HPath.hs --- a/src/HPath.hs +++ b/src/HPath.hs @@ -54,10 +54,10 @@ import Data.ByteString(ByteString, stripPrefix) #else import Data.ByteString(ByteString) +import qualified Data.List as L #endif import qualified Data.ByteString as BS import Data.Data -import qualified Data.List as L import Data.Maybe import Data.Word8 import HPath.Internal @@ -106,19 +106,19 @@ -- -- Throws: 'PathParseException' -- --- >>> parseAbs "/abc" :: Maybe (Path Abs) +-- >>> parseAbs "/abc" :: Maybe (Path Abs) -- Just "/abc" --- >>> parseAbs "/" :: Maybe (Path Abs) +-- >>> parseAbs "/" :: Maybe (Path Abs) -- Just "/" --- >>> parseAbs "/abc/def" :: Maybe (Path Abs) +-- >>> parseAbs "/abc/def" :: Maybe (Path Abs) -- Just "/abc/def" -- >>> parseAbs "/abc/def/.///" :: Maybe (Path Abs) -- Just "/abc/def/" --- >>> parseAbs "abc" :: Maybe (Path Abs) +-- >>> parseAbs "abc" :: Maybe (Path Abs) -- Nothing --- >>> parseAbs "" :: Maybe (Path Abs) +-- >>> parseAbs "" :: Maybe (Path Abs) -- Nothing --- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs) +-- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs) -- Nothing parseAbs :: MonadThrow m => ByteString -> m (Path Abs) @@ -138,23 +138,23 @@ -- -- Throws: 'PathParseException' -- --- >>> parseRel "abc" :: Maybe (Path Rel) +-- >>> parseRel "abc" :: Maybe (Path Rel) -- Just "abc" --- >>> parseRel "def/" :: Maybe (Path Rel) +-- >>> parseRel "def/" :: Maybe (Path Rel) -- Just "def/" --- >>> parseRel "abc/def" :: Maybe (Path Rel) +-- >>> parseRel "abc/def" :: Maybe (Path Rel) -- Just "abc/def" --- >>> parseRel "abc/def/." :: Maybe (Path Rel) +-- >>> parseRel "abc/def/." :: Maybe (Path Rel) -- Just "abc/def/" --- >>> parseRel "/abc" :: Maybe (Path Rel) +-- >>> parseRel "/abc" :: Maybe (Path Rel) -- Nothing --- >>> parseRel "" :: Maybe (Path Rel) +-- >>> parseRel "" :: Maybe (Path Rel) -- Nothing -- >>> parseRel "abc/../foo" :: Maybe (Path Rel) -- Nothing --- >>> parseRel "." :: Maybe (Path Rel) +-- >>> parseRel "." :: Maybe (Path Rel) -- Nothing --- >>> parseRel ".." :: Maybe (Path Rel) +-- >>> parseRel ".." :: Maybe (Path Rel) -- Nothing parseRel :: MonadThrow m => ByteString -> m (Path Rel) @@ -173,25 +173,25 @@ -- -- Throws: 'PathParseException' -- --- >>> parseFn "abc" :: Maybe (Path Fn) +-- >>> parseFn "abc" :: Maybe (Path Fn) -- Just "abc" --- >>> parseFn "..." :: Maybe (Path Fn) +-- >>> parseFn "..." :: Maybe (Path Fn) -- Just "..." --- >>> parseFn "def/" :: Maybe (Path Fn) +-- >>> parseFn "def/" :: Maybe (Path Fn) -- Nothing --- >>> parseFn "abc/def" :: Maybe (Path Fn) +-- >>> parseFn "abc/def" :: Maybe (Path Fn) -- Nothing --- >>> parseFn "abc/def/." :: Maybe (Path Fn) +-- >>> parseFn "abc/def/." :: Maybe (Path Fn) -- Nothing --- >>> parseFn "/abc" :: Maybe (Path Fn) +-- >>> parseFn "/abc" :: Maybe (Path Fn) -- Nothing --- >>> parseFn "" :: Maybe (Path Fn) +-- >>> parseFn "" :: Maybe (Path Fn) -- Nothing -- >>> parseFn "abc/../foo" :: Maybe (Path Fn) -- Nothing --- >>> parseFn "." :: Maybe (Path Fn) +-- >>> parseFn "." :: Maybe (Path Fn) -- Nothing --- >>> parseFn ".." :: Maybe (Path Fn) +-- >>> parseFn ".." :: Maybe (Path Fn) -- Nothing parseFn :: MonadThrow m => ByteString -> m (Path Fn) @@ -234,13 +234,13 @@ -- because this library is IO-agnostic and makes no assumptions about -- file types. -- --- >>> (MkPath "/") (MkPath "file" :: Path Rel) +-- >>> (MkPath "/") (MkPath "file" :: Path Rel) -- "/file" --- >>> (MkPath "/path/to") (MkPath "file" :: Path Rel) +-- >>> (MkPath "/path/to") (MkPath "file" :: Path Rel) -- "/path/to/file" --- >>> (MkPath "/") (MkPath "file/lal" :: Path Rel) +-- >>> (MkPath "/") (MkPath "file/lal" :: Path Rel) -- "/file/lal" --- >>> (MkPath "/") (MkPath "file/" :: Path Rel) +-- >>> (MkPath "/") (MkPath "file/" :: Path Rel) -- "/file/" () :: RelC r => Path b -> Path r -> Path b () (MkPath a) (MkPath b) = MkPath (a' `BS.append` b) @@ -254,15 +254,15 @@ -- -- 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" --- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel) +-- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel) -- Just "fad" --- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel) +-- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel) -- Nothing --- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel) +-- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel) -- Nothing --- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel) +-- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel) -- Nothing stripDir :: MonadThrow m => Path b -> Path b -> m (Path Rel) @@ -278,15 +278,15 @@ -- | Is p a parent of the given location? Implemented in terms of -- 'stripDir'. The bases must match. -- --- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad") +-- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad") -- True --- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad") +-- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad") -- True --- >>> (MkPath "/") `isParentOf` (MkPath "/") +-- >>> (MkPath "/") `isParentOf` (MkPath "/") -- False -- >>> (MkPath "/lal/lad/fad") `isParentOf` (MkPath "/lal/lad") -- False --- >>> (MkPath "fad") `isParentOf` (MkPath "fad") +-- >>> (MkPath "fad") `isParentOf` (MkPath "fad") -- False isParentOf :: Path b -> Path b -> Bool isParentOf p l = isJust (stripDir p l :: Maybe (Path Rel)) @@ -330,7 +330,7 @@ -- -- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn) -- Just "dod" --- >>> basename (MkPath "/") :: Maybe (Path Fn) +-- >>> basename (MkPath "/") :: Maybe (Path Fn) -- Nothing basename :: MonadThrow m => Path b -> m (Path Fn) basename (MkPath l) diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs --- a/src/HPath/IO.hs +++ b/src/HPath/IO.hs @@ -140,10 +140,7 @@ import System.Linux.Sendfile ( sendfileFd - ) -import Network.Sendfile - ( - FileRange(..) + , FileRange(..) ) import System.Posix.ByteString ( @@ -242,8 +239,8 @@ -- - `PermissionDenied` if source directory can't be opened -- - `InvalidArgument` if source directory is wrong type (symlink) -- - `InvalidArgument` if source directory is wrong type (regular file) --- - `SameFile` if source and destination are the same file (`HPathIOException`) -- - `AlreadyExists` if destination already exists +-- - `SameFile` if source and destination are the same file (`HPathIOException`) -- - `DestinationInSource` if destination is contained in source (`HPathIOException`) copyDirRecursive :: Path Abs -- ^ source dir -> Path Abs -- ^ full destination @@ -351,8 +348,8 @@ -- - `PermissionDenied` if source directory can't be opened -- - `InvalidArgument` if source file is wrong type (symlink) -- - `InvalidArgument` if source file is wrong type (directory) --- - `SameFile` if source and destination are the same file (`HPathIOException`) -- - `AlreadyExists` if destination already exists +-- - `SameFile` if source and destination are the same file (`HPathIOException`) -- -- Note: calls `sendfile` and possibly `read`/`write` as fallback copyFile :: Path Abs -- ^ source file @@ -496,7 +493,7 @@ --------------------- --- |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. -- -- Throws: @@ -651,8 +648,8 @@ -- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if source directory cannot be opened -- - `UnsupportedOperation` if source and destination are on different devices --- - `FileDoesExist` if destination file already exists --- - `DirDoesExist` if destination directory already exists +-- - `FileDoesExist` if destination file already exists (`HPathIOException`) +-- - `DirDoesExist` if destination directory already exists (`HPathIOException`) -- - `SameFile` if destination and source are the same file (`HPathIOException`) -- -- Note: calls `rename` (but does not allow to rename over existing files) @@ -678,8 +675,8 @@ -- - `NoSuchThing` if source file does not exist -- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if source directory cannot be opened --- - `FileDoesExist` if destination file already exists --- - `DirDoesExist` if destination directory already exists +-- - `FileDoesExist` if destination file already exists (`HPathIOException`) +-- - `DirDoesExist` if destination directory already exists (`HPathIOException`) -- - `SameFile` if destination and source are the same file (`HPathIOException`) -- -- Note: calls `rename` (but does not allow to rename over existing files) diff --git a/src/HPath/IO/Errors.hs b/src/HPath/IO/Errors.hs --- a/src/HPath/IO/Errors.hs +++ b/src/HPath/IO/Errors.hs @@ -213,12 +213,13 @@ else return False +-- TODO: make this more robust when destination does not exist -- |Checks whether the destination directory is contained -- within the source directory by comparing the device+file ID of the -- source directory with all device+file IDs of the parent directories -- of the destination. throwDestinationInSource :: Path Abs -- ^ source dir - -> Path Abs -- ^ full destination, `dirname dest` + -> Path Abs -- ^ full destination, @dirname dest@ -- must exist -> IO () throwDestinationInSource source dest = do diff --git a/src/System/Posix/FD.hs b/src/System/Posix/FD.hs --- a/src/System/Posix/FD.hs +++ b/src/System/Posix/FD.hs @@ -60,13 +60,13 @@ -- |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 +-- 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. + -> 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 -> diff --git a/src/System/Posix/FilePath.hs b/src/System/Posix/FilePath.hs --- a/src/System/Posix/FilePath.hs +++ b/src/System/Posix/FilePath.hs @@ -12,6 +12,7 @@ -- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute! +{-# LANGUAGE CPP #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wall #-} @@ -19,7 +20,7 @@ module System.Posix.FilePath ( - -- * Separators + -- * Separator predicates pathSeparator , isPathSeparator , searchPathSeparator @@ -27,7 +28,11 @@ , extSeparator , isExtSeparator - -- * File extensions + -- * $PATH methods +, splitSearchPath +, getSearchPath + + -- * Extension functions , splitExtension , takeExtension , replaceExtension @@ -38,8 +43,9 @@ , splitExtensions , dropExtensions , takeExtensions +, stripExtension - -- * Filenames/Directory names + -- * Filename\/directory functions , splitFileName , takeFileName , replaceFileName @@ -48,29 +54,27 @@ , replaceBaseName , takeDirectory , replaceDirectory - - -- * Path combinators and splitters , combine , () , splitPath , joinPath , splitDirectories - -- * Path conversions -, normalise - - -- * Trailing path separator + -- * Trailing slash functions , hasTrailingPathSeparator , addTrailingPathSeparator , dropTrailingPathSeparator - -- * Queries + -- * File name manipulations +, normalise +, makeRelative +, equalFilePath , isRelative , isAbsolute , isValid +, makeValid , isFileName , hasParentDir -, equalFilePath , hiddenFile , module System.Posix.ByteString.FilePath @@ -78,15 +82,20 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import Data.String (fromString) import System.Posix.ByteString.FilePath +import qualified System.Posix.Env.ByteString as PE import Data.Maybe (isJust) import Data.Word8 - +#if !MIN_VERSION_bytestring(0,10,8) +import qualified Data.List as L +#endif import Control.Arrow (second) -- $setup -- >>> import Data.Char +-- >>> import Data.Maybe -- >>> import Test.QuickCheck -- >>> import Control.Applicative -- >>> import qualified Data.ByteString as BS @@ -96,39 +105,85 @@ -- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral + +------------------------ +-- Separator predicates + + -- | Path separator character pathSeparator :: Word8 pathSeparator = _slash + -- | Check if a character is the path separator -- -- prop> \n -> (_chr n == '/') == isPathSeparator n isPathSeparator :: Word8 -> Bool isPathSeparator = (== pathSeparator) + -- | Search path separator searchPathSeparator :: Word8 searchPathSeparator = _colon + -- | Check if a character is the search path separator -- -- prop> \n -> (_chr n == ':') == isSearchPathSeparator n isSearchPathSeparator :: Word8 -> Bool isSearchPathSeparator = (== searchPathSeparator) + -- | File extension separator extSeparator :: Word8 extSeparator = _period + -- | Check if a character is the file extension separator -- -- prop> \n -> (_chr n == '.') == isExtSeparator n isExtSeparator :: Word8 -> Bool isExtSeparator = (== extSeparator) + + ------------------------ --- extension stuff +-- $PATH methods + +-- | Take a ByteString, split it on the 'searchPathSeparator'. +-- Blank items are converted to @.@. +-- +-- Follows the recommendations in +-- +-- +-- >>> splitSearchPath "File1:File2:File3" +-- ["File1","File2","File3"] +-- >>> splitSearchPath "File1::File2:File3" +-- ["File1",".","File2","File3"] +-- >>> splitSearchPath "" +-- ["."] +splitSearchPath :: ByteString -> [RawFilePath] +splitSearchPath = f + where + f bs = let (pre, post) = BS.break isSearchPathSeparator bs + in if BS.null post + then g pre + else g pre ++ f (BS.tail post) + g x + | BS.null x = [BS.singleton _period] + | otherwise = [x] + + +-- | Get a list of 'RawFilePath's in the $PATH variable. +getSearchPath :: IO [RawFilePath] +getSearchPath = fmap (maybe [] splitSearchPath) (PE.getEnv $ fromString "PATH") + + + +------------------------ +-- Extension functions + -- | Split a 'RawFilePath' into a path+filename and extension -- -- >>> splitExtension "file.exe" @@ -147,6 +202,7 @@ (path,file) = splitFileNameRaw x (basename,fileExt) = BS.breakEnd isExtSeparator file + -- | Get the final extension from a 'RawFilePath' -- -- >>> takeExtension "file.exe" @@ -158,12 +214,14 @@ takeExtension :: RawFilePath -> ByteString takeExtension = snd . splitExtension + -- | Change a file's extension -- -- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path replaceExtension :: RawFilePath -> ByteString -> RawFilePath replaceExtension path ext = dropExtension path <.> ext + -- | Drop the final extension from a 'RawFilePath' -- -- >>> dropExtension "file.exe" @@ -175,6 +233,7 @@ dropExtension :: RawFilePath -> RawFilePath dropExtension = fst . splitExtension + -- | Add an extension to a 'RawFilePath' -- -- >>> addExtension "file" ".exe" @@ -190,10 +249,6 @@ | otherwise = BS.intercalate (BS.singleton extSeparator) [file, ext] --- | Operator version of 'addExtension' -(<.>) :: RawFilePath -> ByteString -> RawFilePath -(<.>) = addExtension - -- | Check if a 'RawFilePath' has an extension -- -- >>> hasExtension "file" @@ -205,7 +260,13 @@ hasExtension :: RawFilePath -> Bool hasExtension = isJust . BS.elemIndex extSeparator . takeFileName --- | Split a 'RawFilePath' on the first extension + +-- | Operator version of 'addExtension' +(<.>) :: RawFilePath -> ByteString -> RawFilePath +(<.>) = addExtension + + +-- | Split a 'RawFilePath' on the first extension. -- -- >>> splitExtensions "/path/file.tar.gz" -- ("/path/file",".tar.gz") @@ -219,6 +280,7 @@ (path,file) = splitFileNameRaw x (basename,fileExt) = BS.break isExtSeparator file + -- | Remove all extensions from a 'RawFilePath' -- -- >>> dropExtensions "/path/file.tar.gz" @@ -226,6 +288,7 @@ dropExtensions :: RawFilePath -> RawFilePath dropExtensions = fst . splitExtensions + -- | Take all extensions from a 'RawFilePath' -- -- >>> takeExtensions "/path/file.tar.gz" @@ -233,9 +296,49 @@ takeExtensions :: RawFilePath -> ByteString takeExtensions = snd . splitExtensions + +-- | Drop the given extension from a FilePath, and the @\".\"@ preceding it. +-- Returns 'Nothing' if the FilePath does not have the given extension, or +-- 'Just' and the part before the extension if it does. +-- +-- This function can be more predictable than 'dropExtensions', +-- especially if the filename might itself contain @.@ characters. +-- +-- >>> stripExtension "hs.o" "foo.x.hs.o" +-- Just "foo.x" +-- >>> stripExtension "hi.o" "foo.x.hs.o" +-- Nothing +-- >>> stripExtension ".c.d" "a.b.c.d" +-- Just "a.b" +-- >>> stripExtension ".c.d" "a.b..c.d" +-- Just "a.b." +-- >>> stripExtension "baz" "foo.bar" +-- Nothing +-- >>> stripExtension "bar" "foobar" +-- Nothing +-- +-- prop> \path -> stripExtension "" path == Just path +-- prop> \path -> dropExtension path == fromJust (stripExtension (takeExtension path) path) +-- prop> \path -> dropExtensions path == fromJust (stripExtension (takeExtensions path) path) +stripExtension :: ByteString -> RawFilePath -> Maybe RawFilePath +stripExtension bs path + | BS.null bs = Just path + | otherwise = stripSuffix' dotExt path + where + dotExt = if isExtSeparator $ BS.head bs + then bs + else extSeparator `BS.cons` bs +#if MIN_VERSION_bytestring(0,10,8) + stripSuffix' = BS.stripSuffix +#else + stripSuffix' xs ys = fmap (BS.pack . reverse) $ L.stripPrefix (reverse $ BS.unpack xs) (reverse $ BS.unpack ys) +#endif + + ------------------------ --- more stuff +-- Filename/directory functions + -- | Split a 'RawFilePath' into (path,file). 'combine' is the inverse -- -- >>> splitFileName "path/file.txt" @@ -264,12 +367,14 @@ takeFileName :: RawFilePath -> RawFilePath takeFileName = snd . splitFileName + -- | Change the file name -- -- prop> \path -> replaceFileName path (takeFileName path) == path replaceFileName :: RawFilePath -> ByteString -> RawFilePath replaceFileName x y = fst (splitFileNameRaw x) y + -- | Drop the file name -- -- >>> dropFileName "path/file.txt" @@ -279,6 +384,7 @@ dropFileName :: RawFilePath -> RawFilePath dropFileName = fst . splitFileName + -- | Get the file name, without a trailing extension -- -- >>> takeBaseName "path/file.tar.gz" @@ -288,6 +394,7 @@ takeBaseName :: RawFilePath -> ByteString takeBaseName = dropExtension . takeFileName + -- | Change the base name -- -- >>> replaceBaseName "path/file.tar.gz" "bob" @@ -300,6 +407,7 @@ (dir,file) = splitFileNameRaw path ext = takeExtension file + -- | Get the directory, moving up one level if it's already a directory -- -- >>> takeDirectory "path/file.txt" @@ -319,12 +427,14 @@ res = fst $ BS.spanEnd isPathSeparator file file = dropFileName x + -- | Change the directory component of a 'RawFilePath' -- -- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "." replaceDirectory :: RawFilePath -> ByteString -> RawFilePath replaceDirectory file dir = combineRaw dir (takeFileName file) + -- | Join two paths together -- -- >>> combine "/" "file" @@ -337,6 +447,7 @@ combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b | otherwise = combineRaw a b + -- | Operator version of combine () :: RawFilePath -> RawFilePath -> RawFilePath () = combine @@ -358,6 +469,17 @@ Nothing -> [x] Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) x + +-- | Join a split path back together +-- +-- prop> \path -> joinPath (splitPath path) == path +-- +-- >>> joinPath ["path","to","file.txt"] +-- "path/to/file.txt" +joinPath :: [RawFilePath] -> RawFilePath +joinPath = foldr () BS.empty + + -- | Like 'splitPath', but without trailing slashes -- -- >>> splitDirectories "/path/to/file.txt" @@ -373,16 +495,62 @@ where splitter = filter (not . BS.null) . BS.split pathSeparator --- | Join a split path back together + + +------------------------ +-- Trailing slash functions + +-- | Check if the last character of a 'RawFilePath' is '/'. -- --- prop> \path -> joinPath (splitPath path) == path +-- >>> hasTrailingPathSeparator "/path/" +-- True +-- >>> hasTrailingPathSeparator "/" +-- True +-- >>> hasTrailingPathSeparator "/path" +-- False +hasTrailingPathSeparator :: RawFilePath -> Bool +hasTrailingPathSeparator x + | BS.null x = False + | otherwise = isPathSeparator $ BS.last x + + +-- | Add a trailing path separator. -- --- >>> joinPath ["path","to","file.txt"] --- "path/to/file.txt" -joinPath :: [RawFilePath] -> RawFilePath -joinPath = foldr () BS.empty +-- >>> addTrailingPathSeparator "/path" +-- "/path/" +-- >>> addTrailingPathSeparator "/path/" +-- "/path/" +-- >>> addTrailingPathSeparator "/" +-- "/" +addTrailingPathSeparator :: RawFilePath -> RawFilePath +addTrailingPathSeparator x = if hasTrailingPathSeparator x + then x + else x `BS.snoc` pathSeparator +-- | Remove a trailing path separator +-- +-- >>> dropTrailingPathSeparator "/path/" +-- "/path" +-- >>> dropTrailingPathSeparator "/path////" +-- "/path" +-- >>> dropTrailingPathSeparator "/" +-- "/" +-- >>> dropTrailingPathSeparator "//" +-- "/" +dropTrailingPathSeparator :: RawFilePath -> RawFilePath +dropTrailingPathSeparator x + | x == BS.singleton pathSeparator = x + | otherwise = if hasTrailingPathSeparator x + then dropTrailingPathSeparator $ BS.init x + else x + + + +------------------------ +-- File name manipulations + + -- |Normalise a file. -- -- >>> normalise "/file/\\test////" @@ -436,54 +604,80 @@ dropDots :: [ByteString] -> [ByteString] dropDots = filter (BS.singleton _period /=) ------------------------- --- trailing path separators --- | Check if the last character of a 'RawFilePath' is '/'. + +-- | Contract a filename, based on a relative path. Note that the resulting +-- path will never introduce @..@ paths, as the presence of symlinks +-- means @..\/b@ may not reach @a\/b@ if it starts from @a\/c@. For a +-- worked example see +-- . -- --- >>> hasTrailingPathSeparator "/path/" +-- >>> makeRelative "/directory" "/directory/file.ext" +-- "file.ext" +-- >>> makeRelative "/Home" "/home/bob" +-- "/home/bob" +-- >>> makeRelative "/home/" "/home/bob/foo/bar" +-- "bob/foo/bar" +-- >>> makeRelative "/fred" "bob" +-- "bob" +-- >>> makeRelative "/file/test" "/file/test/fred" +-- "fred" +-- >>> makeRelative "/file/test" "/file/test/fred/" +-- "fred/" +-- >>> makeRelative "some/path" "some/path/a/b/c" +-- "a/b/c" +-- +-- prop> \p -> makeRelative p p == "." +-- prop> \p -> makeRelative (takeDirectory p) p `equalFilePath` takeFileName p +-- prop \x y -> equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x +makeRelative :: RawFilePath -> RawFilePath -> RawFilePath +makeRelative root path + | equalFilePath root path = BS.singleton _period + | takeAbs root /= takeAbs path = path + | otherwise = f (dropAbs root) (dropAbs path) + where + f x y + | BS.null x = BS.dropWhile isPathSeparator y + | otherwise = let (x1,x2) = g x + (y1,y2) = g y + in if equalFilePath x1 y1 then f x2 y2 else path + g x = (BS.dropWhile isPathSeparator a, BS.dropWhile isPathSeparator b) + where (a, b) = BS.break isPathSeparator $ BS.dropWhile isPathSeparator x + dropAbs x = snd $ BS.span (== _slash) x + takeAbs x = fst $ BS.span (== _slash) x + + +-- |Equality of two filepaths. The filepaths are normalised +-- and trailing path separators are dropped. +-- +-- >>> equalFilePath "foo" "foo" -- True --- >>> hasTrailingPathSeparator "/" +-- >>> equalFilePath "foo" "foo/" -- True --- >>> hasTrailingPathSeparator "/path" +-- >>> equalFilePath "foo" "./foo" +-- True +-- >>> equalFilePath "" "" +-- True +-- >>> equalFilePath "foo" "/foo" -- False -hasTrailingPathSeparator :: RawFilePath -> Bool -hasTrailingPathSeparator x - | BS.null x = False - | otherwise = isPathSeparator $ BS.last x - --- | Add a trailing path separator. +-- >>> equalFilePath "foo" "FOO" +-- False +-- >>> equalFilePath "foo" "../foo" +-- False -- --- >>> addTrailingPathSeparator "/path" --- "/path/" --- >>> addTrailingPathSeparator "/path/" --- "/path/" --- >>> addTrailingPathSeparator "/" --- "/" -addTrailingPathSeparator :: RawFilePath -> RawFilePath -addTrailingPathSeparator x = if hasTrailingPathSeparator x - then x - else x `BS.snoc` pathSeparator +-- prop> \p -> equalFilePath p p +equalFilePath :: RawFilePath -> RawFilePath -> Bool +equalFilePath p1 p2 = f p1 == f p2 + where + f x = dropTrailingPathSeparator $ normalise x --- | Remove a trailing path separator + +-- | Check if a path is relative -- --- >>> dropTrailingPathSeparator "/path/" --- "/path" --- >>> dropTrailingPathSeparator "/path////" --- "/path" --- >>> dropTrailingPathSeparator "/" --- "/" --- >>> dropTrailingPathSeparator "//" --- "/" -dropTrailingPathSeparator :: RawFilePath -> RawFilePath -dropTrailingPathSeparator x - | x == BS.singleton pathSeparator = x - | otherwise = if hasTrailingPathSeparator x - then dropTrailingPathSeparator $ BS.init x - else x +-- prop> \path -> isRelative path /= isAbsolute path +isRelative :: RawFilePath -> Bool +isRelative = not . isAbsolute ------------------------- --- Filename/system stuff -- | Check if a path is absolute -- @@ -498,11 +692,6 @@ | BS.length x > 0 = isPathSeparator (BS.head x) | otherwise = False --- | Check if a path is relative --- --- prop> \path -> isRelative path /= isAbsolute path -isRelative :: RawFilePath -> Bool -isRelative = not . isAbsolute -- | Is a FilePath valid, i.e. could you create a file like it? -- @@ -518,6 +707,22 @@ | _nul `BS.elem` filepath = False | otherwise = True + +-- | Take a FilePath and make it valid; does not change already valid FilePaths. +-- +-- >>> makeValid "" +-- "_" +-- >>> makeValid "file\0name" +-- "file_name" +-- +-- prop> \p -> if isValid p then makeValid p == p else makeValid p /= p +-- prop> \p -> isValid (makeValid p) +makeValid :: RawFilePath -> RawFilePath +makeValid path + | BS.null path = BS.singleton _underscore + | otherwise = BS.map (\x -> if x == _nul then _underscore else x) path + + -- | Is the given path a valid filename? This includes -- "." and "..". -- @@ -539,6 +744,7 @@ not (BS.null filepath) && not (_nul `BS.elem` filepath) + -- | Check if the filepath has any parent directories in it. -- -- >>> hasParentDir "/.." @@ -570,29 +776,7 @@ where pathDoubleDot = BS.pack [_period, _period] --- |Equality of two filepaths. The filepaths are normalised --- and trailing path separators are dropped. --- --- >>> equalFilePath "foo" "foo" --- True --- >>> equalFilePath "foo" "foo/" --- True --- >>> equalFilePath "foo" "./foo" --- True --- >>> equalFilePath "foo" "/foo" --- False --- >>> equalFilePath "foo" "FOO" --- False --- >>> equalFilePath "foo" "../foo" --- False --- --- prop> \p -> equalFilePath p p -equalFilePath :: RawFilePath -> RawFilePath -> Bool -equalFilePath p1 p2 = f p1 == f p2 - where - f x = dropTrailingPathSeparator $ normalise x - -- | Whether the file is a hidden file. -- -- >>> hiddenFile ".foo" @@ -619,6 +803,8 @@ `BS.isPrefixOf` fn where fn = takeFileName fp + + ------------------------ -- internal stuff