split groups of related functions out of Utility
This commit is contained in:
parent
4c73d77b42
commit
203148363f
47 changed files with 312 additions and 265 deletions
92
Utility/Path.hs
Normal file
92
Utility/Path.hs
Normal file
|
@ -0,0 +1,92 @@
|
|||
{- path manipulation
|
||||
-
|
||||
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Utility.Path where
|
||||
|
||||
import Data.String.Utils
|
||||
import System.Path
|
||||
import System.FilePath
|
||||
import System.Directory
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Control.Monad (liftM2)
|
||||
|
||||
{- Returns the parent directory of a path. Parent of / is "" -}
|
||||
parentDir :: FilePath -> FilePath
|
||||
parentDir dir =
|
||||
if not $ null dirs
|
||||
then slash ++ join s (take (length dirs - 1) dirs)
|
||||
else ""
|
||||
where
|
||||
dirs = filter (not . null) $ split s dir
|
||||
slash = if isAbsolute dir then s else ""
|
||||
s = [pathSeparator]
|
||||
|
||||
prop_parentDir_basics :: FilePath -> Bool
|
||||
prop_parentDir_basics dir
|
||||
| null dir = True
|
||||
| dir == "/" = parentDir dir == ""
|
||||
| otherwise = p /= dir
|
||||
where
|
||||
p = parentDir dir
|
||||
|
||||
{- Checks if the first FilePath is, or could be said to contain the second.
|
||||
- For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
|
||||
- are all equivilant.
|
||||
-}
|
||||
dirContains :: FilePath -> FilePath -> Bool
|
||||
dirContains a b = a == b || a' == b' || (a'++"/") `isPrefixOf` b'
|
||||
where
|
||||
norm p = fromMaybe "" $ absNormPath p "."
|
||||
a' = norm a
|
||||
b' = norm b
|
||||
|
||||
{- Converts a filename into a normalized, absolute path. -}
|
||||
absPath :: FilePath -> IO FilePath
|
||||
absPath file = do
|
||||
cwd <- getCurrentDirectory
|
||||
return $ absPathFrom cwd file
|
||||
|
||||
{- Converts a filename into a normalized, absolute path
|
||||
- from the specified cwd. -}
|
||||
absPathFrom :: FilePath -> FilePath -> FilePath
|
||||
absPathFrom cwd file = fromMaybe bad $ absNormPath cwd file
|
||||
where
|
||||
bad = error $ "unable to normalize " ++ file
|
||||
|
||||
{- Constructs a relative path from the CWD to a file.
|
||||
-
|
||||
- For example, assuming CWD is /tmp/foo/bar:
|
||||
- relPathCwdToFile "/tmp/foo" == ".."
|
||||
- relPathCwdToFile "/tmp/foo/bar" == ""
|
||||
-}
|
||||
relPathCwdToFile :: FilePath -> IO FilePath
|
||||
relPathCwdToFile f = liftM2 relPathDirToFile getCurrentDirectory (absPath f)
|
||||
|
||||
{- Constructs a relative path from a directory to a file.
|
||||
-
|
||||
- Both must be absolute, and normalized (eg with absNormpath).
|
||||
-}
|
||||
relPathDirToFile :: FilePath -> FilePath -> FilePath
|
||||
relPathDirToFile from to = path
|
||||
where
|
||||
s = [pathSeparator]
|
||||
pfrom = split s from
|
||||
pto = split s to
|
||||
common = map fst $ filter same $ zip pfrom pto
|
||||
same (c,d) = c == d
|
||||
uncommon = drop numcommon pto
|
||||
dotdots = replicate (length pfrom - numcommon) ".."
|
||||
numcommon = length common
|
||||
path = join s $ dotdots ++ uncommon
|
||||
|
||||
prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
|
||||
prop_relPathDirToFile_basics from to
|
||||
| from == to = null r
|
||||
| otherwise = not (null r)
|
||||
where
|
||||
r = relPathDirToFile from to
|
Loading…
Add table
Add a link
Reference in a new issue