Add normalizeAbs, which may or may not be useful
This commit is contained in:
parent
8f7e5806e3
commit
577ecf6750
22
src/HPath.hs
22
src/HPath.hs
@ -41,6 +41,7 @@ module HPath
|
|||||||
,fromAbs
|
,fromAbs
|
||||||
,fromRel
|
,fromRel
|
||||||
,normalize
|
,normalize
|
||||||
|
,normalizeAbs
|
||||||
,toFilePath
|
,toFilePath
|
||||||
-- * Path Operations
|
-- * Path Operations
|
||||||
,(</>)
|
,(</>)
|
||||||
@ -105,6 +106,7 @@ import Foreign.Marshal.Alloc(allocaBytes)
|
|||||||
import HPath.Foreign
|
import HPath.Foreign
|
||||||
import HPath.Internal
|
import HPath.Internal
|
||||||
import Language.Haskell.TH
|
import Language.Haskell.TH
|
||||||
|
import Safe(initDef)
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
@ -245,6 +247,12 @@ fromRel = toFilePath
|
|||||||
normalize :: Path t -> Path t
|
normalize :: Path t -> Path t
|
||||||
normalize (MkPath l) = MkPath $ normalise l
|
normalize (MkPath l) = MkPath $ normalise l
|
||||||
|
|
||||||
|
-- | A variant for `normalize` for absolute paths which
|
||||||
|
-- also removes occurences of '..', which may behave
|
||||||
|
-- strange for symlinks though.
|
||||||
|
normalizeAbs :: Path Abs -> Path Abs
|
||||||
|
normalizeAbs (MkPath l) = MkPath . fromJust . normaliseAbs $ l
|
||||||
|
|
||||||
-- | May fail on `realPath`.
|
-- | May fail on `realPath`.
|
||||||
canonicalizePath :: Path Abs -> IO (Path Abs)
|
canonicalizePath :: Path Abs -> IO (Path Abs)
|
||||||
canonicalizePath (MkPath l) = do
|
canonicalizePath (MkPath l) = do
|
||||||
@ -408,6 +416,20 @@ normalise filepath = result `B.append`
|
|||||||
dropDots = filter (pathDot' /=)
|
dropDots = filter (pathDot' /=)
|
||||||
|
|
||||||
|
|
||||||
|
-- | A variant of `normalise` for absolute paths, which removes
|
||||||
|
-- occurences of '..'. If a non-absolute path is passed, returns Nothing.
|
||||||
|
normaliseAbs :: ByteString -> Maybe ByteString
|
||||||
|
normaliseAbs filepath
|
||||||
|
| isRelative filepath = Nothing
|
||||||
|
| otherwise =
|
||||||
|
let nfp = normalise filepath
|
||||||
|
in Just . joinPath . L.foldl' rmDbl [] . splitDirectories $ nfp
|
||||||
|
where
|
||||||
|
rmDbl x y
|
||||||
|
| x == [pathSeparator'] && y == pathDoubleDot = [pathSeparator']
|
||||||
|
| y == pathDoubleDot = initDef [] x
|
||||||
|
| otherwise = x ++ [y]
|
||||||
|
|
||||||
|
|
||||||
splitPath :: ByteString -> [ByteString]
|
splitPath :: ByteString -> [ByteString]
|
||||||
splitPath filepath = [drv | drv /= B.empty] ++ f pth
|
splitPath filepath = [drv | drv /= B.empty] ++ f pth
|
||||||
|
Loading…
Reference in New Issue
Block a user