Message, mkLocMessage, printError,
Severity(..),
- ErrMsg, WarnMsg, throwErrMsg, handleErrMsg,
+ ErrMsg, WarnMsg,
ErrorMessages, WarningMessages,
errMsgSpans, errMsgContext, errMsgShortDoc, errMsgExtraInfo,
Messages, errorsFound, emptyMessages,
import Control.Monad
import System.Exit ( ExitCode(..), exitWith )
-import Data.Dynamic
import Data.List
import System.IO
-import Exception
-- -----------------------------------------------------------------------------
-- Basic error messages: just render a message with a source location.
-- NB Pretty.Doc not SDoc: we deal with the printing style (in ptic
-- whether to qualify an External Name) at the error occurrence
-instance Exception ErrMsg
-
instance Show ErrMsg where
show em = showSDoc (errMsgShortDoc em)
-throwErrMsg :: ErrMsg -> a
-throwErrMsg = throw
-
-handleErrMsg :: ExceptionMonad m => (ErrMsg -> m a) -> m a -> m a
-handleErrMsg = ghandle
-
--- So we can throw these things as exceptions
-errMsgTc :: TyCon
-errMsgTc = mkTyCon "ErrMsg"
-{-# NOINLINE errMsgTc #-}
-instance Typeable ErrMsg where
- typeOf _ = mkTyConApp errMsgTc []
-
type WarnMsg = ErrMsg
-- A short (one-line) error message, with context to tell us whether
exitWith (ExitFailure 1)
) $
- -- program errors: messages with locations attached. Sometimes it is
- -- convenient to just throw these as exceptions.
- handleErrMsg
- (\em -> liftIO $ do
- printBagOfErrors dflags (unitBag em)
- exitWith (ExitFailure 1)) $
-
-- error messages propagated as exceptions
handleGhcException
(\ge -> liftIO $ do
if exists
then summariseFile hsc_env old_summaries file mb_phase
obj_allowed maybe_buf
- else throwErrMsg $ mkPlainErrMsg noSrcSpan $
+ else throwOneError $ mkPlainErrMsg noSrcSpan $
text "can't find file:" <+> text file
getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
= do maybe_summary <- summariseModule hsc_env old_summary_map False
(srcimps, the_imps, L mod_loc mod_name) <- liftIO $ getImports dflags' buf hspp_fn src_fn
when (mod_name /= wanted_mod) $
- throwErrMsg $ mkPlainErrMsg mod_loc $
+ throwOneError $ mkPlainErrMsg mod_loc $
text "File name does not match module name:"
$$ text "Saw:" <+> quotes (ppr mod_name)
$$ text "Expected:" <+> quotes (ppr wanted_mod)
noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
-- ToDo: we don't have a proper line number for this error
noModError dflags loc wanted_mod err
- = throwErrMsg $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
+ = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
-noHsFileErr :: SrcSpan -> String -> a
+noHsFileErr :: GhcMonad m => SrcSpan -> String -> m a
noHsFileErr loc path
- = throwErrMsg $ mkPlainErrMsg loc $ text "Can't find" <+> text path
+ = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path
-packageModErr :: ModuleName -> a
+packageModErr :: GhcMonad m => ModuleName -> m a
packageModErr mod
- = throwErrMsg $ mkPlainErrMsg noSrcSpan $
+ = throwOneError $ mkPlainErrMsg noSrcSpan $
text "module" <+> quotes (ppr mod) <+> text "is a package module"
multiRootsErr :: [ModSummary] -> IO ()
multiRootsErr [] = panic "multiRootsErr"
multiRootsErr summs@(summ1:_)
- = throwErrMsg $ mkPlainErrMsg noSrcSpan $
+ = throwOneError $ mkPlainErrMsg noSrcSpan $
text "module" <+> quotes (ppr mod) <+>
text "is defined in multiple files:" <+>
sep (map text files)
#include "HsVersions.h"
+import HscTypes
import Parser ( parseHeader )
import Lexer
import FastString
in
return (source_imps, ordinary_imps, mod)
-parseError :: SrcSpan -> Message -> a
-parseError span err = throwErrMsg $ mkPlainErrMsg span err
+parseError :: SrcSpan -> Message -> IO a
+parseError span err = throwOneError $ mkPlainErrMsg span err
-- we aren't interested in package imports here, filter them out
isHomeImp :: ImportDecl name -> Bool
ioMsgMaybe, ioMsg,
logWarnings, clearWarnings, hasWarnings,
SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
- handleSourceError,
+ throwOneError, handleSourceError,
reflectGhc, reifyGhc,
-- * Sessions and compilation state
import StringBuffer ( StringBuffer )
import Fingerprint
import MonadUtils
-import Bag ( emptyBag, unionBags, isEmptyBag )
import Data.Dynamic ( Typeable )
import qualified Data.Dynamic as Dyn
-import Bag ( bagToList )
-import ErrUtils ( ErrorMessages, WarningMessages, Messages )
+import Bag
+import ErrUtils
import System.FilePath
import System.Time ( ClockTime )
srcErrorMessages :: SourceError -> ErrorMessages
mkApiErr :: SDoc -> GhcApiError
+throwOneError :: MonadIO m => ErrMsg -> m ab
+throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err
+
-- | A source error is an error that is caused by one or more errors in the
-- source code. A 'SourceError' is thrown by many functions in the
-- compilation pipeline. Inside GHC these errors are merely printed via
((warns,errs), mb_r) <- liftIO ioA
logWarnings warns
case mb_r of
- Nothing -> throw (mkSrcErr errs)
+ Nothing -> liftIO $ throwIO (mkSrcErr errs)
Just r -> ASSERT( isEmptyBag errs ) return r
-- | Lift a non-failing IO action into a 'GhcMonad'.