Just (ioe :: IOException) ->
fatalErrorMsg dflags (text (show ioe))
_ -> case fromException exception of
+ Just UserInterrupt -> exitWith (ExitFailure 1)
Just StackOverflow ->
fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
_ -> case fromException exception of
hFlush stdout
case ge of
PhaseFailed _ code -> exitWith code
- Interrupted -> exitWith (ExitFailure 1)
Signal _ -> exitWith (ExitFailure 1)
_ -> do fatalErrorMsg dflags (text (show ge))
exitWith (ExitFailure 1)
not (dopt Opt_BreakOnException dflags)
then poke exceptionFlag 1
else case fromException se of
- -- If it is an "Interrupted" exception, we allow
+ -- If it is a "UserInterrupt" exception, we allow
-- a possible break by way of -fbreak-on-exception
- Just Interrupted -> return ()
+ Just UserInterrupt -> return ()
-- In any other case, we don't want to break
_ -> poke exceptionFlag 0
data GhcException
= PhaseFailed String -- name of phase
ExitCode -- an external phase (eg. cpp) failed
- | Interrupted -- someone pressed ^C
| Signal Int -- some other fatal signal (SIGHUP,SIGTERM)
| UsageError String -- prints the short usage msg after the error
| CmdLineError String -- cmdline prob, but doesn't print usage
= showString str
showGhcException (InstallationError str)
= showString str
-showGhcException (Interrupted)
- = showString "interrupted"
showGhcException (Signal n)
= showString "signal: " . shows n
showGhcException (Panic s)
\end{code}
\begin{code}
--- | tryMost is like try, but passes through Interrupted and Panic
+-- | tryMost is like try, but passes through UserInterrupt and Panic
-- exceptions. Used when we want soft failures when reading interface
-- files, for example.
Left se ->
case fromException se of
-- Some GhcException's we rethrow,
- Just Interrupted -> throwIO se
Just (Signal _) -> throwIO se
Just (Panic _) -> throwIO se
-- others we return
modifyMVar_ interruptTargetThread (return . (main_thread :))
let
- interrupt_exn = (toException Interrupted)
+ interrupt_exn = (toException UserInterrupt)
interrupt = do
withMVar interruptTargetThread $ \targets ->
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
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