Rework keys

Finally removed the buggy hjkl navigation in favor of a more traditional
key bindings:

  - h,l move between windows like Tab and S-Tab
  - j,k adjust the master window size

Added ability to swap current window with a marked window using
S-'-<mark>.

2 files changed, 84 insertions, 16 deletions

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 3dff864..0b7b1c3 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -42,8 +42,7 @@ applyKeys config@(XConfig {modMask = modm}) =
   withNewMarkContext $ \markContext -> do
     ks <- newKeys markContext
     ms <- newMouse markContext
-    withWindowNavigation (xK_k, xK_h, xK_j, xK_l) $
-      config { keys = ks, mouseBindings = ms }
+    return $ config { keys = ks, mouseBindings = ms }
 
 newMouse :: MarkContext -> IO (XConfig l -> Map (KeyMask, Button) (Window -> X ()))
 newMouse markContext =
@@ -74,28 +73,41 @@ newKeys :: MarkContext -> IO (KeyMap l)
 newKeys markContext =
     return $ \config@(XConfig {modMask = modm}) ->
       Map.fromList
-        [ ((modm, xK_F12), (void $ spawn "spotify-control next"))
-        , ((modm, xK_F11), (void $ spawn "spotify-control prev"))
-        , ((modm, xK_semicolon), scratchpadSpawnActionTerminal "scratchpad")
-        , ((modm, xK_F10), (void $ spawn "spotify-control play"))
-        , ((modm, xK_r),   runDMenu)
-        , ((modm, xK_c),   runPassMenu)
+        [ ((modm,               xK_F12), (void $ spawn "spotify-control next"))
+        , ((modm,               xK_F11), (void $ spawn "spotify-control prev"))
+        , ((modm,               xK_semicolon), scratchpadSpawnActionTerminal "scratchpad")
+        , ((modm,               xK_F10), (void $ spawn "spotify-control play"))
+        , ((modm,               xK_r),   runDMenu)
+        , ((modm,               xK_c),   runPassMenu)
+        , ((modm,               xK_h),   windows W.focusDown)
+        , ((modm,               xK_l),   windows W.focusUp)
+        , ((modm .|. shiftMask, xK_h),   windows W.swapUp)
+        , ((modm .|. shiftMask, xK_l),   windows W.swapDown)
+        , ((modm              , xK_Return),   windows W.swapMaster)
+        , ((modm,               xK_j),   sendMessage Shrink)
+        , ((modm,               xK_k),   sendMessage Expand)
         , ((modm .|. shiftMask, xK_r),   (void $ spawn "gmrun"))
-        , ((modm .|. mod1Mask, xK_l), (void $ spawn "xsecurelock"))
-        , ((modm .|. mod1Mask, xK_s), (void $ spawn "sudo systemctl suspend && xsecurelock"))
+        , ((modm .|. mod1Mask,  xK_l), (void $ spawn "xsecurelock"))
+        , ((modm .|. mod1Mask,  xK_s), (void $ spawn "sudo systemctl suspend && xsecurelock"))
         , ((modm .|. shiftMask, xK_c), kill)
         , ((modm .|. shiftMask, xK_t), withFocused $ windows . W.sink)
-        , ((mod4Mask, xK_BackSpace),  (void $ spawn "xterm"))
-        , ((mod3Mask, xK_BackSpace),  (void $ spawn "pkill -SIGUSR1 xmobar"))
-        , ((mod3Mask, xK_t),  (void $ spawn (terminal config)))
-        , ((modm, xK_m), (submap $ mapAlpha modm (markCurrentWindow markContext)))
-        , ((modm, xK_w), runXPlus markContext config windowJump)
-        , ((modm, xK_apostrophe), (submap $
+        , ((mod4Mask,           xK_BackSpace),  (void $ spawn "xterm"))
+        , ((modm,               xK_BackSpace),  (void $ spawn "pkill -SIGUSR1 xmobar"))
+        , ((modm,               xK_t),  (void $ spawn (terminal config)))
+        , ((modm,               xK_m), (submap $ mapAlpha modm (markCurrentWindow markContext)))
+        , ((modm,               xK_w), runXPlus markContext config windowJump)
+        , ((modm,               xK_apostrophe), (submap $
               Map.insert
                 (modm, xK_apostrophe)
                 (jumpToLast markContext)
                 (mapAlpha modm (jumpToMark markContext))))
 
+        , ((modm .|. shiftMask, xK_apostrophe), (submap $
+              Map.insert
+                (modm .|. shiftMask, xK_apostrophe)
+                (swapWithLastMark markContext)
+                (mapAlpha (modm .|. shiftMask) (swapWithMark markContext))))
+
         , ((modm, xK_g), (submap $
             mapNumbersAndAlpha 0 (
               runXPlus markContext config . gotoWorkspace)))
diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index e5cf696..606b55e 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -2,6 +2,7 @@
 module Internal.Marking where
 
 import XMonad
+import XMonad.StackSet hiding (focus)
 import Data.IORef
 import Data.Map (Map)
 
@@ -77,3 +78,58 @@ jumpToMark ctx@(MarkContext ioref) mark = do
       focus w
 
   saveMarkState =<< liftIO (readIORef ioref)
+
+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
+    (mapWindowsScreen cur)
+    (map mapWindowsScreen vis)
+    (map mapWindowsWorkspace hid)
+    (Map.mapKeys fn float)
+  where
+    mapWindowsScreen (Screen work a b) = Screen (mapWindowsWorkspace work) a b
+    mapWindowsWorkspace (Workspace t l stack) =
+      Workspace t l (fmap (mapStack fn) stack)
+
+-- | What genius decided to hide the instances for the Stack type!!???
+mapStack :: (a -> b) -> Stack a -> Stack b
+mapStack fn (Stack focus up down) = Stack (fn focus) (map fn up) (map fn down)
+
+setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
+setFocusedWindow
+  window
+  (StackSet (Screen (Workspace t l stack) a b) vis hid float) =
+    let newStack =
+          case stack of
+            Nothing -> Nothing
+            Just (Stack _ up down) -> Just (Stack window up down) in
+    (StackSet (Screen (Workspace t l newStack) a b) vis hid float)
+
+swapWithFocused :: (Ord a) => a -> StackSet i l a s sd -> StackSet i l a s sd
+swapWithFocused winToSwap stackSet =
+  case peek stackSet of
+    Nothing -> stackSet
+    Just focused -> do
+       setFocusedWindow winToSwap $
+          mapWindows (
+            \w -> if w == winToSwap then focused else w) stackSet
+
+swapWithLastMark :: MarkContext -> X ()
+swapWithLastMark ctx@(MarkContext ioref) = do
+  MarkState {markStateMap = m} <- liftIO $ readIORef ioref
+  m <- markLast <$> (liftIO $ readIORef ioref)
+  saveLastMark ctx
+
+  case m of
+    Nothing -> return ()
+    Just win -> windows $ swapWithFocused win
+
+swapWithMark :: MarkContext -> Mark -> X ()
+swapWithMark ctx@(MarkContext ioref) mark = do
+  MarkState {markStateMap = m} <- liftIO $ readIORef ioref
+  saveLastMark ctx
+
+  case Map.lookup mark m of
+    Nothing -> return ()
+    Just winToSwap ->
+      windows $ swapWithFocused winToSwap