13 Commits
0.7.0 ... 0.7.1

Author SHA1 Message Date
08fa277b31 Release 0.7.1 2016-05-24 15:36:34 +02:00
51609781b2 Add makeRelative and makeValid 2016-05-24 15:31:14 +02:00
3cb3a822d7 Add test to equalFilePath 2016-05-24 15:30:56 +02:00
7fa4c041a9 Remove -Wno-redundant-constraints since it's only in ghc >= 8.0.1 2016-05-24 03:31:01 +02:00
e66074af1c Fix stripSuffix' for bytestring < 0.10.8 2016-05-24 03:29:40 +02:00
4032629407 Add TODO 2016-05-24 03:26:07 +02:00
f2fe5a3419 Hide wrong -Wredundant-constraints messages 2016-05-24 03:26:07 +02:00
5ac7450495 Small import fix 2016-05-24 03:26:07 +02:00
b55cf6d9f3 Fix for bytestring versions less than 0.10.8 2016-05-24 03:26:01 +02:00
ae9a806c2e Fix to latest sendfile version to simplify imports 2016-05-24 03:13:36 +02:00
9c199c6da2 Rearrange, prettify and improve haddock
This also matches the documentation order from the
filepath package more.
2016-05-24 02:16:16 +02:00
eb72fce33f Add splitSearchPath, getSearchPath and stripExtension 2016-05-24 02:07:04 +02:00
65bb09d133 Update README 2016-05-23 13:52:34 +02:00
7 changed files with 300 additions and 102 deletions

View File

@@ -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: 0.7.0:
* use 'sendfile' from 'simple-sendfile' in _copyFile and do read/write as a fallback only * use 'sendfile' from 'simple-sendfile' in _copyFile and do read/write as a fallback only
* add isFileName, hasParentDir, hiddenFile to System.Posix.FilePath * add isFileName, hasParentDir, hiddenFile to System.Posix.FilePath

View File

@@ -43,9 +43,20 @@ so it is forked as well and merged into this library.
## Differences to 'posix-paths' ## 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` * 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

View File

@@ -1,5 +1,5 @@
name: hpath name: hpath
version: 0.7.0 version: 0.7.1
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
@@ -36,7 +36,7 @@ library
, deepseq , deepseq
, exceptions , exceptions
, hspec , hspec
, simple-sendfile >= 0.2.22 , simple-sendfile >= 0.2.24
, unix >= 2.5 , unix >= 2.5
, unix-bytestring , unix-bytestring
, utf8-string , utf8-string

View File

@@ -54,10 +54,10 @@ import Control.Monad.Catch (MonadThrow(..))
import Data.ByteString(ByteString, stripPrefix) import Data.ByteString(ByteString, stripPrefix)
#else #else
import Data.ByteString(ByteString) import Data.ByteString(ByteString)
import qualified Data.List as L
#endif #endif
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.Data import Data.Data
import qualified Data.List as L
import Data.Maybe import Data.Maybe
import Data.Word8 import Data.Word8
import HPath.Internal import HPath.Internal

View File

@@ -140,10 +140,7 @@ import System.IO.Error
import System.Linux.Sendfile import System.Linux.Sendfile
( (
sendfileFd sendfileFd
) , FileRange(..)
import Network.Sendfile
(
FileRange(..)
) )
import System.Posix.ByteString import System.Posix.ByteString
( (

View File

@@ -213,6 +213,7 @@ sameFile fp1 fp2 =
else return False else return False
-- TODO: make this more robust when destination does not exist
-- |Checks whether the destination directory is contained -- |Checks whether the destination directory is contained
-- within the source directory by comparing the device+file ID of the -- within the source directory by comparing the device+file ID of the
-- source directory with all device+file IDs of the parent directories -- source directory with all device+file IDs of the parent directories

View File

@@ -12,6 +12,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 CPP #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Wall #-}
@@ -19,7 +20,7 @@
module System.Posix.FilePath ( module System.Posix.FilePath (
-- * Separators -- * Separator predicates
pathSeparator pathSeparator
, isPathSeparator , isPathSeparator
, searchPathSeparator , searchPathSeparator
@@ -27,7 +28,11 @@ module System.Posix.FilePath (
, extSeparator , extSeparator
, isExtSeparator , isExtSeparator
-- * File extensions -- * $PATH methods
, splitSearchPath
, getSearchPath
-- * Extension functions
, splitExtension , splitExtension
, takeExtension , takeExtension
, replaceExtension , replaceExtension
@@ -38,8 +43,9 @@ module System.Posix.FilePath (
, splitExtensions , splitExtensions
, dropExtensions , dropExtensions
, takeExtensions , takeExtensions
, stripExtension
-- * Filenames/Directory names -- * Filename\/directory functions
, splitFileName , splitFileName
, takeFileName , takeFileName
, replaceFileName , replaceFileName
@@ -48,29 +54,27 @@ module System.Posix.FilePath (
, replaceBaseName , replaceBaseName
, takeDirectory , takeDirectory
, replaceDirectory , replaceDirectory
-- * Path combinators and splitters
, combine , combine
, (</>) , (</>)
, splitPath , splitPath
, joinPath , joinPath
, splitDirectories , splitDirectories
-- * Path conversions -- * Trailing slash functions
, normalise
-- * Trailing path separator
, hasTrailingPathSeparator , hasTrailingPathSeparator
, addTrailingPathSeparator , addTrailingPathSeparator
, dropTrailingPathSeparator , dropTrailingPathSeparator
-- * Queries -- * File name manipulations
, normalise
, makeRelative
, equalFilePath
, isRelative , isRelative
, isAbsolute , isAbsolute
, isValid , isValid
, makeValid
, isFileName , isFileName
, hasParentDir , hasParentDir
, equalFilePath
, hiddenFile , hiddenFile
, module System.Posix.ByteString.FilePath , module System.Posix.ByteString.FilePath
@@ -78,15 +82,20 @@ module System.Posix.FilePath (
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.String (fromString)
import System.Posix.ByteString.FilePath import System.Posix.ByteString.FilePath
import qualified System.Posix.Env.ByteString as PE
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Data.Word8 import Data.Word8
#if !MIN_VERSION_bytestring(0,10,8)
import qualified Data.List as L
#endif
import Control.Arrow (second) import Control.Arrow (second)
-- $setup -- $setup
-- >>> import Data.Char -- >>> import Data.Char
-- >>> import Data.Maybe
-- >>> import Test.QuickCheck -- >>> import Test.QuickCheck
-- >>> import Control.Applicative -- >>> import Control.Applicative
-- >>> import qualified Data.ByteString as BS -- >>> import qualified Data.ByteString as BS
@@ -96,38 +105,84 @@ import Control.Arrow (second)
-- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral -- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral
------------------------
-- Separator predicates
-- | Path separator character -- | Path separator character
pathSeparator :: Word8 pathSeparator :: Word8
pathSeparator = _slash pathSeparator = _slash
-- | Check if a character is the path separator -- | Check if a character is the path separator
-- --
-- prop> \n -> (_chr n == '/') == isPathSeparator n -- prop> \n -> (_chr n == '/') == isPathSeparator n
isPathSeparator :: Word8 -> Bool isPathSeparator :: Word8 -> Bool
isPathSeparator = (== pathSeparator) isPathSeparator = (== pathSeparator)
-- | Search path separator -- | Search path separator
searchPathSeparator :: Word8 searchPathSeparator :: Word8
searchPathSeparator = _colon searchPathSeparator = _colon
-- | Check if a character is the search path separator -- | Check if a character is the search path separator
-- --
-- prop> \n -> (_chr n == ':') == isSearchPathSeparator n -- prop> \n -> (_chr n == ':') == isSearchPathSeparator n
isSearchPathSeparator :: Word8 -> Bool isSearchPathSeparator :: Word8 -> Bool
isSearchPathSeparator = (== searchPathSeparator) isSearchPathSeparator = (== searchPathSeparator)
-- | File extension separator -- | File extension separator
extSeparator :: Word8 extSeparator :: Word8
extSeparator = _period extSeparator = _period
-- | Check if a character is the file extension separator -- | Check if a character is the file extension separator
-- --
-- prop> \n -> (_chr n == '.') == isExtSeparator n -- prop> \n -> (_chr n == '.') == isExtSeparator n
isExtSeparator :: Word8 -> Bool isExtSeparator :: Word8 -> Bool
isExtSeparator = (== extSeparator) 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 -- | Split a 'RawFilePath' into a path+filename and extension
-- --
@@ -147,6 +202,7 @@ splitExtension x = if BS.null basename
(path,file) = splitFileNameRaw x (path,file) = splitFileNameRaw x
(basename,fileExt) = BS.breakEnd isExtSeparator file (basename,fileExt) = BS.breakEnd isExtSeparator file
-- | Get the final extension from a 'RawFilePath' -- | Get the final extension from a 'RawFilePath'
-- --
-- >>> takeExtension "file.exe" -- >>> takeExtension "file.exe"
@@ -158,12 +214,14 @@ splitExtension x = if BS.null basename
takeExtension :: RawFilePath -> ByteString takeExtension :: RawFilePath -> ByteString
takeExtension = snd . splitExtension takeExtension = snd . splitExtension
-- | Change a file's extension -- | Change a file's extension
-- --
-- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path -- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path
replaceExtension :: RawFilePath -> ByteString -> RawFilePath replaceExtension :: RawFilePath -> ByteString -> RawFilePath
replaceExtension path ext = dropExtension path <.> ext replaceExtension path ext = dropExtension path <.> ext
-- | Drop the final extension from a 'RawFilePath' -- | Drop the final extension from a 'RawFilePath'
-- --
-- >>> dropExtension "file.exe" -- >>> dropExtension "file.exe"
@@ -175,6 +233,7 @@ replaceExtension path ext = dropExtension path <.> ext
dropExtension :: RawFilePath -> RawFilePath dropExtension :: RawFilePath -> RawFilePath
dropExtension = fst . splitExtension dropExtension = fst . splitExtension
-- | Add an extension to a 'RawFilePath' -- | Add an extension to a 'RawFilePath'
-- --
-- >>> addExtension "file" ".exe" -- >>> addExtension "file" ".exe"
@@ -190,10 +249,6 @@ addExtension file ext
| otherwise = BS.intercalate (BS.singleton extSeparator) [file, ext] | otherwise = BS.intercalate (BS.singleton extSeparator) [file, ext]
-- | Operator version of 'addExtension'
(<.>) :: RawFilePath -> ByteString -> RawFilePath
(<.>) = addExtension
-- | Check if a 'RawFilePath' has an extension -- | Check if a 'RawFilePath' has an extension
-- --
-- >>> hasExtension "file" -- >>> hasExtension "file"
@@ -205,7 +260,13 @@ addExtension file ext
hasExtension :: RawFilePath -> Bool hasExtension :: RawFilePath -> Bool
hasExtension = isJust . BS.elemIndex extSeparator . takeFileName 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" -- >>> splitExtensions "/path/file.tar.gz"
-- ("/path/file",".tar.gz") -- ("/path/file",".tar.gz")
@@ -219,6 +280,7 @@ splitExtensions x = if BS.null basename
(path,file) = splitFileNameRaw x (path,file) = splitFileNameRaw x
(basename,fileExt) = BS.break isExtSeparator file (basename,fileExt) = BS.break isExtSeparator file
-- | Remove all extensions from a 'RawFilePath' -- | Remove all extensions from a 'RawFilePath'
-- --
-- >>> dropExtensions "/path/file.tar.gz" -- >>> dropExtensions "/path/file.tar.gz"
@@ -226,6 +288,7 @@ splitExtensions x = if BS.null basename
dropExtensions :: RawFilePath -> RawFilePath dropExtensions :: RawFilePath -> RawFilePath
dropExtensions = fst . splitExtensions dropExtensions = fst . splitExtensions
-- | Take all extensions from a 'RawFilePath' -- | Take all extensions from a 'RawFilePath'
-- --
-- >>> takeExtensions "/path/file.tar.gz" -- >>> takeExtensions "/path/file.tar.gz"
@@ -233,8 +296,48 @@ dropExtensions = fst . splitExtensions
takeExtensions :: RawFilePath -> ByteString takeExtensions :: RawFilePath -> ByteString
takeExtensions = snd . splitExtensions 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 -- | Split a 'RawFilePath' into (path,file). 'combine' is the inverse
-- --
@@ -264,12 +367,14 @@ splitFileName x = if BS.null path
takeFileName :: RawFilePath -> RawFilePath takeFileName :: RawFilePath -> RawFilePath
takeFileName = snd . splitFileName takeFileName = snd . splitFileName
-- | Change the file name -- | Change the file name
-- --
-- prop> \path -> replaceFileName path (takeFileName path) == path -- prop> \path -> replaceFileName path (takeFileName path) == path
replaceFileName :: RawFilePath -> ByteString -> RawFilePath replaceFileName :: RawFilePath -> ByteString -> RawFilePath
replaceFileName x y = fst (splitFileNameRaw x) </> y replaceFileName x y = fst (splitFileNameRaw x) </> y
-- | Drop the file name -- | Drop the file name
-- --
-- >>> dropFileName "path/file.txt" -- >>> dropFileName "path/file.txt"
@@ -279,6 +384,7 @@ replaceFileName x y = fst (splitFileNameRaw x) </> y
dropFileName :: RawFilePath -> RawFilePath dropFileName :: RawFilePath -> RawFilePath
dropFileName = fst . splitFileName dropFileName = fst . splitFileName
-- | Get the file name, without a trailing extension -- | Get the file name, without a trailing extension
-- --
-- >>> takeBaseName "path/file.tar.gz" -- >>> takeBaseName "path/file.tar.gz"
@@ -288,6 +394,7 @@ dropFileName = fst . splitFileName
takeBaseName :: RawFilePath -> ByteString takeBaseName :: RawFilePath -> ByteString
takeBaseName = dropExtension . takeFileName takeBaseName = dropExtension . takeFileName
-- | Change the base name -- | Change the base name
-- --
-- >>> replaceBaseName "path/file.tar.gz" "bob" -- >>> replaceBaseName "path/file.tar.gz" "bob"
@@ -300,6 +407,7 @@ replaceBaseName path name = combineRaw dir (name <.> ext)
(dir,file) = splitFileNameRaw path (dir,file) = splitFileNameRaw path
ext = takeExtension file ext = takeExtension file
-- | Get the directory, moving up one level if it's already a directory -- | Get the directory, moving up one level if it's already a directory
-- --
-- >>> takeDirectory "path/file.txt" -- >>> takeDirectory "path/file.txt"
@@ -319,12 +427,14 @@ takeDirectory x = case () of
res = fst $ BS.spanEnd isPathSeparator file res = fst $ BS.spanEnd isPathSeparator file
file = dropFileName x file = dropFileName x
-- | Change the directory component of a 'RawFilePath' -- | Change the directory component of a 'RawFilePath'
-- --
-- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "." -- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "."
replaceDirectory :: RawFilePath -> ByteString -> RawFilePath replaceDirectory :: RawFilePath -> ByteString -> RawFilePath
replaceDirectory file dir = combineRaw dir (takeFileName file) replaceDirectory file dir = combineRaw dir (takeFileName file)
-- | Join two paths together -- | Join two paths together
-- --
-- >>> combine "/" "file" -- >>> combine "/" "file"
@@ -337,6 +447,7 @@ combine :: RawFilePath -> RawFilePath -> RawFilePath
combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b
| otherwise = combineRaw a b | otherwise = combineRaw a b
-- | Operator version of combine -- | Operator version of combine
(</>) :: RawFilePath -> RawFilePath -> RawFilePath (</>) :: RawFilePath -> RawFilePath -> RawFilePath
(</>) = combine (</>) = combine
@@ -358,6 +469,17 @@ splitPath = splitter
Nothing -> [x] Nothing -> [x]
Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) 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 -- | Like 'splitPath', but without trailing slashes
-- --
-- >>> splitDirectories "/path/to/file.txt" -- >>> splitDirectories "/path/to/file.txt"
@@ -373,14 +495,60 @@ splitDirectories x
where where
splitter = filter (not . BS.null) . BS.split pathSeparator 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"] -- >>> addTrailingPathSeparator "/path"
-- "path/to/file.txt" -- "/path/"
joinPath :: [RawFilePath] -> RawFilePath -- >>> addTrailingPathSeparator "/path/"
joinPath = foldr (</>) BS.empty -- "/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 a file.
@@ -436,54 +604,80 @@ normalise filepath =
dropDots :: [ByteString] -> [ByteString] dropDots :: [ByteString] -> [ByteString]
dropDots = filter (BS.singleton _period /=) 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 -- True
-- >>> hasTrailingPathSeparator "/" -- >>> equalFilePath "foo" "foo/"
-- True -- True
-- >>> hasTrailingPathSeparator "/path" -- >>> equalFilePath "foo" "./foo"
-- True
-- >>> equalFilePath "" ""
-- True
-- >>> equalFilePath "foo" "/foo"
-- False
-- >>> equalFilePath "foo" "FOO"
-- False
-- >>> equalFilePath "foo" "../foo"
-- False -- False
hasTrailingPathSeparator :: RawFilePath -> Bool
hasTrailingPathSeparator x
| BS.null x = False
| otherwise = isPathSeparator $ BS.last x
-- | Add a trailing path separator.
-- --
-- >>> addTrailingPathSeparator "/path" -- prop> \p -> equalFilePath p p
-- "/path/" equalFilePath :: RawFilePath -> RawFilePath -> Bool
-- >>> addTrailingPathSeparator "/path/" equalFilePath p1 p2 = f p1 == f p2
-- "/path/" where
-- >>> addTrailingPathSeparator "/" f x = dropTrailingPathSeparator $ normalise x
-- "/"
addTrailingPathSeparator :: RawFilePath -> RawFilePath
addTrailingPathSeparator x = if hasTrailingPathSeparator x
then x
else x `BS.snoc` pathSeparator
-- | Remove a trailing path separator
-- | Check if a path is relative
-- --
-- >>> dropTrailingPathSeparator "/path/" -- prop> \path -> isRelative path /= isAbsolute path
-- "/path" isRelative :: RawFilePath -> Bool
-- >>> dropTrailingPathSeparator "/path////" isRelative = not . isAbsolute
-- "/path"
-- >>> dropTrailingPathSeparator "/"
-- "/"
-- >>> dropTrailingPathSeparator "//"
-- "/"
dropTrailingPathSeparator :: RawFilePath -> RawFilePath
dropTrailingPathSeparator x
| x == BS.singleton pathSeparator = x
| otherwise = if hasTrailingPathSeparator x
then dropTrailingPathSeparator $ BS.init x
else x
------------------------
-- Filename/system stuff
-- | Check if a path is absolute -- | Check if a path is absolute
-- --
@@ -498,11 +692,6 @@ isAbsolute x
| BS.length x > 0 = isPathSeparator (BS.head x) | BS.length x > 0 = isPathSeparator (BS.head x)
| otherwise = False | 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? -- | Is a FilePath valid, i.e. could you create a file like it?
-- --
@@ -518,6 +707,22 @@ isValid filepath
| _nul `BS.elem` filepath = False | _nul `BS.elem` filepath = False
| otherwise = True | 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 -- | Is the given path a valid filename? This includes
-- "." and "..". -- "." and "..".
-- --
@@ -539,6 +744,7 @@ isFileName filepath =
not (BS.null filepath) && not (BS.null filepath) &&
not (_nul `BS.elem` filepath) not (_nul `BS.elem` filepath)
-- | Check if the filepath has any parent directories in it. -- | Check if the filepath has any parent directories in it.
-- --
-- >>> hasParentDir "/.." -- >>> hasParentDir "/.."
@@ -570,28 +776,6 @@ hasParentDir filepath =
where where
pathDoubleDot = BS.pack [_period, _period] 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. -- | Whether the file is a hidden file.
-- --
@@ -620,6 +804,8 @@ hiddenFile fp
where where
fn = takeFileName fp fn = takeFileName fp
------------------------ ------------------------
-- internal stuff -- internal stuff