Revert "remove absNormPathUnix, using my absPathFrom replacement"
This reverts commit a7f05c007b
.
Consider: relPathDirToFile (absPathFrom "/tmp/repo/xxx" "y/bar") "/tmp/repo/.git/annex/objects/xxx"
This needs to always yield "../../../.git/annex/objects/xxx" but on
Windows, it is "..\\..\\/tmp/repo/.git/annex/objects/xxx"
This commit is contained in:
parent
0700fbc477
commit
09a66f702d
2 changed files with 17 additions and 2 deletions
|
@ -144,9 +144,11 @@ gitAnnexLocation' key r crippled
|
||||||
gitAnnexLink :: FilePath -> Key -> Git.Repo -> IO FilePath
|
gitAnnexLink :: FilePath -> Key -> Git.Repo -> IO FilePath
|
||||||
gitAnnexLink file key r = do
|
gitAnnexLink file key r = do
|
||||||
currdir <- getCurrentDirectory
|
currdir <- getCurrentDirectory
|
||||||
let absfile = absPathFrom currdir file
|
let absfile = fromMaybe whoops $ absNormPathUnix currdir file
|
||||||
loc <- gitAnnexLocation' key r False
|
loc <- gitAnnexLocation' key r False
|
||||||
relPathDirToFile (parentDir absfile) loc
|
relPathDirToFile (parentDir absfile) loc
|
||||||
|
where
|
||||||
|
whoops = error $ "unable to normalize " ++ file
|
||||||
|
|
||||||
{- File used to lock a key's content. -}
|
{- File used to lock a key's content. -}
|
||||||
gitAnnexContentLock :: Key -> Git.Repo -> GitConfig -> IO FilePath
|
gitAnnexContentLock :: Key -> Git.Repo -> GitConfig -> IO FilePath
|
||||||
|
|
|
@ -5,7 +5,7 @@
|
||||||
- License: BSD-2-clause
|
- License: BSD-2-clause
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE PackageImports, CPP #-}
|
||||||
|
|
||||||
module Utility.Path where
|
module Utility.Path where
|
||||||
|
|
||||||
|
@ -24,6 +24,7 @@ import System.Posix.Files
|
||||||
import Utility.Exception
|
import Utility.Exception
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
import qualified "MissingH" System.Path as MissingH
|
||||||
import Utility.Monad
|
import Utility.Monad
|
||||||
import Utility.UserInfo
|
import Utility.UserInfo
|
||||||
|
|
||||||
|
@ -64,6 +65,18 @@ simplifyPath path = dropTrailingPathSeparator $
|
||||||
absPathFrom :: FilePath -> FilePath -> FilePath
|
absPathFrom :: FilePath -> FilePath -> FilePath
|
||||||
absPathFrom dir path = simplifyPath (combine dir path)
|
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. Resulting path will use / separators. -}
|
||||||
|
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" -}
|
{- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}
|
||||||
parentDir :: FilePath -> FilePath
|
parentDir :: FilePath -> FilePath
|
||||||
parentDir = takeDirectory . dropTrailingPathSeparator
|
parentDir = takeDirectory . dropTrailingPathSeparator
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue