aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--XMonad/Hooks/DebugEvents.hs9
-rw-r--r--XMonad/Util/DebugWindow.hs6
2 files changed, 8 insertions, 7 deletions
diff --git a/XMonad/Hooks/DebugEvents.hs b/XMonad/Hooks/DebugEvents.hs
index d58595e..6256444 100644
--- a/XMonad/Hooks/DebugEvents.hs
+++ b/XMonad/Hooks/DebugEvents.hs
@@ -19,7 +19,7 @@
module XMonad.Hooks.DebugEvents (debugEventsHook) where
-import Prelude hiding (catch)
+import Prelude
import XMonad hiding (windowEvent
,(-->)
@@ -30,7 +30,7 @@ import XMonad.Util.DebugWindow (debugWindow)
-- import Graphics.X11.Xlib.Extras.GetAtomName (getAtomName)
-import Control.Exception.Extensible
+import Control.Exception.Extensible as E
import Control.Monad.State
import Control.Monad.Reader
import Data.Char (isDigit)
@@ -855,7 +855,7 @@ dumpPixmap = guardType pIXMAP $ do
append $ "pixmap " ++ showHex p ""
g' <- inX $ withDisplay $ \d -> io $
Just `fmap` getGeometry d (fromIntegral p)
- `catch`
+ `E.catch`
\e -> case fromException e of
Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
_ -> return Nothing
@@ -1032,7 +1032,8 @@ dumpPercent = guardType cARDINAL $ do
Nothing -> return False
Just n' ->
let pct = 100 * fromIntegral n' / fromIntegral (maxBound :: Word32)
- in append $ show (round pct) ++ "%"
+ pct :: Double
+ in append $ show (round pct :: Integer) ++ "%"
dumpWmHints :: Decoder Bool
dumpWmHints =
diff --git a/XMonad/Util/DebugWindow.hs b/XMonad/Util/DebugWindow.hs
index 413f700..9fe5817 100644
--- a/XMonad/Util/DebugWindow.hs
+++ b/XMonad/Util/DebugWindow.hs
@@ -15,12 +15,12 @@
module XMonad.Util.DebugWindow (debugWindow) where
-import Prelude hiding (catch)
+import Prelude
import XMonad
import Codec.Binary.UTF8.String (decodeString)
-import Control.Exception
+import Control.Exception.Extensible as E
import Control.Monad (when)
import Data.List (unfoldr
,intercalate
@@ -117,7 +117,7 @@ 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 fromException e of
+ (a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of
Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
_ -> runX c st errcase
put s'