-- import PackageConfig
import UniqFM
-import HscTypes ( implicitTyThings, handleFlagWarnings )
+import HscTypes ( handleFlagWarnings )
import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
import Outputable hiding (printForUser, printForUserPartWay)
import Module -- for ModuleEnv
Right home -> return (Just (home </> ".ghci"))
_ -> return Nothing
+ canonicalizePath' :: FilePath -> IO (Maybe FilePath)
+ canonicalizePath' fp = liftM Just (canonicalizePath fp)
+ `catchIO` \_ -> return Nothing
+
sourceConfigFile :: FilePath -> GHCi ()
sourceConfigFile file = do
exists <- io $ doesFileExist file
getDirectory f = case takeDirectory f of "" -> "."; d -> d
when (read_dot_files) $ do
- cfgs0 <- sequence [ current_dir, app_user_dir, home_dir ]
- cfgs <- io $ mapM canonicalizePath (catMaybes cfgs0)
- mapM_ sourceConfigFile (nub cfgs)
+ mcfgs0 <- sequence [ current_dir, app_user_dir, home_dir ]
+ mcfgs <- io $ mapM canonicalizePath' (catMaybes mcfgs0)
+ mapM_ sourceConfigFile $ nub $ catMaybes mcfgs
-- nub, because we don't want to read .ghci twice if the
-- CWD is $HOME.
-- just evaluate the expression we were given
enqueueCommands exprs
let handle e = do st <- getGHCiState
+ -- flush the interpreter's stdout/stderr on exit (#3890)
+ flushInterpBuffers
-- Jump through some hoops to get the
-- current progname in the exception text:
-- <progname>: <exception>
runCommands' :: (SomeException -> GHCi Bool) -- Exception handler
-> InputT GHCi (Maybe String) -> InputT GHCi ()
runCommands' eh getCmd = do
- b <- handleGhcException (\e -> case e of
- Interrupted -> return False
- _other -> liftIO (print e) >> return True)
+ b <- ghandle (\e -> case fromException e of
+ Just UserInterrupt -> return False
+ _ -> case fromException e of
+ Just ghc_e ->
+ do liftIO (print (ghc_e :: GhcException))
+ return True
+ _other ->
+ liftIO (Exception.throwIO e))
(runOneCommand eh getCmd)
if b then return () else runCommands' eh getCmd
maybe (liftIO (ioError collectError))
(\l->if removeSpaces l == ":}"
then return (Just $ removeSpaces c)
- else collectCommand q (c++map normSpace l))
+ else collectCommand q (c ++ "\n" ++ map normSpace l))
where normSpace '\r' = ' '
normSpace c = c
-- QUESTION: is userError the one to use here?
-- constructor in the same type
filterOutChildren :: (a -> TyThing) -> [a] -> [a]
filterOutChildren get_thing xs
- = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)]
+ = filterOut has_parent xs
where
- implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
+ all_names = mkNameSet (map (getName . get_thing) xs)
+ has_parent x = case pprTyThingParent_maybe (get_thing x) of
+ Just p -> getName p `elemNameSet` all_names
+ Nothing -> False
pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
pprInfo pefas (thing, fixity, insts)
showException :: SomeException -> GHCi ()
showException se =
io $ case fromException se of
- Just Interrupted -> putStrLn "Interrupted."
-- omit the location for CmdLineError:
Just (CmdLineError s) -> putStrLn s
-- ditto:
Just ph@(PhaseFailed {}) -> putStrLn (showGhcException ph "")
Just other_ghc_ex -> print other_ghc_ex
- Nothing -> putStrLn ("*** Exception: " ++ show se)
+ Nothing ->
+ case fromException se of
+ Just UserInterrupt -> putStrLn "Interrupted."
+ _other -> putStrLn ("*** Exception: " ++ show se)
-----------------------------------------------------------------------------
-- recursive exception handlers