Respect ExitExceptions, fixes a regression where exitWith had no effect

darcs-hash:20071012152801-a5988-80a14dda451e1e6e7cdc9e42fdc11568c21004b2

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