From e433c6f0bb2ee5f03217b85e3b677b961f5d391a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 25 Apr 2011 13:36:39 -0400
Subject: generalized relPathDirTo functions

---
 Content.hs |  2 +-
 Utility.hs | 37 ++++++++++++++++---------------------
 test.hs    |  2 +-
 3 files changed, 18 insertions(+), 23 deletions(-)

diff --git a/Content.hs b/Content.hs
index f63c02311..576eecb31 100644
--- a/Content.hs
+++ b/Content.hs
@@ -58,7 +58,7 @@ calcGitLink file key = do
 	let absfile = case absNormPath cwd file of
 		Just f -> f
 		Nothing -> error $ "unable to normalize " ++ file
-	return $ relPathDirToDir (parentDir absfile) 
+	return $ relPathDirToFile (parentDir absfile) 
 			(Git.workTree g) </> ".git" </> annexLocation key
 
 {- Updates the LocationLog when a key's presence changes.
diff --git a/Utility.hs b/Utility.hs
index 5639a8799..13ebbfccb 100644
--- a/Utility.hs
+++ b/Utility.hs
@@ -13,8 +13,8 @@ module Utility (
 	parentDir,
 	absPath,
 	absPathFrom,
-	relPathCwdToDir,
-	relPathDirToDir,
+	relPathCwdToFile,
+	relPathDirToFile,
 	boolSystem,
 	shellEscape,
 	shellUnEscape,
@@ -29,7 +29,7 @@ module Utility (
 	prop_idempotent_shellEscape,
 	prop_idempotent_shellEscape_multiword,
 	prop_parentDir_basics,
-	prop_relPathDirToDir_basics
+	prop_relPathDirToFile_basics
 ) where
 
 import System.IO
@@ -180,26 +180,21 @@ absPathFrom cwd file =
 		Just f -> f
 		Nothing -> error $ "unable to normalize " ++ file
 
-{- Constructs a relative path from the CWD to a directory.
+{- Constructs a relative path from the CWD to a file.
  -
  - For example, assuming CWD is /tmp/foo/bar:
- -    relPathCwdToDir "/tmp/foo" == "../"
- -    relPathCwdToDir "/tmp/foo/bar" == "" 
+ -    relPathCwdToFile "/tmp/foo" == ".."
+ -    relPathCwdToFile "/tmp/foo/bar" == "" 
  -}
-relPathCwdToDir :: FilePath -> IO FilePath
-relPathCwdToDir dir = liftM2 relPathDirToDir getCurrentDirectory (absPath dir)
+relPathCwdToFile :: FilePath -> IO FilePath
+relPathCwdToFile f = liftM2 relPathDirToFile getCurrentDirectory (absPath f)
 
-{- Constructs a relative path from one directory to another.
+{- Constructs a relative path from a directory to a file.
  -
- - Both directories must be absolute, and normalized (eg with absNormpath).
- -
- - The path will end with "/", unless it is empty.
+ - Both must be absolute, and normalized (eg with absNormpath).
  -}
-relPathDirToDir :: FilePath -> FilePath -> FilePath
-relPathDirToDir from to = 
-	if not $ null path
-		then addTrailingPathSeparator path
-		else ""
+relPathDirToFile :: FilePath -> FilePath -> FilePath
+relPathDirToFile from to = path
 	where
 		s = [pathSeparator]
 		pfrom = split s from
@@ -211,12 +206,12 @@ relPathDirToDir from to =
 		numcommon = length common
 		path = join s $ dotdots ++ uncommon
 
-prop_relPathDirToDir_basics :: FilePath -> FilePath -> Bool
-prop_relPathDirToDir_basics from to
+prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
+prop_relPathDirToFile_basics from to
 	| from == to = null r
-	| otherwise = not (null r) && (last r == '/')
+	| otherwise = not (null r)
 	where
-		r = relPathDirToDir from to 
+		r = relPathDirToFile from to 
 
 {- Removes a FileMode from a file.
  - For example, call with otherWriteMode to chmod o-w -}
diff --git a/test.hs b/test.hs
index 9304eee83..7775fb8b5 100644
--- a/test.hs
+++ b/test.hs
@@ -62,7 +62,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
 	, qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape
 	, qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword
 	, qctest "prop_parentDir_basics" Utility.prop_parentDir_basics
-	, qctest "prop_relPathDirToDir_basics" Utility.prop_relPathDirToDir_basics
+	, qctest "prop_relPathDirToFile_basics" Utility.prop_relPathDirToFile_basics
 	, qctest "prop_cost_sane" Config.prop_cost_sane
 	, qctest "prop_hmacWithCipher_sane" Crypto.prop_hmacWithCipher_sane
 	]
-- 
cgit v1.2.3