|
- {-# LANGUAGE TupleSections #-}
-
- {-# OPTIONS_GHC -Wall #-}
-
- -- | The equivalent of "System.FilePath" on raw (byte string) file paths.
- --
- -- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute!
- module System.Posix.FilePath (
-
- pathSeparator
- , isPathSeparator
- , searchPathSeparator
- , isSearchPathSeparator
- , extSeparator
- , isExtSeparator
-
- , splitExtension
- , takeExtension
- , replaceExtension
- , dropExtension
- , addExtension
- , hasExtension
- , (<.>)
- , splitExtensions
- , dropExtensions
- , takeExtensions
-
- , splitFileName
- , takeFileName
- , replaceFileName
- , dropFileName
- , takeBaseName
- , replaceBaseName
- , takeDirectory
- , replaceDirectory
- , combine
- , (</>)
- , splitPath
- , joinPath
- , normalise
- , splitDirectories
-
- , hasTrailingPathSeparator
- , addTrailingPathSeparator
- , dropTrailingPathSeparator
-
- , isRelative
- , isAbsolute
- , isValid
- , equalFilePath
-
- , module System.Posix.ByteString.FilePath
- ) where
-
- import Data.ByteString (ByteString)
- import qualified Data.ByteString as BS
- import System.Posix.ByteString.FilePath
-
- import Data.Maybe (isJust)
- import Data.Word8
-
- import Control.Arrow (second)
-
- -- $setup
- -- >>> import Data.Char
- -- >>> import Test.QuickCheck
- -- >>> import Control.Applicative
- -- >>> import qualified Data.ByteString as BS
- -- >>> import Data.ByteString (ByteString)
- -- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary
- -- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack
- --
- -- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral
-
-
- -- | 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
-
- -- | Split a 'RawFilePath' into a path+filename and extension
- --
- -- >>> splitExtension "file.exe"
- -- ("file",".exe")
- -- >>> splitExtension "file"
- -- ("file","")
- -- >>> splitExtension "/path/file.tar.gz"
- -- ("/path/file.tar",".gz")
- --
- -- prop> \path -> uncurry (BS.append) (splitExtension path) == path
- splitExtension :: RawFilePath -> (RawFilePath, ByteString)
- splitExtension x = if BS.null basename
- then (x,BS.empty)
- else (BS.append path (BS.init basename),BS.cons extSeparator fileExt)
- where
- (path,file) = splitFileNameRaw x
- (basename,fileExt) = BS.breakEnd isExtSeparator file
-
- -- | Get the final extension from a 'RawFilePath'
- --
- -- >>> takeExtension "file.exe"
- -- ".exe"
- -- >>> takeExtension "file"
- -- ""
- -- >>> takeExtension "/path/file.tar.gz"
- -- ".gz"
- 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"
- -- "file"
- -- >>> dropExtension "file"
- -- "file"
- -- >>> dropExtension "/path/file.tar.gz"
- -- "/path/file.tar"
- dropExtension :: RawFilePath -> RawFilePath
- dropExtension = fst . splitExtension
-
- -- | Add an extension to a 'RawFilePath'
- --
- -- >>> addExtension "file" ".exe"
- -- "file.exe"
- -- >>> addExtension "file.tar" ".gz"
- -- "file.tar.gz"
- -- >>> addExtension "/path/" ".ext"
- -- "/path/.ext"
- addExtension :: RawFilePath -> ByteString -> RawFilePath
- addExtension file ext
- | BS.null ext = file
- | isExtSeparator (BS.head ext) = BS.append 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
- --
- -- >>> hasExtension "file"
- -- False
- -- >>> hasExtension "file.tar"
- -- True
- -- >>> hasExtension "/path.part1/"
- -- False
- hasExtension :: RawFilePath -> Bool
- hasExtension = isJust . BS.elemIndex extSeparator . takeFileName
-
- -- | Split a 'RawFilePath' on the first extension
- --
- -- >>> splitExtensions "/path/file.tar.gz"
- -- ("/path/file",".tar.gz")
- --
- -- prop> \path -> uncurry addExtension (splitExtensions path) == path
- splitExtensions :: RawFilePath -> (RawFilePath, ByteString)
- splitExtensions x = if BS.null basename
- then (path,fileExt)
- else (BS.append path basename,fileExt)
- where
- (path,file) = splitFileNameRaw x
- (basename,fileExt) = BS.break isExtSeparator file
-
- -- | Remove all extensions from a 'RawFilePath'
- --
- -- >>> dropExtensions "/path/file.tar.gz"
- -- "/path/file"
- dropExtensions :: RawFilePath -> RawFilePath
- dropExtensions = fst . splitExtensions
-
- -- | Take all extensions from a 'RawFilePath'
- --
- -- >>> takeExtensions "/path/file.tar.gz"
- -- ".tar.gz"
- takeExtensions :: RawFilePath -> ByteString
- takeExtensions = snd . splitExtensions
-
- ------------------------
- -- more stuff
-
- -- | Split a 'RawFilePath' into (path,file). 'combine' is the inverse
- --
- -- >>> splitFileName "path/file.txt"
- -- ("path/","file.txt")
- -- >>> splitFileName "path/"
- -- ("path/","")
- -- >>> splitFileName "file.txt"
- -- ("./","file.txt")
- --
- -- prop> \path -> uncurry combine (splitFileName path) == path || fst (splitFileName path) == "./"
- splitFileName :: RawFilePath -> (RawFilePath, RawFilePath)
- splitFileName x = if BS.null path
- then (dotSlash, file)
- else (path,file)
- where
- (path,file) = splitFileNameRaw x
- dotSlash = _period `BS.cons` (BS.singleton pathSeparator)
-
-
- -- | Get the file name
- --
- -- >>> takeFileName "path/file.txt"
- -- "file.txt"
- -- >>> takeFileName "path/"
- -- ""
- 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"
- -- "path/"
- -- >>> dropFileName "file.txt"
- -- "./"
- dropFileName :: RawFilePath -> RawFilePath
- dropFileName = fst . splitFileName
-
- -- | Get the file name, without a trailing extension
- --
- -- >>> takeBaseName "path/file.tar.gz"
- -- "file.tar"
- -- >>> takeBaseName ""
- -- ""
- takeBaseName :: RawFilePath -> ByteString
- takeBaseName = dropExtension . takeFileName
-
- -- | Change the base name
- --
- -- >>> replaceBaseName "path/file.tar.gz" "bob"
- -- "path/bob.gz"
- --
- -- prop> \path -> replaceBaseName path (takeBaseName path) == path
- replaceBaseName :: RawFilePath -> ByteString -> RawFilePath
- replaceBaseName path name = combineRaw dir (name <.> ext)
- where
- (dir,file) = splitFileNameRaw path
- ext = takeExtension file
-
- -- | Get the directory, moving up one level if it's already a directory
- --
- -- >>> takeDirectory "path/file.txt"
- -- "path"
- -- >>> takeDirectory "file"
- -- "."
- -- >>> takeDirectory "/path/to/"
- -- "/path/to"
- -- >>> takeDirectory "/path/to"
- -- "/path"
- takeDirectory :: RawFilePath -> RawFilePath
- takeDirectory x = case () of
- () | x == BS.singleton pathSeparator -> x
- | BS.null res && not (BS.null file) -> file
- | otherwise -> res
- where
- 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"
- -- "/file"
- -- >>> combine "/path/to" "file"
- -- "/path/to/file"
- -- >>> combine "file" "/absolute/path"
- -- "/absolute/path"
- combine :: RawFilePath -> RawFilePath -> RawFilePath
- combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b
- | otherwise = combineRaw a b
-
- -- | Operator version of combine
- (</>) :: RawFilePath -> RawFilePath -> RawFilePath
- (</>) = combine
-
- -- | Split a path into a list of components:
- --
- -- >>> splitPath "/path/to/file.txt"
- -- ["/","path/","to/","file.txt"]
- --
- -- prop> \path -> BS.concat (splitPath path) == path
- splitPath :: RawFilePath -> [RawFilePath]
- splitPath = splitter
- where
- splitter x
- | BS.null x = []
- | otherwise = case BS.elemIndex pathSeparator x of
- Nothing -> [x]
- Just ix -> case BS.findIndex (not . isPathSeparator) $ BS.drop (ix+1) x of
- Nothing -> [x]
- Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) x
-
- -- | Like 'splitPath', but without trailing slashes
- --
- -- >>> splitDirectories "/path/to/file.txt"
- -- ["/","path","to","file.txt"]
- -- >>> splitDirectories ""
- -- []
- splitDirectories :: RawFilePath -> [RawFilePath]
- splitDirectories x
- | BS.null x = []
- | isPathSeparator (BS.head x) = let (root,rest) = BS.splitAt 1 x
- in root : splitter rest
- | otherwise = splitter x
- where
- splitter = filter (not . BS.null) . BS.split pathSeparator
-
- -- | 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
-
-
- -- |Normalise a file.
- --
- -- >>> normalise "/file/\\test////"
- -- "/file/\\test/"
- -- >>> normalise "/file/./test"
- -- "/file/test"
- -- >>> normalise "/test/file/../bob/fred/"
- -- "/test/file/../bob/fred/"
- -- >>> normalise "../bob/fred/"
- -- "../bob/fred/"
- -- >>> normalise "./bob/fred/"
- -- "bob/fred/"
- -- >>> normalise "./bob////.fred/./...///./..///#."
- -- "bob/.fred/.../../#."
- -- >>> normalise "."
- -- "."
- -- >>> normalise "./"
- -- "./"
- -- >>> normalise "./."
- -- "./"
- -- >>> normalise "/./"
- -- "/"
- -- >>> normalise "/"
- -- "/"
- -- >>> normalise "bob/fred/."
- -- "bob/fred/"
- -- >>> normalise "//home"
- -- "/home"
- normalise :: RawFilePath -> RawFilePath
- normalise filepath =
- result `BS.append`
- (if addPathSeparator
- then BS.singleton pathSeparator
- else BS.empty)
- where
- result = let n = f filepath
- in if BS.null n
- then BS.singleton _period
- else n
- addPathSeparator = isDirPath filepath &&
- not (hasTrailingPathSeparator result)
- isDirPath xs = hasTrailingPathSeparator xs
- || not (BS.null xs) && BS.last xs == _period
- && hasTrailingPathSeparator (BS.init xs)
- f = joinPath . dropDots . propSep . splitDirectories
- propSep :: [ByteString] -> [ByteString]
- propSep (x:xs)
- | BS.all (== pathSeparator) x = BS.singleton pathSeparator : xs
- | otherwise = x : xs
- propSep [] = []
- dropDots :: [ByteString] -> [ByteString]
- dropDots = filter (BS.singleton _period /=)
-
-
- ------------------------
- -- trailing path separators
-
- -- | Check if the last character of a 'RawFilePath' is '/'.
- --
- -- >>> 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.
- --
- -- >>> 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
-
- ------------------------
- -- Filename/system stuff
-
- -- | Check if a path is absolute
- --
- -- >>> isAbsolute "/path"
- -- True
- -- >>> isAbsolute "path"
- -- False
- -- >>> isAbsolute ""
- -- False
- isAbsolute :: RawFilePath -> Bool
- isAbsolute x
- | 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?
- --
- -- >>> isValid ""
- -- False
- -- >>> isValid "\0"
- -- False
- -- >>> isValid "/random_ path:*"
- -- True
- isValid :: RawFilePath -> Bool
- isValid filepath
- | BS.null filepath = False
- | _nul `BS.elem` filepath = False
- | otherwise = True
-
- -- |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
-
- ------------------------
- -- internal stuff
-
- -- Just split the input FileName without adding/normalizing or changing
- -- anything.
- splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath)
- splitFileNameRaw x = BS.breakEnd isPathSeparator x
-
- -- | Combine two paths, assuming rhs is NOT absolute.
- combineRaw :: RawFilePath -> RawFilePath -> RawFilePath
- combineRaw a b | BS.null a = b
- | BS.null b = a
- | isPathSeparator (BS.last a) = BS.append a b
- | otherwise = BS.intercalate (BS.singleton pathSeparator) [a, b]
|