Move some functionality from HPath to System.Posix.FilePath

This also removes 'canonicalizePath' from HPath which fixes
the doctest.
This commit is contained in:
Julian Ospald 2016-05-09 14:16:53 +02:00
parent cfe626b6d4
commit 196647a383
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
2 changed files with 83 additions and 108 deletions

View File

@ -31,7 +31,6 @@ module HPath
,parseFn ,parseFn
,parseRel ,parseRel
-- * Path Conversion -- * Path Conversion
,canonicalizePath
,fromAbs ,fromAbs
,fromRel ,fromRel
,normalize ,normalize
@ -47,11 +46,6 @@ module HPath
,withAbsPath ,withAbsPath
,withRelPath ,withRelPath
,withFnPath ,withFnPath
-- * ByteString/Word8 constants
,nullByte
,pathDot
,pathDot'
,pathSeparator'
-- * ByteString operations -- * ByteString operations
,fpToString ,fpToString
,userStringToFP ,userStringToFP
@ -68,14 +62,12 @@ import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.Catch (MonadThrow(..))
import Data.ByteString(ByteString) import Data.ByteString(ByteString)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (fromString, toString)
import Data.Data import Data.Data
import qualified Data.List as L import qualified Data.List as L
import Data.Maybe import Data.Maybe
import Data.Word8 import Data.Word8
import HPath.Internal import HPath.Internal
import System.Posix.FilePath hiding ((</>)) import System.Posix.FilePath hiding ((</>))
import System.Posix.Directory.Traversals(realpath)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -174,7 +166,8 @@ parseRel :: MonadThrow m
=> ByteString -> m (Path Rel) => ByteString -> m (Path Rel)
parseRel filepath = parseRel filepath =
if not (isAbsolute filepath) && if not (isAbsolute filepath) &&
filepath /= pathDot' && filepath /= pathDoubleDot && filepath /= BS.singleton _period &&
filepath /= BS.pack [_period, _period] &&
not (hasParentDir filepath) && not (hasParentDir filepath) &&
isValid filepath isValid filepath
then return (MkPath $ normalise filepath) then return (MkPath $ normalise filepath)
@ -210,7 +203,8 @@ parseFn :: MonadThrow m
=> ByteString -> m (Path Fn) => ByteString -> m (Path Fn)
parseFn filepath = parseFn filepath =
if isFileName filepath && if isFileName filepath &&
filepath /= pathDot' && filepath /= pathDoubleDot && filepath /= BS.singleton _period &&
filepath /= BS.pack [_period, _period] &&
isValid filepath isValid filepath
then return (MkPath filepath) then return (MkPath filepath)
else throwM (InvalidFn filepath) else throwM (InvalidFn filepath)
@ -312,7 +306,7 @@ isParentOf p l = isJust (stripDir p l :: Maybe (Path Rel))
-- [] -- []
getAllParents :: Path Abs -> [Path Abs] getAllParents :: Path Abs -> [Path Abs]
getAllParents (MkPath p) getAllParents (MkPath p)
| np == pathSeparator' = [] | np == BS.singleton pathSeparator = []
| otherwise = dirname (MkPath np) : getAllParents (dirname $ MkPath np) | otherwise = dirname (MkPath np) : getAllParents (dirname $ MkPath np)
where where
np = dropTrailingPathSeparator . normalise $ p np = dropTrailingPathSeparator . normalise $ p
@ -356,13 +350,6 @@ basename (MkPath l)
-- Path IO helpers -- Path IO helpers
-- | May fail on `realpath`.
canonicalizePath :: Path Abs -> IO (Path Abs)
canonicalizePath (MkPath l) = do
nl <- realpath l
return $ MkPath nl
withAbsPath :: Path Abs -> (ByteString -> IO a) -> IO a withAbsPath :: Path Abs -> (ByteString -> IO a) -> IO a
withAbsPath (MkPath p) action = action p withAbsPath (MkPath p) action = action p
@ -393,100 +380,16 @@ withFnPath (MkPath p) action = action p
-- False -- False
hiddenFile :: Path Fn -> Bool hiddenFile :: Path Fn -> Bool
hiddenFile (MkPath fp) hiddenFile (MkPath fp)
| fp == pathDoubleDot = False | fp == BS.pack [_period, _period] = False
| fp == pathDot' = False | fp == BS.pack [_period] = False
| otherwise = pathDot' `BS.isPrefixOf` fp | otherwise = BS.pack [extSeparator]
`BS.isPrefixOf` fp
--------------------------------------------------------------------------------
-- ByteString/Word8 constants
pathSeparator' :: ByteString
pathSeparator' = BS.singleton pathSeparator
pathDot :: Word8
pathDot = _period
pathDot' :: ByteString
pathDot' = BS.singleton pathDot
pathDoubleDot :: ByteString
pathDoubleDot = pathDot `BS.cons` pathDot'
nullByte :: Word8
nullByte = _nul
--------------------------------------------------------------------------------
-- ByteString Operations
-- |Uses UTF-8 decoding to convert the bytestring into a String.
fpToString :: ByteString -> String
fpToString = toString
-- |Uses UTF-8 encoding to convert a user provided String into
-- a ByteString, which represents a filepath.
userStringToFP :: String -> ByteString
userStringToFP = fromString
------------------------
-- ByteString helpers
#if MIN_VERSION_bytestring(0,10,8) #if MIN_VERSION_bytestring(0,10,8)
#else #else
stripPrefix :: ByteString -> ByteString -> Maybe ByteString stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix a b = BS.pack `fmap` L.stripPrefix (BS.unpack a) (BS.unpack b) stripPrefix a b = BS.pack `fmap` L.stripPrefix (BS.unpack a) (BS.unpack b)
#endif #endif
--------------------------------------------------------------------------------
-- ByteString Query functions
-- | Helper function: 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 :: ByteString -> Bool
hasParentDir filepath =
((pathSeparator `BS.cons` pathDoubleDot) `BS.isSuffixOf` filepath) ||
((pathSeparator' `BS.append` pathDoubleDot `BS.append` pathSeparator')
`BS.isInfixOf` filepath) ||
((pathDoubleDot `BS.append` pathSeparator') `BS.isPrefixOf` filepath)
-- | Is the given filename a valid filename?
--
-- >>> isFileName "lal"
-- True
-- >>> isFileName "."
-- True
-- >>> isFileName ".."
-- True
-- >>> isFileName ""
-- False
-- >>> isFileName "\0"
-- False
-- >>> isFileName "/random_ path:*"
-- False
isFileName :: ByteString -> Bool
isFileName filepath =
not (pathSeparator' `BS.isInfixOf` filepath) &&
not (BS.null filepath) &&
not (nullByte `BS.elem` filepath)

View File

@ -47,13 +47,19 @@ module System.Posix.FilePath (
, isRelative , isRelative
, isAbsolute , isAbsolute
, isValid , isValid
, isFileName
, hasParentDir
, equalFilePath , equalFilePath
, fpToString
, userStringToFP
, module System.Posix.ByteString.FilePath , module System.Posix.ByteString.FilePath
) where ) where
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (fromString, toString)
import System.Posix.ByteString.FilePath import System.Posix.ByteString.FilePath
import Data.Maybe (isJust) import Data.Maybe (isJust)
@ -496,6 +502,58 @@ isValid filepath
| _nul `BS.elem` filepath = False | _nul `BS.elem` filepath = False
| otherwise = True | otherwise = True
-- | Is the given filename a valid filename?
--
-- >>> isFileName "lal"
-- True
-- >>> isFileName "."
-- True
-- >>> isFileName ".."
-- True
-- >>> isFileName ""
-- False
-- >>> isFileName "\0"
-- False
-- >>> isFileName "/random_ path:*"
-- False
isFileName :: ByteString -> Bool
isFileName filepath =
not (BS.singleton pathSeparator `BS.isInfixOf` filepath) &&
not (BS.null filepath) &&
not (_nul `BS.elem` filepath)
-- | Helper function: 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 :: ByteString -> 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]
-- |Equality of two filepaths. The filepaths are normalised -- |Equality of two filepaths. The filepaths are normalised
-- and trailing path separators are dropped. -- and trailing path separators are dropped.
-- --
@ -518,6 +576,20 @@ equalFilePath p1 p2 = f p1 == f p2
where where
f x = dropTrailingPathSeparator $ normalise x f x = dropTrailingPathSeparator $ normalise x
------------------------
-- conversion
-- |Uses UTF-8 decoding to convert the bytestring into a String.
fpToString :: ByteString -> String
fpToString = toString
-- |Uses UTF-8 encoding to convert a user provided String into
-- a ByteString, which represents a filepath.
userStringToFP :: String -> ByteString
userStringToFP = fromString
------------------------ ------------------------
-- internal stuff -- internal stuff