diff options
Diffstat (limited to 'XMonad')
-rw-r--r-- | XMonad/Core.hs | 17 | ||||
-rw-r--r-- | XMonad/ManageHook.hs | 6 | ||||
-rw-r--r-- | XMonad/Operations.hs | 5 |
3 files changed, 14 insertions, 14 deletions
diff --git a/XMonad/Core.hs b/XMonad/Core.hs index b0713d7..f8f337b 100644 --- a/XMonad/Core.hs +++ b/XMonad/Core.hs @@ -34,7 +34,7 @@ module XMonad.Core ( import XMonad.StackSet hiding (modify) import Prelude hiding ( catch ) -import Control.Exception (catch, try, bracket, throw, finally, Exception(ExitException)) +import Control.Exception.Extensible (catch, fromException, try, bracket, throw, finally, SomeException(..)) import Control.Applicative import Control.Monad.State import Control.Monad.Reader @@ -171,9 +171,9 @@ catchX :: X a -> X a -> X a catchX job errcase = do st <- get c <- ask - (a, s') <- io $ runX c st job `catch` \e -> case e of - ExitException {} -> throw e - _ -> do hPrint stderr e; runX c st errcase + (a, s') <- io $ runX c st job `catch` \e -> case fromException e of + Just x -> throw e `const` (x `asTypeOf` ExitSuccess) + _ -> do hPrint stderr e; runX c st errcase put s' return a @@ -386,7 +386,7 @@ io = liftIO -- | Lift an 'IO' action into the 'X' monad. If the action results in an 'IO' -- exception, log the exception to stderr and continue normal execution. catchIO :: MonadIO m => IO () -> m () -catchIO f = io (f `catch` \e -> hPrint stderr e >> hFlush stderr) +catchIO f = io (f `catch` \(SomeException e) -> hPrint stderr e >> hFlush stderr) -- | spawn. Launch an external application. Specifically, it double-forks and -- runs the 'String' you pass as a command to /bin/sh. @@ -476,11 +476,11 @@ recompile force = io $ do return () return (status == ExitSuccess) else return True - where getModTime f = catch (Just <$> getModificationTime f) (const $ return Nothing) + where getModTime f = catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing) isSource = flip elem [".hs",".lhs",".hsc"] allFiles t = do let prep = map (t</>) . Prelude.filter (`notElem` [".",".."]) - cs <- prep <$> catch (getDirectoryContents t) (\_ -> return []) + cs <- prep <$> catch (getDirectoryContents t) (\(SomeException _) -> return []) ds <- filterM doesDirectoryExist cs concat . ((cs \\ ds):) <$> mapM allFiles ds @@ -503,7 +503,8 @@ installSignalHandlers :: MonadIO m => m () installSignalHandlers = io $ do installHandler openEndedPipe Ignore Nothing installHandler sigCHLD Ignore Nothing - try $ fix $ \more -> do + (try :: IO a -> IO (Either SomeException a)) + $ fix $ \more -> do x <- getAnyProcessStatus False False when (isJust x) more return () diff --git a/XMonad/ManageHook.hs b/XMonad/ManageHook.hs index 97afce5..04926a0 100644 --- a/XMonad/ManageHook.hs +++ b/XMonad/ManageHook.hs @@ -22,7 +22,7 @@ import Prelude hiding (catch) import XMonad.Core import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME) -import Control.Exception (bracket, catch) +import Control.Exception (bracket, catch, SomeException(..)) import Control.Monad.Reader import Data.Maybe import Data.Monoid @@ -72,10 +72,10 @@ title = ask >>= \w -> liftX $ do let getProp = (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w) - `catch` \_ -> getTextProperty d w wM_NAME + `catch` \(SomeException _) -> getTextProperty d w wM_NAME extract prop = do l <- wcTextPropertyToTextList d prop return $ if null l then "" else head l - io $ bracket getProp (xFree . tp_value) extract `catch` \_ -> return "" + io $ bracket getProp (xFree . tp_value) extract `catch` \(SomeException _) -> return "" -- | Return the application name. appName :: Query String diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs index d96ff1a..9614d47 100644 --- a/XMonad/Operations.hs +++ b/XMonad/Operations.hs @@ -33,9 +33,8 @@ import qualified Data.Set as S import Control.Applicative import Control.Monad.Reader import Control.Monad.State -import qualified Control.Exception as C +import qualified Control.Exception.Extensible as C -import System.IO import System.Posix.Process (executeFile) import Graphics.X11.Xlib import Graphics.X11.Xinerama (getScreenInfo) @@ -400,7 +399,7 @@ cleanMask km = do -- | Get the 'Pixel' value for a named color initColor :: Display -> String -> IO (Maybe Pixel) -initColor dpy c = C.handle (\_ -> return Nothing) $ +initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $ (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c where colormap = defaultColormap dpy (defaultScreen dpy) |