diff options
Diffstat (limited to 'compiler/GHC/Tc/Utils/Monad.hs')
| -rw-r--r-- | compiler/GHC/Tc/Utils/Monad.hs | 15 |
1 files changed, 14 insertions, 1 deletions
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index d713fce376..75b74cbb35 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -2,6 +2,7 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -138,7 +139,7 @@ module GHC.Tc.Utils.Monad( forkM, setImplicitEnvM, - withException, + withException, withIfaceErr, -- * Stuff for cost centres. getCCIndexM, getCCIndexTcM, @@ -222,6 +223,8 @@ import qualified Data.Map as Map import GHC.Driver.Env.KnotVars import GHC.Linker.Types import GHC.Types.Unique.DFM +import GHC.Iface.Errors.Types +import GHC.Iface.Errors.Ppr {- ************************************************************************ @@ -661,6 +664,16 @@ withException ctx do_this = do Failed err -> liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx err)) Succeeded result -> return result +withIfaceErr :: MonadIO m => SDocContext -> m (MaybeErr MissingInterfaceError a) -> m a +withIfaceErr ctx do_this = do + r <- do_this + case r of + Failed err -> do + let opts = defaultDiagnosticOpts @IfaceMessage + msg = missingInterfaceErrorDiagnostic opts err + liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx msg)) + Succeeded result -> return result + {- ************************************************************************ * * |