Commit 60c08b86 authored by Ben Millwood's avatar Ben Millwood
Browse files

Remove more exception compatibility code

This one removes Cabal's throwIOIO in favour of
Control.Exception.throwIO.

Note that throwIO is more polymorphic than throwIOIO, but in all current
use cases the same type is inferred anyway.
parent 80a2226a
......@@ -13,11 +13,9 @@ module Distribution.Compat.CopyFile (
import Control.Monad
( when )
import Control.Exception
( bracket, bracketOnError )
( bracket, bracketOnError, throwIO )
import Distribution.Compat.Exception
( catchIO )
import Distribution.Compat.Exception
( throwIOIO )
import System.IO.Error
( ioeSetLocation )
import System.Directory
......@@ -64,7 +62,7 @@ setDirOrdinary = setFileExecutable
copyFile :: FilePath -> FilePath -> IO ()
copyFile fromFPath toFPath =
copy
`catchIO` (\ioe -> throwIOIO (ioeSetLocation ioe "copyFile"))
`catchIO` (\ioe -> throwIO (ioeSetLocation ioe "copyFile"))
where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
do allocaBytes bufferSize $ copyContents hFrom hTmp
......
module Distribution.Compat.Exception (
catchIO,
catchExit,
throwIOIO,
tryIO,
) where
import System.Exit
import qualified Control.Exception as Exception
throwIOIO :: Exception.IOException -> IO a
throwIOIO = Exception.throwIO
tryIO :: IO a -> IO (Either Exception.IOException a)
tryIO = Exception.try
......
......@@ -136,7 +136,8 @@ import System.Directory(removeFile, doesFileExist,
doesDirectoryExist, removeDirectoryRecursive)
import System.Exit
import System.IO.Error (isDoesNotExistError)
import Distribution.Compat.Exception (catchIO, throwIOIO)
import Control.Exception (throwIO)
import Distribution.Compat.Exception (catchIO)
import Control.Monad (when)
import Data.List (intercalate, unionBy, nub, (\\))
......@@ -646,7 +647,7 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
= action
`catchIO` \ioe -> if isDoesNotExistError ioe
then die notFoundMsg
else throwIOIO ioe
else throwIO ioe
notFoundMsg = "The package has a './configure' script. This requires a "
++ "Unix compatibility toolchain such as MinGW+MSYS or Cygwin."
......
......@@ -187,7 +187,7 @@ import qualified Distribution.ModuleName as ModuleName
import Distribution.Version
(Version(..))
import Control.Exception (IOException, evaluate)
import Control.Exception (IOException, evaluate, throwIO)
import System.Process (runProcess)
import Control.Concurrent (forkIO)
......@@ -202,7 +202,7 @@ import Distribution.Compat.CopyFile
import Distribution.Compat.TempFile
( openTempFile, createTempDirectory )
import Distribution.Compat.Exception
( throwIOIO, tryIO, catchIO, catchExit )
( tryIO, catchIO, catchExit )
import Distribution.Verbosity
#ifdef VERSION_base
......@@ -735,11 +735,11 @@ createDirectoryIfMissingVerbose verbosity create_parents path0
parents = reverse . scanl1 (</>) . splitDirectories . normalise
createDirs [] = return ()
createDirs (dir:[]) = createDir dir throwIOIO
createDirs (dir:[]) = createDir dir throwIO
createDirs (dir:dirs) =
createDir dir $ \_ -> do
createDirs dirs
createDir dir throwIOIO
createDir dir throwIO
createDir :: FilePath -> (IOException -> IO ()) -> IO ()
createDir dir notExistHandler = do
......@@ -758,9 +758,9 @@ createDirectoryIfMissingVerbose verbosity create_parents path0
| isAlreadyExistsError e -> (do
isDir <- doesDirectoryExist dir
if isDir then return ()
else throwIOIO e
else throwIO e
) `catchIO` ((\_ -> return ()) :: IOException -> IO ())
| otherwise -> throwIOIO e
| otherwise -> throwIO e
createDirectoryVerbose :: Verbosity -> FilePath -> IO ()
createDirectoryVerbose verbosity dir = do
......
Supports Markdown
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