From 0244bff4b032f2e16b52fa1c745e0119d0dde2d2 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Tue, 12 Jun 2007 17:42:53 +0200 Subject: add catchX to catch exceptions. darcs-hash:20070612154253-72aca-b2c7e24b5e70a09feaebccd443aebbe37b568efa.gz --- XMonad.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) (limited to 'XMonad.hs') diff --git a/XMonad.hs b/XMonad.hs index b296a38..49c577e 100644 --- a/XMonad.hs +++ b/XMonad.hs @@ -17,7 +17,7 @@ module XMonad ( X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..), Typeable, Message, SomeMessage(..), fromMessage, runLayout, - runX, io, catchIO, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX, + runX, catchX, io, catchIO, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX, atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW ) where @@ -76,6 +76,17 @@ newtype X a = X (ReaderT XConf (StateT XState IO) a) runX :: XConf -> XState -> X a -> IO () runX c st (X a) = runStateT (runReaderT a c) st >> return () +-- | 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 st <- get + c <- ask + (a,s') <- io ((runStateT (runReaderT job c) st) `catch` + \e -> (do hPutStrLn stderr (show e); runStateT (runReaderT errcase c) st)) + put s' + return a + -- --------------------------------------------------------------------- -- Convenient wrappers to state -- cgit v1.2.3