Fix createDirectoryIfMissing silently failing

In some cases, `createDirectoryIfMissing` would silently fail. For
example the following invocation would fail to report via an exception
that it couldn't create a folder:

  let testdir = "/tmp/sometestdir"
  writeFile testdir ""
  createDirectoryIfMissing False testdir

A related issue was the failure to create a folder hierarchy due to lack
of permissions, for instance

  createDirectoryIfMissing True "/foo"

for a non-priviledged user would silently fail (i.e. no exception
thrown), even though "/foo" was not created.

Fixes #4 (see also #10 for discussion)

System/Directory.hs

@@ -393,19 +393,15 @@ createDirectoryIfMissing create_parents path0
           -- This caused GHCi to crash when loading a module in the root
           -- directory.
           | isAlreadyExistsError e
-         || isPermissionError e -> (do
+         || isPermissionError e -> do
 #ifdef mingw32_HOST_OS
-              withFileStatus "createDirectoryIfMissing" dir $ \st -> do
-                 isDir <- isDirectory st
-                 if isDir then return ()
-                          else throwIO e
+              canIgnore <- (withFileStatus "createDirectoryIfMissing" dir isDirectory)
 #else
-              stat <- Posix.getFileStatus dir
-              if Posix.isDirectory stat
-                 then return ()
-                 else throwIO e
+              canIgnore <- (Posix.isDirectory `fmap` Posix.getFileStatus dir)
 #endif
-              ) `E.catch` ((\_ -> return ()) :: IOException -> IO ())
+                           `catch` ((\ _ -> return (isAlreadyExistsError e))
+                                    :: IOException -> IO Bool)
+              unless canIgnore (throwIO e)
           | otherwise              -> throwIO e
 
 #if __GLASGOW_HASKELL__

tests/createDirectoryIfMissing001.hs

@@ -43,6 +43,18 @@ main = do
 
   cleanup
 
+  -- these are all supposed to fail
+
+  writeFile testdir testdir
+  report $ createDirectoryIfMissing False testdir
+  removeFile testdir
+  cleanup
+
+  writeFile testdir testdir
+  report $ createDirectoryIfMissing True testdir_a
+  removeFile testdir
+  cleanup
+
 -- createDirectoryIfMissing is allowed to fail with isDoesNotExistError if
 -- another process/thread removes one of the directories during the proces
 -- of creating the hierarchy.

tests/createDirectoryIfMissing001.stdout

@@ -4,3 +4,5 @@ createDirectoryIfMissing001.d/a: createDirectory: does not exist (No such file o
 ()
 ()
 ()
+createDirectoryIfMissing001.d: createDirectory: already exists (File exists)
+createDirectoryIfMissing001.d/a: createDirectory: inappropriate type (Not a directory)