Fixes to warnings with BSP layout

Ignore-this: 7642710fdb2a866150875f2d521d19fd

darcs-hash:20150315100041-8e960-01ba343721c6eaba5c96da3916201f740feecbec.gz

1 files changed, 40 insertions, 32 deletions

diff --git a/XMonad/Layout/BinarySpacePartition.hs b/XMonad/Layout/BinarySpacePartition.hs
index e5e7dbb..6c6e674 100644
--- a/XMonad/Layout/BinarySpacePartition.hs
+++ b/XMonad/Layout/BinarySpacePartition.hs
@@ -173,11 +173,13 @@ numLeaves (Leaf _) = 1
 numLeaves (Node _ l r) = numLeaves l + numLeaves r
 
 -- right or left rotation of a (sub)tree, no effect if rotation not possible
-rotTree dir (Leaf n) = (Leaf n)
+rotTree :: Direction2D -> Tree a -> Tree a
+rotTree _ (Leaf n) = (Leaf n)
 rotTree R n@(Node _ (Leaf _) _) = n
 rotTree L n@(Node _ _ (Leaf _)) = n
 rotTree R (Node sp (Node sp2 l2 r2) r) = Node sp2 l2 (Node sp r2 r)
 rotTree L (Node sp l (Node sp2 l2 r2)) = Node sp2 (Node sp l l2) r2
+rotTree _ t = t
 
 
 data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a) deriving (Show, Read, Eq)
@@ -237,7 +239,7 @@ goToNthLeaf n z@(t, _) =
 goToFocusedLocation :: (Int,Int,[Window]) -> Zipper a -> Maybe (Zipper a)
 goToFocusedLocation (l,n,_) z = goToNthLeaf l z >>= goUpN n
   where goUpN 0 b = return b
-        goUpN n b = goUp b >>= goUpN (n-1)
+        goUpN m b = goUp b >>= goUpN (m-1)
 
 splitCurrentLeaf :: Zipper Split -> Maybe (Zipper Split)
 splitCurrentLeaf (Leaf _, []) = Just (Node (Split Vertical 0.5) (Leaf 0) (Leaf 0), [])
@@ -360,13 +362,13 @@ resizeSplit dir (xsc,ysc) z = case goToBorder dir z of
 
 -- starting from a leaf, go to node representing a border of the according window
 goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
-goToBorder L z@(_, RightCrumb (Split Vertical _) l:cs) = goUp z
+goToBorder L z@(_, RightCrumb (Split Vertical _) _:_) = goUp z
 goToBorder L z = goUp z >>= goToBorder L
-goToBorder R z@(_, LeftCrumb  (Split Vertical _) r:cs) = goUp z
+goToBorder R z@(_, LeftCrumb  (Split Vertical _) _:_) = goUp z
 goToBorder R z = goUp z >>= goToBorder R
-goToBorder U z@(_, RightCrumb (Split Horizontal _) l:cs) = goUp z
+goToBorder U z@(_, RightCrumb (Split Horizontal _) _:_) = goUp z
 goToBorder U z = goUp z >>= goToBorder U
-goToBorder D z@(_, LeftCrumb  (Split Horizontal _) r:cs) = goUp z
+goToBorder D z@(_, LeftCrumb  (Split Horizontal _) _:_) = goUp z
 goToBorder D z = goUp z >>= goToBorder D
 
 
@@ -404,13 +406,13 @@ rectangles (BinarySpacePartition _ _ (Just node)) rootRect =
 getNodeRect :: BinarySpacePartition a -> Rectangle -> (Int,Int) -> Rectangle
 getNodeRect b r (l,n) = fromMaybe (Rectangle 0 0 1 1)
                       $ (makeZipper b >>= goToFocusedLocation (l,n,[]) >>= getRect [])
-  where getRect ls z@(n, []) = Just $ foldl (\r' (s,f) -> f $ split' s r') r ls
-        getRect ls z@(n, LeftCrumb s t:cs) = goUp z >>= getRect ((s,fst):ls)
-        getRect ls z@(n, RightCrumb s t:cs) = goUp z >>= getRect ((s,snd):ls)
+  where getRect ls (_, []) = Just $ foldl (\r' (s,f) -> f $ split' s r') r ls
+        getRect ls z@(_, LeftCrumb s _:_) = goUp z >>= getRect ((s,fst):ls)
+        getRect ls z@(_, RightCrumb s _:_) = goUp z >>= getRect ((s,snd):ls)
         split' s = split (axis s) (ratio s)
 
 doToNth :: (Zipper Split -> Maybe (Zipper Split)) -> BinarySpacePartition a -> Int -> BinarySpacePartition a
-doToNth f b n = zipperToBinarySpacePartition $ makeZipper b >>= goToFocusedLocation (getFocusedNode b) >>= f
+doToNth f b _ = zipperToBinarySpacePartition $ makeZipper b >>= goToFocusedLocation (getFocusedNode b) >>= f
 
 splitNth :: BinarySpacePartition a -> Int -> BinarySpacePartition a
 splitNth (BinarySpacePartition _ _ Nothing) _ = makeBSP (Leaf 0)
@@ -456,10 +458,10 @@ rotateTreeNth :: Direction2D -> BinarySpacePartition a -> Int -> BinarySpacePart
 rotateTreeNth _ (BinarySpacePartition _ _ Nothing) _ = emptyBSP
 rotateTreeNth U b _ = b
 rotateTreeNth D b _ = b
-rotateTreeNth dir b@(BinarySpacePartition _ _ (Just t)) n =
+rotateTreeNth dir b@(BinarySpacePartition _ _ (Just _)) n =
   doToNth (\t -> case goUp t of
                 Nothing     -> Just t
-                Just (t, c) -> Just (rotTree dir t, c)) b n
+                Just (t', c) -> Just (rotTree dir t', c)) b n
 
 -- set the split ratios so that all windows have the same size, without changing tree itself
 equalizeTree :: BinarySpacePartition a -> BinarySpacePartition a
@@ -474,17 +476,17 @@ balancedTree :: Int -> BinarySpacePartition a
 balancedTree n =  numerateLeaves $ BinarySpacePartition [] ((-1),0,[]) $ Just $ balanced n
   where balanced 1 = Leaf 0
         balanced 2 = Node (Split Horizontal 0.5) (Leaf 0) (Leaf 0)
-        balanced n = Node (Split Horizontal 0.5) (balanced (n`div`2)) (balanced (n-n`div`2))
+        balanced m = Node (Split Horizontal 0.5) (balanced (m`div`2)) (balanced (m-m`div`2))
 
 -- attempt to rotate splits optimally in order choose more quad-like rects
 optimizeOrientation :: Rectangle -> BinarySpacePartition a -> BinarySpacePartition a
-optimizeOrientation r (BinarySpacePartition _ _ Nothing) = emptyBSP
-optimizeOrientation r (BinarySpacePartition olr foc (Just t)) = BinarySpacePartition olr foc $ Just $ opt t r
-  where opt (Leaf v) rect = (Leaf v)
+optimizeOrientation _ (BinarySpacePartition _ _ Nothing) = emptyBSP
+optimizeOrientation rct (BinarySpacePartition olr foc (Just t)) = BinarySpacePartition olr foc $ Just $ opt t rct
+  where opt (Leaf v) _ = (Leaf v)
         opt (Node sp l r) rect = Node sp' (opt l lrect) (opt r rrect)
          where (Rectangle _ _ w1 h1,Rectangle _ _ w2 h2) = split (axis sp) (ratio sp) rect
                (Rectangle _ _ w3 h3,Rectangle _ _ w4 h4) = split (axis $ oppositeSplit sp) (ratio sp) rect
-               f w h = if w > h then w'/h' else h'/w' where (w',h') = (fromIntegral w, fromIntegral h)
+               f w h = if w > h then w'/h' else h'/w' where (w',h') = (fromIntegral w :: Double, fromIntegral h :: Double)
                wratio = min (f w1 h1) (f w2 h2)
                wratio' = min (f w3 h3) (f w4 h4)
                sp' = if wratio<wratio' then sp else oppositeSplit sp
@@ -500,7 +502,7 @@ flattenLeaves (BinarySpacePartition _ _ (Just t)) = flatten t
 -- we do this before an action to look afterwards which leaves moved where
 numerateLeaves :: BinarySpacePartition a -> BinarySpacePartition a
 numerateLeaves b@(BinarySpacePartition _ _ Nothing) = b
-numerateLeaves b@(BinarySpacePartition olr foc (Just t)) = BinarySpacePartition olr foc . Just . snd $ numerate 0 t
+numerateLeaves (BinarySpacePartition olr foc (Just t)) = BinarySpacePartition olr foc . Just . snd $ numerate 0 t
   where numerate n (Leaf _) = (n+1, Leaf n)
         numerate n (Node s l r) = (n'', Node s nl nr)
           where (n', nl) = numerate n l
@@ -547,10 +549,17 @@ replaceFloating wsm = do
   put st{windowset=wset{W.floating=wsm}}
 
 -- some helpers to filter windows
+--
+getFloating :: X [Window]
 getFloating = (M.keys . W.floating) <$> gets windowset -- all floating windows
+
+getStackSet :: X (Maybe (W.Stack Window))
 getStackSet = (W.stack . W.workspace . W.current) <$> gets windowset -- windows on this WS (with floating)
+
+withoutFloating :: [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window)
 withoutFloating fs = maybe Nothing (unfloat fs)
-isFloating w = getFloating >>= (\fs -> return $ w `elem` fs)
+
+getScreenRect :: X Rectangle
 getScreenRect = (screenRect . W.screenDetail . W.current) <$> gets windowset
 
 -- ignore messages if current focus is on floating window, otherwise return stack without floating
@@ -610,22 +619,21 @@ instance LayoutClass BinarySpacePartition Window where
           resize (MoveSplit dir) s = autoSizeNth dir b $ index s
           rotateTr RotateL s = rotateTreeNth L b $ index s
           rotateTr RotateR s = rotateTreeNth R b $ index s
-          balanceTr r Equalize = equalizeTree b
+          balanceTr _ Equalize = equalizeTree b
           balanceTr r Balance = optimizeOrientation r $ balancedTree (size b)
 
   description _  = "BSP"
 
 -- React to SetGeometry message to work with BorderResize/MouseResize
 handleResize :: BinarySpacePartition Window -> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Window))
-handleResize b (SetGeometry newrect@(Rectangle x y w h)) = do
+handleResize b (SetGeometry newrect@(Rectangle _ _ w h)) = do
   ws <- getStackSet
   fs <- getFloating
   case W.focus <$> ws of
     Nothing -> return Nothing
     Just win -> do
-      isfloat <- isFloating win
       (_,_,_,_,_,mx,my,_) <- withDisplay (\d -> (io $ queryPointer d win))
-      let oldrect@(Rectangle ox oy ow oh) = fromMaybe (Rectangle 0 0 0 0) $ lookup win $ getOldRects b
+      let oldrect@(Rectangle _ _ ow oh) = fromMaybe (Rectangle 0 0 0 0) $ lookup win $ getOldRects b
       let (xsc,ysc)   = (fi w % fi ow, fi h % fi oh)
           (xsc',ysc') = (rough xsc, rough ysc)
           dirs = changedDirs oldrect newrect (fi mx,fi my)
@@ -636,16 +644,16 @@ handleResize b (SetGeometry newrect@(Rectangle x y w h)) = do
       return $ case n of
                 Just n' -> Just $ foldl' (\b' d -> resizeSplitNth d (xsc',ysc') b' n') b dirs
                 Nothing -> Nothing --focused window is floating -> ignore
-
   where rough v = min 1.5 $ max 0.75 v -- extreme scale factors are forbidden
+handleResize _ _ = return Nothing
 
 -- find out which borders have been pulled. We need the old and new rects and the mouse coordinates
 changedDirs :: Rectangle -> Rectangle -> (Int,Int) -> [Direction2D]
-changedDirs (Rectangle ox oy ow oh) (Rectangle x y w h) (mx,my) = catMaybes [lr, ud]
+changedDirs (Rectangle _ _ ow oh) (Rectangle _ _ w h) (mx,my) = catMaybes [lr, ud]
  where lr = if ow==w then Nothing
-            else Just (if fi mx > (fi ow)/2 then R else L)
+            else Just (if (fi mx :: Double) >  (fi ow :: Double)/2 then R else L)
        ud = if oh==h then Nothing
-            else Just (if fi my > (fi oh)/2 then D else U)
+            else Just (if (fi my :: Double) > (fi oh :: Double)/2 then D else U)
 
 -- move focus to next higher parent node of current focused leaf if possible, cyclic
 focusParent :: BinarySpacePartition a -> X (Maybe (BinarySpacePartition a))
@@ -667,8 +675,8 @@ updateBorder r b = do
   foc <- maybe 0 index <$> (withoutFloating <$> getFloating <*> getStackSet)
   let (l,n,ws) = getFocusedNode b
   removeBorder ws
-  if n==0 || foc/=l then return $ b{getFocusedNode=(foc,0,[])}
-  else createBorder (getNodeRect b r (l,n)) Nothing >>= (\ws -> return $ b{getFocusedNode=(l,n,ws)})
+  if n==0 || foc/=l then return b{getFocusedNode=(foc,0,[])}
+    else createBorder (getNodeRect b r (l,n)) Nothing >>= (\ws' -> return b{getFocusedNode=(l,n,ws')})
 
 clearBorder :: BinarySpacePartition a -> X (BinarySpacePartition a)
 clearBorder b = do
@@ -677,7 +685,8 @@ clearBorder b = do
   return b{getFocusedNode=((-1),0,[])}
 
 -- create a window for each border line, show, add into stack and set floating
-createBorder r@(Rectangle wx wy ww wh) c = do
+createBorder :: Rectangle -> Maybe String -> X [Window]
+createBorder (Rectangle wx wy ww wh) c = do
   bw <- asks (borderWidth.config)
   bc <- case c of
          Nothing -> asks (focusedBorderColor.config)
@@ -698,11 +707,10 @@ createBorder r@(Rectangle wx wy ww wh) c = do
   where toRR (Rectangle x y w h) = W.RationalRect (fi x) (fi y) (fi w) (fi h)
 
 -- remove border line windows from stack + floating, kill
+removeBorder :: [Window] -> X ()
 removeBorder ws = do
   modify (\s -> s{mapped = mapped s `S.difference` S.fromList ws})
   flip (foldl (flip M.delete)) ws . W.floating . windowset <$> get >>= replaceFloating
   maybe Nothing (\s -> Just s{W.down=W.down s \\ ws}) <$> getStackSet >>= replaceStack
   deleteWindows ws
 
-debug str = spawn $ "echo \""++str++"\" >> /tmp/xdebug"
-