Add ability to tile-drag

1 files changed, 52 insertions, 46 deletions

diff --git a/src/Rahm/Desktop/StackSet.hs b/src/Rahm/Desktop/StackSet.hs
index 9b027d6..36d41a4 100644
--- a/src/Rahm/Desktop/StackSet.hs
+++ b/src/Rahm/Desktop/StackSet.hs
@@ -1,5 +1,6 @@
 module Rahm.Desktop.StackSet
   ( masterWindow,
+    allVisibleWindows,
     windowsOnWorkspace,
     findWorkspace,
     dbgStackSet,
@@ -16,6 +17,9 @@ module Rahm.Desktop.StackSet
     WindowLocation (..),
     windowMemberOfWorkspace,
     findWindow,
+    sinkBy,
+    modifyWorkspace,
+    getFocusedWindow,
     module W,
   )
 where
@@ -32,52 +36,7 @@ import qualified Data.Map as Map
 import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
 import Text.Printf (printf)
 import XMonad (Rectangle (..), ScreenDetail (..), WindowSet)
-import XMonad.StackSet as W
-  ( RationalRect (..),
-    Screen (..),
-    Stack (..),
-    StackSet (..),
-    Workspace (..),
-    abort,
-    allWindows,
-    currentTag,
-    delete,
-    delete',
-    differentiate,
-    ensureTags,
-    filter,
-    findTag,
-    float,
-    focusDown,
-    focusDown',
-    focusMaster,
-    focusUp,
-    focusUp',
-    focusWindow,
-    index,
-    insertUp,
-    integrate,
-    integrate',
-    lookupWorkspace,
-    mapLayout,
-    mapWorkspace,
-    member,
-    modify,
-    modify',
-    new,
-    peek,
-    renameTag,
-    screens,
-    shift,
-    shiftMaster,
-    sink,
-    swapDown,
-    swapMaster,
-    swapUp,
-    tagMember,
-    view,
-    workspaces,
-  )
+import XMonad.StackSet as W hiding (greedyView, shiftWin)
 import qualified XMonad.StackSet (shiftWin)
 import Prelude hiding (head)
 
@@ -91,6 +50,10 @@ getLocationWorkspace (OnScreen (Screen w _ _)) = Just w
 getLocationWorkspace (OnHiddenWorkspace w) = Just w
 getLocationWorkspace _ = Nothing
 
+allVisibleWindows :: StackSet i l a s sd -> [a]
+allVisibleWindows =
+  concatMap (W.integrate' . W.stack . W.workspace) <$> W.screens
+
 mapWindows :: (Ord a, Ord b) => (a -> b) -> StackSet i l a s sd -> StackSet i l b s sd
 mapWindows fn (StackSet cur vis hid float) =
   StackSet
@@ -251,3 +214,46 @@ findWindow (StackSet cur vis hid float) win =
 
 windowMemberOfWorkspace :: (Eq a) => Workspace i l a -> a -> Bool
 windowMemberOfWorkspace (Workspace _ _ s) w = w `elem` integrate' s
+
+modifyWorkspace :: (Eq i) => i -> (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd
+modifyWorkspace tag fn =
+  mapWorkspace
+    ( \ws ->
+        if W.tag ws == tag
+          then fn ws
+          else ws
+    )
+
+getFocusedWindow :: StackSet i l a s sd -> Maybe a
+getFocusedWindow (StackSet cur _ _ _) = W.focus <$> (W.stack . W.workspace) cur
+
+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 =
+  case (findTag win ss, findTag toSinkBy ss) of
+    (Nothing, _) -> ss
+    (Just w1, Just w2)
+      | w1 == w2 ->
+        modifyWorkspace
+          w1
+          ( \(W.Workspace t l s) ->
+              W.Workspace t l (Just $ insertBy win toSinkBy s)
+          )
+          $ W.delete win ss
+    _ -> W.sink win ss
+  where
+    insertBy win to Nothing = W.Stack win [] []
+    insertBy win to (Just (W.Stack foc down up)) =
+      case () of
+        ()
+          | to `elem` down ->
+            W.Stack
+              foc
+              (concatMap (\e -> if e == to then [e, win] else [e]) down)
+              up
+        ()
+          | to `elem` up ->
+            W.Stack
+              foc
+              down
+              (concatMap (\e -> if e == to then [win, e] else [e]) up)
+        () -> W.Stack win (foc : down) up