[commit: packages/filepath] master: Bug fix: on Windows, makeRelative "/" "//" == "//" (03dfb79)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/filepath

On branch  : master
Link       : http://git.haskell.org/packages/filepath.git/commitdiff/03dfb79c75436f27730a0edc1f45a98f75320137

>---------------------------------------------------------------

commit 03dfb79c75436f27730a0edc1f45a98f75320137
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date:   Sun Oct 26 22:16:00 2014 +0100

    Bug fix: on Windows, makeRelative "/" "//" == "//"


>---------------------------------------------------------------

03dfb79c75436f27730a0edc1f45a98f75320137
 System/FilePath/Internal.hs | 5 +++--
 changelog.md                | 3 +++
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs
index 0a8726f..739aa60 100644
--- a/System/FilePath/Internal.hs
+++ b/System/FilePath/Internal.hs
@@ -693,6 +693,7 @@ equalFilePath a b = f a == f b
 -- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob"
 -- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob"
 -- > Windows: makeRelative "/Home" "/home/bob" == "bob"
+-- > Windows: makeRelative "/" "//" == "//"
 -- > Posix:   makeRelative "/Home" "/home/bob" == "/home/bob"
 -- > Posix:   makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"
 -- > Posix:   makeRelative "/fred" "bob" == "bob"
@@ -714,10 +715,10 @@ makeRelative root path
             where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x
 
         -- on windows, need to drop '/' which is kind of absolute, but not a drive
-        dropAbs (x:xs) | isPathSeparator x = xs
+        dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = tail x
         dropAbs x = dropDrive x
 
-        takeAbs (x:_) | isPathSeparator x = [pathSeparator]
+        takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator]
         takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x
 
 -- | Normalise a file
diff --git a/changelog.md b/changelog.md
index b037c48..77405bf 100644
--- a/changelog.md
+++ b/changelog.md
@@ -21,6 +21,9 @@
   * Bug fix: on Windows, `normalise "//server/test"` now retuns
     `"\\\\server\\test"`, instead of `"//server/test"` unchanged.
 
+  * Bug fix: on Windows, `makeRelative "/" "//"` now returns `"//"`, instead
+    of `""`.
+
 ## 1.3.0.2  *Mar 2014*
 
   * Bundled with GHC 7.8.1