From f5a5c67a06608691b44b625c8aff2c4dc9b2d392 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Fri, 12 Oct 2007 17:28:01 +0200 Subject: Respect ExitExceptions, fixes a regression where exitWith had no effect darcs-hash:20071012152801-a5988-80a14dda451e1e6e7cdc9e42fdc11568c21004b2.gz --- XMonad.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'XMonad.hs') diff --git a/XMonad.hs b/XMonad.hs index f124d7e..5a39661 100644 --- a/XMonad.hs +++ b/XMonad.hs @@ -25,7 +25,7 @@ module XMonad ( import StackSet import Prelude hiding ( catch ) -import Control.Exception ( catch ) +import Control.Exception (catch, throw, Exception(ExitException)) import Control.Monad.State import Control.Monad.Reader import System.IO @@ -87,11 +87,13 @@ runX c st (X a) = runStateT (runReaderT a c) st -- | Run in the X monad, and in case of exception, and catch it and log it -- to stderr, and run the error case. catchX :: X a -> X a -> X a -catchX (X job) (X errcase) = do +catchX job errcase = do st <- get c <- ask - (a,s') <- io ((runStateT (runReaderT job c) st) `catch` - \e -> (do hPutStrLn stderr (show e); runStateT (runReaderT errcase c) st)) + (a, s') <- io $ runX c st job `catch` + \e -> case e of + ExitException {} -> throw e + _ -> do hPrint stderr e; runX c st errcase put s' return a -- cgit v1.2.3