[commit: ghc] ghc-7.4: Fix :issafe safe haskell ghci command (fbb371a)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-7.4

http://hackage.haskell.org/trac/ghc/changeset/fbb371a9853db538d4b9e5e4ad38a546a127da9d

>---------------------------------------------------------------

commit fbb371a9853db538d4b9e5e4ad38a546a127da9d
Author: David Terei <davidterei at gmail.com>
Date:   Wed Dec 21 15:23:36 2011 -0800

    Fix :issafe safe haskell ghci command

>---------------------------------------------------------------

 ghc/InteractiveUI.hs |   32 ++++++++++++++++++++++++--------
 1 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 0525f40..970625c 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -1416,23 +1416,39 @@ isSafeModule m = do
                                     (GHC.moduleNameString $ GHC.moduleName m))
 
     let iface' = fromJust iface
-        trust  = showPpr $ getSafeMode $ GHC.mi_trust iface'
-        pkg    = if packageTrusted dflags m then "trusted" else "untrusted"
-        (good, bad) = tallyPkgs dflags $
-                        map fst $ filter snd $ dep_pkgs $ GHC.mi_deps iface'
+
+        trust = showPpr $ getSafeMode $ GHC.mi_trust iface'
+        pkgT  = packageTrusted dflags m
+        pkg   = if pkgT then "trusted" else "untrusted"
+        (good', bad') = tallyPkgs dflags $
+                            map fst $ filter snd $ dep_pkgs $ GHC.mi_deps iface'
+        (good, bad) = case GHC.mi_trust_pkg iface' of
+                          True | pkgT -> (modulePackageId m:good', bad')
+                          True        -> (good', modulePackageId m:bad')
+                          False       -> (good', bad')
 
     liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")"
-    when (not $ null good)
+    liftIO $ putStrLn $ "Package Trust: "
+                            ++ (if packageTrustOn dflags then "On" else "Off")
+
+    when (packageTrustOn dflags && not (null good))
          (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
                         (intercalate ", " $ map packageIdString good))
-    if (null bad)
-        then liftIO $ putStrLn $ mname ++ " is trusted!"
-        else do
+
+    case goodTrust (getSafeMode $ GHC.mi_trust iface') of
+        True | (null bad || not (packageTrustOn dflags)) ->
+            liftIO $ putStrLn $ mname ++ " is trusted!"
+
+        True -> do
             liftIO $ putStrLn $ "Trusted package dependencies (untrusted): "
                         ++ (intercalate ", " $ map packageIdString bad)
             liftIO $ putStrLn $ mname ++ " is NOT trusted!"
 
+        False -> liftIO $ putStrLn $ mname ++ " is NOT trusted!"
+
   where
+    goodTrust t = t `elem` [Sf_Safe, Sf_SafeInfered, Sf_Trustworthy]
+
     mname = GHC.moduleNameString $ GHC.moduleName m
 
     packageTrusted dflags m