From c1ce4da7907a0ccfa48c7a5bcb3f24b26274b828 Mon Sep 17 00:00:00 2001 From: Jens Petersen Date: Fri, 26 Nov 2010 23:45:53 +1000 Subject: [PATCH] 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(+) create mode 100644 xmonad-0.9.1-ghc7-base4.patch 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 - 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 - 0.9.1-9