Still a work-in-progress, but better dragging window.

Dragging a window will leave a hole behind until it reaches its final
destination, making it look a little better.

Now I've also implemented drag so that when ending the drag with a
right-click it tiles the window on the screen it's currently on.

It is still pretty jenky and very much a WIP.

1 files changed, 42 insertions, 4 deletions

diff --git a/src/Rahm/Desktop/StackSet.hs b/src/Rahm/Desktop/StackSet.hs
index 36d41a4..7793ec5 100644
--- a/src/Rahm/Desktop/StackSet.hs
+++ b/src/Rahm/Desktop/StackSet.hs
@@ -1,6 +1,7 @@
 module Rahm.Desktop.StackSet
   ( masterWindow,
     allVisibleWindows,
+    concatMapTiledWindows,
     windowsOnWorkspace,
     findWorkspace,
     dbgStackSet,
@@ -20,31 +21,48 @@ module Rahm.Desktop.StackSet
     sinkBy,
     modifyWorkspace,
     getFocusedWindow,
+    windowTilePosition,
+    TilePosition (..),
     module W,
   )
 where
 
 import Control.Monad.Writer
-import Data.List (find)
+import Data.List (find, findIndex, elemIndex)
 import Data.List.Safe (head)
 import qualified Data.Map as Map
   ( fromList,
     keys,
     lookup,
-    mapKeys,
+    mapKeys, keysSet,
   )
 import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
 import Text.Printf (printf)
 import XMonad (Rectangle (..), ScreenDetail (..), WindowSet)
-import XMonad.StackSet as W hiding (greedyView, shiftWin)
+import XMonad.StackSet as W hiding (greedyView, shiftWin, filter)
 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)
   | OnHiddenWorkspace (Workspace i l a)
   | Floating
 
+data TilePosition i where
+  TilePosition :: forall i. i -> Int -> TilePosition i
+  deriving (Eq, Show, Ord, Read)
+
+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
+
 getLocationWorkspace :: WindowLocation i l a s sd -> Maybe (Workspace i l a)
 getLocationWorkspace (OnScreen (Screen w _ _)) = Just w
 getLocationWorkspace (OnHiddenWorkspace w) = Just w
@@ -54,6 +72,26 @@ allVisibleWindows :: StackSet i l a s sd -> [a]
 allVisibleWindows =
   concatMap (W.integrate' . W.stack . W.workspace) <$> W.screens
 
+concatMapTiledWindows :: (Ord a) => (a -> [a]) -> StackSet i l a s sd -> StackSet i l a s sd
+concatMapTiledWindows fn (StackSet cur vis hid float) =
+  StackSet
+    (mapWindowsScreen cur)
+    (map mapWindowsScreen vis)
+    (map mapWindowsWorkspace hid)
+    float
+  where
+    mapWindowsScreen (Screen work a b) = Screen (mapWindowsWorkspace work) a b
+    mapWindowsWorkspace w@(Workspace t l Nothing) = w
+    mapWindowsWorkspace (Workspace t l (Just (Stack foc up down))) =
+      let up' = concatMap fn up
+          down' = concatMap fn down
+       in Workspace t l $
+            case fn foc of
+              [] | (h : t) <- up' -> Just $ Stack h t down
+              [] | [] <- up', (h : t) <- down' -> Just $ Stack h [] t
+              (h : t) -> Just $ Stack h up (t ++ down)
+              _ -> Nothing
+
 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
@@ -255,5 +293,5 @@ sinkBy win toSinkBy ss =
             W.Stack
               foc
               down
-              (concatMap (\e -> if e == to then [win, e] else [e]) up)
+              (concatMap (\e -> if e == to then [e, win] else [e]) up)
         () -> W.Stack win (foc : down) up