From 46e88e6ef397d16c034fc2348867ec2054114bd0 Mon Sep 17 00:00:00 2001 From: David Terei <davidterei@gmail.com> Date: Thu, 23 Aug 2012 00:29:02 -0700 Subject: [PATCH] Improve Safe Haskell warn/error output. MERGED from commit 2b5b178f4880b8034ef8c187e6227cfc09edf0d5 --- compiler/main/HscMain.hs | 16 +++++++++------- ghc/InteractiveUI.hs | 6 +----- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 215a6541855e..2552b77f2903 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -1045,7 +1045,7 @@ hscCheckSafe' dflags m l = do <> text ", to check that it can be safely imported" -- got iface, check trust - Just iface' -> do + Just iface' -> let trust = getSafeMode $ mi_trust iface' trust_own_pkg = mi_trust_pkg iface' -- check module is trusted @@ -1054,15 +1054,17 @@ hscCheckSafe' dflags m l = do safeP = packageTrusted trust trust_own_pkg m -- pkg trust reqs pkgRs = map fst $ filter snd $ dep_pkgs $ mi_deps iface' - case (safeM, safeP) of -- General errors we throw but Safe errors we log - (True, True ) -> return (trust == Sf_Trustworthy, pkgRs) - (True, False) -> liftIO . throwIO $ pkgTrustErr - (False, _ ) -> logWarnings modTrustErr >> - return (trust == Sf_Trustworthy, pkgRs) + errs = case (safeM, safeP) of + (True, True ) -> emptyBag + (True, False) -> pkgTrustErr + (False, _ ) -> modTrustErr + in do + logWarnings errs + return (trust == Sf_Trustworthy, pkgRs) where - pkgTrustErr = mkSrcErr $ unitBag $ mkPlainErrMsg dflags l $ + pkgTrustErr = unitBag $ mkPlainErrMsg dflags l $ sep [ ppr (moduleName m) <> text ": Can't be safely imported!" , text "The package (" <> ppr (modulePackageId m) diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index fd5337d14d6e..0bd0592727e2 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -1761,11 +1761,7 @@ checkAdd ii = do m <- GHC.lookupModule modname pkgqual when safe $ do t <- GHC.isModuleTrusted m - when (not t) $ - ghcError $ CmdLineError $ - "can't import " ++ moduleNameString modname - ++ " as it isn't trusted." - + when (not t) $ ghcError $ ProgramError $ "" -- ----------------------------------------------------------------------------- -- Update the GHC API's view of the context -- GitLab