From 660e5d4eb38ae58acb5e91e40124738df812b8b7 Mon Sep 17 00:00:00 2001 From: Adam Vogt Date: Mon, 18 Jan 2010 19:15:32 +0100 Subject: Correct warnings with ghc-6.12 Ignore-this: a48ed095b72aedec9eeb88781ace66dc Changes include: - compatibility with base-4 or 3 (base-2 untested) by using extensible-exceptions. This adds an additional dependency for users of ghc<6.10) - list all dependencies again when -ftesting (change in Cabal-1.8.0.2) - remove unnecessary imports - suppress -fwarn-unused-do-bind, with appropriate Cabal-1.8 workaround, described here: http://www.haskell.org/pipermail/xmonad/2010-January/009554.html darcs-hash:20100118181532-1499c-5c496678ef76f2f50b43b0fc4582cfef7c237654.gz --- Main.hs | 1 - XMonad/Core.hs | 17 +++++++++-------- XMonad/ManageHook.hs | 6 +++--- XMonad/Operations.hs | 5 ++--- tests/Properties.hs | 6 +++--- xmonad.cabal | 18 ++++++++++++++---- 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 -- cgit v1.2.3