diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for hpath-filepath + +## 0.9.3 -- 2020-01-04 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2020, Julian Ospald + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Julian Ospald nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,23 @@ +# HPath-filepath + +[![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-filepath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-filepath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath-filepath.svg)](http://packdeps.haskellers.com/feed?needle=hpath-filepath) + +Support for bytestring based filepath manipulation, similar to 'filepath'. + +## Motivation + +This is basically a fork of [posix-paths](https://github.com/JohnLato/posix-paths), which seemed to have stalled development. + +There is also a similar library [filepath-bytestring](https://hackage.haskell.org/package/filepath-bytestring), but it doesn't follow an open development model and is cross-platform, which this library is not interested in. + +## Differences to 'posix-paths' + +* uses the `word8` package for save word8 literals instead of `OverloadedStrings` +* `hasTrailingPathSeparator` and `dropTrailingPathSeparator` behave in the same way as their `System.FilePath` counterpart +* has some additional functions + +## Differences to 'filepath-bytestring' + +* uses the `word8` package for save word8 literals instead of `OverloadedStrings` +* is not cross-platform (less odd code to maintain) +* has some additional functions diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hpath-filepath.cabal b/hpath-filepath.cabal new file mode 100644 --- /dev/null +++ b/hpath-filepath.cabal @@ -0,0 +1,39 @@ +name: hpath-filepath +version: 0.10.0 +synopsis: ByteString based filepath manipulation +description: ByteString based filepath manipulation, similar to 'filepath' package. This is POSIX only. +-- bug-reports: +license: BSD3 +license-file: LICENSE +author: Julian Ospald +maintainer: Julian Ospald +copyright: Julian Ospald 2016 +category: Filesystem +build-type: Simple +cabal-version: 1.14 +tested-with: GHC==7.10.3 + , GHC==8.0.2 + , GHC==8.2.2 + , GHC==8.4.4 + , GHC==8.6.5 + , GHC==8.8.1 +extra-source-files: README.md + CHANGELOG.md + +library + if os(windows) + build-depends: unbuildable<0 + buildable: False + exposed-modules: System.Posix.FilePath + -- other-modules: + -- other-extensions: + build-depends: base >=4.8 && <5 + , bytestring >= 0.10.0.0 + , unix >= 2.5 + , word8 + hs-source-dirs: src + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/hasufell/hpath diff --git a/src/System/Posix/FilePath.hs b/src/System/Posix/FilePath.hs new file mode 100644 --- /dev/null +++ b/src/System/Posix/FilePath.hs @@ -0,0 +1,824 @@ +-- | +-- Module : System.Posix.FilePath +-- Copyright : © 2016 Julian Ospald +-- License : BSD3 +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- The equivalent of "System.FilePath" on raw (byte string) file paths. +-- +-- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute! + + +{-# LANGUAGE CPP #-} +{-# LANGUAGE TupleSections #-} + +{-# OPTIONS_GHC -Wall #-} + + +module System.Posix.FilePath ( + + -- * Separator predicates + pathSeparator +, isPathSeparator +, searchPathSeparator +, isSearchPathSeparator +, extSeparator +, isExtSeparator + + -- * $PATH methods +, splitSearchPath +, getSearchPath + + -- * Extension functions +, splitExtension +, takeExtension +, replaceExtension +, dropExtension +, addExtension +, hasExtension +, (<.>) +, splitExtensions +, dropExtensions +, takeExtensions +, stripExtension + + -- * Filename\/directory functions +, splitFileName +, takeFileName +, replaceFileName +, dropFileName +, takeBaseName +, replaceBaseName +, takeDirectory +, replaceDirectory +, combine +, () +, splitPath +, joinPath +, splitDirectories + + -- * Trailing slash functions +, hasTrailingPathSeparator +, addTrailingPathSeparator +, dropTrailingPathSeparator + + -- * File name manipulations +, normalise +, makeRelative +, equalFilePath +, isRelative +, isAbsolute +, isValid +, makeValid +, isFileName +, hasParentDir +, hiddenFile + +, module System.Posix.ByteString.FilePath +) where + +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 Data.Word8 +-- >>> import Test.QuickCheck +-- >>> import Control.Applicative +-- >>> import qualified Data.ByteString as BS +-- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary +-- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack +-- +-- >>> 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) + + + +------------------------ +-- $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" +-- ("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] + + +-- | 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 + + +-- | Operator version of 'addExtension' +(<.>) :: RawFilePath -> ByteString -> RawFilePath +(<.>) = addExtension + + +-- | 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 + + +-- | 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 + + +------------------------ +-- Filename/directory functions + + +-- | 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 + + +-- | 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" +-- ["/","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 + + + +------------------------ +-- Trailing slash functions + +-- | 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 + + + +------------------------ +-- File name manipulations + + +-- |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 /=) + + + +-- | 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 +-- . +-- +-- >>> 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 +-- >>> equalFilePath "foo" "foo/" +-- True +-- >>> equalFilePath "foo" "./foo" +-- True +-- >>> equalFilePath "" "" +-- 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 + + +-- | Check if a path is relative +-- +-- prop> \path -> isRelative path /= isAbsolute path +isRelative :: RawFilePath -> Bool +isRelative = not . isAbsolute + + +-- | 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 + + +-- | 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 + + +-- | 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 "..". +-- +-- >>> isFileName "lal" +-- True +-- >>> isFileName "." +-- True +-- >>> isFileName ".." +-- True +-- >>> isFileName "" +-- False +-- >>> isFileName "\0" +-- False +-- >>> isFileName "/random_ path:*" +-- False +isFileName :: RawFilePath -> Bool +isFileName filepath = + not (BS.singleton pathSeparator `BS.isInfixOf` filepath) && + not (BS.null filepath) && + not (_nul `BS.elem` filepath) + + +-- | Check if the filepath has any parent directories in it. +-- +-- >>> hasParentDir "/.." +-- True +-- >>> hasParentDir "foo/bar/.." +-- True +-- >>> hasParentDir "foo/../bar/." +-- True +-- >>> hasParentDir "foo/bar" +-- False +-- >>> hasParentDir "foo" +-- False +-- >>> hasParentDir "" +-- False +-- >>> hasParentDir ".." +-- False +hasParentDir :: RawFilePath -> Bool +hasParentDir filepath = + (pathSeparator `BS.cons` pathDoubleDot) + `BS.isSuffixOf` filepath + || + (BS.singleton pathSeparator + `BS.append` pathDoubleDot + `BS.append` BS.singleton pathSeparator) + `BS.isInfixOf` filepath + || + (pathDoubleDot `BS.append` BS.singleton pathSeparator) + `BS.isPrefixOf` filepath + where + pathDoubleDot = BS.pack [_period, _period] + + +-- | Whether the file is a hidden file. +-- +-- >>> hiddenFile ".foo" +-- True +-- >>> hiddenFile "..foo.bar" +-- True +-- >>> hiddenFile "some/path/.bar" +-- True +-- >>> hiddenFile "..." +-- True +-- >>> hiddenFile "dod.bar" +-- False +-- >>> hiddenFile "." +-- False +-- >>> hiddenFile ".." +-- False +-- >>> hiddenFile "" +-- False +hiddenFile :: RawFilePath -> Bool +hiddenFile fp + | fn == BS.pack [_period, _period] = False + | fn == BS.pack [_period] = False + | otherwise = BS.pack [extSeparator] + `BS.isPrefixOf` fn + where + fn = takeFileName fp + + + +------------------------ +-- internal stuff + +-- Just split the input FileName without adding/normalizing or changing +-- anything. +splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath) +splitFileNameRaw = BS.breakEnd isPathSeparator + +-- | 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] +