aboutsummaryrefslogtreecommitdiff
path: root/Utility/Path.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-01-06 15:31:24 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-01-06 16:19:41 -0400
commitc9f1281cdd937e9facd26741b3e42d60a9c5cf28 (patch)
treed93784c4a23a160d98fbfc40e69818c38ac06525 /Utility/Path.hs
parent57c62d73082b6293a243f026003c697eda02b401 (diff)
Switch to using relative paths to the git repository.
This allows the git repository to be moved while git-annex is running in it, with fewer problems. On Windows, this avoids some of the problems with the absurdly small MAX_PATH of 260 bytes. In particular, git-annex repositories should work in deeper/longer directory structures than before. See http://git-annex.branchable.com/bugs/__34__git-annex:_direct:_1_failed__34___on_Windows/ There are several possible ways this change could break git-annex: 1. If it changes its working directory while it's running, that would be Bad News. Good news everyone! git-annex never does so. It would also break thread safety, so all such things were stomped out long ago. 2. parentDir "." -> "" which is not a valid path. I had to fix one instace of this, and I should probably wipe all calls to parentDir out of the git-annex code base; it was never a good idea. 3. Things like relPathDirToFile require absolute input paths, and code assumes that the git repo path is absolute and passes it to it as-is. In the case of relPathDirToFile, I converted it to not make this assumption. Currently, the test suite has 16 failures.
Diffstat (limited to 'Utility/Path.hs')
-rw-r--r--Utility/Path.hs23
1 files changed, 14 insertions, 9 deletions
diff --git a/Utility/Path.hs b/Utility/Path.hs
index c3e893d16..7427bfe27 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -126,14 +126,19 @@ absPath file = do
- relPathCwdToFile "/tmp/foo/bar" == ""
-}
relPathCwdToFile :: FilePath -> IO FilePath
-relPathCwdToFile f = relPathDirToFile <$> getCurrentDirectory <*> absPath f
+relPathCwdToFile f = do
+ c <- getCurrentDirectory
+ relPathDirToFile c f
-{- Constructs a relative path from a directory to a file.
- -
- - Both must be absolute, and cannot contain .. etc. (eg use absPath first).
+{- Constructs a relative path from a directory to a file. -}
+relPathDirToFile :: FilePath -> FilePath -> IO FilePath
+relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
+
+{- This requires the first path to be absolute, and the
+ - second path cannot contain ../ or ./
-}
-relPathDirToFile :: FilePath -> FilePath -> FilePath
-relPathDirToFile from to = join s $ dotdots ++ uncommon
+relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
+relPathDirToFileAbs from to = join s $ dotdots ++ uncommon
where
s = [pathSeparator]
pfrom = split s from
@@ -149,7 +154,7 @@ prop_relPathDirToFile_basics from to
| from == to = null r
| otherwise = not (null r)
where
- r = relPathDirToFile from to
+ r = relPathDirToFileAbs from to
prop_relPathDirToFile_regressionTest :: Bool
prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
@@ -158,7 +163,7 @@ prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
- location, but it's not really the same directory.
- Code used to get this wrong. -}
same_dir_shortcurcuits_at_difference =
- relPathDirToFile (joinPath [pathSeparator : "tmp", "r", "lll", "xxx", "yyy", "18"])
+ relPathDirToFileAbs (joinPath [pathSeparator : "tmp", "r", "lll", "xxx", "yyy", "18"])
(joinPath [pathSeparator : "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"])
== joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]
@@ -187,7 +192,7 @@ relHome :: FilePath -> IO String
relHome path = do
home <- myHomeDir
return $ if dirContains home path
- then "~/" ++ relPathDirToFile home path
+ then "~/" ++ relPathDirToFileAbs home path
else path
{- Checks if a command is available in PATH.