[commit: ghc] master: More info from :issafe ghci command (5bbb5cf)

[David Terei]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/5bbb5cf300073335828887a80deff0e4cfd757a8

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

commit 5bbb5cf300073335828887a80deff0e4cfd757a8
Author: David Terei <davidterei at gmail.com>
Date:   Fri Aug 19 01:47:59 2011 -0700

    More info from :issafe ghci command

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

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

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 6cdce2c..169075f 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -34,7 +34,7 @@ import Packages
 -- import PackageConfig
 import UniqFM
 
-import HscTypes ( handleFlagWarnings, getSafeMode )
+import HscTypes ( handleFlagWarnings, getSafeMode, dep_pkgs )
 import HsImpExp
 import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
 import RdrName (RdrName)
@@ -1327,38 +1327,55 @@ runScript filename = do
 
 isSafeCmd :: String -> InputT GHCi ()
 isSafeCmd m = 
-  case words m of
-    [s] | looksLikeModuleName s -> do
-        m <- lift $ lookupModule s
-        isSafeModule m
-    [] -> do m <- guessCurrentModule
-             isSafeModule m
-    _ -> ghcError (CmdLineError "syntax:  :issafe <module>")
+    case words m of
+        [s] | looksLikeModuleName s -> do
+            m <- lift $ lookupModule s
+            isSafeModule m
+        [] -> do m <- guessCurrentModule
+                 isSafeModule m
+        _ -> ghcError (CmdLineError "syntax:  :issafe <module>")
 
 isSafeModule :: Module -> InputT GHCi ()
 isSafeModule m = do
-  mb_mod_info <- GHC.getModuleInfo m
-  case mb_mod_info of
-    Nothing -> ghcError $ CmdLineError ("unknown module: " ++
-                                GHC.moduleNameString (GHC.moduleName m))
-    Just mi -> do
-        dflags <- getDynFlags
-        let iface = GHC.modInfoIface mi
-        case iface of
-             Just iface' -> do
-                 let trust = showPpr $ getSafeMode $ GHC.mi_trust iface'
-                     pkg   = if packageTrusted dflags m then "trusted" else "untrusted"
-                 liftIO $ putStrLn $ "Trust type is (Module: " ++ trust
-                                               ++ ", Package: " ++ pkg ++ ")"
-             Nothing -> ghcError $ CmdLineError ("can't load interface file for module: " ++
-                                            GHC.moduleNameString (GHC.moduleName m))
+    mb_mod_info <- GHC.getModuleInfo m
+    when (isNothing mb_mod_info)
+         (ghcError $ CmdLineError $ "unknown module: " ++ mname)
+
+    dflags <- getDynFlags
+    let iface = GHC.modInfoIface $ fromJust mb_mod_info
+    when (isNothing iface)
+         (ghcError $ CmdLineError $ "can't load interface file for module: " ++
+                                    (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'
+
+    liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")"
+    when (not $ null good)
+         (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
+                        (intercalate ", " $ map packageIdString good))
+    if (null bad)
+        then liftIO $ putStrLn $ mname ++ " is trusted!"
+        else do
+            liftIO $ putStrLn $ "Trusted package dependencies (untrusted): "
+                        ++ (intercalate ", " $ map packageIdString bad)
+            liftIO $ putStrLn $ mname ++ " is NOT trusted!")
+
   where
-    packageTrusted :: DynFlags -> Module -> Bool
+    mname = GHC.moduleNameString $ GHC.moduleName m
+
     packageTrusted dflags m
         | thisPackage dflags == modulePackageId m = True
         | otherwise = trusted $ getPackageDetails (pkgState dflags)
                                                   (modulePackageId m)
 
+    tallyPkgs dflags deps = partition part deps
+        where state = pkgState dflags
+              part pkg = trusted $ getPackageDetails state pkg
+
 
 -----------------------------------------------------------------------------
 -- Browsing a module's contents