Commit 4acde561 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Replace uses of the old try function with the new one

parent 0ecb30d8
......@@ -10,7 +10,7 @@
#endif
module Distribution.Compat.Exception
(onException, catchIO, catchExit, throwIOIO)
(onException, catchIO, catchExit, throwIOIO, tryIO)
where
import System.Exit
......@@ -31,6 +31,13 @@ throwIOIO = Exception.throwIO
throwIOIO = Exception.throwIO . Exception.IOException
#endif
tryIO :: IO a -> IO (Either Exception.IOException a)
#ifdef NEW_EXCEPTION
tryIO = Exception.try
#else
tryIO = Exception.tryJust Exception.ioErrors
#endif
catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
#ifdef NEW_EXCEPTION
catchIO = Exception.catch
......
......@@ -27,7 +27,7 @@ import System.IO (Handle, openTempFile, openBinaryTempFile)
import Data.Bits ((.|.))
import System.Posix.Internals (c_open, c_close, o_CREAT, o_EXCL, o_RDWR,
o_BINARY, o_NONBLOCK, o_NOCTTY)
import System.IO.Error (try, isAlreadyExistsError)
import System.IO.Error (isAlreadyExistsError)
#if __GLASGOW_HASKELL__ >= 611
import System.Posix.Internals (withFilePath)
#else
......@@ -39,7 +39,7 @@ import GHC.IO.Handle.FD (fdToHandle)
#else
import GHC.Handle (fdToHandle)
#endif
import Distribution.Compat.Exception (onException)
import Distribution.Compat.Exception (onException, tryIO)
#endif
import Foreign.C (getErrno, errnoToIOError)
......@@ -190,7 +190,7 @@ createTempDirectory dir template = do
where
findTempName x = do
let dirpath = dir </> template ++ show x
r <- try $ mkPrivateDir dirpath
r <- tryIO $ mkPrivateDir dirpath
case r of
Right _ -> return dirpath
Left e | isAlreadyExistsError e -> findTempName (x+1)
......
......@@ -104,11 +104,12 @@ import Distribution.Verbosity as Verbosity
( Verbosity, normal )
import Distribution.Compat.CopyFile
( setFileExecutable )
import Distribution.Compat.Exception
( tryIO )
import System.FilePath ((</>), (<.>), isAbsolute)
import System.Directory
( getCurrentDirectory, removeDirectoryRecursive )
import System.IO.Error (try)
import Data.Maybe
( isJust, fromMaybe, maybeToList )
......@@ -375,10 +376,10 @@ unregister pkg lbi regFlags = do
(invocationAsSystemScript buildOS invocation)
else runProgramInvocation verbosity invocation
Hugs -> do
_ <- try $ removeDirectoryRecursive (libdir installDirs)
_ <- tryIO $ removeDirectoryRecursive (libdir installDirs)
return ()
NHC -> do
_ <- try $ removeDirectoryRecursive (libdir installDirs)
_ <- tryIO $ removeDirectoryRecursive (libdir installDirs)
return ()
_ ->
die ("only unregistering with GHC and Hugs is implemented")
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment