Prefer safe alternatives to getWindowAttributes

Whenever possible, prefer the safe wrappers withWindowAttributes or
safeGetWindowAttributes to getWindowAttributes.

Places where these are not applicable are limited to layouts, where
there is not good "default value" to give back in case these calls fail.
In these cases, we let the exception handling of the layout mechanism
handle it and fall back to the Full layout.

Fixes: xmonad#146

XMonad/Actions/ConstrainedResize.hs

@@ -44,8 +44,8 @@ import XMonad
 
 -- | Resize (floating) window with optional aspect ratio constraints.
 mouseResizeWindow :: Window -> Bool -> X ()
-mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     sh <- io $ getWMNormalHints d w
     io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
     mouseDrag (\ex ey -> do

XMonad/Actions/EasyMotion.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
@@ -263,7 +264,7 @@ handleSelectWindow c = do
       visibleWindows :: [Window]
       visibleWindows = toList mappedWins
       sortedOverlayWindows :: X [OverlayWindow]
-      sortedOverlayWindows = sortOverlayWindows <$> buildOverlayWindows dpy th visibleWindows
+      sortedOverlayWindows = sortOverlayWindows <$> buildOverlayWindows th visibleWindows
     PerScreenKeys m ->
       fmap concat
         $ sequence
@@ -275,7 +276,7 @@ handleSelectWindow c = do
       visibleWindowsOnScreen :: ScreenId -> [Window]
       visibleWindowsOnScreen sid = filter (`elem` toList mappedWins) $ W.integrate' $ screenById sid >>= W.stack . W.workspace
       sortedOverlayWindows :: ScreenId -> X [OverlayWindow]
-      sortedOverlayWindows sid = sortOverlayWindows <$> buildOverlayWindows dpy th (visibleWindowsOnScreen sid)
+      sortedOverlayWindows sid = sortOverlayWindows <$> buildOverlayWindows th (visibleWindowsOnScreen sid)
   status <- io $ grabKeyboard dpy rw True grabModeAsync grabModeAsync currentTime
   if status == grabSuccess
     then do
@@ -298,21 +299,23 @@ handleSelectWindow c = do
   buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay]
   buildOverlays = appendChords (maxChordLen c)
 
-  buildOverlayWindows :: Display -> Position -> [Window] -> X [OverlayWindow]
-  buildOverlayWindows dpy th ws = sequence $ buildOverlayWin dpy th <$> ws
+  buildOverlayWindows :: Position -> [Window] -> X [OverlayWindow]
+  buildOverlayWindows th = fmap (fromMaybe [] . sequenceA)
+                         . traverse (buildOverlayWin th)
 
   sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow]
   sortOverlayWindows = sortOn ((wa_x &&& wa_y) . attrs)
 
   makeRect :: WindowAttributes -> Rectangle
   makeRect wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) (fi (wa_width wa)) (fi (wa_height wa))
 
-  buildOverlayWin :: Display -> Position -> Window -> X OverlayWindow
-  buildOverlayWin dpy th w = do
-    wAttrs <- io $ getWindowAttributes dpy w
-    let r = overlayF c th $ makeRect wAttrs
-    o <- createNewWindow r Nothing "" True
-    return OverlayWindow { rect=r, overlay=o, win=w, attrs=wAttrs }
+  buildOverlayWin :: Position -> Window -> X (Maybe OverlayWindow)
+  buildOverlayWin th w = safeGetWindowAttributes w >>= \case
+    Nothing     -> pure Nothing
+    Just wAttrs -> do
+      let r = overlayF c th $ makeRect wAttrs
+      o <- createNewWindow r Nothing "" True
+      return . Just $ OverlayWindow { rect=r, overlay=o, win=w, attrs=wAttrs }
 
   -- | Display an overlay with the provided formatting
   displayOverlay :: XMonadFont -> Overlay -> X ()

XMonad/Actions/FlexibleManipulate.hs

@@ -24,9 +24,9 @@ module XMonad.Actions.FlexibleManipulate (
 ) where
 
 import XMonad
-import XMonad.Prelude ((<&>))
+import XMonad.Prelude ((<&>), fi)
 import qualified Prelude as P
-import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, map, otherwise, round, snd, uncurry, ($), (.))
+import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, otherwise, round, snd, uncurry, ($))
 
 -- $usage
 -- First, add this import to your @~\/.xmonad\/xmonad.hs@:
@@ -80,8 +80,10 @@ position = const 0.5
 -- | Given an interpolation function, implement an appropriate window
 --   manipulation action.
 mouseWindow :: (Double -> Double) -> Window -> X ()
-mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
-    [wpos, wsize] <- io $ getWindowAttributes d w <&> winAttrs
+mouseWindow f w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
+    let wpos  = (fi (wa_x wa), fi (wa_y wa))
+        wsize = (fi (wa_width wa), fi (wa_height wa))
     sh <- io $ getWMNormalHints d w
     pointer <- io $ queryPointer d w <&> pointerPos
 
@@ -104,18 +106,10 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
 
   where
     pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
-    winAttrs :: WindowAttributes -> [Pnt]
-    winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height]
-
 
 -- I'd rather I didn't have to do this, but I hate writing component 2d math
 type Pnt = (Double, Double)
 
-pairUp :: [a] -> [(a,a)]
-pairUp [] = []
-pairUp [_] = []
-pairUp (x:y:xs) = (x, y) : pairUp xs
-
 mapP :: (a -> b) -> (a, a) -> (b, b)
 mapP f (x, y) = (f x, f y)
 zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c)

XMonad/Actions/FlexibleResize.hs

@@ -50,8 +50,8 @@ mouseResizeEdgeWindow
   :: Rational -- ^ The size of the area where only one edge is resized.
   -> Window   -- ^ The window to resize.
   -> X ()
-mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     sh <- io $ getWMNormalHints d w
     (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w
     let

XMonad/Actions/FloatKeys.hs

@@ -44,8 +44,8 @@ import XMonad.Prelude (fi)
 -- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the
 --   right and @dy@ pixels down.
 keysMoveWindow :: D -> Window -> X ()
-keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     io $ moveWindow d w (fi (fi (wa_x wa) + dx))
                         (fi (fi (wa_y wa) + dy))
     float w
@@ -61,8 +61,8 @@ keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
 -- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen
 -- > keysMoveWindowTo (1024,0) (1, 0)      -- put window in the top right corner
 keysMoveWindowTo :: P -> G -> Window -> X ()
-keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     io $ moveWindow d w (x - round (gx * fi (wa_width wa)))
                         (y - round (gy * fi (wa_height wa)))
     float w
@@ -113,8 +113,8 @@ keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))
         ny = round $ fi y + gy * fi h - gy * fi nh
 
 keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()
-keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     sh <- io $ getWMNormalHints d w
     let wa_dim = (fi $ wa_width wa, fi $ wa_height wa)
         wa_pos = (fi $ wa_x wa, fi $ wa_y wa)

XMonad/Actions/FloatSnap.hs

@@ -92,8 +92,8 @@ snapMagicMouseResize
     -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
     -> Window    -- ^ The window to move and resize.
     -> X ()
-snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     (_, _, _, px, py, _, _, _) <- io $ queryPointer d w
     let x = (fromIntegral px - wx wa)/ww wa
         y = (fromIntegral py - wy wa)/wh wa
@@ -119,9 +119,8 @@ snapMagicResize
     -> Maybe Int   -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
     -> Window      -- ^ The window to move and resize.
     -> X ()
-snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
-
+snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     (xbegin,xend) <- handleAxis True d wa
     (ybegin,yend) <- handleAxis False d wa
 
@@ -168,9 +167,8 @@ snapMagicMove
     -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
     -> Window    -- ^ The window to move.
     -> X ()
-snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
-
+snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     nx <- handleAxis True d wa
     ny <- handleAxis False d wa
 
@@ -208,8 +206,8 @@ snapMove U = doSnapMove False True
 snapMove D = doSnapMove False False
 
 doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
-doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     ((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w
 
     let (mb,mf) = if rev then (bl,fl)
@@ -247,8 +245,8 @@ snapShrink
 snapShrink = snapResize False
 
 snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
-snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     mr <- case dir of
               L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w
                       return $ case (if grow then mg else ms) of

XMonad/Actions/Navigation2D.hs

@@ -616,11 +616,8 @@ actOnScreens act wrap = withWindowSet $ \winset -> do
 
 -- | Determines whether a given window is mapped
 isMapped :: Window -> X Bool
-isMapped win  =  withDisplay
-              $  \dpy -> io
-              $  (waIsUnmapped /=)
-              .  wa_map_state
-             <$> getWindowAttributes dpy win
+isMapped = fmap (maybe False ((waIsUnmapped /=) .  wa_map_state))
+         . safeGetWindowAttributes
 
 ----------------------------------------------------------------------------------------------------
 ----------------------------------------------------------------------------------------------------

XMonad/Actions/NoBorders.hs

@@ -27,8 +27,7 @@ import XMonad
 toggleBorder :: Window -> X ()
 toggleBorder w = do
     bw <- asks (borderWidth . config)
-    withDisplay $ \d -> io $ do
-        cw <- wa_border_width <$> getWindowAttributes d w
-        if cw == 0
+    withDisplay $ \d -> withWindowAttributes d w $ \wa -> io $
+        if wa_border_width wa == 0
             then setWindowBorderWidth d w bw
             else setWindowBorderWidth d w 0

XMonad/Actions/TiledWindowDragging.hs

@@ -48,10 +48,11 @@ import           XMonad.Layout.DraggingVisualizer
 -- | Create a mouse binding for this to be able to drag your windows around.
 -- You need "XMonad.Layout.DraggingVisualizer" for this to look good.
 dragWindow :: Window -> X ()
-dragWindow window = whenX (isClient window) $ do
+dragWindow window = whenX (isClient window) $ withDisplay $ \dpy ->
+  withWindowAttributes dpy window $ \wa -> do
     focus window
-    (offsetX, offsetY)                <- getPointerOffset window
-    (winX, winY, winWidth, winHeight) <- getWindowPlacement window
+    (offsetX, offsetY)                    <- getPointerOffset window
+    let (winX, winY, winWidth, winHeight)  = getWindowPlacement wa
 
     mouseDrag
         (\posX posY ->
@@ -71,11 +72,8 @@ getPointerOffset win = do
     return (fi oX, fi oY)
 
 -- | return a tuple of windowX, windowY, windowWidth, windowHeight
-getWindowPlacement :: Window -> X (Int, Int, Int, Int)
-getWindowPlacement window = do
-    wa <- withDisplay (\d -> io $ getWindowAttributes d window)
-    return (fi $ wa_x wa, fi $ wa_y wa, fi $ wa_width wa, fi $ wa_height wa)
-
+getWindowPlacement :: WindowAttributes -> (Int, Int, Int, Int)
+getWindowPlacement wa = (fi $ wa_x wa, fi $ wa_y wa, fi $ wa_width wa, fi $ wa_height wa)
 
 performWindowSwitching :: Window -> X ()
 performWindowSwitching win = do

XMonad/Actions/UpdatePointer.hs

@@ -28,7 +28,6 @@ import XMonad
 import XMonad.Prelude
 import XMonad.StackSet (member, peek, screenDetail, current)
 
-import Control.Exception (SomeException, try)
 import Control.Arrow ((&&&), (***))
 
 -- $usage
@@ -73,10 +72,9 @@ updatePointer refPos ratio = do
   let defaultRect = screenRect $ screenDetail $ current ws
   rect <- case peek ws of
         Nothing -> return defaultRect
-        Just w  -> do tryAttributes <- io $ try $ getWindowAttributes dpy w
-                      return $ case tryAttributes of
-                        Left (_ :: SomeException) -> defaultRect
-                        Right attributes          -> windowAttributesToRectangle attributes
+        Just w  -> maybe defaultRect windowAttributesToRectangle
+               <$> safeGetWindowAttributes w
+
   root <- asks theRoot
   mouseIsMoving <- asks mouseFocused
   (_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root

XMonad/Actions/Warp.hs

@@ -91,11 +91,9 @@ warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y
 -- | Warp the pointer to a given position relative to the currently
 --   focused window.  Top left = (0,0), bottom right = (1,1).
 warpToWindow :: Rational -> Rational -> X ()
-warpToWindow h v =
-    withDisplay $ \d ->
-        withFocused $ \w -> do
-            wa <- io $ getWindowAttributes d w
-            warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
+warpToWindow h v = withDisplay $ \d -> withFocused $ \w ->
+  withWindowAttributes d w $ \wa ->
+    warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
 
 -- | Warp the pointer to the given position (top left = (0,0), bottom
 --   right = (1,1)) on the given screen.

XMonad/Actions/WindowMenu.hs

@@ -51,9 +51,9 @@ colorizer _ isFg = do
                 else (nBC, fBC)
 
 windowMenu :: X ()
-windowMenu = withFocused $ \w -> do
+windowMenu = withFocused $ \w -> withDisplay $ \d -> withWindowAttributes d w $ \wa -> do
     tags <- asks (workspaces . config)
-    Rectangle x y wh ht <- getSize w
+    let Rectangle x y wh ht = getSize wa
     Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset
     let originFractX = (fi x - fi sx + fi wh / 2) / fi swh
         originFractY = (fi y - fi sy + fi ht / 2) / fi sht
@@ -69,12 +69,10 @@ windowMenu = withFocused $ \w -> do
                     | tag <- tags ]
     runSelectedAction gsConfig actions
 
-getSize :: Window -> X Rectangle
-getSize w = do
-  d  <- asks display
-  wa <- io $ getWindowAttributes d w
+getSize :: WindowAttributes -> Rectangle
+getSize wa =
   let x = fi $ wa_x wa
       y = fi $ wa_y wa
       wh = fi $ wa_width wa
       ht = fi $ wa_height wa
-  return (Rectangle x y wh ht)
+   in Rectangle x y wh ht

XMonad/Hooks/ManageDocks.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP, LambdaCase #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.ManageDocks
@@ -42,10 +42,11 @@ import XMonad.Layout.LayoutModifier
 import XMonad.Util.Types
 import XMonad.Util.WindowProperties (getProp32s)
 import qualified XMonad.Util.ExtensibleState as XS
-import XMonad.Prelude (All (..), fi, filterM, foldlM, void, when, (<=<))
+import XMonad.Prelude
 
-import qualified Data.Set as S
-import qualified Data.Map as M
+import qualified Data.Set        as S
+import qualified Data.Map        as M
+import qualified XMonad.StackSet as W
 
 -- $usage
 -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
@@ -200,15 +201,16 @@ getStrut w = do
 -- | Goes through the list of windows and find the gap so that all
 --   STRUT settings are satisfied.
 calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
-calcGap ss = withDisplay $ \dpy -> do
+calcGap ss = do
     rootw <- asks theRoot
     struts <- filter careAbout . concat . M.elems <$> getStrutCache
 
-    -- we grab the window attributes of the root window rather than checking
-    -- the width of the screen because xlib caches this info and it tends to
-    -- be incorrect after RAndR
-    wa <- io $ getWindowAttributes dpy rootw
-    let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)
+    -- If possible, we grab the window attributes of the root window rather
+    -- than checking the width of the screen because xlib caches this info
+    -- and it tends to be incorrect after RAndR
+    screen <- safeGetWindowAttributes rootw >>= \case
+        Nothing -> gets $ r2c . screenRect . W.screenDetail . W.current . windowset
+        Just wa -> pure . r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)
     return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts
   where careAbout (s,_,_,_) = s `S.member` ss
 

XMonad/Hooks/PositionStoreHooks.hs

@@ -68,10 +68,9 @@ positionStoreManageHook :: Maybe Theme -> ManageHook
 positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook
 
 positionStoreInit :: Maybe Theme -> Window -> X ()
-positionStoreInit mDecoTheme w  = withDisplay $ \d -> do
+positionStoreInit mDecoTheme w  = withDisplay $ \d -> withWindowAttributes d w $ \wa -> do
         let decoH = maybe 0 decoHeight mDecoTheme   -- take decoration into account, which - in its current
                                                     -- form - makes windows smaller to make room for it
-        wa <- io $ getWindowAttributes d w
         ws <- gets windowset
         arbitraryOffsetX <- randomIntOffset
         arbitraryOffsetY <- randomIntOffset