[commit: packages/directory] master: Fix trailing path sep behavior of canonicalizePath and makeAbsolute (67c18f0)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/67c18f0be0f3f94d0deed1aa13a4423e816fb13d/directory

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

commit 67c18f0be0f3f94d0deed1aa13a4423e816fb13d
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Mon Feb 8 06:54:53 2016 -0500

    Fix trailing path sep behavior of canonicalizePath and makeAbsolute
    
    It used to be that `canonicalizePath "."` returned a path without a
    trailing slash, but now it does.  This is due to the use of `normalise`
    in `makeAbsolute`, which adds extra slashes whenever `.` gets stripped
    out at the end.  This commit restores the original behavior for
    `canonicalizePath`, and also affects `makeAbsolute` in a similar manner.
    
    Fixes #42.


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

67c18f0be0f3f94d0deed1aa13a4423e816fb13d
 System/Directory.hs       | 41 ++++++++++++++++++++++++++++-------------
 changelog.md              | 10 ++++++++++
 directory.cabal           |  2 +-
 tests/CanonicalizePath.hs |  5 ++++-
 4 files changed, 43 insertions(+), 15 deletions(-)

diff --git a/System/Directory.hs b/System/Directory.hs
index d67a249..0c6e830 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -828,13 +828,13 @@ canonicalizePath = \ path ->
   modifyIOError ((`ioeSetLocation` "canonicalizePath") .
                  (`ioeSetFileName` path)) $
   -- normalise does more stuff, like upper-casing the drive letter
-  normalise <$> (transform =<< makeAbsolute path)
+  normalise <$> (transform =<< prependCurrentDirectory path)
   where
 #if defined(mingw32_HOST_OS)
     transform path = Win32.getFullPathName path
                      `catchIOError` \ _ -> return path
 #else
-    transform path = copySlash path <$> do
+    transform path = matchTrailingSeparator path <$> do
       encoding <- getFileSystemEncoding
       realpathPrefix encoding (reverse (zip prefixes suffixes)) path
       where segments = splitPath path
@@ -856,25 +856,40 @@ canonicalizePath = \ path ->
 
     doesPathExist path = (Posix.getFileStatus path >> return True)
                          `catchIOError` \ _ -> return False
-
-    -- make sure trailing slash is preserved
-    copySlash path | hasTrailingPathSeparator path = addTrailingPathSeparator
-                   | otherwise                     = id
 #endif
 
--- | Make a path absolute by prepending the current directory (if it isn't
--- already absolute) and applying 'normalise' to the result.
+-- | Convert a (possibly) relative path into an absolute path.  This is nearly
+-- equivalent to prepending the current directory (if the path isn't already
+-- absolute) and then applying 'normalise' to the result.  The trailing path
+-- separator, if any, is preserved during the process.
 --
 -- If the path is already absolute, the operation never fails.  Otherwise, the
 -- operation may fail with the same exceptions as 'getCurrentDirectory'.
 --
 -- @since 1.2.2.0
 makeAbsolute :: FilePath -> IO FilePath
-makeAbsolute = (normalise <$>) . absolutize
-  where absolutize path -- avoid the call to `getCurrentDirectory` if we can
-          | isRelative path = (</> path) . addTrailingPathSeparator <$>
-                              getCurrentDirectory
-          | otherwise       = return path
+makeAbsolute path =
+  modifyIOError ((`ioeSetLocation` "makeAbsolute") .
+                 (`ioeSetFileName` path)) $
+  matchTrailingSeparator path . normalise <$> prependCurrentDirectory path
+
+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
+
+matchTrailingSeparator :: FilePath -> FilePath -> FilePath
+matchTrailingSeparator path
+  | hasTrailingPathSeparator path = addTrailingPathSeparator
+  | otherwise                     = dropTrailingPathSeparator
 
 -- | 'makeRelative' the current directory.
 makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
diff --git a/changelog.md b/changelog.md
index 13b6af3..6e9e984 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,6 +1,16 @@
 Changelog for the [`directory`][1] package
 ==========================================
 
+## 1.2.5.1 (February 2015)
+
+  * Fix the behavior of trailing path separators in `canonicalizePath` as well
+    as `makeAbsolute` when applied to the current directory; they should now
+    match the behavior of `canonicalizePath` prior to 1.2.3.0 (when the bug
+    was introduced)
+    ([#42](https://github.com/haskell/directory/issues/42))
+
+  * Set the location in IO errors from `makeAbsolute`.
+
 ## 1.2.5.0 (December 2015)
 
   * Add `listDirectory`, which is similar to `getDirectoryContents`
diff --git a/directory.cabal b/directory.cabal
index d112a77..5a58dcf 100644
--- a/directory.cabal
+++ b/directory.cabal
@@ -1,5 +1,5 @@
 name:           directory
-version:        1.2.5.0
+version:        1.2.5.1
 -- NOTE: Don't forget to update ./changelog.md
 license:        BSD3
 license-file:   LICENSE
diff --git a/tests/CanonicalizePath.hs b/tests/CanonicalizePath.hs
index 4d05198..e9d3672 100644
--- a/tests/CanonicalizePath.hs
+++ b/tests/CanonicalizePath.hs
@@ -2,13 +2,16 @@
 module CanonicalizePath where
 #include "util.inl"
 import System.Directory
-import System.FilePath ((</>), normalise)
+import System.FilePath ((</>), hasTrailingPathSeparator, 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')
 
   writeFile "bar" ""
   bar <- canonicalizePath "bar"