Commit 20b4ab03 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Merge pull request #1377 from benmachine/updated-nocompat

Removing some redundant exception compatibility code
parents dd2f425b 60c08b86
......@@ -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 (
Exception.IOException,
onException,
catchIO,
catchExit,
throwIOIO,
tryIO,
) where
import System.Exit
import qualified Control.Exception as Exception
onException :: IO a -> IO b -> IO a
onException = Exception.onException
throwIOIO :: Exception.IOException -> IO a
throwIOIO = Exception.throwIO
tryIO :: IO a -> IO (Either Exception.IOException a)
tryIO = Exception.try
......
......@@ -19,7 +19,8 @@ import System.IO.Error (isAlreadyExistsError)
import System.Posix.Internals (withFilePath)
import Foreign.C (CInt)
import GHC.IO.Handle.FD (fdToHandle)
import Distribution.Compat.Exception (onException, tryIO)
import Distribution.Compat.Exception (tryIO)
import Control.Exception (onException)
import Foreign.C (getErrno, errnoToIOError)
import System.Posix.Internals (c_getpid)
......
......@@ -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."
......
......@@ -191,7 +191,7 @@ import qualified Distribution.ModuleName as ModuleName
import Distribution.Version
(Version(..))
import Control.Exception (evaluate)
import Control.Exception (IOException, evaluate, throwIO)
import System.Process (runProcess)
import Control.Concurrent (forkIO)
......@@ -206,7 +206,7 @@ import Distribution.Compat.CopyFile
import Distribution.Compat.TempFile
( openTempFile, createTempDirectory )
import Distribution.Compat.Exception
( IOException, throwIOIO, tryIO, catchIO, catchExit )
( tryIO, catchIO, catchExit )
import Distribution.Verbosity
#ifdef VERSION_base
......@@ -742,11 +742,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
......@@ -765,9 +765,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
......
......@@ -33,13 +33,12 @@ import qualified Data.Set as S
import Data.Maybe
( isJust, fromMaybe, maybeToList )
import Control.Exception as Exception
( bracket, handleJust )
import Control.Exception as Exception
( Exception(toException), catches, Handler(Handler), IOException )
( Exception(toException), bracket, catches, Handler(Handler), handleJust
, IOException, SomeException )
import System.Exit
( ExitCode )
import Distribution.Compat.Exception
( SomeException, catchIO, catchExit )
( catchIO, catchExit )
import Control.Monad
( when, unless )
import System.Directory
......
......@@ -30,7 +30,7 @@ import Distribution.Version
import Data.Map (Map)
import Network.URI (URI)
import Data.ByteString.Lazy (ByteString)
import Distribution.Compat.Exception
import Control.Exception
( SomeException )
newtype Username = Username { unUsername :: String }
......
{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
module Distribution.Compat.Exception (
SomeException,
mask,
mask_,
onException,
catchIO,
handleIO,
catchExit,
throwIOIO
) where
import System.Exit
import qualified Control.Exception as Exception
import Control.Exception (SomeException)
#if MIN_VERSION_base(4,3,0)
-- it's much less of a headache if we re-export the "real" mask and mask_
......@@ -33,17 +28,8 @@ mask_ :: IO a -> IO a
mask_ = block
#endif
onException :: IO a -> IO b -> IO a
onException = Exception.onException
throwIOIO :: Exception.IOException -> IO a
throwIOIO = Exception.throwIO
catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
catchIO = Exception.catch
handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
handleIO = flip catchIO
catchExit :: IO a -> (ExitCode -> IO a) -> IO a
catchExit = Exception.catch
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