diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-15 16:09:30 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-15 16:09:30 -0400 |
commit | e577656fea6f66ef64547374e962adb7fd4ce80a (patch) | |
tree | 95fceeac0b0781ad8708121ee7edf58a84663686 /Utility.hs | |
parent | 80104eab9a28b9a94fb36653b7cd95b734e16e4d (diff) |
relative link fix
Diffstat (limited to 'Utility.hs')
-rw-r--r-- | Utility.hs | 48 |
1 files changed, 47 insertions, 1 deletions
diff --git a/Utility.hs b/Utility.hs index 349dd9355..a8324815e 100644 --- a/Utility.hs +++ b/Utility.hs @@ -4,12 +4,16 @@ module Utility ( withFileLocked, hGetContentsStrict, - parentDir + parentDir, + relPathCwdToDir, + relPathDirToDir, ) where import System.IO import System.Posix.IO import Data.String.Utils +import System.Path +import System.Directory {- Let's just say that Haskell makes reading/writing a file with - file locking excessively difficult. -} @@ -39,3 +43,45 @@ parentDir dir = where dirs = filter (\x -> length x > 0) $ split "/" dir absolute = if ((dir !! 0) == '/') then "/" else "" + +{- Constructs a relative path from the CWD to a directory. + - + - For example, assuming CWD is /tmp/foo/bar: + - relPathCwdToDir "/tmp/foo" == "../" + - relPathCwdToDir "/tmp/foo/bar" == "" + - relPathCwdToDir "/tmp/foo/bar" == "" + -} +relPathCwdToDir :: FilePath -> IO FilePath +relPathCwdToDir dir = do + cwd <- getCurrentDirectory + let absdir = abs cwd dir + return $ relPathDirToDir cwd absdir + where + -- absolute, normalized form of the directory + abs cwd dir = + case (absNormPath cwd dir) of + Just d -> d + Nothing -> error $ "unable to normalize " ++ dir + +{- Constructs a relative path from one directory to another. + - + - Both directories must be absolute, and normalized (eg with absNormpath). + - + - The path will end with "/", unless it is empty. + - -} +relPathDirToDir :: FilePath -> FilePath -> FilePath +relPathDirToDir from to = + if (0 < length path) + then if (endswith "/" path) + then path + else path ++ "/" + else "" + where + pfrom = split "/" from + pto = split "/" to + common = map fst $ filter same $ zip pfrom pto + same (c,d) = c == d + uncommon = drop numcommon pto + dotdots = take ((length pfrom) - numcommon) $ repeat ".." + numcommon = length $ common + path = join "/" $ dotdots ++ uncommon |