use some library functions

retry with a bugfix
This commit is contained in:
Joey Hess 2010-10-15 19:01:20 -04:00
parent 0989dd2694
commit 23f95ac6df

View file

@ -13,6 +13,7 @@ import System.IO
import System.Posix.IO import System.Posix.IO
import Data.String.Utils import Data.String.Utils
import System.Path import System.Path
import System.FilePath
import System.Directory import System.Directory
{- Let's just say that Haskell makes reading/writing a file with {- Let's just say that Haskell makes reading/writing a file with
@ -38,11 +39,13 @@ hGetContentsStrict h = hGetContents h >>= \s -> length s `seq` return s
parentDir :: String -> String parentDir :: String -> String
parentDir dir = parentDir dir =
if length dirs > 0 if length dirs > 0
then absolute ++ (join "/" $ take ((length dirs) - 1) dirs) then slash ++ (join s $ take ((length dirs) - 1) dirs)
else "" else ""
where where
dirs = filter (\x -> length x > 0) $ split "/" dir dirs = filter (\x -> length x > 0) $
absolute = if ((dir !! 0) == '/') then "/" else "" split s dir
slash = if (not $ isAbsolute dir) then "" else s
s = [pathSeparator]
{- Constructs a relative path from the CWD to a directory. {- Constructs a relative path from the CWD to a directory.
- -
@ -68,20 +71,19 @@ relPathCwdToDir dir = do
- Both directories must be absolute, and normalized (eg with absNormpath). - Both directories must be absolute, and normalized (eg with absNormpath).
- -
- The path will end with "/", unless it is empty. - The path will end with "/", unless it is empty.
- -} -}
relPathDirToDir :: FilePath -> FilePath -> FilePath relPathDirToDir :: FilePath -> FilePath -> FilePath
relPathDirToDir from to = relPathDirToDir from to =
if (0 < length path) if (0 < length path)
then if (endswith "/" path) then addTrailingPathSeparator path
then path
else path ++ "/"
else "" else ""
where where
pfrom = split "/" from s = [pathSeparator]
pto = split "/" to pfrom = split s from
pto = split s to
common = map fst $ filter same $ zip pfrom pto common = map fst $ filter same $ zip pfrom pto
same (c,d) = c == d same (c,d) = c == d
uncommon = drop numcommon pto uncommon = drop numcommon pto
dotdots = take ((length pfrom) - numcommon) $ repeat ".." dotdots = take ((length pfrom) - numcommon) $ repeat ".."
numcommon = length $ common numcommon = length $ common
path = join "/" $ dotdots ++ uncommon path = join s $ dotdots ++ uncommon