diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-01-06 15:31:24 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-01-06 16:19:41 -0400 |
commit | c9f1281cdd937e9facd26741b3e42d60a9c5cf28 (patch) | |
tree | d93784c4a23a160d98fbfc40e69818c38ac06525 /Git.hs | |
parent | 57c62d73082b6293a243f026003c697eda02b401 (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 'Git.hs')
-rw-r--r-- | Git.hs | 46 |
1 files changed, 25 insertions, 21 deletions
@@ -31,6 +31,7 @@ module Git ( hookPath, assertLocal, adjustPath, + relPath, ) where import Network.URI (uriPath, uriScheme, unEscapeString) @@ -141,25 +142,28 @@ hookPath script repo = do isexecutable f = isExecutable . fileMode <$> getFileStatus f #endif -{- Adusts the path to a local Repo. - - - - On windows, prefixing a path with \\?\ makes it be processed as a raw - - path (/ is not converted to \). The benefit is that such a path does - - avoids Windows's 260 byte limitation on the entire path. -} -adjustPath :: Repo -> Repo -adjustPath r@(Repo { location = l@(Local { gitdir = d, worktree = w }) }) = r - { location = l - { gitdir = adjustPath' d - , worktree = fmap adjustPath' w +{- Makes the path to a local Repo be relative to the cwd. -} +relPath :: Repo -> IO Repo +relPath = adjustPath torel + where + torel p = do + p' <- relPathCwdToFile p + if null p' + then return "." + else return p' + +{- Adusts the path to a local Repo using the provided function. -} +adjustPath :: (FilePath -> IO FilePath) -> Repo -> IO Repo +adjustPath f r@(Repo { location = l@(Local { gitdir = d, worktree = w }) }) = do + d' <- f d + w' <- maybe (pure Nothing) (Just <$$> f) w + return $ r + { location = l + { gitdir = d' + , worktree = w' + } } - } -adjustPath r@(Repo { location = LocalUnknown d }) = - r { location = LocalUnknown (adjustPath' d) } -adjustPath r = r - -adjustPath' :: FilePath -> FilePath -#if mingw32_HOST_OS -adjustPath' d = "\\\\?\\" ++ d -#else -adjustPath' = id -#endif +adjustPath f r@(Repo { location = LocalUnknown d }) = do + d' <- f d + return $ r { location = LocalUnknown d' } +adjustPath _ r = pure r |