Bunch of changes. Not good git ettiquite

 - Added ShiftAndSwap functionality, which allows user to shift a
   <windowset> to a <workspace> and then swap that workspace with
   another <workspace>

   e.g. move Spotify to workspace 's' and put workspace 's' on the last
   monitor.

   This replaces the shift-and-follow as this is more powerful (shift
   and follow just puts the "shifted-to" workspace on the current
   monitor.)

   ofc if the two workspaces to swap are not visible, this just operates
   as a normal shift command.

 - Moved more dragging functionality to the Dragging.hs file and cleaned
   it up a little. More is certainly needed.

 - With the more powerful dragging functionality, many bindings are made
   redundant. I replaced one of these redundant bindings (button13 ->
   mouseWheel). This used to move the focused window around the stack,
   but this has been made redundant by the drag-to-swap functionality
   (button14 -> left-click-drag), so now it changes the master region
   size.

3 files changed, 189 insertions, 153 deletions

diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index c3a6a31..5c29a1c 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -48,7 +48,6 @@ import qualified Rahm.Desktop.StackSet as S
     workspaces,
   )
 import Text.Printf (printf)
-import qualified XMonad as X
 import XMonad
   ( ScreenId,
     Window,
@@ -69,6 +68,7 @@ import XMonad
     withFocused,
     withWindowSet,
   )
+import qualified XMonad as X
 import XMonad.Prompt (XPrompt (commandToComplete, showXPrompt))
 import XMonad.Util.XUtils (pixelToString, stringToPixel)
 
@@ -80,8 +80,8 @@ data Location = Location
   deriving (Read, Show, Eq, Ord)
 
 focusLocation :: Location -> X ()
-focusLocation (Location ws Nothing) = windows $ S.greedyView ws
-focusLocation (Location _ (Just win)) = windows $ S.focusWindow win
+focusLocation (Location ws mWin) =
+  windows $ maybe id S.focusWindow mWin . S.greedyView ws
 
 masterWindow :: MaybeT X Window
 masterWindow = MaybeT $
@@ -225,4 +225,3 @@ click = do
   (dpy, root) <- asks $ (,) <$> display <*> X.theRoot
   (_, _, window, _, _, _, _, _) <- io $ X.queryPointer dpy root
   focus window
-
diff --git a/src/Rahm/Desktop/Dragging.hs b/src/Rahm/Desktop/Dragging.hs
index 555555d..8485a46 100644
--- a/src/Rahm/Desktop/Dragging.hs
+++ b/src/Rahm/Desktop/Dragging.hs
@@ -1,13 +1,31 @@
 module Rahm.Desktop.Dragging where
 
-import Control.Monad (filterM)
+import Control.Monad (filterM, when)
+import Control.Monad.Trans (lift)
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import Data.IORef (newIORef, readIORef, writeIORef)
 import Data.Maybe (fromMaybe)
-import qualified Rahm.Desktop.Common as C
+import Rahm.Desktop.Common (runMaybeT_, setBorderColor)
 import Rahm.Desktop.Layout.Hole (addHoleForWindow, removeHoleForWindow, resetHole)
 import Rahm.Desktop.Logger
+import Rahm.Desktop.Marking (setAlternateWindows)
 import qualified Rahm.Desktop.StackSet as W
 import XMonad (X, io)
 import qualified XMonad as X
+import XMonad.Util.WindowProperties (getProp32s)
+
+-- Action which happens after a dragging event.
+--
+-- The window is the window under
+newtype AfterDragAction = AfterDragAction (X.Window -> X.Button -> X ())
+
+instance Semigroup AfterDragAction where
+  (AfterDragAction f1) <> (AfterDragAction f2) =
+    AfterDragAction $ \w b -> f1 w b >> f2 w b
+
+instance Monoid AfterDragAction where
+  mappend = (<>)
+  mempty = AfterDragAction $ \_ _ -> return ()
 
 afterDrag :: X () -> X ()
 afterDrag action = do
@@ -22,7 +40,7 @@ windowsUnderCursor = do
   aw <- X.withWindowSet (return . W.allVisibleWindows)
   let fi :: (Integral a, Integral b) => a -> b
       fi = fromIntegral
-  (_, _, _, fi -> cx, fi -> cy, _, _, _) <- io $ X.queryPointer dpy root
+  (cx, cy) <- pointerLocation
 
   filterM
     ( \win -> do
@@ -36,34 +54,9 @@ windowsUnderCursor = do
     )
     aw
 
--- mouseMoveWindowAndSink :: X ()
--- mouseMoveWindowAndSink = do
---   C.click
---   (>>=) (X.withWindowSet $ return . W.getFocusedWindow) $
---     mapM_ $ \window -> do
---       tilePosition <- X.withWindowSet $ return . W.windowTilePosition window
---       logs Debug "TilePos %s" (show tilePosition)
---       mapM_ (X.broadcastMessage . flip addHoleForWindow window) tilePosition
---       X.mouseMoveWindow window
---
---       afterDrag $ do
---         curev <- X.asks X.currentEvent
---         logs Debug "Current Event: %s" (show curev)
---
---         logs Info "\n\n***AFTER DRAG****\n\n"
---         wins <- filter (/= window) <$> windowsUnderCursor
---         logs Debug "Remove hole for window [%s]" (show window)
---         X.broadcastMessage $ removeHoleForWindow window
---         logs Debug "Windows under cursor %s" (show wins)
---         X.windows $
---           W.focusWindow window
---             . case wins of
---               (h : _) -> W.sinkBy window h
---               _ -> W.sink window
-thenSink :: X.Window -> X.Button -> X ()
-thenSink window _ = do
-  (dpy, root) <- X.asks $ (,) <$> X.display <*> X.theRoot
-  (_, _, _, fi -> cx, fi -> cy, _, _, _) <- io $ X.queryPointer dpy root
+sinkOnRelease :: AfterDragAction
+sinkOnRelease = AfterDragAction $ \window _ -> do
+  (cx, cy) <- pointerLocation
   wins <- filter (/= window) <$> windowsUnderCursor
   t <- fmap (W.tag . W.workspace) <$> X.pointScreen cx cy
 
@@ -79,19 +72,109 @@ thenSink window _ = do
   where
     fi = fromIntegral
 
-mouseMoveWindowAndSink :: X ()
-mouseMoveWindowAndSink = mouseMoveWindow thenSink
-
-mouseMoveWindow :: (X.Window -> X.Button -> X ()) -> X ()
-mouseMoveWindow afterAction = do
-  C.click
-  (>>=) (X.withWindowSet $ return . W.getFocusedWindow) $
-    mapM_ $ \window -> do
-      tilePosition <- X.withWindowSet $ return . W.windowTilePosition window
-      mapM_ (X.broadcastMessage . flip addHoleForWindow window) tilePosition
-      X.mouseMoveWindow window
-
-      afterDrag $ do
-        X.broadcastMessage $ removeHoleForWindow window
-        curev <- X.asks X.currentEvent
-        afterAction window (maybe 0 X.ev_button curev)
+ifReleased :: X.Button -> AfterDragAction -> AfterDragAction
+ifReleased but (AfterDragAction act) = AfterDragAction $ \win b -> do
+  when (but == b) $ act win b
+
+-- Like ifReleased, but with a function instead of an AfterDragAction
+ifReleased' :: X.Button -> (X.Window -> X.Button -> X ()) -> AfterDragAction
+ifReleased' but act = ifReleased but (AfterDragAction act)
+
+mouseMoveWindowAndThen ::
+  (X.Window -> X ()) ->
+  AfterDragAction ->
+  X.Window ->
+  X ()
+mouseMoveWindowAndThen beforeAction (AfterDragAction releaseAction) window = do
+  beforeAction window
+  tilePosition <- X.withWindowSet $ return . W.windowTilePosition window
+  mapM_ (X.broadcastMessage . flip addHoleForWindow window) tilePosition
+  X.mouseMoveWindow window
+
+  afterDrag $ do
+    X.broadcastMessage $ removeHoleForWindow window
+    curev <- X.asks X.currentEvent
+    releaseAction window (maybe 0 X.ev_button curev)
+    X.refresh
+
+getDisplayAndRoot :: X (X.Display, X.Window)
+getDisplayAndRoot = X.asks $ (,) <$> X.display <*> X.theRoot
+
+pointerLocation :: (Integral a, Integral b) => X (a, b)
+pointerLocation = do
+  (dpy, root) <- getDisplayAndRoot
+  (_, _, _, fromIntegral -> x, fromIntegral -> y, _, _, _) <-
+    io $ X.queryPointer dpy root
+  return (x, y)
+
+pointerWindow :: X X.Window
+pointerWindow = do
+  (dpy, root) <- getDisplayAndRoot
+  (_, _, w, _, _, _, _, _) <-
+    io $ X.queryPointer dpy root
+  return w
+
+dragWorkspace :: X ()
+dragWorkspace = do
+  (ox, oy) <- pointerLocation
+  X.mouseDrag (\_ _ -> return ()) $ do
+    (nx, ny) <- pointerLocation
+    runMaybeT_ $ do
+      (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ X.pointScreen ox oy
+      (W.Screen (W.tag -> ws2) _ _) <- MaybeT $ X.pointScreen nx ny
+
+      lift $ X.windows $ W.switchWorkspaces ws1 ws2
+
+dragWindow :: X ()
+dragWindow = do
+  w <- pointerWindow
+  if w == 0
+    then dragWorkspace
+    else do
+      cleanup <- setBorderColor "#00ffff" [w]
+
+      ref <- io $ newIORef (w, return ())
+
+      X.mouseDrag
+        ( \_ _ -> do
+            w' <- pointerWindow
+            (ow, ocleanup) <- io $ readIORef ref
+            case () of
+              () | ow /= w' -> do
+                ocleanup
+                cleanup' <-
+                  if w' == 0 || w' == w
+                    then return (return ())
+                    else setBorderColor "#80a0a0" [w']
+                io $ writeIORef ref (w', cleanup')
+              () -> return ()
+
+            return ()
+        )
+        $ do
+          (nx, ny) <- pointerLocation
+          w' <- pointerWindow
+          (_, iocleanup) <- io $ readIORef ref
+          dock <- X.getAtom "_NET_WM_WINDOW_TYPE_DOCK"
+          desk <- X.getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
+          mbr <-
+            if w' == 0
+              then return Nothing
+              else getProp32s "_NET_WM_WINDOW_TYPE" w'
+
+          let isDock =
+                maybe False (any ((`elem` [dock, desk]) . fromIntegral)) mbr
+          case w' of
+            _ | w' == 0 || isDock ->
+              runMaybeT_ $ do
+                (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ X.pointScreen nx ny
+                lift $ do
+                  setAlternateWindows [w]
+                  X.windows $ W.sink w . W.shiftWin ws1 w
+            _ -> do
+              X.windows $ W.focusWindow w . W.swapWindows [(w, w')]
+
+              setAlternateWindows [w, w']
+
+              iocleanup
+              cleanup
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index f84ccad..fe96338 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -276,6 +276,8 @@ mapWindows fn (W.StackSet cur vis hidden float) =
     mapScreen fn (W.Screen ws s sd) = W.Screen (mapWorkspace fn ws) s sd
     mapWorkspace fn (W.Workspace t l s) = W.Workspace t l (fmap (fmap fn) s)
 
+data ShiftType = JustShift | ShiftAndFollow | ShiftAndSwap
+
 keymap :: XConfig l -> KeyBindings
 keymap = runKeys $ do
   config <- getConfig
@@ -608,21 +610,42 @@ keymap = runKeys $ do
         sendMessage rotateLayout
 
   bind xK_s $ do
-    forM_ [(False, justMod), (True, shiftMod)] $ \(doView, f) ->
+    forM_ [(JustShift, justMod), (ShiftAndSwap, shiftMod), (ShiftAndFollow, controlMod)] $ \(shiftType, f) ->
       f $
         doc
-          ( if doView
-              then "Shift a windowset to a workspace and goto that workspace."
-              else "Shift a windowset to a workspace"
+          ( case shiftType of
+              ShiftAndFollow ->
+                "Shift-and-follow: Like shift-and-swap with the implicit \
+                \third parameter being the current workspace (.)"
+              ShiftAndSwap ->
+                "Shift-and-swap: Shift a windowset to a workspace then swap \
+                \that workspace with another. Primary use case is to move a \
+                \that workspace to a different screen than the current screen. \
+                \Note that this command will only work with normal workspaces."
+              JustShift -> "Shift a windowset to a workspace"
           )
-          $ pushPendingBuffer (if doView then "S " else "s ") $
-            runMaybeT_ $
+          $ pushPendingBuffer
+            ( case shiftType of
+                ShiftAndSwap -> "S "
+                JustShift -> "s "
+                ShiftAndFollow -> "^s "
+            )
+            $ runMaybeT_ $
               do
                 stackset <- lift $ X.windowset <$> X.get
                 selection <- mapMaybe locationWindow <$> readNextLocationSet
 
                 withBorderColorM "#00ffff" selection $ do
+                  lift $ addStringToPendingBuffer " "
                   ws <- readNextWorkspace
+                  finalSwap <-
+                    case shiftType of
+                      ShiftAndSwap -> do
+                        lift $ addStringToPendingBuffer " "
+                        wsName <- MaybeT . return $ workspaceName ws
+                        W.switchWorkspaces wsName <$> readNextWorkspaceName
+                      _ -> return id
+
                   lift $ do
                     (Endo allMovements) <-
                       mconcat
@@ -639,15 +662,15 @@ keymap = runKeys $ do
                         (W.findTag win stackset)
 
                     windows $
-                      ( \ss ->
-                          case () of
-                            ()
-                              | doView,
-                                (w : _) <- selection,
-                                Just ws <- W.findTag w ss ->
-                                W.greedyView ws ss
-                            _ -> ss
-                      )
+                      finalSwap
+                        . ( \ss ->
+                              case shiftType of
+                                ShiftAndFollow
+                                  | (w : _) <- selection,
+                                    Just ws <- W.findTag w ss ->
+                                    W.greedyView ws ss
+                                _ -> ss
+                          )
                         . allMovements
 
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
@@ -714,7 +737,7 @@ keymap = runKeys $ do
                 \have 'x' on 'z' instead. If a theater does explicity place a window,\n\t\
                 \the window is placed in the hidden workspace (which is '*')\n"
                 $ do
-                  addStringToPendingBuffer "g "
+                  addStringToPendingBuffer " g "
                   runMaybeT_ $
                     do
                       mapNextString $ \_ str -> lift $
@@ -923,6 +946,13 @@ buttonBindingsToButtonMap bindings config = Map.mapWithKey bindingToX (bindings
               )
               window
 
+myMouseMoveWindow =
+  D.mouseMoveWindowAndThen X.focus $
+    mconcat
+      [ D.ifReleased button3 D.sinkOnRelease,
+        D.ifReleased' button13 $ \w _ -> X.killWindow w
+      ]
+
 mouseMap :: forall l. XConfig l -> ButtonBindings
 mouseMap = runButtons $ do
   config <- getConfig
@@ -988,7 +1018,7 @@ mouseMap = runButtons $ do
           bind button1 $
             noMod $
               doc "Swap a window with another window by dragging." $
-                noWindow dragWindow
+                noWindow D.dragWindow
 
           bind button13 $ do
             noMod $
@@ -1028,17 +1058,8 @@ mouseMap = runButtons $ do
         subMouse $ do
           bind button1 $
             noMod $
-              doc "Start moving the window under the cursor" $
-                noWindow $
-                  D.mouseMoveWindow $ \win button ->
-                    if (button == button3)
-                      then D.thenSink win button
-                      else refresh
-
-          bind button14 $
-            noMod $
-              doc "Start moving the mouse under the cursor, but tile when completed." $
-                noWindow D.mouseMoveWindowAndSink
+              doc "Move the mouse under the cursor (like how Mod+leftMouse works)" $
+                myMouseMoveWindow
 
           bind button2 $
             noMod $
@@ -1049,19 +1070,19 @@ mouseMap = runButtons $ do
             noMod $
               doc "Resize the window under the cursor" mouseResizeWindow
 
-          let swapButtons =
+          let resizeButtons =
                 [ ( button4,
-                    "Swap the current window with the next one in the stack",
-                    noWindow $ windows W.swapDown
+                    "Increase the size of the master region",
+                    noWindow $ sendMessage Expand
                   ),
                   ( button5,
-                    "Swap the current window with the last one in the stack",
-                    noWindow $ windows W.swapUp
+                    "Shrink the size of the master region",
+                    noWindow $ sendMessage Shrink
                   )
                 ]
 
           continuous $
-            forM_ swapButtons $ \(b, d, a) ->
+            forM_ resizeButtons $ \(b, d, a) ->
               bind b $ noMod $ doc d a
 
           bind button13 $
@@ -1099,7 +1120,7 @@ mouseMap = runButtons $ do
           bind button1 $
             noMod $
               doc "'drag' a workspace to another screen" $
-                noWindow dragWorkspace
+                noWindow D.dragWorkspace
 
           let workspaceButtons =
                 [ ( button2,
@@ -1287,70 +1308,3 @@ modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
   where
     clip i | i < 0 = 0
     clip i = i
-
-dragWorkspace :: X ()
-dragWorkspace = do
-  (dpy, root) <- asks $ (,) <$> display <*> theRoot
-  (_, _, _, fromIntegral -> ox, fromIntegral -> oy, _, _, _) <- io $ queryPointer dpy root
-  mouseDrag (\_ _ -> return ()) $ do
-    (_, _, _, fromIntegral -> nx, fromIntegral -> ny, _, _, _) <- io $ queryPointer dpy root
-    runMaybeT_ $ do
-      (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ pointScreen ox oy
-      (W.Screen (W.tag -> ws2) _ _) <- MaybeT $ pointScreen nx ny
-
-      lift $ windows $ W.switchWorkspaces ws1 ws2
-
-dragWindow :: X ()
-dragWindow = do
-  (dpy, root) <- asks $ (,) <$> display <*> theRoot
-  (_, _, w, _, _, _, _, _) <- io $ queryPointer dpy root
-  if w == 0
-    then dragWorkspace
-    else do
-      cleanup <- setBorderColor "#00ffff" [w]
-
-      ref <- io $ newIORef (w, return ())
-
-      mouseDrag
-        ( \_ _ -> do
-            (_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root
-            (ow, ocleanup) <- io $ readIORef ref
-            logs Debug "%s, %s, %s\n" (show w) (show w') (show ow)
-            case () of
-              () | ow /= w' -> do
-                ocleanup
-                cleanup' <-
-                  if w' == 0 || w' == w
-                    then return (return ())
-                    else setBorderColor "#80a0a0" [w']
-                io $ writeIORef ref (w', cleanup')
-              () -> return ()
-
-            return ()
-        )
-        $ do
-          (_, _, w', fromIntegral -> nx, fromIntegral -> ny, _, _, _) <- io $ queryPointer dpy root
-          (_, iocleanup) <- io $ readIORef ref
-          dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
-          desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
-          mbr <-
-            if w' == 0
-              then return Nothing
-              else getProp32s "_NET_WM_WINDOW_TYPE" w'
-
-          let isDock =
-                maybe False (any ((`elem` [dock, desk]) . fromIntegral)) mbr
-          case w' of
-            _ | w' == 0 || isDock ->
-              runMaybeT_ $ do
-                (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ pointScreen nx ny
-                lift $ do
-                  setAlternateWindows [w]
-                  windows $ W.sink w . W.shiftWin ws1 w
-            _ -> do
-              windows $ W.focusWindow w . W.swapWindows [(w, w')]
-
-              setAlternateWindows [w, w']
-
-              iocleanup
-              cleanup