[commit: packages/directory] Mistuke-bump-win32-version-bounds, bgamari-patch-1, master: canonicalizePath: Drop trailing slashes (43488ba)

[git at git.haskell.org]

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

On branches: Mistuke-bump-win32-version-bounds,bgamari-patch-1,master
Link       : http://ghc.haskell.org/trac/ghc/changeset/43488ba64da36df921bc0a5ecec21a8bd69db6ed/directory

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

commit 43488ba64da36df921bc0a5ecec21a8bd69db6ed
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Mon Nov 28 22:39:46 2016 -0500

    canonicalizePath: Drop trailing slashes
    
    After discussion with Duncan Coutts, it was found that the trailing
    slash-preserving behavior was actually a bug on Windows.  This means
    there is really no reason for the current, somewhat quirky behavior of
    preserving trailing slashes.  However, it has been a while since the
    change was made, so it would be safer to introduce this as a major
    version bump.
    
    The internal prependCurrentDirectory function has been reworked slightly
    with regards to the behavior on empty paths, but this not have any
    visible effect on the public API since they always end up normalizing
    the result of prependCurrentDirectory in some way or another.
    
    Fixes #63.


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

43488ba64da36df921bc0a5ecec21a8bd69db6ed
 System/Directory.hs       | 27 ++++++++++++-----------
 changelog.md              |  5 +++++
 directory.cabal           |  2 +-
 tests/CanonicalizePath.hs | 56 +++++++++++++++++++++++++++++++++++++++--------
 4 files changed, 67 insertions(+), 23 deletions(-)

diff --git a/System/Directory.hs b/System/Directory.hs
index 3ab645e..a4f8ba1 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -1038,26 +1038,31 @@ copyFileTimesFromStatus st dst = do
 -- returned path due to the presence of hard links, mount points, etc.
 --
 -- Similar to 'normalise', passing an empty path is equivalent to passing the
--- current directory.  The function preserves the presence or absence of the
--- trailing path separator unless the path refers to the root directory @/@.
+-- current directory.  The function drops trailing path separators where
+-- possible (via 'dropTrailingPathSeparator').
 --
--- /Known bug(s)/: on Windows, the function does not resolve symbolic links.
+-- /Known bug(s)/: on Windows, the function does not resolve symbolic links
+-- and the letter case of filenames is not canonicalized.
 --
 -- /Changes since 1.2.3.0:/ The function has been altered to be more robust
 -- and has the same exception behavior as 'makeAbsolute'.
 --
+-- /Changes since 1.3.0.0:/ The function no longer preserves the trailing path
+-- separator.
+--
 canonicalizePath :: FilePath -> IO FilePath
 canonicalizePath = \ path ->
   modifyIOError ((`ioeSetLocation` "canonicalizePath") .
                  (`ioeSetFileName` path)) $
   -- normalise does more stuff, like upper-casing the drive letter
-  normalise <$> (transform =<< prependCurrentDirectory path)
+  dropTrailingPathSeparator . normalise <$>
+    (transform =<< prependCurrentDirectory path)
   where
 #if defined(mingw32_HOST_OS)
     transform path = Win32.getFullPathName path
                      `catchIOError` \ _ -> return path
 #else
-    transform path = matchTrailingSeparator path <$> do
+    transform path = do
       encoding <- getFileSystemEncoding
       realpathPrefix encoding (reverse (zip prefixes suffixes)) path
       where segments = splitPath path
@@ -1088,6 +1093,7 @@ canonicalizePath = \ path ->
 -- operation may fail with the same exceptions as 'getCurrentDirectory'.
 --
 -- @since 1.2.2.0
+--
 makeAbsolute :: FilePath -> IO FilePath
 makeAbsolute path =
   modifyIOError ((`ioeSetLocation` "makeAbsolute") .
@@ -1107,14 +1113,9 @@ prependCurrentDirectory :: FilePath -> IO FilePath
 prependCurrentDirectory path =
   modifyIOError ((`ioeSetLocation` "prependCurrentDirectory") .
                  (`ioeSetFileName` path)) $
-  case path of
-    "" -> -- avoid trailing path separator
-      prependCurrentDirectory "."
-    _     -- avoid the call to `getCurrentDirectory` if we can
-      | isRelative path ->
-          (</> path) . addTrailingPathSeparator <$> getCurrentDirectory
-      | otherwise ->
-          return path
+  if isRelative path -- avoid the call to `getCurrentDirectory` if we can
+  then (</> path) <$> getCurrentDirectory
+  else return path
 
 -- | Add or remove the trailing path separator in the second path so as to
 -- match its presence in the first path.
diff --git a/changelog.md b/changelog.md
index a0bf189..e2a370b 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,6 +1,11 @@
 Changelog for the [`directory`][1] package
 ==========================================
 
+## 1.3.0.0 (November 2016)
+
+  * Drop trailing slashes in `canonicalizePath`
+    ([#63](https://github.com/haskell/directory/issues/63))
+
 ## 1.2.7.1 (November 2016)
 
   * Don't abort `removePathForcibly` if files or directories go missing.
diff --git a/directory.cabal b/directory.cabal
index 75163dc..86652a4 100644
--- a/directory.cabal
+++ b/directory.cabal
@@ -1,5 +1,5 @@
 name:           directory
-version:        1.2.7.1
+version:        1.3.0.0
 -- NOTE: Don't forget to update ./changelog.md
 license:        BSD3
 license-file:   LICENSE
diff --git a/tests/CanonicalizePath.hs b/tests/CanonicalizePath.hs
index e9d3672..60294e2 100644
--- a/tests/CanonicalizePath.hs
+++ b/tests/CanonicalizePath.hs
@@ -2,25 +2,63 @@
 module CanonicalizePath where
 #include "util.inl"
 import System.Directory
-import System.FilePath ((</>), hasTrailingPathSeparator, normalise)
+import System.FilePath ((</>), dropTrailingPathSeparator, normalise)
 
 main :: TestEnv -> IO ()
 main _t = do
-  dot' <- canonicalizePath "./"
-  dot <- canonicalizePath "."
-  nul <- canonicalizePath ""
-  T(expectEq) () dot nul
-  T(expect) dot (not (hasTrailingPathSeparator dot))
-  T(expect) dot' (hasTrailingPathSeparator dot')
+  dot <- canonicalizePath ""
+  dot2 <- canonicalizePath "."
+  dot3 <- canonicalizePath "./"
+  dot4 <- canonicalizePath "./."
+  T(expectEq) () dot (dropTrailingPathSeparator dot)
+  T(expectEq) () dot dot2
+  T(expectEq) () dot dot3
+  T(expectEq) () dot dot4
 
   writeFile "bar" ""
   bar <- canonicalizePath "bar"
+  bar2 <- canonicalizePath "bar/"
+  bar3 <- canonicalizePath "bar/."
+  bar4 <- canonicalizePath "bar/./"
+  bar5 <- canonicalizePath "./bar"
+  bar6 <- canonicalizePath "./bar/"
+  bar7 <- canonicalizePath "./bar/."
   T(expectEq) () bar (normalise (dot </> "bar"))
+  T(expectEq) () bar bar2
+  T(expectEq) () bar bar3
+  T(expectEq) () bar bar4
+  T(expectEq) () bar bar5
+  T(expectEq) () bar bar6
+  T(expectEq) () bar bar7
 
   createDirectory "foo"
-  foo <- canonicalizePath "foo/"
-  T(expectEq) () foo (normalise (dot </> "foo/"))
+  foo <- canonicalizePath "foo"
+  foo2 <- canonicalizePath "foo/"
+  foo3 <- canonicalizePath "foo/."
+  foo4 <- canonicalizePath "foo/./"
+  foo5 <- canonicalizePath "./foo"
+  foo6 <- canonicalizePath "./foo/"
+  T(expectEq) () foo (normalise (dot </> "foo"))
+  T(expectEq) () foo foo2
+  T(expectEq) () foo foo3
+  T(expectEq) () foo foo4
+  T(expectEq) () foo foo5
+  T(expectEq) () foo foo6
 
   -- should not fail for non-existent paths
   fooNon <- canonicalizePath "foo/non-existent"
+  fooNon2 <- canonicalizePath "foo/non-existent/"
+  fooNon3 <- canonicalizePath "foo/non-existent/."
+  fooNon4 <- canonicalizePath "foo/non-existent/./"
+  fooNon5 <- canonicalizePath "./foo/non-existent"
+  fooNon6 <- canonicalizePath "./foo/non-existent/"
+  fooNon7 <- canonicalizePath "./foo/./non-existent"
+  fooNon8 <- canonicalizePath "./foo/./non-existent/"
   T(expectEq) () fooNon (normalise (foo </> "non-existent"))
+  T(expectEq) () fooNon fooNon2
+  T(expectEq) () fooNon fooNon3
+  T(expectEq) () fooNon fooNon4
+  T(expectEq) () fooNon fooNon5
+  T(expectEq) () fooNon fooNon6
+  T(expectEq) () fooNon fooNon7
+  T(expectEq) () fooNon fooNon8