aboutsummaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2017-10-25 19:04:26 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2017-10-25 19:36:29 -0400
commit48503d747011befb10f01a1ee4097ddc93103d20 (patch)
treee98fcf9e5e87496afd5aaea2e18c96e7ec6bfa80 /Utility
parent59233f1b18fc58df1ebf500cd992c572deb701d6 (diff)
fix gitAnnexLink to not be absolute on Windows
Windows: Fix reversion that caused the path used to link to annexed content include the drive letter and full path, rather than being relative. (`git annex fix` will fix up after this problem). I've not identified the commit that brought the reversion (probably it happened this spring when I was removing MisingH and last touched Utility.Path). Likely commit c88dfda7e03cab4d96417518b6cfcffd54ad8f5d? The problem is that relPathDirToFile got called two paths that had the slashes different ways around. Since takeDrive includes the first slash, this made two paths on the same drive seem different and it bailed. (ifdefs around this to avoid doing extra work on non-windows) This commit was sponsored by Jack Hill on Patreon.
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Path.hs7
1 files changed, 6 insertions, 1 deletions
diff --git a/Utility/Path.hs b/Utility/Path.hs
index 0779d1676..0409ff05f 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -136,7 +136,9 @@ relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
-}
relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
relPathDirToFileAbs from to
- | takeDrive from /= takeDrive to = to
+#ifdef mingw32_HOST_OS
+ | normdrive from /= normdrive to = to
+#endif
| otherwise = joinPath $ dotdots ++ uncommon
where
pfrom = sp from
@@ -147,6 +149,9 @@ relPathDirToFileAbs from to
uncommon = drop numcommon pto
dotdots = replicate (length pfrom - numcommon) ".."
numcommon = length common
+#ifdef mingw32_HOST_OS
+ normdrive = map toLower . takeWhile (/= ':') . takeDrive
+#endif
prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
prop_relPathDirToFile_basics from to