diff options
author | Sasha Bogicevic <sasa.bogicevic@pm.me> | 2021-04-20 18:13:35 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-04-26 23:58:56 -0400 |
commit | dd0a95a34657c5b6de003f7177242af990c924aa (patch) | |
tree | 7b12f93a1aac65a1072855243d3d6e08f15e79a5 | |
parent | 72c1812feecd2aff2a96b629063ba90a2f4cdb7b (diff) | |
download | haskell-dd0a95a34657c5b6de003f7177242af990c924aa.tar.gz |
18000 Use GHC.IO.catchException in favor of Exception.catch
fix #18000
-rw-r--r-- | compiler/GHC/Data/IOEnv.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Data/Maybe.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Runtime/Interpreter.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/SysTools/Tasks.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/SysTools/Terminal.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Types/Error.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Utils/Exception.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Utils/TmpFs.hs | 8 | ||||
-rw-r--r-- | utils/ghc-pkg/Main.hs | 5 |
9 files changed, 27 insertions, 22 deletions
diff --git a/compiler/GHC/Data/IOEnv.hs b/compiler/GHC/Data/IOEnv.hs index 5a3c56db3f..29cd831ecb 100644 --- a/compiler/GHC/Data/IOEnv.hs +++ b/compiler/GHC/Data/IOEnv.hs @@ -36,6 +36,7 @@ import GHC.Prelude import GHC.Driver.Session import {-# SOURCE #-} GHC.Driver.Hooks +import GHC.IO (catchException) import GHC.Utils.Exception import GHC.Unit.Module import GHC.Utils.Panic @@ -183,7 +184,7 @@ safeTry act = do -- Fork, so that 'act' is safe from all asynchronous exceptions other than the ones we send it t <- forkIO $ try (restore act) >>= putMVar var restore (readMVar var) - `catch` \(e :: SomeException) -> do + `catchException` \(e :: SomeException) -> do -- Control reaches this point only if the parent thread was sent an async exception -- In that case, kill the 'act' thread and re-raise the exception killThread t diff --git a/compiler/GHC/Data/Maybe.hs b/compiler/GHC/Data/Maybe.hs index ac9c687b62..9d47c8ccd8 100644 --- a/compiler/GHC/Data/Maybe.hs +++ b/compiler/GHC/Data/Maybe.hs @@ -26,10 +26,11 @@ module GHC.Data.Maybe ( ) where import GHC.Prelude +import GHC.IO (catchException) import Control.Monad import Control.Monad.Trans.Maybe -import Control.Exception (catch, SomeException(..)) +import Control.Exception (SomeException(..)) import Data.Maybe import Data.Foldable ( foldlM ) import GHC.Utils.Misc (HasCallStack) @@ -93,7 +94,7 @@ liftMaybeT act = MaybeT $ Just `liftM` act -- | Try performing an 'IO' action, failing on error. tryMaybeT :: IO a -> MaybeT IO a -tryMaybeT action = MaybeT $ catch (Just `fmap` action) handler +tryMaybeT action = MaybeT $ catchException (Just `fmap` action) handler where handler (SomeException _) = return Nothing diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs index d6f2979848..25674396d3 100644 --- a/compiler/GHC/Runtime/Interpreter.hs +++ b/compiler/GHC/Runtime/Interpreter.hs @@ -59,6 +59,7 @@ module GHC.Runtime.Interpreter import GHC.Prelude +import GHC.IO (catchException) import GHC.Driver.Ppr (showSDoc) import GHC.Driver.Env import GHC.Driver.Session @@ -547,19 +548,19 @@ findSystemLibrary interp str = interpCmd interp (FindSystemLibrary str) iservCall :: Binary a => IServInstance -> Message a -> IO a iservCall iserv msg = remoteCall (iservPipe iserv) msg - `catch` \(e :: SomeException) -> handleIServFailure iserv e + `catchException` \(e :: SomeException) -> handleIServFailure iserv e -- | Read a value from the iserv process readIServ :: IServInstance -> Get a -> IO a readIServ iserv get = readPipe (iservPipe iserv) get - `catch` \(e :: SomeException) -> handleIServFailure iserv e + `catchException` \(e :: SomeException) -> handleIServFailure iserv e -- | Send a value to the iserv process writeIServ :: IServInstance -> Put -> IO () writeIServ iserv put = writePipe (iservPipe iserv) put - `catch` \(e :: SomeException) -> handleIServFailure iserv e + `catchException` \(e :: SomeException) -> handleIServFailure iserv e handleIServFailure :: IServInstance -> SomeException -> IO a handleIServFailure iserv e = do diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs index 0fb74233fc..a3bde302bc 100644 --- a/compiler/GHC/SysTools/Tasks.hs +++ b/compiler/GHC/SysTools/Tasks.hs @@ -12,6 +12,7 @@ module GHC.SysTools.Tasks where import GHC.Prelude import GHC.Platform import GHC.ForeignSrcLang +import GHC.IO (catchException) import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersionMin, supportedLlvmVersionMax, llvmVersionStr, parseLlvmVersion) @@ -190,7 +191,7 @@ runClang logger dflags args = traceToolCommand logger dflags "clang" $ do args1 = map Option (getOpts dflags opt_a) args2 = args0 ++ args1 ++ args mb_env <- getGccEnv args2 - catch + catchException (runSomethingFiltered logger dflags id "Clang (Assembler)" clang args2 Nothing mb_env) (\(err :: SomeException) -> do errorMsg logger dflags $ diff --git a/compiler/GHC/SysTools/Terminal.hs b/compiler/GHC/SysTools/Terminal.hs index fb122865f0..1c04e21c34 100644 --- a/compiler/GHC/SysTools/Terminal.hs +++ b/compiler/GHC/SysTools/Terminal.hs @@ -3,15 +3,15 @@ module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where import GHC.Prelude +import GHC.IO (catchException) #if defined(MIN_VERSION_terminfo) -import Control.Exception (catch) import Data.Maybe (fromMaybe) import System.Console.Terminfo (SetupTermError, Terminal, getCapability, setupTermFromEnv, termColors) import System.Posix (queryTerminal, stdError) #elif defined(mingw32_HOST_OS) -import Control.Exception (catch, try) +import Control.Exception (try) -- import Data.Bits ((.|.), (.&.)) import Foreign (Ptr, peek, with) import qualified Graphics.Win32 as Win32 @@ -43,7 +43,7 @@ stderrSupportsAnsiColors' = do stderr_available <- queryTerminal stdError if stderr_available then fmap termSupportsColors setupTermFromEnv - `catch` \ (_ :: SetupTermError) -> pure False + `catchException` \ (_ :: SetupTermError) -> pure False else pure False where @@ -52,7 +52,7 @@ stderrSupportsAnsiColors' = do #elif defined(mingw32_HOST_OS) h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE - `catch` \ (_ :: IOError) -> + `catchException` \ (_ :: IOError) -> pure Win32.nullHANDLE if h == Win32.nullHANDLE then pure False @@ -72,7 +72,7 @@ stderrSupportsAnsiColors' = do enableVTP h mode = do setConsoleMode h (modeAddVTP mode) modeHasVTP <$> getConsoleMode h - `catch` \ (_ :: IOError) -> + `catchException` \ (_ :: IOError) -> pure False modeHasVTP :: Win32.DWORD -> Bool diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs index fe45954310..e995ad8a4b 100644 --- a/compiler/GHC/Types/Error.hs +++ b/compiler/GHC/Types/Error.hs @@ -48,6 +48,7 @@ import GHC.Prelude import GHC.Driver.Flags import GHC.Data.Bag +import GHC.IO (catchException) import GHC.Utils.Outputable as Outputable import qualified GHC.Utils.Ppr.Colour as Col import GHC.Types.SrcLoc as SrcLoc @@ -55,8 +56,6 @@ import GHC.Data.FastString (unpackFS) import GHC.Data.StringBuffer (atLine, hGetStringBuffer, len, lexemeToString) import GHC.Utils.Json -import System.IO.Error ( catchIOError ) - {- Note [Messages] ~~~~~~~~~~~~~~~ @@ -371,7 +370,7 @@ getCaretDiagnostic msg_class (RealSrcSpan span _) = where getSrcLine fn i = getLine i (unpackFS fn) - `catchIOError` \_ -> + `catchException` \(_ :: IOError) -> pure Nothing getLine i fn = do diff --git a/compiler/GHC/Utils/Exception.hs b/compiler/GHC/Utils/Exception.hs index 46c1f9d37d..4d3c777932 100644 --- a/compiler/GHC/Utils/Exception.hs +++ b/compiler/GHC/Utils/Exception.hs @@ -10,13 +10,14 @@ module GHC.Utils.Exception import GHC.Prelude +import GHC.IO (catchException) import Control.Exception as CE import Control.Monad.IO.Class import Control.Monad.Catch -- Monomorphised versions of exception-handling utilities catchIO :: IO a -> (IOException -> IO a) -> IO a -catchIO = CE.catch +catchIO = catchException handleIO :: (IOException -> IO a) -> IO a -> IO a handleIO = flip catchIO diff --git a/compiler/GHC/Utils/TmpFs.hs b/compiler/GHC/Utils/TmpFs.hs index d108f55b3b..fb671ad486 100644 --- a/compiler/GHC/Utils/TmpFs.hs +++ b/compiler/GHC/Utils/TmpFs.hs @@ -300,7 +300,7 @@ getTempDir logger tmpfs dflags = do Just dir -> do removeDirectory our_dir return dir - `catchIO` \e -> if isAlreadyExistsError e + `Exception.catchIO` \e -> if isAlreadyExistsError e then mkTempDir prefix else ioError e {- Note [Deterministic base name] @@ -343,7 +343,7 @@ removeTmpFiles logger dflags fs (non_deletees, deletees) = partition isHaskellUserSrcFilename fs removeWith :: Logger -> DynFlags -> (FilePath -> IO ()) -> FilePath -> IO () -removeWith logger dflags remover f = remover f `catchIO` +removeWith logger dflags remover f = remover f `Exception.catchIO` (\e -> let msg = if isDoesNotExistError e then text "Warning: deleting non-existent" <+> text f @@ -394,7 +394,7 @@ withTempDirectory targetDir template = (ignoringIOErrors . removeDirectoryRecursive) ignoringIOErrors :: IO () -> IO () -ignoringIOErrors ioe = ioe `catchIO` const (return ()) +ignoringIOErrors ioe = ioe `Exception.catchIO` const (return ()) createTempDirectory :: FilePath -> String -> IO FilePath @@ -405,5 +405,5 @@ createTempDirectory dir template = do let path = dir </> template ++ show x createDirectory path return path - `catchIO` \e -> if isAlreadyExistsError e + `Exception.catchIO` \e -> if isAlreadyExistsError e then findTempName (x+1) else ioError e diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index fc33f3ce37..a83f60b87a 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -78,6 +78,7 @@ import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getArgs, getProgName, getEnv ) import System.IO import System.IO.Error +import GHC.IO ( catchException ) import GHC.IO.Exception (IOErrorType(InappropriateType)) import Data.List ( group, sort, sortBy, nub, partition, find , intercalate, intersperse, foldl', unfoldr @@ -750,7 +751,7 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do else do db <- readParseDatabase verbosity mb_user_conf mode use_cache db_path - `Exception.catch` couldntOpenDbForModification db_path + `catchException` couldntOpenDbForModification db_path let ro_db = db { packageDbLock = GhcPkg.DbOpenReadOnly } return (ro_db, Just db) | db_path <- final_stack ] @@ -2236,7 +2237,7 @@ installSignalHandlers = do #endif catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -catchIO = Exception.catch +catchIO = catchException tryIO :: IO a -> IO (Either Exception.IOException a) tryIO = Exception.try |