1 files changed, 67 insertions, 12 deletions

diff --git a/src/Rahm/Desktop/StackSet.hs b/src/Rahm/Desktop/StackSet.hs
index 89e7eed..355c5c6 100644
--- a/src/Rahm/Desktop/StackSet.hs
+++ b/src/Rahm/Desktop/StackSet.hs
@@ -1,6 +1,8 @@
 module Rahm.Desktop.StackSet
   ( masterWindow,
+    windowsOnWorkspace,
     findWorkspace,
+    dbgStackSet,
     ensureWorkspace,
     swapWorkspaces,
     greedyView,
@@ -17,6 +19,7 @@ module Rahm.Desktop.StackSet
   )
 where
 
+import Control.Monad.Writer
 import Data.List (find)
 import Data.List.Safe (head)
 import qualified Data.Map as Map
@@ -26,6 +29,8 @@ import qualified Data.Map as Map
     mapKeys,
   )
 import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
+import Text.Printf (printf)
+import XMonad (Rectangle (..), ScreenDetail (..), WindowSet)
 import XMonad.StackSet as W
   ( RationalRect (..),
     Screen (..),
@@ -125,30 +130,80 @@ ensureWorkspace t ss =
        in (ss {hidden = ws : hidden ss}, ws)
     Just ws -> (ss, ws)
 
+ensureWorkspaces ::
+  (Eq i) =>
+  [i] ->
+  StackSet i l a s sd ->
+  (StackSet i l a s sd, [Workspace i l a])
+ensureWorkspaces (t : ts) ss =
+  let (ss', w) = ensureWorkspace t ss
+      (ss'', ws) = ensureWorkspaces ts ss'
+   in (ss'', w : ws)
+ensureWorkspaces [] ss = (ss, [])
+
 swapWorkspaces ::
   (Eq i) =>
   i ->
   i ->
   StackSet i l a s sd ->
   StackSet i l a s sd
-swapWorkspaces wid1 wid2 ss =
-  let (ss', workspace1) = ensureWorkspace wid1 ss
-      (ss'', workspace2) = ensureWorkspace wid2 ss'
-   in mapWorkspace
-        ( \w ->
-            case () of
-              _ | tag w == wid1 -> workspace2
-              _ | tag w == wid2 -> workspace1
-              _ -> w
-        )
-        ss''
+swapWorkspaces tag1 tag2 =
+  W.mapWorkspace
+    ( \(W.Workspace t a b) ->
+        W.Workspace
+          ( case (t == tag1, t == tag2) of
+              (True, False) -> tag2
+              (False, True) -> tag1
+              _ -> t
+          )
+          a
+          b
+    )
+
+switchWorkspaces ::
+  (Eq i) =>
+  i ->
+  i ->
+  StackSet i l a s sd ->
+  StackSet i l a s sd
+switchWorkspaces t1 t2 (ensureWorkspaces [t1, t2] -> (ss, [w1, w2])) =
+  W.mapWorkspace
+    ( \case
+        (Workspace t _ _) | t == t1 -> w2
+        (Workspace t _ _) | t == t2 -> w1
+        w -> w
+    )
+    ss
+
+dbgStackSet :: WindowSet -> String
+dbgStackSet ws@(W.StackSet cur vis hidden _) = execWriter $ do
+  tell "* " >> logScreen cur >> tell "\n"
+  mapM_ (\s -> tell "  " >> logScreen s >> tell "\n") vis
+
+  mapM_ logWorkspace (W.workspaces ws)
+  where
+    logWorkspace (Workspace tag _ st) = do
+      tell $ printf "WS %s\n" tag
+      forM_ st $ \(Stack foc up down) -> do
+        mapM_ (tell . printf "    %d\n") up
+        tell $ printf "  * %d\n" foc
+        mapM_ (tell . printf "    %d\n") down
+
+    logScreen (Screen ws sid (SD (Rectangle _ _ w h))) = do
+      tell (printf "id=%s (%sx%s) - [%s]" (show sid) (show w) (show h) (W.tag ws))
 
 greedyView :: (Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
-greedyView wid ss = swapWorkspaces (tag . workspace . current $ ss) wid ss
+greedyView wid ss = switchWorkspaces (tag . workspace . current $ ss) wid ss
 
 shiftWin :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
 shiftWin wid a = XMonad.StackSet.shiftWin wid a . fst . ensureWorkspace wid
 
+windowsOnWorkspace :: (Eq i) => i -> StackSet i l a s sd -> [a]
+windowsOnWorkspace i ss = fromMaybe [] $ do
+  ws <- find ((== i) . W.tag) (W.workspaces ss)
+  s <- W.stack ws
+  return (W.integrate s)
+
 screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
 screenRotateBackward (W.StackSet current visible others floating) = do
   let screens = current : visible