Fix trailing path sep behavior of canonicalizePath and makeAbsolute

Fixes haskell#42.

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

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`

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

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"