aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Main.hs1
-rw-r--r--XMonad/Core.hs17
-rw-r--r--XMonad/ManageHook.hs6
-rw-r--r--XMonad/Operations.hs5
-rw-r--r--tests/Properties.hs6
-rw-r--r--xmonad.cabal18
6 files changed, 31 insertions, 22 deletions
diff --git a/Main.hs b/Main.hs
index 2d16db6..a2cf797 100644
--- a/Main.hs
+++ b/Main.hs
@@ -17,7 +17,6 @@ module Main (main) where
import XMonad
import Control.Monad (unless)
-import System.IO
import System.Info
import System.Environment
import System.Posix.Process (executeFile)
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)
diff --git a/tests/Properties.hs b/tests/Properties.hs
index 8a8ab04..ae3f2e7 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -14,7 +14,7 @@ import Data.Ratio
import Data.Maybe
import System.Environment
import Control.Exception (assert)
-import qualified Control.Exception as C
+import qualified Control.Exception.Extensible as C
import Control.Monad
import Test.QuickCheck hiding (promote)
import System.IO.Unsafe
@@ -613,13 +613,13 @@ prop_lookup_visible (x :: T) =
-- and help out hpc
prop_abort x = unsafePerformIO $ C.catch (abort "fail")
- (\e -> return $ show e == "xmonad: StackSet: fail" )
+ (\(C.SomeException e) -> return $ show e == "xmonad: StackSet: fail" )
where
_ = x :: Int
-- new should fail with an abort
prop_new_abort x = unsafePerformIO $ C.catch f
- (\e -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" )
+ (\(C.SomeException e) -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" )
where
f = new undefined{-layout-} [] [] `seq` return False
diff --git a/xmonad.cabal b/xmonad.cabal
index 420050b..5b43a13 100644
--- a/xmonad.cabal
+++ b/xmonad.cabal
@@ -43,12 +43,17 @@ library
XMonad.StackSet
if flag(small_base)
- build-depends: base < 4 && >=3, containers, directory, process, filepath
+ build-depends: base < 5 && >=3, containers, directory, process, filepath, extensible-exceptions
else
build-depends: base < 3
build-depends: X11>=1.5.0.0 && < 1.6, mtl, unix
- ghc-options: -funbox-strict-fields -Wall
+ if true
+ ghc-options: -funbox-strict-fields -Wall
+
+ if impl(ghc >= 6.12.1)
+ ghc-options: -fno-warn-unused-do-bind
+
ghc-prof-options: -prof -auto-all
extensions: CPP
@@ -66,7 +71,12 @@ executable xmonad
XMonad.Operations
XMonad.StackSet
- ghc-options: -funbox-strict-fields -Wall
+ if true
+ ghc-options: -funbox-strict-fields -Wall
+
+ if impl(ghc >= 6.12.1)
+ ghc-options: -fno-warn-unused-do-bind
+
ghc-prof-options: -prof -auto-all
extensions: CPP
@@ -76,4 +86,4 @@ executable xmonad
build-depends: QuickCheck < 2
ghc-options: -Werror
if flag(testing) && flag(small_base)
- build-depends: random
+ build-depends: filepath, process, directory, mtl, unix, X11, base, containers, random, extensible-exceptions
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-24 17:15:57 +0000