[xmonad] backport exceptions changes from upstream darcs for ghc7 base4
Jens Petersen
petersen at fedoraproject.org
Fri Nov 26 13:45:56 UTC 2010
commit c1ce4da7907a0ccfa48c7a5bcb3f24b26274b828
Author: Jens Petersen <petersen at redhat.com>
Date: Fri Nov 26 23:45:53 2010 +1000
backport exceptions changes from upstream darcs for ghc7 base4
xmonad-0.9.1-ghc7-base4.patch | 116 +++++++++++++++++++++++++++++++++++++++++
xmonad.spec | 3 +
2 files changed, 119 insertions(+), 0 deletions(-)
---
diff --git a/xmonad-0.9.1-ghc7-base4.patch b/xmonad-0.9.1-ghc7-base4.patch
new file mode 100644
index 0000000..4d082f6
--- /dev/null
+++ b/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
diff --git a/xmonad.spec b/xmonad.spec
index eef3cad..2216277 100644
--- a/xmonad.spec
+++ b/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 at 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 at gmail.com> - 0.9.1-9
More information about the scm-commits
mailing list