Add ability to move floating windows around using mod+shift+{l,h}

2 files changed, 57 insertions, 23 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 5aad26d..7bceeef 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -492,7 +492,9 @@ bindings = do
 
     shiftMod $
       doc "Swap the current window with the next one down in the stack" $
-        windows W.swapDown
+        withFocused $ \w ->
+          withWindowsUnpinned [w] $
+            windows W.swapDownOrMirror
 
     controlMod $
       doc
@@ -522,7 +524,9 @@ bindings = do
 
     shiftMod $
       doc "Swap the currently focused window with the next window in the stack." $
-        windows W.swapUp
+        withFocused $ \w ->
+          withWindowsUnpinned [w] $
+            windows W.swapUpOrMirror
 
     controlMod $
       doc
diff --git a/src/Rahm/Desktop/StackSet.hs b/src/Rahm/Desktop/StackSet.hs
index 94c044e..c7471e1 100644
--- a/src/Rahm/Desktop/StackSet.hs
+++ b/src/Rahm/Desktop/StackSet.hs
@@ -24,27 +24,24 @@ module Rahm.Desktop.StackSet
     modifyWorkspace,
     getFocusedWindow,
     windowTilePosition,
+    swapUpOrMirror,
+    swapDownOrMirror,
     TilePosition (..),
     module W,
   )
 where
 
 import Control.Monad.Writer
-import Data.List (find, findIndex, elemIndex)
+import Data.List (elemIndex, find, findIndex)
 import Data.List.Safe (head)
 import qualified Data.Map as Map
-  ( fromList,
-    keys,
-    lookup,
-    mapKeys, keysSet,
-  )
 import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
+import qualified Data.Set as Set
 import Text.Printf (printf)
 import XMonad (Rectangle (..), ScreenDetail (..), WindowSet)
-import XMonad.StackSet as W hiding (greedyView, shiftWin, filter)
+import XMonad.StackSet as W hiding (filter, greedyView, shiftWin)
 import qualified XMonad.StackSet (shiftWin)
 import Prelude hiding (head)
-import qualified Data.Set  as Set
 
 data WindowLocation i l a s sd
   = OnScreen (Screen i l a s sd)
@@ -57,13 +54,13 @@ data TilePosition i where
 
 windowTilePosition :: (Eq a, Eq i, Ord a) => a -> StackSet i l a s sd -> Maybe (TilePosition i)
 windowTilePosition win ss =
-  let ks = Map.keysSet (W.floating ss) in
-  case W.findTag win ss of
-    Just tag
-      | (Just ws) <- findWorkspace tag ss,
-        (Just s) <- W.stack ws ->
-        TilePosition tag <$> elemIndex win (filter (`Set.notMember`ks) $ W.integrate s)
-    _ -> Nothing
+  let ks = Map.keysSet (W.floating ss)
+   in case W.findTag win ss of
+        Just tag
+          | (Just ws) <- findWorkspace tag ss,
+            (Just s) <- W.stack ws ->
+            TilePosition tag <$> elemIndex win (filter (`Set.notMember` ks) $ W.integrate s)
+        _ -> Nothing
 
 getLocationWorkspace :: WindowLocation i l a s sd -> Maybe (Workspace i l a)
 getLocationWorkspace (OnScreen (Screen w _ _)) = Just w
@@ -267,8 +264,8 @@ modifyWorkspace tag fn =
 differentiateWithFocus :: (Eq a) => a -> [a] -> Maybe (Stack a)
 differentiateWithFocus _ [] = Nothing
 differentiateWithFocus thing lst =
-  case break (==thing) lst of
-    (up, foc:down) -> Just $ Stack foc (reverse up) down
+  case break (== thing) lst of
+    (up, foc : down) -> Just $ Stack foc (reverse up) down
     _ -> differentiate lst
 
 getFocusedWindow :: StackSet i l a s sd -> Maybe a
@@ -276,10 +273,11 @@ getFocusedWindow (StackSet cur _ _ _) = W.focus <$> (W.stack . W.workspace) cur
 
 shiftWinNoFocus :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
 shiftWinNoFocus n w s = case findTag w s of
-                    Just from | n `tagMember` s && n /= from -> go from s
-                    _                                        -> s
- where go from = onWorkspace n (focusDown . insertUp w) . onWorkspace from (delete' w)
-       onWorkspace n f s = view (currentTag s) . f . view n $ s
+  Just from | n `tagMember` s && n /= from -> go from s
+  _ -> s
+  where
+    go from = onWorkspace n (focusDown . insertUp w) . onWorkspace from (delete' w)
+    onWorkspace n f s = view (currentTag s) . f . view n $ s
 
 sinkBy :: (Eq a, Eq i, Ord a) => a -> a -> StackSet i l a s sd -> StackSet i l a s sd
 sinkBy win toSinkBy ss =
@@ -311,3 +309,35 @@ sinkBy win toSinkBy ss =
               down
               (concatMap (\e -> if e == to then [e, win] else [e]) up)
         () -> W.Stack win (foc : down) up
+
+swapUpOrMirror :: (Eq a, Eq i, Ord a) => StackSet i l a s sd -> StackSet i l a s sd
+swapUpOrMirror
+  ss@StackSet
+    { floating = flt
+    } =
+    let mwin = W.peek ss
+     in case mwin of
+          Nothing -> ss
+          Just win ->
+            if win `Map.member` flt
+              then ss {floating = Map.update (Just . flipVert) win flt}
+              else W.swapUp ss
+    where
+      flipVert (RationalRect x y w h) =
+        RationalRect x (abs (1 - y) - h) w h
+
+swapDownOrMirror :: (Eq a, Eq i, Ord a) => StackSet i l a s sd -> StackSet i l a s sd
+swapDownOrMirror
+  ss@StackSet
+    { floating = flt
+    } =
+    let mwin = W.peek ss
+     in case mwin of
+          Nothing -> ss
+          Just win ->
+            if win `Map.member` flt
+              then ss {floating = Map.update (Just . flipHoriz) win flt}
+              else W.swapDown ss
+    where
+      flipHoriz (RationalRect x y w h) =
+        RationalRect (abs (1 - x) - w) y w h