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.

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.

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.

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

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