[commit: packages/filepath] master: Bug fix: isValid "\\\\\\foo" == False (bef533f)

[git at git.haskell.org]

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

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

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

commit bef533f555111f697d23ab27e9b506169e2ca1a7
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date:   Sun Oct 26 00:21:24 2014 +0200

    Bug fix: isValid "\\\\\\foo" == False
    
    Share name can not start with a slash.


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

bef533f555111f697d23ab27e9b506169e2ca1a7
 System/FilePath/Internal.hs | 9 +++++++--
 changelog.md                | 3 +++
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs
index f85e635..263836f 100644
--- a/System/FilePath/Internal.hs
+++ b/System/FilePath/Internal.hs
@@ -807,14 +807,16 @@ badElements = ["CON", "PRN", "AUX", "NUL", "COM1", "COM2", "COM3", "COM4", "COM5
 -- > Windows: isValid "c:\\test\\prn.txt" == False
 -- > Windows: isValid "c:\\nul\\file" == False
 -- > Windows: isValid "\\\\" == False
+-- > Windows: isValid "\\\\\\foo" == False
 isValid :: FilePath -> Bool
 isValid "" = False
 isValid _ | isPosix = True
 isValid path =
         not (any (`elem` badCharacters) x2) &&
         not (any f $ splitDirectories x2) &&
-        not (length path >= 2 && all isPathSeparator path)
+        not (length x1 >= 2 && all isPathSeparator x1)
     where
+        x1 = head (splitPath path)
         x2 = dropDrive path
         f x = map toUpper (dropExtensions x) `elem` badElements
 
@@ -831,10 +833,13 @@ isValid path =
 -- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt"
 -- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"
 -- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"
+-- > Windows: makeValid "\\\\\\foo" == "\\\\drive"
 makeValid :: FilePath -> FilePath
 makeValid "" = "_"
 makeValid path | isPosix = path
-makeValid x | length x >= 2 && all isPathSeparator x = take 2 x ++ "drive"
+makeValid xs | length x >= 2 && all isPathSeparator x = take 2 x ++ "drive"
+    where
+        x = head (splitPath xs)
 makeValid path = joinDrive drv $ validElements $ validChars pth
     where
         (drv,pth) = splitDrive path
diff --git a/changelog.md b/changelog.md
index 13dad0e..1637673 100644
--- a/changelog.md
+++ b/changelog.md
@@ -7,6 +7,9 @@
   * Bug fix: on Windows, `dropTrailingPathSeparator "/"` now returns `"/"`
     unchanged, instead of the normalised `"\\"`.
 
+  * Bug fix: on Windows, `isValid "\\\\\\foo"` now returns `False`, instead
+    of `True`.
+
 ## 1.3.0.2  *Mar 2014*
 
   * Bundled with GHC 7.8.1