[bugfix] change swap to work entirely inside a KeyFeed monad.

1 files changed, 29 insertions, 52 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index ae06b9d..af1893b 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -398,31 +398,6 @@ bindings = do
                        in liftFromX $ do
                             setAlternateWindows (l1'' ++ l2')
                             swapWindows l1'' l2'
-
-    -- let doExec :: KeyFeed a -> KeyFeed a -> KeyFeed a
-    --     doExec ifDouble notDouble =
-    --       peekKey
-    --         ( \case
-    --             (m, xK_w, _) | m == mod4Mask -> skipKey >> ifDouble
-    --             _ -> notDouble
-    --         )
-    --  in runKeyFeed $
-    --       doExec (pure ()) $
-    --         runMaybeT_ $
-    --           do
-    --             l1 <- mapMaybe (\(Location _ w) -> w) <$> readNextLocationSet
-    --             withBorderColorM selectedWindowsColor l1 $ do
-    --               lift $ addStringToPendingBuffer " "
-    --               l2 <- mapMaybe (\(Location _ w) -> w) <$> readNextLocationSet
-    --               let (l1', l2') =
-    --                     if length l1 > length l2
-    --                       then (l1, l2)
-    --                       else (l2, l1)
-    --                   l1'' = filter (not . (`elem` l2')) l1'
-
-    --               lift $ do
-    --                 setAlternateWindows (l1'' ++ l2')
-    --                 windows $ W.swapWindows $ zip l1'' l2' ++ zip l2' l1''
     shiftMod
       $ doc
         "Swap two workspaces (or rename the current one). \
@@ -832,35 +807,37 @@ bindings = do
                 ShiftAndFollow -> "^s "
             )
           $ runMaybeT_
+          $ runKeyFeed
           $ do
-            stackset <- lift $ X.windowset <$> X.get
-            selection <- mapMaybe locationWindow <$> runKeyFeed readNextLocationSet
-            (allMovements, finalSwap) <- withBorderColor selectedWindowsColor selection $ do
-              lift $ addStringToPendingBuffer " "
-              ws <- runKeyFeed readNextWorkspace
-              finalSwap <-
-                case shiftType of
-                  ShiftAndSwap -> do
-                    lift $ addStringToPendingBuffer " "
-                    wsName <- MaybeT . return $ workspaceName ws
-                    W.switchWorkspaces wsName <$> runKeyFeed readNextWorkspaceName
-                  _ -> return id
-
-              lift $ do
-                allMovements <- moveWindowsToWorkspaceFn ws selection
-
-                setAlternateWindows selection
-
-                forM_ selection $ \win -> do
-                  mapM_
-                    ( \t -> do
-                        logs Debug "Set alternate workspace %s -> %s" (show win) t
-                        setAlternateWorkspace win t
-                    )
-                    (W.findTag win stackset)
-                return (allMovements, finalSwap)
+            stackset <- liftFromX $ X.windowset <$> X.get
+            selection <- mapMaybe locationWindow <$> readNextLocationSet
+            (allMovements, finalSwap) <-
+              withBorderColor selectedWindowsColor selection $ do
+                liftFromX $ addStringToPendingBuffer " "
+                ws <- readNextWorkspace
+                finalSwap <-
+                  case shiftType of
+                    ShiftAndSwap -> do
+                      liftFromX $ addStringToPendingBuffer " "
+                      wsName <- absorbMaybe $ return $ workspaceName ws
+                      W.switchWorkspaces wsName <$> readNextWorkspaceName
+                    _ -> return id
+
+                liftFromX $ do
+                  allMovements <- moveWindowsToWorkspaceFn ws selection
+
+                  setAlternateWindows selection
+
+                  forM_ selection $ \win -> do
+                    mapM_
+                      ( \t -> do
+                          logs Debug "Set alternate workspace %s -> %s" (show win) t
+                          setAlternateWorkspace win t
+                      )
+                      (W.findTag win stackset)
+                  return (allMovements, finalSwap)
 
-            lift $
+            liftFromX $
               withWindowsUnpinned selection $
                 windows $
                   finalSwap