backport exceptions changes from upstream darcs for ghc7 base4

xmonad-0.9.1-ghc7-base4.patch

@@ -0,0 +1,116 @@
+diff -up xmonad-0.9.1/XMonad/Core.hs~ xmonad-0.9.1/XMonad/Core.hs
+--- xmonad-0.9.1/XMonad/Core.hs~	2010-11-26 23:12:51.000000000 +1000
++++ xmonad-0.9.1/XMonad/Core.hs	2010-11-26 23:34:39.000000000 +1000
+@@ -33,7 +33,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
+@@ -165,9 +165,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
+ 
+@@ -353,7 +353,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.
+@@ -439,11 +439,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
+ 
+@@ -466,7 +466,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 -up xmonad-0.9.1/XMonad/ManageHook.hs~ xmonad-0.9.1/XMonad/ManageHook.hs
+--- xmonad-0.9.1/XMonad/ManageHook.hs~	2009-12-17 09:25:04.000000000 +1000
++++ xmonad-0.9.1/XMonad/ManageHook.hs	2010-11-26 23:37:52.000000000 +1000
+@@ -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.Extensible (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 -up xmonad-0.9.1/XMonad/Operations.hs~ xmonad-0.9.1/XMonad/Operations.hs
+--- xmonad-0.9.1/XMonad/Operations.hs~	2009-12-17 09:25:04.000000000 +1000
++++ xmonad-0.9.1/XMonad/Operations.hs	2010-11-26 23:36:46.000000000 +1000
+@@ -33,7 +33,7 @@ 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)
+@@ -400,7 +400,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 -up xmonad-0.9.1/xmonad.cabal~ xmonad-0.9.1/xmonad.cabal
+--- xmonad-0.9.1/xmonad.cabal~	2009-12-17 09:25:04.000000000 +1000
++++ xmonad-0.9.1/xmonad.cabal	2010-11-26 23:14:44.000000000 +1000
+@@ -43,7 +43,7 @@ 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

xmonad.spec

@@ -35,6 +35,7 @@ Source2:        xmonad-start
 Source3:        xmonad.desktop
 Source4:        README.fedora
 Patch1:         xmonad-dynamic-link.patch
+Patch2:         xmonad-0.9.1-ghc7-base4.patch
 # fedora ghc archs:
 ExclusiveArch:  %{ix86} x86_64 ppc alpha
 BuildRequires:  ghc, ghc-doc, ghc-prof
@@ -56,6 +57,7 @@ Requires:       xorg-x11-apps
 %prep
 %setup -q
 %patch1 -p1 -b .orig
+%patch2 -p1 -b .base3
 cp -p %SOURCE4 .
 
 
@@ -94,6 +96,7 @@ rm -rf $RPM_BUILD_ROOT
 
 %changelog
 * Fri Nov 26 2010 Jens Petersen <petersen@redhat.com> - 0.9.1-10
+- backport exceptions changes from upstream darcs for ghc7 base4
 - update url and drop -o obsoletes
 
 * Sun Nov 07 2010 Ben Boeckel <mathstuf@gmail.com> - 0.9.1-9