18000 Use GHC.IO.catchException in favor of Exception.catch

fix #18000

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