X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FDirectory.hs;h=1df632f25ead83d2ab0d0003d44019c22691345d;hb=12608d12873e6b88c44881b3ff91bba6807affe5;hp=cf179628ed65844d902e34ec5d19c2a394f91aff;hpb=3adeec498777cae875f5cdb61efe723d7221d6e1;p=haskell-directory.git

diff --git a/System/Directory.hs b/System/Directory.hs
index cf17962..1df632f 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -1,3 +1,6 @@
+{-# OPTIONS_GHC -w #-}
+-- XXX We get some warnings on Windows
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  System.Directory
@@ -67,6 +70,7 @@ module System.Directory
    ) where
 
 import Prelude hiding ( catch )
+import qualified Prelude
 
 import System.Environment      ( getEnv )
 import System.FilePath
@@ -365,7 +369,7 @@ removeDirectoryRecursive startLoc = do
               case temp of
                 Left e  -> do isDir <- doesDirectoryExist f
                               -- If f is not a directory, re-throw the error
-                              unless isDir $ throw e
+                              unless isDir $ throw (e :: SomeException)
                               removeDirectoryRecursive f
                 Right _ -> return ()
 
@@ -545,19 +549,17 @@ copyFile fromFPath toFPath =
        return ()
 #else
 copyFile fromFPath toFPath =
-    copy `catch` (\e -> case e of
-                        IOException exc ->
-                            throw $ IOException $ ioeSetLocation exc "copyFile"
-                        _ -> throw e)
+    copy `Prelude.catch` (\exc -> throw $ ioeSetLocation exc "copyFile")
     where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
                  bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
                  do allocaBytes bufferSize $ copyContents hFrom hTmp
                     hClose hTmp
-                    try (copyPermissions fromFPath tmpFPath)
+                    ignoreIOExceptions $ copyPermissions fromFPath tmpFPath
                     renameFile tmpFPath toFPath
           openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"
-          cleanTmp (tmpFPath, hTmp) = do try $ hClose hTmp
-                                         try $ removeFile tmpFPath
+          cleanTmp (tmpFPath, hTmp)
+              = do ignoreIOExceptions $ hClose hTmp
+                   ignoreIOExceptions $ removeFile tmpFPath
           bufferSize = 1024
 
           copyContents hFrom hTo buffer = do
@@ -565,6 +567,10 @@ copyFile fromFPath toFPath =
                   when (count > 0) $ do
                           hPutBuf hTo buffer count
                           copyContents hFrom hTo buffer
+
+          ignoreIOExceptions io = io `catch` ioExceptionIgnorer
+          ioExceptionIgnorer :: IOException -> IO ()
+          ioExceptionIgnorer _ = return ()
 #endif
 
 -- | Given path referring to a file or directory, returns a
@@ -805,20 +811,18 @@ exists and is a directory, and 'False' otherwise.
 -}
 
 doesDirectoryExist :: FilePath -> IO Bool
-doesDirectoryExist name = 
- catch
+doesDirectoryExist name =
    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
-   (\ _ -> return False)
+   `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 
 {- |The operation 'doesFileExist' returns 'True'
 if the argument file exists and is not a directory, and 'False' otherwise.
 -}
 
 doesFileExist :: FilePath -> IO Bool
-doesFileExist name = do 
- catch
+doesFileExist name =
    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
-   (\ _ -> return False)
+   `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 
 {- |The 'getModificationTime' operation returns the
 clock time at which the file or directory was last modified.
@@ -913,11 +917,11 @@ getHomeDirectory :: IO FilePath
 getHomeDirectory =
 #if defined(mingw32_HOST_OS)
   allocaBytes long_path_size $ \pPath -> do
-     r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
-     if (r < 0)
+     r0 <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
+     if (r0 < 0)
        then do
-          r <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
-	  when (r < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
+          r1 <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
+	  when (r1 < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
        else return ()
      peekCString pPath
 #else
@@ -1026,14 +1030,13 @@ getTemporaryDirectory :: IO FilePath
 getTemporaryDirectory = do
 #if defined(mingw32_HOST_OS)
   allocaBytes long_path_size $ \pPath -> do
-     r <- c_GetTempPath (fromIntegral long_path_size) pPath
+     _r <- c_GetTempPath (fromIntegral long_path_size) pPath
      peekCString pPath
 #else
   getEnv "TMPDIR"
 #if !__NHC__
-    `catch` \ex -> case ex of
-                     IOException e | isDoesNotExistError e -> return "/tmp"
-                     _ -> throw ex
+    `Prelude.catch` \e -> if isDoesNotExistError e then return "/tmp"
+                          else throw e
 #else
     `catch` (\ex -> return "/tmp")
 #endif
@@ -1054,6 +1057,7 @@ foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
 
 foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt
 
+raiseUnsupported :: String -> IO ()
 raiseUnsupported loc = 
    ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)