Remove custom ExceptionMonad class (#18075) (updating haddock submodule accordingly)

1 files changed, 10 insertions, 25 deletions

diff --git a/compiler/GHC/Driver/Monad.hs b/compiler/GHC/Driver/Monad.hs
index d0c950baf5..72dc3b9800 100644
--- a/compiler/GHC/Driver/Monad.hs
+++ b/compiler/GHC/Driver/Monad.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, DeriveFunctor, RankNTypes #-}
+{-# LANGUAGE CPP, DeriveFunctor, DerivingVia, RankNTypes #-}
 {-# OPTIONS_GHC -funbox-strict-fields #-}
 -- -----------------------------------------------------------------------------
 --
@@ -32,6 +32,8 @@ import GHC.Utils.Exception
 import GHC.Utils.Error
 
 import Control.Monad
+import Control.Monad.Catch as MC
+import Control.Monad.Trans.Reader
 import Data.IORef
 
 -- -----------------------------------------------------------------------------
@@ -50,7 +52,7 @@ import Data.IORef
 -- If you do not use 'Ghc' or 'GhcT', make sure to call 'GHC.initGhcMonad'
 -- before any call to the GHC API functions can occur.
 --
-class (Functor m, MonadIO m, ExceptionMonad m, HasDynFlags m) => GhcMonad m where
+class (Functor m, ExceptionMonad m, HasDynFlags m) => GhcMonad m where
   getSession :: m HscEnv
   setSession :: HscEnv -> m ()
 
@@ -71,7 +73,7 @@ modifySession f = do h <- getSession
 withSavedSession :: GhcMonad m => m a -> m a
 withSavedSession m = do
   saved_session <- getSession
-  m `gfinally` setSession saved_session
+  m `MC.finally` setSession saved_session
 
 -- | Call an action with a temporarily modified Session.
 withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a
@@ -90,7 +92,9 @@ logWarnings warns = do
 -- | A minimal implementation of a 'GhcMonad'.  If you need a custom monad,
 -- e.g., to maintain additional state consider wrapping this monad or using
 -- 'GhcT'.
-newtype Ghc a = Ghc { unGhc :: Session -> IO a } deriving (Functor)
+newtype Ghc a = Ghc { unGhc :: Session -> IO a }
+  deriving (Functor)
+  deriving (MonadThrow, MonadCatch, MonadMask) via (ReaderT Session IO)
 
 -- | The Session is a handle to the complete state of a compilation
 -- session.  A compilation session consists of a set of modules
@@ -111,16 +115,6 @@ instance MonadIO Ghc where
 instance MonadFix Ghc where
   mfix f = Ghc $ \s -> mfix (\x -> unGhc (f x) s)
 
-instance ExceptionMonad Ghc where
-  gcatch act handle =
-      Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s
-  gmask f =
-      Ghc $ \s -> gmask $ \io_restore ->
-                             let
-                                g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)
-                             in
-                                unGhc (f g_restore) s
-
 instance HasDynFlags Ghc where
   getDynFlags = getSessionDynFlags
 
@@ -155,7 +149,8 @@ reifyGhc act = Ghc $ act
 --
 -- Note that the wrapped monad must support IO and handling of exceptions.
 newtype GhcT m a = GhcT { unGhcT :: Session -> m a }
-    deriving (Functor)
+  deriving (Functor)
+  deriving (MonadThrow, MonadCatch, MonadMask) via (ReaderT Session m)
 
 liftGhcT :: m a -> GhcT m a
 liftGhcT m = GhcT $ \_ -> m
@@ -170,16 +165,6 @@ instance Monad m => Monad (GhcT m) where
 instance MonadIO m => MonadIO (GhcT m) where
   liftIO ioA = GhcT $ \_ -> liftIO ioA
 
-instance ExceptionMonad m => ExceptionMonad (GhcT m) where
-  gcatch act handle =
-      GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s
-  gmask f =
-      GhcT $ \s -> gmask $ \io_restore ->
-                           let
-                              g_restore (GhcT m) = GhcT $ \s -> io_restore (m s)
-                           in
-                              unGhcT (f g_restore) s
-
 instance MonadIO m => HasDynFlags (GhcT m) where
   getDynFlags = GhcT $ \(Session r) -> liftM hsc_dflags (liftIO $ readIORef r)