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

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