[xmonad] Re: darcs patch: Correct warnings with ghc-6.12 (and 1
more)
Adam Vogt
vogt.adam at gmail.com
Mon Jan 18 13:26:05 EST 2010
* On Monday, January 18 2010, Adam Vogt wrote:
>Mon Jan 18 11:20:58 EST 2010 Adam Vogt <vogt.adam at gmail.com>
> * Correct warnings with ghc-6.12
>
> 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
Attached is an amended patch that re-throws ExitSuccess, fixing a
regression where you could not exit xmonad (without killing it or
calling exitFailure).
The other patch in this bundle is not re-sent.
--
Adam
-------------- next part --------------
Mon Jan 18 13:15:32 EST 2010 Adam Vogt <vogt.adam at gmail.com>
* Correct warnings with ghc-6.12
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
New patches:
[Correct warnings with ghc-6.12
Adam Vogt <vogt.adam at gmail.com>**20100118181532
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
] {
hunk ./Main.hs 20
import XMonad
import Control.Monad (unless)
-import System.IO
import System.Info
import System.Environment
import System.Posix.Process (executeFile)
hunk ./XMonad/Core.hs 37
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
hunk ./XMonad/Core.hs 174
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
hunk ./XMonad/Core.hs 389
-- | 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.
hunk ./XMonad/Core.hs 479
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` [".",".."])
hunk ./XMonad/Core.hs 483
- cs <- prep <$> catch (getDirectoryContents t) (\_ -> return [])
+ cs <- prep <$> catch (getDirectoryContents t) (\(SomeException _) -> return [])
ds <- filterM doesDirectoryExist cs
concat . ((cs \\ ds):) <$> mapM allFiles ds
hunk ./XMonad/Core.hs 506
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 ()
hunk ./XMonad/ManageHook.hs 25
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
hunk ./XMonad/ManageHook.hs 75
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
hunk ./XMonad/ManageHook.hs 78
- 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
hunk ./XMonad/Operations.hs 36
import Control.Applicative
import Control.Monad.Reader
import Control.Monad.State
-import qualified Control.Exception as C
+import qualified Control.Exception.Extensible as C
hunk ./XMonad/Operations.hs 38
-import System.IO
import System.Posix.Process (executeFile)
import Graphics.X11.Xlib
import Graphics.X11.Xinerama (getScreenInfo)
hunk ./XMonad/Operations.hs 402
-- | 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)
hunk ./tests/Properties.hs 17
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
hunk ./tests/Properties.hs 616
-- 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
hunk ./tests/Properties.hs 622
-- 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
hunk ./xmonad.cabal 46
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
hunk ./xmonad.cabal 51
- 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
hunk ./xmonad.cabal 74
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
hunk ./xmonad.cabal 89
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
}
Context:
[Add xfork: a forkProcess that works around process global state
Spencer Janssen <spencerjanssen at gmail.com>**20091223061623
Ignore-this: 3f968260d8c1b6710c82566520c47c43
]
[TAG 0.9.1
Spencer Janssen <spencerjanssen at gmail.com>**20091216233643
Ignore-this: 856abdca8283155bbb8bdf003797ba34
]
[extra-source-files for the new manpage
Spencer Janssen <spencerjanssen at gmail.com>**20091216232005
Ignore-this: 919d964238198dd56d96a5052c2419c7
]
[Bump to 0.9.1
Spencer Janssen <spencerjanssen at gmail.com>**20091216231110
Ignore-this: 8a03850d758e1e4030d930cd8bf08ba9
]
[Determine numlockMask automatically, fixes #120
Spencer Janssen <spencerjanssen at gmail.com>**20091216012140
Ignore-this: d80c82dd0a23dc7a77fdc32fd2792130
]
[Update for X11 1.5.0.0
Spencer Janssen <spencerjanssen at gmail.com>**20091216011700
Ignore-this: 669c764c4c0ca516c8bdc1dfa35cd66
]
[Safer X11 version dependency
Spencer Janssen <spencerjanssen at gmail.com>**20091216010330
Ignore-this: 8297f7a6a65c5c97f83f860f642fc25
]
[man/xmonad.hs: remove reference to deprecated 'dynamicLogDzen' function
Brent Yorgey <byorgey at cis.upenn.edu>**20091126053908
Ignore-this: 7aeeac9791ffd3e6ac22bf158ea86536
]
[A few tweaks to --verbose-version
Spencer Janssen <spencerjanssen at gmail.com>**20091208040729
Ignore-this: cf3d6a904d23891829c10f4966974673
]
[Main.hs +--verbose-version flag
gwern0 at gmail.com**20091128144840
Ignore-this: 61a081f33adb460ea459950a750dd93f
This resolves http://code.google.com/p/xmonad/issues/detail?id=320 by adding a
--verbose-version option yielding output like "xmonad 0.9 compiled by ghc 6.10 for linux/i386"
]
[Generalize the type of (<+>). It can be used for keybindings too.
Adam Vogt <vogt.adam at gmail.com>**20091205233611
Ignore-this: af15248be5e483d1a6e924f786fcc1c4
]
[Swap the order that windows are mapped/unmapped. Addresses #322
Spencer Janssen <spencerjanssen at gmail.com>**20091119025440
Ignore-this: 22087204f1b84dae98a3cf2b7f116d3f
]
[Add GPL warning to GenerateManpage
Spencer Janssen <spencerjanssen at gmail.com>**20091111000106
Ignore-this: ea24691b8198976a4088a2708e0b4c94
]
[Add a basic header to the html manpage output
Adam Vogt <vogt.adam at gmail.com>**20091028033042
Ignore-this: 2641e0fb3179616075fa7549b57740f3
]
[Use pandoc to convert a markdown manpage tranlation to html and man.
Adam Vogt <vogt.adam at gmail.com>**20091028030639
Ignore-this: cdf7cdc8e44b21de8fc7725bde299792
]
[Support for extensible state in contrib modules.
Daniel Schoepe <daniel.schoepe at gmail.com>**20091106115050
Ignore-this: d04ee1989313ed5710c94f9d7fda3f2a
]
[Set SIGPIPE to default in forked processes
Spencer Janssen <spencerjanssen at gmail.com>**20091106223743
Ignore-this: f73943e4fe6c5f08967ddb82afad3eaa
]
[TAG 0.9
Spencer Janssen <spencerjanssen at gmail.com>**20091026004641
Ignore-this: 80347d432f3b606c8d722536d0d729aa
]
Patch bundle hash:
bf80a50dacbb40f8e9986bed6ba56ac971c7c408
More information about the xmonad
mailing list