X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FGhcMonad.hs;fp=compiler%2Fmain%2FGhcMonad.hs;h=711259c9baf3ffd0d05249be3f08cc3e5c7fcda1;hb=a79a531965cd1f0d04dd3e0250b076037bf9ff4e;hp=c62ea4c09387cf2bb4829ff4c08ed7a62e632af8;hpb=45bc009da2922cf8d5181d79d01c1c61e8d603fa;p=ghc-hetmet.git

diff --git a/compiler/main/GhcMonad.hs b/compiler/main/GhcMonad.hs
index c62ea4c..711259c 100644
--- a/compiler/main/GhcMonad.hs
+++ b/compiler/main/GhcMonad.hs
@@ -18,7 +18,8 @@ module GhcMonad (
 	Session(..), withSession, modifySession, withTempSession,
 
         -- ** Warnings
-        logWarnings
+        logWarnings, printException, printExceptionAndWarnings,
+	WarnErrLogger, defaultWarnErrLogger
   ) where
 
 import MonadUtils
@@ -175,3 +176,23 @@ instance ExceptionMonad m => ExceptionMonad (GhcT m) where
 instance (Functor m, ExceptionMonad m, MonadIO m) => GhcMonad (GhcT m) where
   getSession = GhcT $ \(Session r) -> liftIO $ readIORef r
   setSession s' = GhcT $ \(Session r) -> liftIO $ writeIORef r s'
+
+
+-- | Print the error message and all warnings.  Useful inside exception
+--   handlers.  Clears warnings after printing.
+printException :: GhcMonad m => SourceError -> m ()
+printException err = do
+  dflags <- getSessionDynFlags
+  liftIO $ printBagOfErrors dflags (srcErrorMessages err)
+
+{-# DEPRECATED printExceptionAndWarnings "use printException instead" #-}
+printExceptionAndWarnings :: GhcMonad m => SourceError -> m ()
+printExceptionAndWarnings = printException
+
+-- | A function called to log warnings and errors.
+type WarnErrLogger = GhcMonad m => Maybe SourceError -> m ()
+
+defaultWarnErrLogger :: WarnErrLogger
+defaultWarnErrLogger Nothing  = return ()
+defaultWarnErrLogger (Just e) = printException e
+