From ae329e52be569ca83774fb1698a1a4c47015f5e3 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 11 Dec 2023 10:37:00 -0700
Subject: Fixed workspace mouse movements to be more intuitive.

---
 src/Rahm/Desktop/Workspaces.hs | 27 +++++++++++++++++++--------
 1 file changed, 19 insertions(+), 8 deletions(-)

(limited to 'src/Rahm/Desktop/Workspaces.hs')

diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index 4763e26..6f0c08a 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -11,6 +11,7 @@ module Rahm.Desktop.Workspaces
     adjacentWorkspaceNotVisible,
     adjacentWorkspace,
     viewAdjacent,
+    viewAdjacentTo,
     adjacentScreen,
     withScreen,
     workspaceWithWindow,
@@ -19,17 +20,15 @@ module Rahm.Desktop.Workspaces
 where
 
 import Control.Arrow (Arrow ((&&&)))
+import Control.Monad.Trans (lift)
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
 import Data.Char (isUpper, toLower, toUpper)
-import Data.List (find, sort, sortBy, sortOn)
+import Data.List (find, sort, sortBy, sortOn, (\\))
 import Data.List.Safe ((!!))
 import Data.Maybe (fromMaybe, mapMaybe)
-import Rahm.Desktop.Common (getCurrentWorkspace, gotoWorkspace)
+import Rahm.Desktop.Common (getCurrentWorkspace, gotoWorkspace, runMaybeT_)
+import Rahm.Desktop.Logger
 import qualified Rahm.Desktop.StackSet as W
-  ( Screen (Screen, screenDetail, workspace),
-    StackSet (StackSet, current, visible),
-    Workspace (Workspace, tag),
-    integrate',
-  )
 import XMonad
   ( Rectangle (Rectangle),
     ScreenDetail (SD),
@@ -41,7 +40,6 @@ import XMonad
     windows,
     withWindowSet,
   )
-
 import Prelude hiding ((!!))
 
 newtype Selector = Selector (forall a. (a -> Bool) -> [a] -> Maybe a)
@@ -132,6 +130,19 @@ viewAdjacent :: Selector -> X ()
 viewAdjacent sel =
   gotoWorkspace =<< (adjacentWorkspaceNotVisible sel =<< getCurrentWorkspace)
 
+viewAdjacentTo :: X (Maybe WorkspaceId) -> Selector -> X ()
+viewAdjacentTo wsM (Selector sel) = runMaybeT_ $ do
+  lift $ logs Debug "viewAdjacentTo"
+  tag <- MaybeT wsM
+  lift $ logs Debug "from: %s" tag
+  ws <- MaybeT $ withWindowSet $ \ws ->
+    let vis = map (W.tag . W.workspace) (W.screens ws)
+        allW = sort $ map (W.tag . snd) (getPopulatedWorkspaces ws)
+        final = allW \\ (vis \\ [tag])
+     in return $ sel (== tag) final
+  lift $ logs Debug "to: %s" ws
+  lift $ windows $ W.switchWorkspaces tag ws
+
 adjacentScreen :: Selector -> X WorkspaceId
 adjacentScreen (Selector f) = do
   (screens, current) <-
-- 
cgit