[commit: packages/directory] master: Refactor imports of Control.Exception (and some others) (34ed1af)

git at git.haskell.org git at git.haskell.org
Fri Dec 18 09:50:43 UTC 2015


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

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

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

commit 34ed1af53dd37dc60f7b2e6d3b171b582f636c48
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Mon May 25 02:44:10 2015 -0400

    Refactor imports of Control.Exception (and some others)


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

34ed1af53dd37dc60f7b2e6d3b171b582f636c48
 System/Directory.hs | 74 ++++++++++++++++++++++++++++-------------------------
 1 file changed, 39 insertions(+), 35 deletions(-)

diff --git a/System/Directory.hs b/System/Directory.hs
index 49c8c1e..e871797 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -82,6 +82,8 @@ module System.Directory
     , getModificationTime
 
    ) where
+import Control.Exception ( bracket, bracketOnError )
+import Control.Monad ( when, unless )
 #if !MIN_VERSION_base(4, 8, 0)
 import Data.Functor ((<$>))
 #endif
@@ -95,8 +97,16 @@ import Data.Maybe
 import System.FilePath
 import System.IO
 import System.IO.Error
-import Control.Monad           ( when, unless )
-import Control.Exception.Base as E
+  ( catchIOError
+  , ioeSetErrorString
+  , ioeSetFileName
+  , ioeSetLocation
+  , isAlreadyExistsError
+  , isDoesNotExistError
+  , isPermissionError
+  , mkIOError
+  , modifyIOError
+  , tryIOError )
 
 #ifdef __HUGS__
 import Hugs.Directory
@@ -379,16 +389,15 @@ createDirectoryIfMissing create_parents path0
     parents = reverse . scanl1 (</>) . splitDirectories . normalise
 
     createDirs []         = return ()
-    createDirs (dir:[])   = createDir dir throwIO
+    createDirs (dir:[])   = createDir dir ioError
     createDirs (dir:dirs) =
       createDir dir $ \_ -> do
         createDirs dirs
-        createDir dir throwIO
+        createDir dir ioError
 
-    createDir :: FilePath -> (IOException -> IO ()) -> IO ()
     createDir dir notExistHandler = do
-      r <- E.try $ createDirectory dir
-      case (r :: Either IOException ()) of
+      r <- tryIOError (createDirectory dir)
+      case r of
         Right ()                   -> return ()
         Left  e
           | isDoesNotExistError  e -> notExistHandler e
@@ -406,16 +415,17 @@ 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
+              canIgnore <- isDir `catchIOError` \ _ ->
+                           return (isAlreadyExistsError e)
+              unless canIgnore (ioError e)
+          | otherwise              -> ioError e
+      where
 #ifdef mingw32_HOST_OS
-              canIgnore <- (withFileStatus "createDirectoryIfMissing" dir isDirectory)
+        isDir = withFileStatus "createDirectoryIfMissing" dir isDirectory
 #else
-              canIgnore <- (Posix.isDirectory <$> Posix.getFileStatus dir)
+        isDir = (Posix.isDirectory <$> Posix.getFileStatus dir)
 #endif
-                           `E.catch` ((\ _ -> return (isAlreadyExistsError e))
-                                    :: IOException -> IO Bool)
-              unless canIgnore (throwIO e)
-          | otherwise              -> throwIO e
 
 #if __GLASGOW_HASKELL__
 
@@ -726,7 +736,7 @@ copied to /new/, if possible.
 
 copyFile :: FilePath -> FilePath -> IO ()
 copyFile fromFPath toFPath =
-    copy `catchIOError` (\exc -> throwIO $ ioeSetLocation exc "copyFile")
+    copy `catchIOError` (\ exc -> ioError (ioeSetLocation exc "copyFile"))
     where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
                  bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
                  do allocaBytes bufferSize $ copyContents hFrom hTmp
@@ -1051,7 +1061,7 @@ doesDirectoryExist name =
    (do stat <- Posix.getFileStatus name
        return (Posix.isDirectory stat))
 #endif
-   `E.catch` ((\ _ -> return False) :: IOException -> IO Bool)
+   `catchIOError` \ _ -> return False
 
 {- |The operation 'doesFileExist' returns 'True'
 if the argument file exists and is not a directory, and 'False' otherwise.
@@ -1065,7 +1075,7 @@ doesFileExist name =
    (do stat <- Posix.getFileStatus name
        return (not (Posix.isDirectory stat)))
 #endif
-   `E.catch` ((\ _ -> return False) :: IOException -> IO Bool)
+   `catchIOError` \ _ -> return False
 
 {- |The 'getModificationTime' operation returns the
 clock time at which the file or directory was last modified.
@@ -1164,19 +1174,14 @@ The home directory for the current user does not exist, or
 cannot be found.
 -}
 getHomeDirectory :: IO FilePath
-getHomeDirectory =
-  modifyIOError ((`ioeSetLocation` "getHomeDirectory")) $ do
+getHomeDirectory = modifyIOError (`ioeSetLocation` "getHomeDirectory") get
+  where
 #if defined(mingw32_HOST_OS)
-    r <- E.try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_PROFILE nullPtr 0
-    case (r :: Either IOException String) of
-      Right s -> return s
-      Left  _ -> do
-        r1 <- E.try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_WINDOWS nullPtr 0
-        case r1 of
-          Right s -> return s
-          Left  e -> ioError (e :: IOException)
+    get = getFolderPath Win32.cSIDL_PROFILE `catchIOError` \ _ ->
+          getFolderPath Win32.cSIDL_WINDOWS
+    getFolderPath what = Win32.sHGetFolderPath nullPtr what nullPtr 0
 #else
-    getEnv "HOME"
+    get = getEnv "HOME"
 #endif
 
 -- | Special directories for storing user-specific application data,
@@ -1268,7 +1273,7 @@ tryIOErrorType :: (IOError -> Bool) -> IO a -> IO (Either IOError a)
 tryIOErrorType check action = do
   result <- tryIOError action
   case result of
-    Left  err -> if check err then return (Left err) else throwIO err
+    Left  err -> if check err then return (Left err) else ioError err
     Right val -> return (Right val)
 #endif
 
@@ -1304,7 +1309,7 @@ getAppUserDataDirectory :: FilePath     -- ^ a relative path that is appended
                                         --   to the path
                         -> IO FilePath
 getAppUserDataDirectory appName = do
-  modifyIOError ((`ioeSetLocation` "getAppUserDataDirectory")) $ do
+  modifyIOError (`ioeSetLocation` "getAppUserDataDirectory") $ do
 #if defined(mingw32_HOST_OS)
     s <- Win32.sHGetFolderPath nullPtr Win32.cSIDL_APPDATA nullPtr 0
     return (s++'\\':appName)
@@ -1335,7 +1340,7 @@ cannot be found.
 -}
 getUserDocumentsDirectory :: IO FilePath
 getUserDocumentsDirectory = do
-  modifyIOError ((`ioeSetLocation` "getUserDocumentsDirectory")) $ do
+  modifyIOError (`ioeSetLocation` "getUserDocumentsDirectory") $ do
 #if defined(mingw32_HOST_OS)
     Win32.sHGetFolderPath nullPtr Win32.cSIDL_PERSONAL nullPtr 0
 #else
@@ -1369,13 +1374,12 @@ The operating system has no notion of temporary directory.
 The function doesn\'t verify whether the path exists.
 -}
 getTemporaryDirectory :: IO FilePath
-getTemporaryDirectory = do
+getTemporaryDirectory =
 #if defined(mingw32_HOST_OS)
   Win32.getTemporaryDirectory
 #else
-  getEnv "TMPDIR"
-    `catchIOError` \e -> if isDoesNotExistError e then return "/tmp"
-                          else throwIO e
+  getEnv "TMPDIR" `catchIOError` \ err ->
+  if isDoesNotExistError err then return "/tmp" else ioError err
 #endif
 
 -- ToDo: This should be determined via autoconf (AC_EXEEXT)



More information about the ghc-commits mailing list