From 5e9e07a33e17da01245f0cea78e6a6f8a32ac77d Mon Sep 17 00:00:00 2001
From: David Terei <davidterei@gmail.com>
Date: Thu, 9 Feb 2012 03:45:24 -0800
Subject: Have :load work under -XSafe in GHCi.

---
 ghc/InteractiveUI.hs | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

(limited to 'ghc')

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 8d0205d846..3d0adacf6b 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -1655,7 +1655,9 @@ checkAdd :: Bool -> String -> GHCi (InteractiveImport)
 checkAdd star mstr = do
   dflags <- getDynFlags 
   case safeLanguageOn dflags of
-    True | star -> ghcError $ CmdLineError "can't use * imports with Safe Haskell"
+    True | star -> do
+        liftIO $ putStrLn "Warning: can't use * imports with Safe Haskell; ignoring *"
+        checkAdd False mstr
 
     True -> do m <- lookupModule mstr
                s <- GHC.isModuleTrusted m
@@ -1685,8 +1687,8 @@ checkAdd star mstr = do
 setGHCContextFromGHCiState :: GHCi ()
 setGHCContextFromGHCiState = do
   st <- getGHCiState
-  goodTran <- filterM (tryBool . ok) $ transient_ctx st
-  goodRemb <- filterM (tryBool . ok) $ remembered_ctx st
+  goodTran <- mapMaybeM (tryBool . ok) $ transient_ctx st
+  goodRemb <- mapMaybeM (tryBool . ok) $ remembered_ctx st
   -- drop bad imports so we don't keep replaying it to the user!
   modifyGHCiState $ \s -> s { transient_ctx  = goodTran }
   modifyGHCiState $ \s -> s { remembered_ctx = goodRemb }
@@ -1696,6 +1698,8 @@ setGHCContextFromGHCiState = do
     ok (IIModule m) = checkAdd True  (moduleNameString (moduleName m))
     ok (IIDecl   d) = checkAdd False (moduleNameString (unLoc (ideclName d)))
 
+    mapMaybeM f xs = catMaybes `fmap` sequence (map f xs)
+
 setContext :: [String] -> [String] -> GHCi ()
 setContext starred not_starred = do
   is1 <- mapM (checkAdd True)  starred
@@ -2752,12 +2756,12 @@ ghciHandle h m = Haskeline.catch m $ \e -> unblock (h e)
 ghciTry :: GHCi a -> GHCi (Either SomeException a)
 ghciTry (GHCi m) = GHCi $ \s -> gtry (m s)
 
-tryBool :: GHCi a -> GHCi Bool
+tryBool :: GHCi a -> GHCi (Maybe a)
 tryBool m = do
     r <- ghciTry m
     case r of
-      Left e  -> showException e >> return False
-      Right _ -> return True
+      Left e  -> showException e >> return Nothing
+      Right a -> return $ Just a
 
 -- ----------------------------------------------------------------------------
 -- Utils
-- 
cgit v1.2.1