remove absNormPathUnix again

Moving toward dropping MissingH dep.

I think I've addressed the problem identified earlier in
09a66f702d. On Windows,
absPathFrom "/tmp/repo/xxx" "y/bar" would be "/tmp/repo/xxx\\y/bar",
which then confuses relPathDirToFile. Fixed by converting to unix (git)
style paths.

Also, relPathDirToFile was splitting only on \\ on windows and not /
which broke the example in 09a66f702d of
relPathDirToFile (absPathFrom "/tmp/repo/xxx" "y/bar") "/tmp/repo/.git/annex/objects/xxx"

Now, on windows, that will yield "..\\..\\..\\.git/annex/objects/xxx"
which once converted to unix style paths is what we want.
This commit is contained in:
Joey Hess 2017-05-15 17:13:08 -04:00
parent e40d9a1b12
commit 18b9a4b802
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 9 additions and 22 deletions

View file

@ -172,7 +172,7 @@ gitAnnexLocation' key r config crippled symlinkssupported checker gitdir
gitAnnexLink :: FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath
gitAnnexLink file key r config = do
currdir <- getCurrentDirectory
let absfile = fromMaybe whoops $ absNormPathUnix currdir file
let absfile = absNormPathUnix currdir file
let gitdir = getgitdir currdir
loc <- gitAnnexLocation' key r config False False (\_ -> return True) gitdir
toInternalGitPath <$> relPathDirToFile (parentDir absfile) loc
@ -182,10 +182,10 @@ gitAnnexLink file key r config = do
- supporting symlinks; generate link target that will
- work portably. -}
| not (coreSymlinks config) && needsSubmoduleFixup r =
fromMaybe whoops $ absNormPathUnix currdir $
Git.repoPath r </> ".git"
absNormPathUnix currdir $ Git.repoPath r </> ".git"
| otherwise = Git.localGitDir r
whoops = error $ "unable to normalize " ++ file
absNormPathUnix d p = toInternalGitPath $
absPathFrom (toInternalGitPath d) (toInternalGitPath p)
{- Calculates a symlink target as would be used in a typical git
- repository, with .git in the top of the work tree. -}

View file

@ -25,7 +25,6 @@ import System.Posix.Files
import Utility.Exception
#endif
import qualified "MissingH" System.Path as MissingH
import Utility.Monad
import Utility.UserInfo
import Utility.Directory
@ -68,18 +67,6 @@ simplifyPath path = dropTrailingPathSeparator $
absPathFrom :: FilePath -> FilePath -> FilePath
absPathFrom dir path = simplifyPath (combine dir path)
{- On Windows, this converts the paths to unix-style, in order to run
- MissingH's absNormPath on them. -}
absNormPathUnix :: FilePath -> FilePath -> Maybe FilePath
#ifndef mingw32_HOST_OS
absNormPathUnix dir path = MissingH.absNormPath dir path
#else
absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos path)
where
fromdos = replace "\\" "/"
todos = replace "/" "\\"
#endif
{- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}
parentDir :: FilePath -> FilePath
parentDir = takeDirectory . dropTrailingPathSeparator
@ -149,13 +136,13 @@ relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
relPathDirToFileAbs from to
| takeDrive from /= takeDrive to = to
| otherwise = intercalate s $ dotdots ++ uncommon
| otherwise = joinPath $ dotdots ++ uncommon
where
s = [pathSeparator]
pfrom = split s from
pto = split s to
pfrom = sp from
pto = sp to
sp = dropTrailingPathSeparator . splitPath
common = map fst $ takeWhile same $ zip pfrom pto
same (c,d) = c == d
same (c,d) = c = d
uncommon = drop numcommon pto
dotdots = replicate (length pfrom - numcommon) ".."
numcommon = length common