[commit: packages/directory] master: Improve error message of getCurrentDirectory when cwd no longer exists (dccac6b)

[git at git.haskell.org]

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

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

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

commit dccac6b66068d7f6aba4743ee9b18e360867712e
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Sun Jan 3 15:58:36 2016 -0500

    Improve error message of getCurrentDirectory when cwd no longer exists
    
    Fixes #39.


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

dccac6b66068d7f6aba4743ee9b18e360867712e
 System/Directory.hs | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/System/Directory.hs b/System/Directory.hs
index 511b7c4..d67a249 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -1070,11 +1070,17 @@ listDirectory path =
 --
 #ifdef __GLASGOW_HASKELL__
 getCurrentDirectory :: IO FilePath
-getCurrentDirectory = do
+getCurrentDirectory =
+  modifyIOError (`ioeSetLocation` "getCurrentDirectory") $
+  specializeErrorString
+    "Current working directory no longer exists"
+    isDoesNotExistError
+    getCwd
+  where
 #ifdef mingw32_HOST_OS
-  Win32.getCurrentDirectory
+    getCwd = Win32.getCurrentDirectory
 #else
-  Posix.getWorkingDirectory
+    getCwd = Posix.getWorkingDirectory
 #endif
 
 -- | Change the working directory to the given path.
@@ -1499,6 +1505,13 @@ tryIOErrorType check action = do
     Right val -> return (Right val)
 #endif
 
+specializeErrorString :: String -> (IOError -> Bool) -> IO a -> IO a
+specializeErrorString str errType action = do
+  mx <- tryIOErrorType errType action
+  case mx of
+    Left  e -> ioError (ioeSetErrorString e str)
+    Right x -> return x
+
 -- | Obtain the path to a special directory for storing user-specific
 --   application data (traditional Unix location).  Except for backward
 --   compatibility reasons, newer applications may prefer the the