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 --- Main.hs | 1 + XMonad.hs | 10 ++++++---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/Main.hs b/Main.hs index 06b0162..d4b602f 100644 --- a/Main.hs +++ b/Main.hs @@ -103,6 +103,7 @@ main = do -- main loop, for all you HOF/recursion fans out there. forever_ $ handle =<< io (nextEvent dpy e >> getEvent e) + return () where forever_ a = a >> forever_ a -- --------------------------------------------------------------------- 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