hpath 0.7.0 → 0.7.1

raw patch · 8 files changed

+348/−150 lines, 8 filesdep ~simple-sendfilePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: simple-sendfile

API changes (from Hackage documentation)

Files

• CHANGELOG +3/−0
• README.md +16/−5
• hpath.cabal +2/−2
• src/HPath.hs +38/−38
• src/HPath/IO.hs +8/−11
• src/HPath/IO/Errors.hs +2/−1
• src/System/Posix/FD.hs +2/−2
• src/System/Posix/FilePath.hs +277/−91

@@ -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

@@ -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 

@@ -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

@@ -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)

@@ -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)

@@ -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

@@ -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 ->

@@ -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+-- <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>+--+-- >>> 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+-- <http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html this blog post>. ----- >>> 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