X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FGhcMonad.hs;h=4c72f144c28daa6843590445d8c2f4c53222e09a;hb=fa328fb3cbf09e767a35ecc2dd9811d6673882da;hp=c62ea4c09387cf2bb4829ff4c08ed7a62e632af8;hpb=94bf0d3604ff0d2ecab246924af712bdd1c29a40;p=ghc-hetmet.git

diff --git a/compiler/main/GhcMonad.hs b/compiler/main/GhcMonad.hs
index c62ea4c..4c72f14 100644
--- a/compiler/main/GhcMonad.hs
+++ b/compiler/main/GhcMonad.hs
@@ -15,10 +15,11 @@ module GhcMonad (
         reflectGhc, reifyGhc,
         getSessionDynFlags, 
         liftIO,
-	Session(..), withSession, modifySession, withTempSession,
+        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
+