From 125172361e1eef9d922ba541751c3a0a503daef7 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 1 Nov 2021 11:04:29 -0600
Subject: add passmenu

---
 src/Internal/PassMenu.hs | 15 +++++++++++++++
 1 file changed, 15 insertions(+)
 create mode 100644 src/Internal/PassMenu.hs

diff --git a/src/Internal/PassMenu.hs b/src/Internal/PassMenu.hs
new file mode 100644
index 0000000..7374bed
--- /dev/null
+++ b/src/Internal/PassMenu.hs
@@ -0,0 +1,15 @@
+module Internal.PassMenu where
+
+import XMonad
+import XMonad.Util.Run
+import Control.Monad
+
+runPassMenu :: X ()
+runPassMenu = void $
+  safeSpawn "passmenu" [
+    "-p", "Password ", 
+    "-l", "12",
+    "-dim", "0.4",
+    "-sb", "#f54245",
+    "-nf", "#f54245" ]
+    
-- 
cgit 


From a9b95646b8581e8b0afd4eec99f960d9f42b9c38 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 1 Nov 2021 11:14:31 -0600
Subject: fix startup script

---
 startup | 19 +++++++++----------
 1 file changed, 9 insertions(+), 10 deletions(-)

diff --git a/startup b/startup
index 5c59e4d..a7cd604 100755
--- a/startup
+++ b/startup
@@ -1,14 +1,5 @@
 #!/bin/bash
 
-
-common
-
-hostname_fn="hostname_$(hostname)"
-
-if [[ typeset -f "$hostname_fn" ]] ; then
-  "$hostname_fn" 
-fi
-
 common() {
   # Startup commands common to all the hosts.
   xsetroot -cursor_name left_ptr
@@ -17,7 +8,6 @@ common() {
 
 hostname_rahm1() {
   # Startup commands specific to my worktop.
-
   xinput set-prop "TPPS/2 Elan TrackPoint" "Coordinate Transformation Matrix" 3 0 0 0 3 0 0 0 1
   xinput set-prop "SYNA8004:00 06CB:CD8B Touchpad" "Coordinate Transformation Matrix" 3 0 0 0 3 0 0 0 1
 
@@ -33,3 +23,12 @@ hostname_photon() {
   xrandr --output DVI-I-1 --right-of DP-5 --mode 2560x1440
   feh --bg-scale "/home/rahm/.xmonad/wallpaper.jpg"
 }
+
+
+common
+
+hostname_fn="hostname_$(hostname)"
+
+if [[ "$(type -t "$hostname_fn")" == function ]] ; then
+  "$hostname_fn" 
+fi
-- 
cgit 


From 1e38cda801d91f39ffe0eeb9808afb32f300098d Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 1 Nov 2021 13:59:03 -0600
Subject: Add more DMenu integration & Add ability to change the spacing with
 Mod+Shift+[].

---
 .gitignore            |  3 +++
 src/Internal/DMenu.hs | 29 +++++++++++++++++++++++++++++
 src/Internal/Keys.hs  | 11 +++++++++--
 src/Internal/Lib.hs   | 31 ++++++++++++++++++++-----------
 startup               |  2 +-
 5 files changed, 62 insertions(+), 14 deletions(-)
 create mode 100644 .gitignore

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..f5570ff
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/*
+*.cabal
+*.lock
diff --git a/src/Internal/DMenu.hs b/src/Internal/DMenu.hs
index c5cac49..d91c7ba 100644
--- a/src/Internal/DMenu.hs
+++ b/src/Internal/DMenu.hs
@@ -1,10 +1,39 @@
 module Internal.DMenu where
 
+import XMonad.Util.Dmenu
 import XMonad
 import XMonad.Util.Run
 import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
+import XMonad.Util.Run
+import Data.List (intercalate)
+
+data Colors =
+  Colors {
+    fg :: String,
+    bg :: String
+  }  | DefaultColors
 
 runDMenu :: X ()
 runDMenu = void $
   safeSpawn "/usr/bin/dmenu_run" [
     "-p", "Execute ", "-l", "12", "-dim", "0.4"]
+
+runDMenuPrompt :: String -> Maybe String -> [String] -> X String
+runDMenuPrompt prompt color select =
+  let realColor = maybe [] (\c -> ["-sb", c, "-nf", c]) color
+       in
+    runProcessWithInput "/home/rahm/.local/bin/dmenu_debug.sh" ([
+      "-p", prompt,
+      "-l", "12",
+      "-dim", "0.4" ]  ++ realColor) (intercalate "\n" select)
+
+
+runDMenuPromptWithMap :: String -> Maybe String -> Map String a -> X (Maybe a)
+runDMenuPromptWithMap prompt color map = do
+  let realColor = maybe [] (\c -> ["-sb", c, "-nf", c]) color
+  menuMapArgs "dmenu"([
+      "-p", prompt,
+      "-l", "12",
+      "-dim", "0.4" ]  ++ realColor) map
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 91d033d..c97736f 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -4,6 +4,7 @@ module Internal.Keys where
 import Graphics.X11.ExtraTypes.XorgDefault
 import System.Process
 import XMonad.Util.Ungrab
+import XMonad.Layout.Spacing
 import Internal.XPlus
 import Data.Maybe (isJust)
 import Debug.Trace
@@ -65,6 +66,10 @@ click = do
   (_, _, window, _, _, _, _, _) <- io $ queryPointer dpy root
   focus window
 
+modifyWindowBorder :: Integer -> SpacingModifier
+modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
+  (Border (a + i) (b + i) (c + i) (d + i))
+
 newKeys :: MarkContext -> IO (KeyMap l)
 newKeys markContext =
     return $ \config@(XConfig {modMask = modm}) ->
@@ -102,8 +107,10 @@ newKeys markContext =
             mapNumbersAndAlpha 0 (
               runXPlus markContext config . swapWorkspace)))
 
-        , ((modm .|. shiftMask, xK_bracketleft), sendMessage (IncMasterN (-1)))
-        , ((modm .|. shiftMask, xK_bracketright), sendMessage (IncMasterN 1))
+        , ((modm, xK_minus), sendMessage (IncMasterN (-1)))
+        , ((modm, xK_plus), sendMessage (IncMasterN 1))
+        , ((modm .|. shiftMask, xK_bracketleft), sendMessage (modifyWindowBorder (-1)))
+        , ((modm .|. shiftMask, xK_bracketright), sendMessage (modifyWindowBorder 1))
         , ((modm, xK_bracketleft), sendMessage ShrinkZoom)
         , ((modm, xK_bracketright), sendMessage ExpandZoom)
 
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index e0b78c5..feb5f26 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -3,6 +3,7 @@ module Internal.Lib where
 
 import Prelude hiding ((!!))
 
+import XMonad.Util.Run
 import XMonad.Prompt
 import XMonad.Prompt.Input
 import XMonad.Prompt.Shell
@@ -19,6 +20,7 @@ import Text.Printf
 import XMonad hiding (workspaces, Screen)
 import XMonad.StackSet hiding (filter, focus)
 import qualified Data.Map as Map
+import Internal.DMenu
 
 type WorkspaceName = Char
 newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a)
@@ -123,15 +125,22 @@ windowJump = do
     windowTitlesToWinId <- withWindowSet $ \ss ->
       Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
 
-    mkXPrompt
-      WinPrompt
-      xpConfig
-      (\input -> return $ filter (fuzzyCompletion input) (Map.keys windowTitlesToWinId)) $
-      \str -> do
+    windowId <- runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
+
+    case windowId of
+      Nothing -> return ()
+      Just wid -> do
         saveLastMark markContext
-        case Map.lookup str windowTitlesToWinId of
-          Just w -> focus w
-          Nothing ->
-            case filter (fuzzyCompletion str) (Map.keys windowTitlesToWinId) of
-              [s] -> mapM_ focus (Map.lookup s windowTitlesToWinId)
-              _ -> return ()
+        focus wid
+    -- mkXPrompt
+    --   WinPrompt
+    --   xpConfig
+    --   (\input -> return $ filter (fuzzyCompletion input) (Map.keys windowTitlesToWinId)) $
+    --   \str -> do
+    --     saveLastMark markContext
+    --     case Map.lookup str windowTitlesToWinId of
+    --       Just w -> focus w
+    --       Nothing ->
+    --         case filter (fuzzyCompletion str) (Map.keys windowTitlesToWinId) of
+    --           [s] -> mapM_ focus (Map.lookup s windowTitlesToWinId)
+    --           _ -> return ()
diff --git a/startup b/startup
index a7cd604..bb43beb 100755
--- a/startup
+++ b/startup
@@ -18,7 +18,7 @@ hostname_photon() {
   # Startup commands specific to my desktop.
 
   if [ ! -z "$(ps aux | grep compton | grep -v grep)" ] ; then
-    nohup compton --backend glx & > /dev/null
+    nohup compton --backend xrender & > /dev/null
   fi
   xrandr --output DVI-I-1 --right-of DP-5 --mode 2560x1440
   feh --bg-scale "/home/rahm/.xmonad/wallpaper.jpg"
-- 
cgit 


From 0d13796f6cb360ec8c00bf84651d68df5a108a33 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 2 Nov 2021 00:41:08 -0600
Subject: Big powerpill added to my XMonad and XMobar.

---
 install.sh                      |   2 +
 package.yaml                    |   1 +
 src/Internal/LayoutDraw.hs      |  19 ++--
 src/Main.hs                     |  38 +++++--
 startup                         |  10 +-
 xmobar/extras/battery/battery.c | 226 ++++++++++++++++++++++++++++++++++++++++
 xmobarrc                        |  43 ++++++--
 7 files changed, 308 insertions(+), 31 deletions(-)
 create mode 100644 xmobar/extras/battery/battery.c

diff --git a/install.sh b/install.sh
index dd8c299..a965ad8 100755
--- a/install.sh
+++ b/install.sh
@@ -5,6 +5,8 @@ cd "$real_dir"
 
 mkdir -p "$HOME/.xmonad"
 
+cc -o ~/.xmonad/xmobar-battery xmobar/extras/battery/battery.c -lm
+
 ln -sfv "$real_dir/build-script.sh" "$HOME/.xmonad/build"
 ln -sfv "$real_dir/compton.conf" "$HOME/.config/compton.conf"
 ln -sfv "$real_dir/startup" "$HOME/.xmonad/startup"
diff --git a/package.yaml b/package.yaml
index 686aaa7..e6e3648 100644
--- a/package.yaml
+++ b/package.yaml
@@ -19,3 +19,4 @@ dependencies:
   - cryptohash
   - listsafe
   - X11
+  - split
diff --git a/src/Internal/LayoutDraw.hs b/src/Internal/LayoutDraw.hs
index 7dc2087..4bb069a 100644
--- a/src/Internal/LayoutDraw.hs
+++ b/src/Internal/LayoutDraw.hs
@@ -54,13 +54,13 @@ drawPng l = do
            -- (0.9, 0.9, 1.0),
            -- (0.8, 0.8, 1.0),
            -- (0.7, 0.7, 1.0),
-           (0.6, 0.6, 0.8),
-           (0.5, 0.5, 0.8),
-           (0.4, 0.4, 0.8),
-           (0.3, 0.3, 0.8),
-           (0.2, 0.2, 0.8),
-           (0.1, 0.1, 0.8),
-           (0.0, 0.0, 0.8)
+           (0.8, 0.6, 0.6),
+           (0.8, 0.5, 0.5),
+           (0.8, 0.4, 0.4),
+           (0.8, 0.3, 0.3),
+           (0.8, 0.2, 0.2),
+           (0.8, 0.1, 0.1),
+           (0.8, 0.0, 0.0)
           ]
 
     exists <- liftIO $ doesFileExist filepathXpm
@@ -71,7 +71,7 @@ drawPng l = do
               setLineCap LineCapButt
               setLineJoin LineJoinMiter
 
-              forM_ (reverse $ zip (map (second padR) rects) colors) $
+              forM_ (reverse $ zip (map (second extraPad) rects) colors) $
                 \((wind, Rectangle x y w h), (r, g, b)) -> do
                   setSourceRGBA r g b 1
 
@@ -93,7 +93,8 @@ drawPng l = do
 
     return filepathXpm
     where
-      padR = id
+      extraPad (Rectangle x y w h) =
+        Rectangle (x + 100) (y + 100) (w - 100) (h - 100)
       -- padR (Rectangle x y w h) =
       --   Rectangle x y (max 1 $ w - 120) (max 1 $ h - 120)
 
diff --git a/src/Main.hs b/src/Main.hs
index 25c930e..7e1cc68 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -10,6 +10,7 @@ import Internal.Layout
 import XMonad.Hooks.ManageHelpers
 import XMonad.Layout.IndependentScreens
 import Text.Printf
+import Data.List.Split
 import XMonad.Hooks.EwmhDesktops
 
 import Internal.Keys
@@ -29,7 +30,8 @@ main = do
        , borderWidth = 2
        , keys = \config -> mempty
        , focusedBorderColor = "#ff6c00"
-       , normalBorderColor = "#ffd9bf"
+       -- , normalBorderColor = "#ffd9bf"
+       , normalBorderColor = "#000000"
        , layoutHook = myLayout
        , startupHook = do
           ewmhDesktopsStartup
@@ -55,15 +57,17 @@ main = do
     statusBar
       "xmobar"
       xmobarPP {
-                 ppCurrent = xmobarColor "#ffffff" "red" . printf "%s"
-               , ppVisible = xmobarColor "#8888ff" "" . printf "%s"
-               , ppHidden  = xmobarColor "#888888" "" . printf "%s"
-               , ppWsSep = "<fn=1><fc=#808080> · </fc></fn>"
+                 ppCurrent = xmobarColor "#ff8888" "red" . printf "<fn=1>%s</fn>"
+               , ppVisible = xmobarColor "#8888ff" "" . printf "<fn=0>%s</fn>"
+               , ppHidden  = xmobarColor "#888888" "" . printf "<fn=2>%s</fn>"
+               , ppWsSep = "<fn=1><fc=#808080> </fc></fn>"
                , ppTitle =
-                   xmobarColor "#8888ff" "" . printf "%s" .
-                      (printf "<fn=1>%s</fn>" :: String -> String)
+                   xmobarColor "#808080" "" .
+                      printf "<fn=3><fc=#bbbbbb>%s</fc></fn>" .
+                        parseOut .
+                          trunc 50
 
-               , ppSep = xmobarColor "#404040" "" "   ────   "
+               , ppSep = xmobarColor "#404040" "" " │ "
                , ppLayout = const ""
                , ppExtras = [showLayout]
                , ppOrder =  \ss ->
@@ -72,3 +76,21 @@ main = do
                }
       toggleStructsKey
       config
+
+  where
+    parseOut :: String -> String
+    parseOut str =
+      let colors = ["#ff878f", "#e187ff", "#8f87ff", "#87fff7", "#8bff87", "#ffe987", "#ff8787"]
+          components = zip (cycle colors) (splitOnAll [" - ", " · ", " "] str)
+          in  concatMap (\(color, str) ->
+                  printf "<fc=%s>%s</fc> " color str) components
+
+    trunc amt str =
+      if length str > amt - 4
+        then take (amt - 4) str ++ " ..."
+        else str
+
+    splitOnAll arr str = splitOnAll' arr [str]
+    splitOnAll' [] str = str
+    splitOnAll' (a:as) str = splitOnAll' as (concatMap (splitOn a) str)
+
diff --git a/startup b/startup
index bb43beb..dc302b7 100755
--- a/startup
+++ b/startup
@@ -11,14 +11,18 @@ hostname_rahm1() {
   xinput set-prop "TPPS/2 Elan TrackPoint" "Coordinate Transformation Matrix" 3 0 0 0 3 0 0 0 1
   xinput set-prop "SYNA8004:00 06CB:CD8B Touchpad" "Coordinate Transformation Matrix" 3 0 0 0 3 0 0 0 1
 
-  feh --bg-scale "/home/rahm/.xmonad/assets/Death-Valley-desert-USA_3840x2160.jpg"
+  if [ -z "$(ps aux | grep compton | grep -v grep)" ] ; then
+    __GL_SYNC_TO_VBLANK=1 nohup compton --backend=glx &>/dev/null &
+  fi
+
+  feh --bg-scale "$HOME/wp.jpg"
 }
 
 hostname_photon() {
   # Startup commands specific to my desktop.
 
-  if [ ! -z "$(ps aux | grep compton | grep -v grep)" ] ; then
-    nohup compton --backend xrender & > /dev/null
+  if [ -z "$(ps aux | grep compton | grep -v grep)" ] ; then
+    __GL_SYNC_TO_VBLANK=1 nohup compton --backend=glx &>/dev/null &
   fi
   xrandr --output DVI-I-1 --right-of DP-5 --mode 2560x1440
   feh --bg-scale "/home/rahm/.xmonad/wallpaper.jpg"
diff --git a/xmobar/extras/battery/battery.c b/xmobar/extras/battery/battery.c
new file mode 100644
index 0000000..8e5e58e
--- /dev/null
+++ b/xmobar/extras/battery/battery.c
@@ -0,0 +1,226 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <string.h>
+#include <fcntl.h>
+#include <stdint.h>
+#include <math.h>
+
+#define N_ICONS 5
+
+char* icons[] = {
+  "",
+  "",
+  "",
+  "",
+  "",
+  "",
+  "",
+  "",
+  "",
+  "",
+  "",
+  "",
+};
+
+typedef long long llong_t;
+
+llong_t get_number(const char* file)
+{
+  int fd;
+  char buf[128];
+  fd = open(file, O_RDONLY);
+
+  if (fd < 0) {
+    return -1;
+  }
+
+  size_t count = read(fd, buf, sizeof(buf));
+  close(fd);
+
+  if (count < 0 || count > sizeof(buf) - 1) {
+    return -1;
+  }
+
+  buf[count] = 0;
+  return atoll(buf);
+}
+
+float absf(float f)
+{
+  return f < 0 ? -f : f;
+}
+
+uint32_t hsv_to_rgb(int h, int s, int v){
+  if(h > 360 || h < 0 || s > 100 || s < 0 || v > 100 || v < 0){
+    return -1;
+  }
+
+  float sf = s / 100.0;
+  float vf = v / 100.0;
+  float hf = (float) h;
+
+  float c = sf * vf;
+  float x = c * (1 - absf(fmod(hf / 60.0, 2) - 1));
+  float m = vf - c;
+  float r,g,b;
+
+  if(h >= 0 && h < 60){
+    r = c;
+    g = x;
+    b = 0;
+  }
+  else if(h >= 60 && h < 120){
+    r = x;
+    g = c;
+    b = 0;
+  }
+  else if(h >= 120 && h < 180){
+    r = 0;
+    g = c;
+    b = x;
+  }
+  else if(h >= 180 && h < 240){
+    r = 0;
+    g = x;
+    b = c;
+  }
+  else if(h >= 240 && h < 300){
+    r = x;
+    g = 0;
+    b = c;
+  }
+  else{
+    r = c;
+    g = 0;
+    b = x;
+  }
+
+  int ri = (int) ((r + m) * 255);
+  int gi = (int) ((g + m) * 255);
+  int bi = (int) ((b + m) * 255);
+
+  return (ri << 16) | (gi << 8) | bi;
+}
+
+llong_t get_capacity()
+{
+  return get_number("/sys/class/power_supply/BAT0/capacity");
+}
+
+llong_t get_energy_full()
+{
+  return get_number("/sys/class/power_supply/BAT0/energy_full");
+}
+
+llong_t get_energy_now()
+{
+  return get_number("/sys/class/power_supply/BAT0/energy_now");
+}
+
+llong_t get_ac_online()
+{
+  return get_number("/sys/class/power_supply/AC/online");
+}
+
+llong_t get_power()
+{
+  return get_number("/sys/class/power_supply/BAT0/power_now");
+}
+
+int get_status(char* buf, size_t size)
+{
+  int fd;
+  fd = open("/sys/class/power_supply/BAT0/status", O_RDONLY);
+
+  if (fd < 0) {
+    return 1;
+  }
+
+  size_t count = read(fd, buf, size);
+  close(fd);
+
+  if (count < 0 || count > size - 1) {
+    return 1;
+  }
+
+  buf[count] = 0;
+  --count;
+  while (count > 0 && buf[count] == '\n') {
+    buf[count --] = 0;
+  }
+
+  return 0;
+}
+
+uint32_t percentage_to_color(int percentage)
+{
+  int h = 135 * percentage / 100; 
+  int s = 81;
+  int v = 76;
+
+  return hsv_to_rgb(h, s, v);
+}
+
+void get_time_left(char* buf, size_t sz, llong_t energy, llong_t power)
+{
+  llong_t minutes_left = energy * 60 / power;
+
+  llong_t hours = minutes_left / 60;
+  llong_t minutes = minutes_left % 60;
+
+  snprintf(buf, sz - 1, "%2lluh%2llum", hours, minutes);
+  buf[sz - 1] = 0;
+}
+
+int main(int argc, char** argv)
+{
+  char* icon;
+  char timeleft[128];
+
+  llong_t capacity;
+  llong_t energy_now;
+  llong_t ac_online;
+  llong_t power;
+
+  if ((energy_now = get_energy_now()) < 0) {
+    fprintf(stderr, "Unable to get current energy.");
+    goto fail;
+  }
+
+  if ((capacity = get_capacity()) < 0) {
+    fprintf(stderr, "Unable to get capacity.");
+    goto fail;
+  }
+
+  if ((ac_online = get_ac_online()) < 0) {
+    fprintf(stderr, "Unable to get status.");
+    goto fail;
+  }
+
+  if ((power = get_power()) < 0) {
+    fprintf(stderr, "Unable toget power.");
+    goto fail;
+  }
+  
+  ac_online = !! ac_online;
+
+  int percentage = (int) capacity;
+  if (percentage >= 100) {
+    icon = icons[10 + ac_online];
+  } else {
+    int quintile = percentage / 20;
+    icon = icons[quintile + (5 * ac_online) ];
+  }
+
+  get_time_left(timeleft, sizeof(timeleft), energy_now, power);
+
+  double dpower = power / 1000000.0;
+  uint32_t color = percentage_to_color(percentage);
+  printf("<fc=#%06x>%s </fc><fc=#8888ff>%d%% %2.1fW %s</fc>", color, icon, percentage, dpower, timeleft);
+  return 0;
+
+fail:
+  printf("");
+  return 0;
+}
diff --git a/xmobarrc b/xmobarrc
index 9c0b7f8..2893a17 100644
--- a/xmobarrc
+++ b/xmobarrc
@@ -1,10 +1,13 @@
 Config
-   { font = "xft:Ubuntu Mono:size=20"
-   , additionalFonts = ["xft:Lato:style=bold"]        -- default: []
-   , borderColor = "#ffd9bf"
-   , border = BottomB
-   , borderWidth = 1
-   , bgColor = "black"
+   { font = "xft:Monofur Nerd Font:size=15"
+   , additionalFonts = [
+       "xft:Monofur bold Nerd Font:style=bold:size=15",
+       "xft:Monofur Nerd Font:size=12",
+       "xft:Monofur Nerd Font:size=12" ]
+   , borderColor = "black"
+   , border = FullB
+   , borderWidth = 2
+   , bgColor = "#17171b"
    , fgColor = "white"
    , alpha = 250                 -- default: 255
    , position = TopSize L 100 50
@@ -19,7 +22,7 @@ Config
    , overrideRedirect = False    -- default: True
    , sepChar = "%"
    , alignSep = "}{"
-   , template = "     %StdinReader% }{<fc=#404040>   ────   </fc><fc=#ffffff>%battery%</fc>    <fc=#404040>────</fc>    <fc=#8888ff>%date%</fc>     "
+   , template = " <fc=#ff8888></fc> <fc=#404040> │</fc><fc=#ff8888> %date%</fc><fc=#404040> │ </fc>%StdinReader% }<fc=#8888ff>%time%</fc>{ %cpu% <fc=#404040>│</fc> %KBDU% <fc=#404040>│</fc> <fc=#8888ff>%uname%</fc> <fc=#404040>│ </fc>%bat% "
    , commands = [
      Run Battery [ "--template" , "<fn=1><acstatus></fn>"
                  , "--Low"      , "10"        -- units: %
@@ -30,12 +33,30 @@ Config
 
                  , "--" -- battery specific options
                            -- discharging status
-                           , "-o"	, "<left>% - <timeleft>"
+                           , "-o"	, " (<left>%, <timeleft>)"
                            -- AC "on" status
-                           , "-O"	, "<fc=#dAA520>Charging</fc>"
+                           , "-O"	, "<fc=#dA20A5> (<left>%)</fc>"
                            -- charged status
-                           , "-i"	, "<fc=#006000>Charged</fc>"
+                           , "-i"	, "<fc=#006000></fc>"
                  ] 50,
-       Run StdinReader
+       Run StdinReader,
+       Run Date "%H:%M:%S" "time" 10,
+       Run Date "%m/%d" "date" 10,
+       Run Cpu ["-t", "<total>%", "-L","3","-H","50","--normal","green","--high","red"] 10,
+       Run WeatherX "KBDU"
+             [ ("clear", "<fc=#ddcf04>")
+             , ("sunny", "<fc=#ddcf04>")
+             , ("mostly clear", "<fc=#ddcf04>")
+             , ("mostly sunny", "<fc=#ddcf04>")
+             , ("partly sunny", "<fc=#ddcf04>")
+             , ("fair", "<fc=#a0a0a0>🌑")
+             , ("cloudy","<fc=#a0a0a0>摒")
+             , ("overcast","<fc=#808080>")
+             , ("partly cloudy", "<fc=#a0a0a0>杖")
+             , ("mostly cloudy", "<fc=#808080>")
+             , ("considerable cloudiness", "<fc=#a0a0a0>ﭽ")]
+             ["--template", "<skyConditionS></fc><fc=#8888ff>  <tempF>°F</fc>"] 360000,
+       Run Com "uname" ["-r"] "uname" 0,
+       Run Com ".xmonad/xmobar-battery" [] "bat" 20
      ]
    }
-- 
cgit 


From bc641331a060a8bd4941b1854a08a97b3700fe6c Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 2 Nov 2021 00:53:16 -0600
Subject: Changed how titles are parsed.

---
 src/Main.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Main.hs b/src/Main.hs
index 7e1cc68..195c151 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -92,5 +92,6 @@ main = do
 
     splitOnAll arr str = splitOnAll' arr [str]
     splitOnAll' [] str = str
-    splitOnAll' (a:as) str = splitOnAll' as (concatMap (splitOn a) str)
+    splitOnAll' (a:as) [str] = splitOnAll' as (splitOn a str)
+    splitOnAll' _ lst = lst
 
-- 
cgit 


From 791ea7971b097a8146e993ed5ba490ccf0b2c72c Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 2 Nov 2021 20:15:32 -0600
Subject: More XMobar sexiness.

Revamped the install script to make it easier to handle the install
process.
---
 .gitignore                                    |   1 +
 assets/wallpaper.jpg                          | Bin 767997 -> 0 bytes
 build-script.sh                               |  17 ------
 compton.conf                                  |  52 ----------------
 extras/HOME/.config/compton.conf              |  49 +++++++++++++++
 extras/HOME/.local/.local/bin/spotify-control |  40 +++++++++++++
 extras/HOME/.local/.local/bin/vim             |  83 ++++++++++++++++++++++++++
 extras/HOME/.local/bin/bluetooth-select.sh    |  14 +++++
 extras/HOME/.local/bin/spotify-control        |  40 +++++++++++++
 extras/HOME/.xmobarrc                         |  71 ++++++++++++++++++++++
 extras/HOME/.xmonad/build                     |  17 ++++++
 extras/HOME/.xmonad/startup                   |  38 ++++++++++++
 extras/HOME/.xmonad/wallpaper.jpg             | Bin 0 -> 767997 bytes
 extras/HOME/.xmonad/xmobar-bluetooth          |  18 ++++++
 extras/HOME/.xmonad/xmobar-logo               |   9 +++
 install.sh                                    |  24 ++++++--
 src/Internal/Keys.hs                          |   6 +-
 src/Main.hs                                   |   2 +-
 startup                                       |  38 ------------
 xmobar/extras/battery/battery.c               |  44 +++++++++++---
 xmobarrc                                      |  62 -------------------
 21 files changed, 441 insertions(+), 184 deletions(-)
 delete mode 100644 assets/wallpaper.jpg
 delete mode 100755 build-script.sh
 delete mode 100644 compton.conf
 create mode 100644 extras/HOME/.config/compton.conf
 create mode 100755 extras/HOME/.local/.local/bin/spotify-control
 create mode 100755 extras/HOME/.local/.local/bin/vim
 create mode 100755 extras/HOME/.local/bin/bluetooth-select.sh
 create mode 100755 extras/HOME/.local/bin/spotify-control
 create mode 100644 extras/HOME/.xmobarrc
 create mode 100755 extras/HOME/.xmonad/build
 create mode 100755 extras/HOME/.xmonad/startup
 create mode 100644 extras/HOME/.xmonad/wallpaper.jpg
 create mode 100755 extras/HOME/.xmonad/xmobar-bluetooth
 create mode 100755 extras/HOME/.xmonad/xmobar-logo
 delete mode 100755 startup
 delete mode 100644 xmobarrc

diff --git a/.gitignore b/.gitignore
index f5570ff..bb6c218 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,4 @@
 .stack-work/*
 *.cabal
 *.lock
+build/*
diff --git a/assets/wallpaper.jpg b/assets/wallpaper.jpg
deleted file mode 100644
index 4976715..0000000
Binary files a/assets/wallpaper.jpg and /dev/null differ
diff --git a/build-script.sh b/build-script.sh
deleted file mode 100755
index 72b6310..0000000
--- a/build-script.sh
+++ /dev/null
@@ -1,17 +0,0 @@
-#!/bin/sh
-
-actual_bin=$(readlink -f "$0")
-proj_dir="$(dirname $actual_bin)"
-olddir="$(pwd)"
-
-cd "$proj_dir"
-stack install
-
-ec="$?"
-if [ "$ec" -ne 0 ] ; then
-  exit "$ec"
-fi
-
-cd "$olddir"
-
-ln -sf "$HOME/.local/bin/jrahm-xmonad" "$1"
diff --git a/compton.conf b/compton.conf
deleted file mode 100644
index 90be41d..0000000
--- a/compton.conf
+++ /dev/null
@@ -1,52 +0,0 @@
-backend = "glx";
-
-### Shadow
-shadow = true;
-no-dnd-shadow = true;
-# no-dock-shadow = true;
-# clear-shadow = true;
-shadow-radius = 7;
-shadow-offset-x = -10;
-shadow-offset-y = -5;
-shadow-opacity = 0.8;
-shadow-red = 0.0;
-shadow-green = 0.0;
-shadow-blue = 0.0;
-
-inactive-dim=0.1
-inactive-opacity=0.99
-
-shadow-exclude = [
-  # From the Ubuntu forums link ('screaminj3sus')
-  # "! name~=''",
-  # "n:e:Notification",
-  # "n:e:Plank",
-  # "n:e:Docky",
-  # "g:e:Synapse",
-  # "g:e:Kupfer",
-  # "g:e:Conky",
-  # "n:w:*Firefox*",
-  # "class_g ?= 'Notify-osd'",
-  # "class_g ?= 'Cairo-dock'",
-  # "class_g ?= 'Xfce4-notifyd'",
-  # "class_g ?= 'Xfce4-power-manager'"
-];
-shadow-ignore-shaped = false;
-
-blur-background = true;
-
-wintypes:
-{
-  tooltip =
-  {
-    fade = true;
-    shadow = false;
-    opacity = 0.85;
-    focus = true;
-  }
-
-
-
-}
-# shadow-exclude-reg = "x10+0+0";
-# xinerama-shadow-crop = true;
diff --git a/extras/HOME/.config/compton.conf b/extras/HOME/.config/compton.conf
new file mode 100644
index 0000000..2728ce1
--- /dev/null
+++ b/extras/HOME/.config/compton.conf
@@ -0,0 +1,49 @@
+backend = "glx";
+
+### Shadow
+shadow = true;
+no-dnd-shadow = true;
+# no-dock-shadow = true;
+# clear-shadow = true;
+shadow-radius = 7;
+shadow-offset-x = -10;
+shadow-offset-y = -5;
+shadow-opacity = 0.8;
+shadow-red = 0.0;
+shadow-green = 0.0;
+shadow-blue = 0.0;
+
+inactive-dim=0.1
+inactive-opacity=0.99
+
+shadow-exclude = [
+  # From the Ubuntu forums link ('screaminj3sus')
+  # "! name~=''",
+  # "n:e:Notification",
+  # "n:e:Plank",
+  # "n:e:Docky",
+  # "g:e:Synapse",
+  # "g:e:Kupfer",
+  # "g:e:Conky",
+  # "n:w:*Firefox*",
+  # "class_g ?= 'Notify-osd'",
+  # "class_g ?= 'Cairo-dock'",
+  # "class_g ?= 'Xfce4-notifyd'",
+  # "class_g ?= 'Xfce4-power-manager'"
+];
+shadow-ignore-shaped = false;
+
+blur-background = false;
+
+wintypes:
+{
+  tooltip =
+  {
+    fade = true;
+    shadow = false;
+    opacity = 0.85;
+    focus = true;
+  }
+}
+# shadow-exclude-reg = "x10+0+0";
+# xinerama-shadow-crop = true;
diff --git a/extras/HOME/.local/.local/bin/spotify-control b/extras/HOME/.local/.local/bin/spotify-control
new file mode 100755
index 0000000..751f562
--- /dev/null
+++ b/extras/HOME/.local/.local/bin/spotify-control
@@ -0,0 +1,40 @@
+#!/bin/bash
+
+if [ $# -lt 1 ]
+then
+        echo "No command?"
+        exit
+fi
+
+if [ "$(pidof spotify)" = "" ] 
+then
+  echo "Spotify is not running"
+  exit
+fi
+
+case $1 in
+    "play")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.PlayPause
+        ;;
+    "next")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.Next
+        ;;
+    "prev")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.Previous
+        ;;
+    "getTitle")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'Metadata'|egrep -A 1 "title"|egrep -v "title"|cut -b 44-|cut -d '"' -f 1|egrep -v ^$
+        ;;
+    "getArtist")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'Metadata'|egrep -A 2 "artist"|egrep -v "artist"|egrep -v "array"|cut -b 27-|cut -d '"' -f 1|egrep -v ^$
+        ;;
+    "getAlbum")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'Metadata'|egrep -A 2 "album"|egrep -v "album"|egrep -v "array"|cut -b 44-|cut -d '"' -f 1|egrep -v ^$
+        ;;
+    "getStatus")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'PlaybackStatus'|grep 'string "[^"]*"'|sed 's/.*"\(.*\)"[^"]*$/\1/'
+        ;;
+    *)
+        echo "Unknown command: " $1
+        ;;
+esac
diff --git a/extras/HOME/.local/.local/bin/vim b/extras/HOME/.local/.local/bin/vim
new file mode 100755
index 0000000..d0aafa5
--- /dev/null
+++ b/extras/HOME/.local/.local/bin/vim
@@ -0,0 +1,83 @@
+#!/usr/bin/python3
+
+import neovim, os, re, sys, time
+
+# Get a list of buffers that haven't been deleted. `nvim.buffers` includes
+# buffers that have had `:bdelete` called on them and aren't in the buffer
+# list, so we have to filter those out.
+def get_listed_buffers(nvim):
+    return set(buf.number for buf in nvim.buffers \
+        if nvim.eval('buflisted(%d)' % buf.number))
+
+
+def resolve_google3(fname):
+  if fname.startswith('//depot/google3'):
+    cwd = os.getcwd()
+    if "/google3" in cwd:
+      depot_dir = cwd[:cwd.find('/google3')]
+      realfname = fname.replace('//depot', depot_dir)
+      return realfname
+  return fname
+
+# For now, treat all arguments that don't start with - or + as filenames. This
+# is good enough to recognize '-f' and `+11`, which is all this script really
+# needs right now.
+filenames = [
+    re.sub(' ', '\ ', os.path.abspath(resolve_google3(arg)))
+        for arg in sys.argv[1:] if not arg[0] in ['-', '+']
+]
+
+try:
+    nvim_socket = os.environ["NVIM_LISTEN_ADDRESS"]
+except KeyError:
+    # If we aren't running inside a `:terminal`, just exec nvim.
+    os.execvp(u'nvim', sys.argv)
+
+nvim = neovim.attach('socket', path=nvim_socket)
+
+existing_buffers = get_listed_buffers(nvim)
+
+nvim.command('split')
+nvim.command('args %s' % ' '.join(filenames))
+
+new_buffers = get_listed_buffers(nvim).difference(existing_buffers)
+
+for arg in sys.argv:
+    if arg[0] == '+':
+        nvim.command(arg[1:])
+
+# The '-f' flag is a signal that we're in a situation like a `git commit`
+# invocation where we need to block until the user is done with the file(s).
+if '-f' in sys.argv and len(new_buffers) > 0:
+    # The rule here is that the user is 'done' with the opened files when none
+    # of them are visible onscreen. This allows for use cases like hitting `:q`
+    # on a `git commit` tempfile. However, we can't just poll to see if they're
+    # visible, because using `nvim.windows`, `nvim.eval()`, or `nvim.call()`
+    # will interrupt any multi-key mappings the user may be inputting. The
+    # solution is to set a buffer-local autocmd on each opened buffer so that
+    # we only check for visibility immediately after the user either closes or
+    # hides one of the buffers.
+    channel_id = nvim.channel_id
+    for buffer in new_buffers:
+        nvim.command((
+            'autocmd BufDelete,BufHidden <buffer=%d> ' +
+            'call rpcnotify(%d, "check_buffers")'
+        ) % (buffer, channel_id))
+
+    stay_open = True
+    while stay_open:
+        nvim.next_message() # block until `rpcnotify` is called
+        open_buffers = [window.buffer.number for window in nvim.windows]
+        stay_open = any([buffer in open_buffers for buffer in new_buffers])
+
+    # Now that none of the opened files are visible anymore, we do a few
+    # cleanup steps before ending the script:
+    #  * Clear the arg list, since otherwise `:next` would reopen the tempfile
+    #    or whatever.
+    #  * Clear the autocmds we added, since `bdelete` just hides the buffer and
+    #    the autocmds will still be active if the user reopens the file(s).
+    #  * Delete each of the buffers we created.
+    nvim.command('argdel *')
+    for buffer in new_buffers:
+        nvim.command('autocmd! BufDelete,BufHidden <buffer=%d>' % buffer)
+        nvim.command('bdelete! %d' % buffer)
diff --git a/extras/HOME/.local/bin/bluetooth-select.sh b/extras/HOME/.local/bin/bluetooth-select.sh
new file mode 100755
index 0000000..a0b8559
--- /dev/null
+++ b/extras/HOME/.local/bin/bluetooth-select.sh
@@ -0,0 +1,14 @@
+#!/bin/bash
+
+devices="$(bluetoothctl -- devices | sed 's#^Device ##')"
+selection="$(
+  echo -e "$devices\nDisconnect" |
+    dmenu -i -nf "#8888ff" -sb "#8888ff" -p "Connect Bluetooth" -l 12)"
+
+macaddr="${selection%% *}"
+
+if [[ "$macaddr" == "Disconnect" ]] ; then
+  exec bluetoothctl -- disconnect
+fi
+
+exec bluetoothctl -- connect "$macaddr"
diff --git a/extras/HOME/.local/bin/spotify-control b/extras/HOME/.local/bin/spotify-control
new file mode 100755
index 0000000..751f562
--- /dev/null
+++ b/extras/HOME/.local/bin/spotify-control
@@ -0,0 +1,40 @@
+#!/bin/bash
+
+if [ $# -lt 1 ]
+then
+        echo "No command?"
+        exit
+fi
+
+if [ "$(pidof spotify)" = "" ] 
+then
+  echo "Spotify is not running"
+  exit
+fi
+
+case $1 in
+    "play")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.PlayPause
+        ;;
+    "next")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.Next
+        ;;
+    "prev")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.Previous
+        ;;
+    "getTitle")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'Metadata'|egrep -A 1 "title"|egrep -v "title"|cut -b 44-|cut -d '"' -f 1|egrep -v ^$
+        ;;
+    "getArtist")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'Metadata'|egrep -A 2 "artist"|egrep -v "artist"|egrep -v "array"|cut -b 27-|cut -d '"' -f 1|egrep -v ^$
+        ;;
+    "getAlbum")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'Metadata'|egrep -A 2 "album"|egrep -v "album"|egrep -v "array"|cut -b 44-|cut -d '"' -f 1|egrep -v ^$
+        ;;
+    "getStatus")
+        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'PlaybackStatus'|grep 'string "[^"]*"'|sed 's/.*"\(.*\)"[^"]*$/\1/'
+        ;;
+    *)
+        echo "Unknown command: " $1
+        ;;
+esac
diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
new file mode 100644
index 0000000..ecf53ed
--- /dev/null
+++ b/extras/HOME/.xmobarrc
@@ -0,0 +1,71 @@
+Config
+   { font = "xft:Monofur Nerd Font:size=15"
+   , additionalFonts = [
+       "xft:Monofur bold Nerd Font:style=bold:size=12",
+       "xft:Monofur Nerd Font:size=9",
+       "xft:Monofur bold Nerd Font:size=9",
+       "xft:Monofur Nerd Font:size=6",
+       "xft:Monofur bold Nerd Font:size=40",
+       "xft:Monofur Nerd Font:style=bold:size=12"
+       ]
+   , borderColor = "black"
+   , border = FullBM -1
+   , borderWidth = 2
+   , bgColor = "#17171b"
+   , fgColor = "white"
+   , alpha = 250                 -- default: 255
+   , position = TopSize L 100 40
+   , textOffset = -1             -- default: -1
+   , iconOffset = -1             -- default: -1
+   , lowerOnStart = True
+   , pickBroadest = False        -- default: False
+   , persistent = True
+   , hideOnStart = False
+   , iconRoot = "/usr/local/google/home/rahm/.xmonad/resources"  -- default: "."
+   , allDesktops = True          -- default: True
+   , overrideRedirect = False    -- default: True
+   , sepChar = "%"
+   , alignSep = "}{"
+   , template =
+      " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc><fc=#404040> │\
+      \</fc><fc=#a0a0a0> %date%</fc><fc=#404040> │ \
+      \</fc>%StdinReader%}<fn=1><fc=#8888ff>%time%</fc></fn>\
+      \{ %cpu% <fc=#404040>\
+      \│</fc> %KLMO% <fc=#404040>│\
+      \</fc> <fc=#a0a0a0>%mpris2%</fc> <fc=#404040>│ \
+      \</fc>%bluetooth%%bat% "
+   , commands = [
+       Run StdinReader,
+       Run Memory ["-t", "<usedbar>"] 10,
+       Run Date "%H:%M:%S" "time" 10,
+       Run Date "<fn=3>%m/%d</fn>" "date" 10,
+       Run Cpu [
+         "-t", "<fn=3><fc=#000000><bar></fc></fn>",
+         "-L", "3",
+         "-H", "50",
+         "-b", "─",
+         "-f", "─",
+         "--normal", "green",
+         "--high", "red"
+       ] 10,
+       Run WeatherX "KLMO"
+             [ ("clear", "<fc=#ddcf04>")
+             , ("sunny", "<fc=#ddcf04>")
+             , ("mostly clear", "<fc=#ddcf04>")
+             , ("mostly sunny", "<fc=#ddcf04>")
+             , ("partly sunny", "<fc=#ddcf04>")
+             , ("fair", "<fc=#a0a0a0>🌑")
+             , ("cloudy","<fc=#a0a0a0>摒")
+             , ("overcast","<fc=#808080>")
+             , ("partly cloudy", "<fc=#a0a0a0>杖")
+             , ("mostly cloudy", "<fc=#808080>")
+             , ("considerable cloudiness", "<fc=#a0a0a0>ﭽ")]
+             ["--template", "<skyConditionS></fc><fn=3><fc=#a0a0a0>   \
+             \<tempF>°F</fc></fn>"] 360000,
+       Run Mpris2 "spotify" ["-t", "<fc=#1aa54b></fc>  <fn=3><title></fn>"] 20,
+       Run Com ".xmonad/xmobar-logo" [] "logo" 0,
+       Run Com "uname" ["-r"] "uname" 0,
+       Run Com ".xmonad/xmobar-bluetooth" [] "bluetooth" 50,
+       Run Com ".xmonad/xmobar-battery" [] "bat" 20
+     ]
+   }
diff --git a/extras/HOME/.xmonad/build b/extras/HOME/.xmonad/build
new file mode 100755
index 0000000..72b6310
--- /dev/null
+++ b/extras/HOME/.xmonad/build
@@ -0,0 +1,17 @@
+#!/bin/sh
+
+actual_bin=$(readlink -f "$0")
+proj_dir="$(dirname $actual_bin)"
+olddir="$(pwd)"
+
+cd "$proj_dir"
+stack install
+
+ec="$?"
+if [ "$ec" -ne 0 ] ; then
+  exit "$ec"
+fi
+
+cd "$olddir"
+
+ln -sf "$HOME/.local/bin/jrahm-xmonad" "$1"
diff --git a/extras/HOME/.xmonad/startup b/extras/HOME/.xmonad/startup
new file mode 100755
index 0000000..dc302b7
--- /dev/null
+++ b/extras/HOME/.xmonad/startup
@@ -0,0 +1,38 @@
+#!/bin/bash
+
+common() {
+  # Startup commands common to all the hosts.
+  xsetroot -cursor_name left_ptr
+  xset r rate 200 60
+}
+
+hostname_rahm1() {
+  # Startup commands specific to my worktop.
+  xinput set-prop "TPPS/2 Elan TrackPoint" "Coordinate Transformation Matrix" 3 0 0 0 3 0 0 0 1
+  xinput set-prop "SYNA8004:00 06CB:CD8B Touchpad" "Coordinate Transformation Matrix" 3 0 0 0 3 0 0 0 1
+
+  if [ -z "$(ps aux | grep compton | grep -v grep)" ] ; then
+    __GL_SYNC_TO_VBLANK=1 nohup compton --backend=glx &>/dev/null &
+  fi
+
+  feh --bg-scale "$HOME/wp.jpg"
+}
+
+hostname_photon() {
+  # Startup commands specific to my desktop.
+
+  if [ -z "$(ps aux | grep compton | grep -v grep)" ] ; then
+    __GL_SYNC_TO_VBLANK=1 nohup compton --backend=glx &>/dev/null &
+  fi
+  xrandr --output DVI-I-1 --right-of DP-5 --mode 2560x1440
+  feh --bg-scale "/home/rahm/.xmonad/wallpaper.jpg"
+}
+
+
+common
+
+hostname_fn="hostname_$(hostname)"
+
+if [[ "$(type -t "$hostname_fn")" == function ]] ; then
+  "$hostname_fn" 
+fi
diff --git a/extras/HOME/.xmonad/wallpaper.jpg b/extras/HOME/.xmonad/wallpaper.jpg
new file mode 100644
index 0000000..4976715
Binary files /dev/null and b/extras/HOME/.xmonad/wallpaper.jpg differ
diff --git a/extras/HOME/.xmonad/xmobar-bluetooth b/extras/HOME/.xmonad/xmobar-bluetooth
new file mode 100755
index 0000000..93caa50
--- /dev/null
+++ b/extras/HOME/.xmonad/xmobar-bluetooth
@@ -0,0 +1,18 @@
+#!/bin/sh
+
+cur=""
+
+bluetoothctl -- info | while read line ; do
+  key=${line%%: *}
+  value=${line//*: }
+
+  if [ "$key" == "Name" ] ; then
+    cur="$value"
+  fi
+
+  if [ "$key" == "Connected" -a "$value" == "yes" ] ; then
+    exec echo "<fc=#4287f5></fc> <fc=#a0a0a0><fn=3>$cur</fn></fc> <fc=#404040>│</fc> "
+  fi
+done
+
+exec echo "<fc=#a0a0a0></fc> <fc=#404040>│</fc>"
diff --git a/extras/HOME/.xmonad/xmobar-logo b/extras/HOME/.xmonad/xmobar-logo
new file mode 100755
index 0000000..848ebd2
--- /dev/null
+++ b/extras/HOME/.xmonad/xmobar-logo
@@ -0,0 +1,9 @@
+#!/bin/bash
+
+case "$(uname -a)" in
+  *-arch-*) exec echo '<fn=5><fc=#1785bd></fc></fn>' ;;
+  *Debian*) exec echo '<fn=5><fc=#c00649></fc></fn>' ;;
+  *Ubuntu*) exec echo '<fn=5><fc=#ff8888></fc></fn>' ;;
+  *Linux*)  exec echo '<fn=5><fc=#ffffff></fc></fn>' ;;
+  *BSD*)    exec echo '<fn=5><fc=#ff4444></fc></fn>' ;;
+esac
diff --git a/install.sh b/install.sh
index a965ad8..59a5078 100755
--- a/install.sh
+++ b/install.sh
@@ -4,11 +4,23 @@ real_dir=$(dirname $(readlink -f "$0"))
 cd "$real_dir"
 
 mkdir -p "$HOME/.xmonad"
+mkdir -p "$HOME/.config"
 
-cc -o ~/.xmonad/xmobar-battery xmobar/extras/battery/battery.c -lm
+mkdir -p build/extras/HOME/.xmonad
 
-ln -sfv "$real_dir/build-script.sh" "$HOME/.xmonad/build"
-ln -sfv "$real_dir/compton.conf" "$HOME/.config/compton.conf"
-ln -sfv "$real_dir/startup" "$HOME/.xmonad/startup"
-ln -sfv "$real_dir/xmobarrc" "$HOME/.xmobarrc"
-ln -sfv "$real_dir/assets/wallpaper.jpg" "$HOME/.xmonad/wallpaper.jpg"
+cc -o \
+  build/extras/HOME/.xmonad/xmobar-battery \
+  xmobar/extras/battery/battery.c \
+  -lm
+
+GLOBIGNORE=".:.."
+shopt -u dotglob
+
+cd "$HOME"
+cp -rsvf                           \
+  "$real_dir"/extras/HOME/*        \
+  "$real_dir"/extras/HOME/.*       \
+  "$real_dir"/build/extras/HOME/*  \
+  "$real_dir"/build/extras/HOME/.* \
+  .
+cd "$real_dir"
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index c97736f..3dff864 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -85,7 +85,8 @@ newKeys markContext =
         , ((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_Escape),  (void $ spawn "xterm"))
+        , ((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)
@@ -122,6 +123,9 @@ newKeys markContext =
         , ((modm, xK_q), spawn "xmonad --recompile && xmonad --restart")
         , ((modm, xK_z), sendMessage ToggleZoom)
 
+        , ((modm, xK_x), spawn "bluetooth-select.sh")
+        , ((modm .|. shiftMask, xK_x), spawn "bluetoothctl -- disconnect")
+
         , ((modm, xK_Tab), windows W.focusDown)
         , ((modm .|. shiftMask, xK_Tab), windows W.focusUp)
 
diff --git a/src/Main.hs b/src/Main.hs
index 195c151..85d18c7 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -58,7 +58,7 @@ main = do
       "xmobar"
       xmobarPP {
                  ppCurrent = xmobarColor "#ff8888" "red" . printf "<fn=1>%s</fn>"
-               , ppVisible = xmobarColor "#8888ff" "" . printf "<fn=0>%s</fn>"
+               , ppVisible = xmobarColor "#8888ff" "" . printf "<fn=6>%s</fn>"
                , ppHidden  = xmobarColor "#888888" "" . printf "<fn=2>%s</fn>"
                , ppWsSep = "<fn=1><fc=#808080> </fc></fn>"
                , ppTitle =
diff --git a/startup b/startup
deleted file mode 100755
index dc302b7..0000000
--- a/startup
+++ /dev/null
@@ -1,38 +0,0 @@
-#!/bin/bash
-
-common() {
-  # Startup commands common to all the hosts.
-  xsetroot -cursor_name left_ptr
-  xset r rate 200 60
-}
-
-hostname_rahm1() {
-  # Startup commands specific to my worktop.
-  xinput set-prop "TPPS/2 Elan TrackPoint" "Coordinate Transformation Matrix" 3 0 0 0 3 0 0 0 1
-  xinput set-prop "SYNA8004:00 06CB:CD8B Touchpad" "Coordinate Transformation Matrix" 3 0 0 0 3 0 0 0 1
-
-  if [ -z "$(ps aux | grep compton | grep -v grep)" ] ; then
-    __GL_SYNC_TO_VBLANK=1 nohup compton --backend=glx &>/dev/null &
-  fi
-
-  feh --bg-scale "$HOME/wp.jpg"
-}
-
-hostname_photon() {
-  # Startup commands specific to my desktop.
-
-  if [ -z "$(ps aux | grep compton | grep -v grep)" ] ; then
-    __GL_SYNC_TO_VBLANK=1 nohup compton --backend=glx &>/dev/null &
-  fi
-  xrandr --output DVI-I-1 --right-of DP-5 --mode 2560x1440
-  feh --bg-scale "/home/rahm/.xmonad/wallpaper.jpg"
-}
-
-
-common
-
-hostname_fn="hostname_$(hostname)"
-
-if [[ "$(type -t "$hostname_fn")" == function ]] ; then
-  "$hostname_fn" 
-fi
diff --git a/xmobar/extras/battery/battery.c b/xmobar/extras/battery/battery.c
index 8e5e58e..791bc69 100644
--- a/xmobar/extras/battery/battery.c
+++ b/xmobar/extras/battery/battery.c
@@ -13,7 +13,7 @@ char* icons[] = {
   "",
   "",
   "",
-  "",
+  "",
   "",
   "",
   "",
@@ -162,14 +162,22 @@ uint32_t percentage_to_color(int percentage)
   return hsv_to_rgb(h, s, v);
 }
 
-void get_time_left(char* buf, size_t sz, llong_t energy, llong_t power)
+void get_time_left(
+    char* buf,
+    size_t sz,
+    llong_t energy,
+    llong_t power)
 {
+  if (power == 0) {
+    buf[0] = 0;
+    return;
+  }
   llong_t minutes_left = energy * 60 / power;
 
   llong_t hours = minutes_left / 60;
   llong_t minutes = minutes_left % 60;
 
-  snprintf(buf, sz - 1, "%2lluh%2llum", hours, minutes);
+  snprintf(buf, sz - 1, "%lluh%2llum", hours, minutes);
   buf[sz - 1] = 0;
 }
 
@@ -177,9 +185,12 @@ int main(int argc, char** argv)
 {
   char* icon;
   char timeleft[128];
+  char watts[128];
+  char percent[128];
 
   llong_t capacity;
   llong_t energy_now;
+  llong_t energy_full;
   llong_t ac_online;
   llong_t power;
 
@@ -206,18 +217,37 @@ int main(int argc, char** argv)
   ac_online = !! ac_online;
 
   int percentage = (int) capacity;
-  if (percentage >= 100) {
+  if (percentage >= 98) {
     icon = icons[10 + ac_online];
   } else {
     int quintile = percentage / 20;
     icon = icons[quintile + (5 * ac_online) ];
   }
 
-  get_time_left(timeleft, sizeof(timeleft), energy_now, power);
+  if (ac_online) {
+    if ((energy_full = get_energy_full()) < 0) {
+      fprintf(stderr, "Unable to get current energy.");
+      goto fail;
+    }
+    get_time_left(timeleft, sizeof(timeleft), energy_full - energy_now, power);
+  } else {
+    get_time_left(timeleft, sizeof(timeleft), energy_now, power);
+  }
+
+  watts[0] = 0;
+  percent[0] = 0;
+  if (power) {
+    double dpower = power / 1000000.0;
+    snprintf(watts, sizeof(watts), "%2.1fW ", dpower);
+  }
+
+  if (percentage < 99 || ! ac_online) {
+    snprintf(percent, sizeof(percent), "%2d%% ", percentage);
+  }
 
-  double dpower = power / 1000000.0;
   uint32_t color = percentage_to_color(percentage);
-  printf("<fc=#%06x>%s </fc><fc=#8888ff>%d%% %2.1fW %s</fc>", color, icon, percentage, dpower, timeleft);
+  printf("<fc=#%06x>%s </fc><fn=3><fc=#a0a0a0>%s%s%s</fc></fn>",
+      color, icon, percent, watts, timeleft);
   return 0;
 
 fail:
diff --git a/xmobarrc b/xmobarrc
deleted file mode 100644
index 2893a17..0000000
--- a/xmobarrc
+++ /dev/null
@@ -1,62 +0,0 @@
-Config
-   { font = "xft:Monofur Nerd Font:size=15"
-   , additionalFonts = [
-       "xft:Monofur bold Nerd Font:style=bold:size=15",
-       "xft:Monofur Nerd Font:size=12",
-       "xft:Monofur Nerd Font:size=12" ]
-   , borderColor = "black"
-   , border = FullB
-   , borderWidth = 2
-   , bgColor = "#17171b"
-   , fgColor = "white"
-   , alpha = 250                 -- default: 255
-   , position = TopSize L 100 50
-   , textOffset = -1             -- default: -1
-   , iconOffset = -1             -- default: -1
-   , lowerOnStart = True
-   , pickBroadest = False        -- default: False
-   , persistent = True
-   , hideOnStart = False
-   , iconRoot = "/usr/local/google/home/rahm/.xmonad/resources"  -- default: "."
-   , allDesktops = True          -- default: True
-   , overrideRedirect = False    -- default: True
-   , sepChar = "%"
-   , alignSep = "}{"
-   , template = " <fc=#ff8888></fc> <fc=#404040> │</fc><fc=#ff8888> %date%</fc><fc=#404040> │ </fc>%StdinReader% }<fc=#8888ff>%time%</fc>{ %cpu% <fc=#404040>│</fc> %KBDU% <fc=#404040>│</fc> <fc=#8888ff>%uname%</fc> <fc=#404040>│ </fc>%bat% "
-   , commands = [
-     Run Battery [ "--template" , "<fn=1><acstatus></fn>"
-                 , "--Low"      , "10"        -- units: %
-                 , "--High"     , "80"        -- units: %
-                 , "--low"      , "darkred"
-                 , "--normal"   , "darkorange"
-                 , "--high"     , "darkgreen"
-
-                 , "--" -- battery specific options
-                           -- discharging status
-                           , "-o"	, " (<left>%, <timeleft>)"
-                           -- AC "on" status
-                           , "-O"	, "<fc=#dA20A5> (<left>%)</fc>"
-                           -- charged status
-                           , "-i"	, "<fc=#006000></fc>"
-                 ] 50,
-       Run StdinReader,
-       Run Date "%H:%M:%S" "time" 10,
-       Run Date "%m/%d" "date" 10,
-       Run Cpu ["-t", "<total>%", "-L","3","-H","50","--normal","green","--high","red"] 10,
-       Run WeatherX "KBDU"
-             [ ("clear", "<fc=#ddcf04>")
-             , ("sunny", "<fc=#ddcf04>")
-             , ("mostly clear", "<fc=#ddcf04>")
-             , ("mostly sunny", "<fc=#ddcf04>")
-             , ("partly sunny", "<fc=#ddcf04>")
-             , ("fair", "<fc=#a0a0a0>🌑")
-             , ("cloudy","<fc=#a0a0a0>摒")
-             , ("overcast","<fc=#808080>")
-             , ("partly cloudy", "<fc=#a0a0a0>杖")
-             , ("mostly cloudy", "<fc=#808080>")
-             , ("considerable cloudiness", "<fc=#a0a0a0>ﭽ")]
-             ["--template", "<skyConditionS></fc><fc=#8888ff>  <tempF>°F</fc>"] 360000,
-       Run Com "uname" ["-r"] "uname" 0,
-       Run Com ".xmonad/xmobar-battery" [] "bat" 20
-     ]
-   }
-- 
cgit 


From 62bccd284a4ae1c6c6c324112df8c6c14dc26ac9 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 2 Nov 2021 21:58:50 -0600
Subject: Synchronize with the look on photon

---
 extras/HOME/.config/compton.conf     | 10 +++++-----
 extras/HOME/.xmobarrc                | 22 ++++++++++++++++------
 extras/HOME/.xmonad/startup          |  7 ++++---
 extras/HOME/.xmonad/xmobar-bluetooth |  2 +-
 extras/HOME/.xmonad/xmobar-logo      |  2 +-
 src/Internal/Layout.hs               |  4 +++-
 src/Main.hs                          |  2 +-
 xmobar/extras/battery/battery.c      |  2 +-
 8 files changed, 32 insertions(+), 19 deletions(-)

diff --git a/extras/HOME/.config/compton.conf b/extras/HOME/.config/compton.conf
index 2728ce1..828d949 100644
--- a/extras/HOME/.config/compton.conf
+++ b/extras/HOME/.config/compton.conf
@@ -5,9 +5,9 @@ shadow = true;
 no-dnd-shadow = true;
 # no-dock-shadow = true;
 # clear-shadow = true;
-shadow-radius = 7;
-shadow-offset-x = -10;
-shadow-offset-y = -5;
+shadow-radius = 10;
+shadow-offset-x = -3;
+shadow-offset-y = -3;
 shadow-opacity = 0.8;
 shadow-red = 0.0;
 shadow-green = 0.0;
@@ -33,14 +33,14 @@ shadow-exclude = [
 ];
 shadow-ignore-shaped = false;
 
-blur-background = false;
+blur-background = true;
 
 wintypes:
 {
   tooltip =
   {
     fade = true;
-    shadow = false;
+    shadow = true;
     opacity = 0.85;
     focus = true;
   }
diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index ecf53ed..fc85d91 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -30,21 +30,29 @@ Config
       " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc><fc=#404040> │\
       \</fc><fc=#a0a0a0> %date%</fc><fc=#404040> │ \
       \</fc>%StdinReader%}<fn=1><fc=#8888ff>%time%</fc></fn>\
-      \{ %cpu% <fc=#404040>\
+      \{ %cpu% %memory% <fc=#404040>\
       \│</fc> %KLMO% <fc=#404040>│\
       \</fc> <fc=#a0a0a0>%mpris2%</fc> <fc=#404040>│ \
       \</fc>%bluetooth%%bat% "
    , commands = [
        Run StdinReader,
-       Run Memory ["-t", "<usedbar>"] 10,
        Run Date "%H:%M:%S" "time" 10,
        Run Date "<fn=3>%m/%d</fn>" "date" 10,
        Run Cpu [
-         "-t", "<fn=3><fc=#000000><bar></fc></fn>",
+           "-t", "<fn=3><fc=#000000><bar></fc></fn>",
+           "-L", "3",
+         "-H", "50",
+         "-b", "-",
+         "-f", "-",
+         "--normal", "green",
+         "--high", "red"
+       ] 10,
+       Run Memory [
+         "-t", "<fn=3><fc=#000000><usedbar></fc></fn>",
          "-L", "3",
          "-H", "50",
-         "-b", "─",
-         "-f", "─",
+         "-b", "-",
+         "-f", "-",
          "--normal", "green",
          "--high", "red"
        ] 10,
@@ -62,7 +70,9 @@ Config
              , ("considerable cloudiness", "<fc=#a0a0a0>ﭽ")]
              ["--template", "<skyConditionS></fc><fn=3><fc=#a0a0a0>   \
              \<tempF>°F</fc></fn>"] 360000,
-       Run Mpris2 "spotify" ["-t", "<fc=#1aa54b></fc>  <fn=3><title></fn>"] 20,
+       Run Mpris2 "spotify" [
+           "-t", "<fc=#1aa54b></fc>  <fn=3><title></fn>",
+           "--nastring", "<fc=#404040> </fc>"] 20,
        Run Com ".xmonad/xmobar-logo" [] "logo" 0,
        Run Com "uname" ["-r"] "uname" 0,
        Run Com ".xmonad/xmobar-bluetooth" [] "bluetooth" 50,
diff --git a/extras/HOME/.xmonad/startup b/extras/HOME/.xmonad/startup
index dc302b7..25df7d1 100755
--- a/extras/HOME/.xmonad/startup
+++ b/extras/HOME/.xmonad/startup
@@ -24,14 +24,15 @@ hostname_photon() {
   if [ -z "$(ps aux | grep compton | grep -v grep)" ] ; then
     __GL_SYNC_TO_VBLANK=1 nohup compton --backend=glx &>/dev/null &
   fi
-  xrandr --output DVI-I-1 --right-of DP-5 --mode 2560x1440
-  feh --bg-scale "/home/rahm/.xmonad/wallpaper.jpg"
+  # xrandr --output DVI-I-1 --right-of DP-5 --mode 2560x1440
+  feh --bg-scale "/usr/share/backgrounds/archlinux/mountain.jpg"
 }
 
 
 common
 
-hostname_fn="hostname_$(hostname)"
+xrdb "$HOME/.Xresources"
+hostname_fn="hostname_$(cat /etc/hostname)"
 
 if [[ "$(type -t "$hostname_fn")" == function ]] ; then
   "$hostname_fn" 
diff --git a/extras/HOME/.xmonad/xmobar-bluetooth b/extras/HOME/.xmonad/xmobar-bluetooth
index 93caa50..3024cfe 100755
--- a/extras/HOME/.xmonad/xmobar-bluetooth
+++ b/extras/HOME/.xmonad/xmobar-bluetooth
@@ -15,4 +15,4 @@ bluetoothctl -- info | while read line ; do
   fi
 done
 
-exec echo "<fc=#a0a0a0></fc> <fc=#404040>│</fc>"
+exec echo "<fc=#a0a0a0></fc> <fc=#404040>│</fc> "
diff --git a/extras/HOME/.xmonad/xmobar-logo b/extras/HOME/.xmonad/xmobar-logo
index 848ebd2..bf48047 100755
--- a/extras/HOME/.xmonad/xmobar-logo
+++ b/extras/HOME/.xmonad/xmobar-logo
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 case "$(uname -a)" in
-  *-arch-*) exec echo '<fn=5><fc=#1785bd></fc></fn>' ;;
+  *-arch*) exec echo '<fn=5><fc=#1785bd></fc></fn>' ;;
   *Debian*) exec echo '<fn=5><fc=#c00649></fc></fn>' ;;
   *Ubuntu*) exec echo '<fn=5><fc=#ff8888></fc></fn>' ;;
   *Linux*)  exec echo '<fn=5><fc=#ffffff></fc></fn>' ;;
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index c54ffa7..2339cca 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -10,6 +10,7 @@ import Data.List
 import XMonad.Layout.Spiral
 import XMonad.Layout.ThreeColumns
 import XMonad.Layout.Grid
+import XMonad.Layout.Dishes
 import XMonad.Layout
 import XMonad.Layout.LayoutModifier
 import XMonad
@@ -24,7 +25,8 @@ myLayout =
       Tall 1 (3/100) (1/2) |||
       ThreeCol 1 (3/100) (1/2) |||
       Full |||
-      Grid
+      Grid |||
+      Dishes 2 (1/6)
 
 data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
 
diff --git a/src/Main.hs b/src/Main.hs
index 85d18c7..28d50ad 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -81,7 +81,7 @@ main = do
     parseOut :: String -> String
     parseOut str =
       let colors = ["#ff878f", "#e187ff", "#8f87ff", "#87fff7", "#8bff87", "#ffe987", "#ff8787"]
-          components = zip (cycle colors) (splitOnAll [" - ", " · ", " "] str)
+          components = zip (cycle colors) (splitOnAll [" - ", " | ", " · ", " "] str)
           in  concatMap (\(color, str) ->
                   printf "<fc=%s>%s</fc> " color str) components
 
diff --git a/xmobar/extras/battery/battery.c b/xmobar/extras/battery/battery.c
index 791bc69..55deb17 100644
--- a/xmobar/extras/battery/battery.c
+++ b/xmobar/extras/battery/battery.c
@@ -251,6 +251,6 @@ int main(int argc, char** argv)
   return 0;
 
 fail:
-  printf("");
+  printf("<fc=#404040>%s</fc> ", icons[11]);
   return 0;
 }
-- 
cgit 


From 4db7274561b8dd6444e6b93c483479423450c6e6 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 2 Nov 2021 23:20:35 -0600
Subject: 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>.
---
 src/Internal/Keys.hs    | 44 ++++++++++++++++++++++++--------------
 src/Internal/Marking.hs | 56 +++++++++++++++++++++++++++++++++++++++++++++++++
 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
-- 
cgit 


From 6f76e166bb2572ade759291f308460f78e8af12f Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 2 Nov 2021 23:49:25 -0600
Subject: Add ability to flip the layout with mod-f.

---
 src/Internal/Keys.hs   | 43 ++++++++++++++++++++++---------------------
 src/Internal/Layout.hs | 43 ++++++++++++++++++++++++++++++++++++-------
 2 files changed, 58 insertions(+), 28 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 0b7b1c3..ab6eab6 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -73,29 +73,30 @@ 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_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 .|. shiftMask, xK_c), kill)
-        , ((modm .|. shiftMask, xK_t), withFocused $ windows . W.sink)
+        [ ((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_f),          sendMessage FlipLayout)
+        , ((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 .|. shiftMask, xK_c),          kill)
+        , ((modm .|. shiftMask, xK_t),          withFocused $ windows . W.sink)
         , ((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_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)
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index 2339cca..aa3df1a 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
 module Internal.Layout where 
 
+import Control.Arrow (second)
 import XMonad.Hooks.ManageDocks
 import XMonad.Layout.Circle
 import XMonad.Layout.Accordion
@@ -20,26 +21,54 @@ import qualified XMonad.StackSet as W
 
 myLayout =
   ModifiedLayout (Zoomable False 0.05 0.05) $
-    spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ avoidStruts $
-      spiral (6/7) |||
-      Tall 1 (3/100) (1/2) |||
-      ThreeCol 1 (3/100) (1/2) |||
-      Full |||
-      Grid |||
-      Dishes 2 (1/6)
+    ModifiedLayout (Flippable False) $
+      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ avoidStruts $
+        spiral (6/7) |||
+        Tall 1 (3/100) (1/2) |||
+        ThreeCol 1 (3/100) (1/2) |||
+        Full |||
+        Grid |||
+        Dishes 2 (1/6)
 
 data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
 
 instance Message ResizeZoom where
 
+data Flippable a = Flippable Bool -- True if flipped
+  deriving (Show, Read)
+
+data FlipLayout = FlipLayout deriving (Typeable)
+
 data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
   deriving (Show, Read)
 
 data ToggleZoom = ToggleZoom
   deriving (Typeable)
 
+instance Message FlipLayout where
+
 instance Message ToggleZoom where
 
+instance (Eq a) => LayoutModifier Flippable a where
+  pureModifier (Flippable flip) (Rectangle _ _ sw _) stack returned =
+    if flip 
+      then (map (second doFlip) returned, Nothing)
+      else (returned, Nothing)
+    where
+      doFlip (Rectangle x y w h) = Rectangle (fromIntegral sw - x - fromIntegral w) y w h
+
+  pureMess (Flippable flip) message = 
+    case fromMessage message of
+      Just FlipLayout -> Just (Flippable (not flip))
+      Nothing -> Nothing
+
+  modifyDescription (Flippable flipped) underlying =
+    let descr = description underlying in
+      if flipped
+        then descr ++ " Flipped"
+        else descr
+    
+
 instance (Eq a) => LayoutModifier Zoomable a where
   redoLayout (Zoomable doit ws hs) (Rectangle x y w h) stack returned =
     if doit
-- 
cgit 


From 8f6e5103dc8dc3068637b696762e96c2729e939e Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Wed, 3 Nov 2021 01:13:07 -0600
Subject: Added MosaicAlt Layout. Changed weather icon to use moon icon for
 'clear'

---
 extras/HOME/.xmobarrc      |  6 +++---
 src/Internal/Keys.hs       |  4 ++++
 src/Internal/Layout.hs     | 50 +++++++++++++++++++++++++++++++++++++---------
 src/Internal/LayoutDraw.hs |  3 ++-
 4 files changed, 50 insertions(+), 13 deletions(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index fc85d91..5a5d4a4 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -5,7 +5,7 @@ Config
        "xft:Monofur Nerd Font:size=9",
        "xft:Monofur bold Nerd Font:size=9",
        "xft:Monofur Nerd Font:size=6",
-       "xft:Monofur bold Nerd Font:size=40",
+       "xft:Monofur bold Nerd Font:size=15",
        "xft:Monofur Nerd Font:style=bold:size=12"
        ]
    , borderColor = "black"
@@ -57,9 +57,9 @@ Config
          "--high", "red"
        ] 10,
        Run WeatherX "KLMO"
-             [ ("clear", "<fc=#ddcf04>")
+             [ ("clear", "<fc=#00a3c4>")
              , ("sunny", "<fc=#ddcf04>")
-             , ("mostly clear", "<fc=#ddcf04>")
+             , ("mostly clear", "<fc=#00a3c4>")
              , ("mostly sunny", "<fc=#ddcf04>")
              , ("partly sunny", "<fc=#ddcf04>")
              , ("fair", "<fc=#a0a0a0>🌑")
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index ab6eab6..cf7846d 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys where
 
+import XMonad.Layout.MosaicAlt
 import Graphics.X11.ExtraTypes.XorgDefault
 import System.Process
 import XMonad.Util.Ungrab
@@ -84,6 +85,7 @@ newKeys markContext =
         , ((modm .|. shiftMask, xK_h),          windows W.swapUp)
         , ((modm .|. shiftMask, xK_l),          windows W.swapDown)
         , ((modm              , xK_f),          sendMessage FlipLayout)
+        , ((modm .|. shiftMask, xK_f),          sendMessage HFlipLayout)
         , ((modm              , xK_Return),     windows W.swapMaster)
         , ((modm,               xK_j),          sendMessage Shrink)
         , ((modm,               xK_k),          sendMessage Expand)
@@ -92,6 +94,8 @@ newKeys markContext =
         , ((modm .|. mod1Mask,  xK_s),          (void $ spawn "sudo systemctl suspend && xsecurelock"))
         , ((modm .|. shiftMask, xK_c),          kill)
         , ((modm .|. shiftMask, xK_t),          withFocused $ windows . W.sink)
+        , ((modm,               xK_comma),      withFocused $ sendMessage . shrinkWindowAlt)
+        , ((modm,               xK_period),     withFocused $ sendMessage . expandWindowAlt)
         , ((mod4Mask,           xK_BackSpace),  (void $ spawn "xterm"))
         , ((modm,               xK_BackSpace),  (void $ spawn "pkill -SIGUSR1 xmobar"))
         , ((modm,               xK_t),          (void $ spawn (terminal config)))
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index aa3df1a..853a885 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -12,23 +12,27 @@ import XMonad.Layout.Spiral
 import XMonad.Layout.ThreeColumns
 import XMonad.Layout.Grid
 import XMonad.Layout.Dishes
+import XMonad.Layout.MosaicAlt
 import XMonad.Layout
 import XMonad.Layout.LayoutModifier
 import XMonad
 import XMonad.Core
 
+import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
 myLayout =
   ModifiedLayout (Zoomable False 0.05 0.05) $
     ModifiedLayout (Flippable False) $
-      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ avoidStruts $
-        spiral (6/7) |||
-        Tall 1 (3/100) (1/2) |||
-        ThreeCol 1 (3/100) (1/2) |||
-        Full |||
-        Grid |||
-        Dishes 2 (1/6)
+      ModifiedLayout (HFlippable False) $
+        spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ avoidStruts $
+          spiral (6/7) |||
+          Tall 1 (3/100) (1/2) |||
+          ThreeCol 1 (3/100) (1/2) |||
+          Full |||
+          Grid |||
+          Dishes 2 (1/6) |||
+          (MosaicAlt M.empty :: MosaicAlt Window)
 
 data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
 
@@ -37,8 +41,13 @@ instance Message ResizeZoom where
 data Flippable a = Flippable Bool -- True if flipped
   deriving (Show, Read)
 
+data HFlippable a = HFlippable Bool -- True if flipped
+  deriving (Show, Read)
+
 data FlipLayout = FlipLayout deriving (Typeable)
 
+data HFlipLayout = HFlipLayout deriving (Typeable)
+
 data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
   deriving (Show, Read)
 
@@ -47,15 +56,18 @@ data ToggleZoom = ToggleZoom
 
 instance Message FlipLayout where
 
+instance Message HFlipLayout where
+
 instance Message ToggleZoom where
 
 instance (Eq a) => LayoutModifier Flippable a where
-  pureModifier (Flippable flip) (Rectangle _ _ sw _) stack returned =
+  pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
     if flip 
       then (map (second doFlip) returned, Nothing)
       else (returned, Nothing)
     where
-      doFlip (Rectangle x y w h) = Rectangle (fromIntegral sw - x - fromIntegral w) y w h
+      doFlip (Rectangle x y w h) =
+        Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
 
   pureMess (Flippable flip) message = 
     case fromMessage message of
@@ -67,6 +79,26 @@ instance (Eq a) => LayoutModifier Flippable a where
       if flipped
         then descr ++ " Flipped"
         else descr
+
+instance (Eq a) => LayoutModifier HFlippable a where
+  pureModifier (HFlippable flip) (Rectangle _ sy _ sh) stack returned =
+    if flip 
+      then (map (second doFlip) returned, Nothing)
+      else (returned, Nothing)
+    where
+      doFlip (Rectangle x y w h) =
+        Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
+
+  pureMess (HFlippable flip) message = 
+    case fromMessage message of
+      Just HFlipLayout -> Just (HFlippable (not flip))
+      Nothing -> Nothing
+
+  modifyDescription (HFlippable flipped) underlying =
+    let descr = description underlying in
+      if flipped
+        then descr ++ " HFlipped"
+        else descr
     
 
 instance (Eq a) => LayoutModifier Zoomable a where
diff --git a/src/Internal/LayoutDraw.hs b/src/Internal/LayoutDraw.hs
index 4bb069a..7c69a08 100644
--- a/src/Internal/LayoutDraw.hs
+++ b/src/Internal/LayoutDraw.hs
@@ -10,6 +10,7 @@ import Control.Monad
 import Graphics.Rendering.Cairo
 import Graphics.Rendering.Cairo.Internal (Render(runRender))
 import Graphics.Rendering.Cairo.Types (Cairo(Cairo))
+import Control.Concurrent (threadDelay)
 
 import System.FilePath
 import XMonad
@@ -85,7 +86,7 @@ drawPng l = do
 
             surfaceWriteToPNG surface filepathPng
 
-            (!_) <- readProcessWithExitCode
+            out <- readProcessWithExitCode
               "/usr/bin/convert"
               [filepathPng, filepathXpm]
               ""
-- 
cgit 


From e4d9cc1c22ba36516d24902c7f0de52b1009570b Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 3 Nov 2021 13:17:54 -0600
Subject: Finally, after much wailing and gnashing of teeth, fixed the Xmobar
 layout icon issue!

---
 src/Internal/LayoutDraw.hs | 106 +++++++++++++++++++++++----------------------
 src/Main.hs                |  59 ++++++++++++++-----------
 2 files changed, 88 insertions(+), 77 deletions(-)

diff --git a/src/Internal/LayoutDraw.hs b/src/Internal/LayoutDraw.hs
index 7c69a08..dedac0f 100644
--- a/src/Internal/LayoutDraw.hs
+++ b/src/Internal/LayoutDraw.hs
@@ -2,6 +2,8 @@
 ScopedTypeVariables, BangPatterns #-}
 module Internal.LayoutDraw where
 
+import System.IO
+
 import System.Process
 import Text.Printf
 import Control.Arrow
@@ -21,17 +23,17 @@ import System.Directory
 import Internal.Layout
 import Internal.Hash
 
-showLayout :: X (Maybe String)
+showLayout :: X (Bool, String, Maybe String)
 showLayout = do
     winset <- gets windowset
     let layout = S.layout . S.workspace . S.current $ winset
-    xpm <- drawPng layout
-    return $ Just $ printf "<icon=%s/>" xpm
+    (cached, xpm) <- drawPng layout
+    return $ (cached, description layout, Just $ printf "<icon=%s/>" xpm)
 
 iconSize :: (Num a) => (a, a)
 iconSize = (64, 32)
 
-drawPng :: (LayoutClass layout Window) => layout Window -> X String
+drawPng :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
 drawPng l = do
     dir <- getXMonadDir
     let sixWindows = [1..(4 :: Window)]
@@ -45,54 +47,54 @@ drawPng l = do
     let descr = description l
     let pngCacheDir = dir </> "icons" </> "cache"
 
-    liftIO $ createDirectoryIfMissing True pngCacheDir
-    let testf = dir </> "text.txt"
-    let filepathPng = pngCacheDir </> (quickHash descr ++ ".png")
-    let filepathXpm = pngCacheDir </> (quickHash descr ++ ".xpm")
-
-    let colors = [
-           -- (1.0, 1.0, 1.0),
-           -- (0.9, 0.9, 1.0),
-           -- (0.8, 0.8, 1.0),
-           -- (0.7, 0.7, 1.0),
-           (0.8, 0.6, 0.6),
-           (0.8, 0.5, 0.5),
-           (0.8, 0.4, 0.4),
-           (0.8, 0.3, 0.3),
-           (0.8, 0.2, 0.2),
-           (0.8, 0.1, 0.1),
-           (0.8, 0.0, 0.0)
-          ]
-
-    exists <- liftIO $ doesFileExist filepathXpm
-    when (not exists) $
-      liftIO $ do
-        withImageSurface FormatARGB32 64 32 $ \surface -> do
-            renderWith surface $ do
-              setLineCap LineCapButt
-              setLineJoin LineJoinMiter
-
-              forM_ (reverse $ zip (map (second extraPad) rects) colors) $
-                \((wind, Rectangle x y w h), (r, g, b)) -> do
-                  setSourceRGBA r g b 1
-
-                  rectangle
-                    (fromIntegral $ floor (fromIntegral x / 30.0))
-                    (fromIntegral $ floor (fromIntegral y / 30.0))
-                    (fromIntegral $ floor (fromIntegral w / 30.0))
-                    (fromIntegral $ floor (fromIntegral h / 30.0))
-
-                  fill
-
-            surfaceWriteToPNG surface filepathPng
-
-            out <- readProcessWithExitCode
-              "/usr/bin/convert"
-              [filepathPng, filepathXpm]
-              ""
-            return ()
-
-    return filepathXpm
+    liftIO $ do
+      createDirectoryIfMissing True pngCacheDir
+      let testf = dir </> "text.txt"
+      let filepathPng = pngCacheDir </> (quickHash descr ++ ".png")
+      let filepathXpm = pngCacheDir </> (quickHash descr ++ ".xpm")
+
+      let colors = [
+             -- (1.0, 1.0, 1.0),
+             -- (0.9, 0.9, 1.0),
+             -- (0.8, 0.8, 1.0),
+             -- (0.7, 0.7, 1.0),
+             (0.8, 0.6, 0.6),
+             (0.8, 0.5, 0.5),
+             (0.8, 0.4, 0.4),
+             (0.8, 0.3, 0.3),
+             (0.8, 0.2, 0.2),
+             (0.8, 0.1, 0.1),
+             (0.8, 0.0, 0.0)
+            ]
+
+      exists <- doesFileExist filepathXpm
+      when (not exists) $ do
+          withImageSurface FormatARGB32 64 32 $ \surface -> do
+              renderWith surface $ do
+                setLineCap LineCapButt
+                setLineJoin LineJoinMiter
+
+                forM_ (reverse $ zip (map (second extraPad) rects) colors) $
+                  \((wind, Rectangle x y w h), (r, g, b)) -> do
+                    setSourceRGBA r g b 1
+
+                    rectangle
+                      (fromIntegral $ floor (fromIntegral x / 30.0))
+                      (fromIntegral $ floor (fromIntegral y / 30.0))
+                      (fromIntegral $ floor (fromIntegral w / 30.0))
+                      (fromIntegral $ floor (fromIntegral h / 30.0))
+
+                    fill
+
+              surfaceWriteToPNG surface filepathPng
+
+              _ <- handle (\(e :: SomeException) -> return ()) $ void $ readProcessWithExitCode
+                     "/usr/bin/convert"
+                     [filepathPng, filepathXpm]
+                     ""
+              return ()
+
+      return (exists, filepathXpm)
     where
       extraPad (Rectangle x y w h) =
         Rectangle (x + 100) (y + 100) (w - 100) (h - 100)
diff --git a/src/Main.hs b/src/Main.hs
index 28d50ad..47a00e2 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,5 +1,7 @@
 import XMonad
+import Control.Exception
 import XMonad.Hooks.DynamicLog
+import Control.Concurrent
 import XMonad.Layout.Spacing
 import XMonad.Actions.WindowNavigation
 import XMonad.Util.CustomKeys
@@ -12,10 +14,15 @@ import XMonad.Layout.IndependentScreens
 import Text.Printf
 import Data.List.Split
 import XMonad.Hooks.EwmhDesktops
+import XMonad.Hooks.ManageDocks
+import XMonad.Util.Run (spawnPipe)
+import Control.Monad (when)
+import System.IO
 
 import Internal.Keys
 import Internal.LayoutDraw
 import Data.List (partition, isPrefixOf)
+import Data.Maybe
 
 
 main = do
@@ -23,8 +30,10 @@ main = do
   homeDir <- getHomeDirectory
   let fp = homeDir </> ".xmonad" </> "startup"
 
+  xmproc <- spawnPipe "xmobar"
+
   config <-
-    applyKeys $ def
+    applyKeys $ docks $ def
        { terminal    = "alacritty"
        , modMask     = mod3Mask
        , borderWidth = 2
@@ -49,33 +58,33 @@ main = do
        , handleEventHook = fullscreenEventHook
        , focusFollowsMouse = False
        , clickJustFocuses = False
-       }
+       , logHook = do
+           (_, _, layout) <- showLayout
 
-  let toggleStructsKey XConfig {XMonad.modMask = modMask} = (modMask, xK_b)
+           dynamicLogWithPP $ xmobarPP {
+               ppCurrent = xmobarColor "#ff8888" "red" . printf "<fn=1>%s</fn>"
+             , ppVisible = xmobarColor "#8888ff" "" . printf "<fn=6>%s</fn>"
+             , ppHidden  = xmobarColor "#888888" "" . printf "<fn=2>%s</fn>"
+             , ppWsSep = "<fn=1><fc=#808080> </fc></fn>"
+             , ppTitle =
+                 xmobarColor "#808080" "" .
+                    printf "<fn=3><fc=#bbbbbb>%s</fc></fn>" .
+                      parseOut .
+                        trunc 50
+
+             , ppSep = xmobarColor "#404040" "" " │ "
+             , ppLayout = const (fromMaybe "" layout)
+             , ppExtras = []
+             , ppOutput = hPutStrLn xmproc
+             , ppOrder =  \ss ->
+                 let (icons, etc) = partition ("<icon"`isPrefixOf`) ss
+                     in icons ++ etc
+             }
+       }
 
-  xmonad =<<
-    statusBar
-      "xmobar"
-      xmobarPP {
-                 ppCurrent = xmobarColor "#ff8888" "red" . printf "<fn=1>%s</fn>"
-               , ppVisible = xmobarColor "#8888ff" "" . printf "<fn=6>%s</fn>"
-               , ppHidden  = xmobarColor "#888888" "" . printf "<fn=2>%s</fn>"
-               , ppWsSep = "<fn=1><fc=#808080> </fc></fn>"
-               , ppTitle =
-                   xmobarColor "#808080" "" .
-                      printf "<fn=3><fc=#bbbbbb>%s</fc></fn>" .
-                        parseOut .
-                          trunc 50
+  -- let toggleStructsKey XConfig {XMonad.modMask = modMask} = (modMask, xK_b)
 
-               , ppSep = xmobarColor "#404040" "" " │ "
-               , ppLayout = const ""
-               , ppExtras = [showLayout]
-               , ppOrder =  \ss ->
-                   let (icons, etc) = partition ("<icon"`isPrefixOf`) ss
-                       in icons ++ etc
-               }
-      toggleStructsKey
-      config
+  xmonad config
 
   where
     parseOut :: String -> String
-- 
cgit 


From f890f6d10158af006dda0be806813d4779cd1e89 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 3 Nov 2021 16:46:42 -0600
Subject: Killed Dependency on Cairo. Vastly improved layout experience.

---
 extras/HOME/.xmonad/startup |   5 +-
 package.yaml                |   2 +-
 src/Internal/Layout.hs      |  51 +++++++++++-
 src/Internal/LayoutDraw.hs  | 193 +++++++++++++++++++++++---------------------
 stack.yaml                  |   4 -
 5 files changed, 155 insertions(+), 100 deletions(-)

diff --git a/extras/HOME/.xmonad/startup b/extras/HOME/.xmonad/startup
index 25df7d1..59621af 100755
--- a/extras/HOME/.xmonad/startup
+++ b/extras/HOME/.xmonad/startup
@@ -4,6 +4,10 @@ common() {
   # Startup commands common to all the hosts.
   xsetroot -cursor_name left_ptr
   xset r rate 200 60
+
+  xrdb "$HOME/.Xresources"
+
+  rm -rf "$HOME/.xmonad/icons/cache/"
 }
 
 hostname_rahm1() {
@@ -31,7 +35,6 @@ hostname_photon() {
 
 common
 
-xrdb "$HOME/.Xresources"
 hostname_fn="hostname_$(cat /etc/hostname)"
 
 if [[ "$(type -t "$hostname_fn")" == function ]] ; then
diff --git a/package.yaml b/package.yaml
index e6e3648..bc8e530 100644
--- a/package.yaml
+++ b/package.yaml
@@ -14,9 +14,9 @@ dependencies:
   - filepath
   - process
   - containers
-  - cairo
   - bytestring
   - cryptohash
   - listsafe
   - X11
   - split
+  - mtl
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index 853a885..eb33a5e 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -13,6 +13,7 @@ import XMonad.Layout.ThreeColumns
 import XMonad.Layout.Grid
 import XMonad.Layout.Dishes
 import XMonad.Layout.MosaicAlt
+import qualified XMonad.Layout.Dwindle as D
 import XMonad.Layout
 import XMonad.Layout.LayoutModifier
 import XMonad
@@ -27,12 +28,56 @@ myLayout =
       ModifiedLayout (HFlippable False) $
         spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ avoidStruts $
           spiral (6/7) |||
-          Tall 1 (3/100) (1/2) |||
-          ThreeCol 1 (3/100) (1/2) |||
+          ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |||
+          ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |||
           Full |||
           Grid |||
           Dishes 2 (1/6) |||
-          (MosaicAlt M.empty :: MosaicAlt Window)
+          (MosaicAlt M.empty :: MosaicAlt Window) |||
+          (D.Dwindle D.R D.CW 1.5 1.1)
+
+data ModifyDescription m l a = ModifyDescription m (l a)
+  deriving (Show, Read)
+
+data TallDescriptionModifier = TallDescriptionModifier
+  deriving (Show, Read)
+
+data ThreeColDescMod = ThreeColDescMod
+  deriving (Show, Read)
+
+class DescriptionModifier m l where
+  newDescription :: m -> l a -> String -> String
+
+instance (Show m, DescriptionModifier m l, LayoutClass l a) => LayoutClass (ModifyDescription m l) a where
+  runLayout (W.Workspace t (ModifyDescription m l) a) rect = do
+    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
+    return (rects, fmap (ModifyDescription m) maybeNewLayout)
+
+  doLayout (ModifyDescription m l) a s = do
+    (rects, maybeNewLayout) <- doLayout l a s
+    return (rects, fmap (ModifyDescription m) maybeNewLayout)
+
+  pureLayout (ModifyDescription m l) a s = pureLayout l a s
+
+  emptyLayout (ModifyDescription m l) a = do
+    (rects, maybeNewLayout) <- emptyLayout l a
+    return (rects, fmap (ModifyDescription m) maybeNewLayout)
+
+  handleMessage (ModifyDescription m l) a = do
+    maybeNewLayout <- handleMessage l a
+    return (ModifyDescription m <$> maybeNewLayout)
+
+  pureMessage (ModifyDescription m l) a =
+    let maybeNewLayout = pureMessage l a in
+      ModifyDescription m <$> maybeNewLayout
+
+  description (ModifyDescription m l) = newDescription m l (description l)
+
+instance DescriptionModifier TallDescriptionModifier Tall where
+  newDescription _ (Tall mast _ _) _ = "Tall(" ++ show mast ++ ")"
+
+instance DescriptionModifier ThreeColDescMod ThreeCol where
+  newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
 
 data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
 
diff --git a/src/Internal/LayoutDraw.hs b/src/Internal/LayoutDraw.hs
index dedac0f..7f960f2 100644
--- a/src/Internal/LayoutDraw.hs
+++ b/src/Internal/LayoutDraw.hs
@@ -4,20 +4,20 @@ module Internal.LayoutDraw where
 
 import System.IO
 
+import Control.Monad.Writer
+import XMonad.Layout.Spacing
 import System.Process
 import Text.Printf
 import Control.Arrow
 import Control.Exception
 import Control.Monad
-import Graphics.Rendering.Cairo
-import Graphics.Rendering.Cairo.Internal (Render(runRender))
-import Graphics.Rendering.Cairo.Types (Cairo(Cairo))
 import Control.Concurrent (threadDelay)
 
 import System.FilePath
 import XMonad
 import XMonad.StackSet as S
 import Data.Maybe
+import Data.Foldable
 import System.Directory
 
 import Internal.Layout
@@ -27,93 +27,104 @@ showLayout :: X (Bool, String, Maybe String)
 showLayout = do
     winset <- gets windowset
     let layout = S.layout . S.workspace . S.current $ winset
-    (cached, xpm) <- drawPng layout
+
+    layout' <- handleMessage layout (
+       SomeMessage $ ModifyWindowBorder (
+          const (Border 0 0 0 0)))
+
+    let layout'' = layout'
+
+    (cached, xpm) <-
+        case layout'' of
+          Just l -> drawXpmIO l
+          Nothing -> drawXpmIO layout
     return $ (cached, description layout, Just $ printf "<icon=%s/>" xpm)
 
-iconSize :: (Num a) => (a, a)
-iconSize = (64, 32)
-
-drawPng :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
-drawPng l = do
-    dir <- getXMonadDir
-    let sixWindows = [1..(4 :: Window)]
-    let stack = differentiate sixWindows
-    (rects, _) <-
-          runLayout
-            (Workspace "0" l stack)
-            (Rectangle 0 0 (fst iconSize * 30) (snd iconSize * 30))
-    return ()
-
-    let descr = description l
-    let pngCacheDir = dir </> "icons" </> "cache"
-
-    liftIO $ do
-      createDirectoryIfMissing True pngCacheDir
-      let testf = dir </> "text.txt"
-      let filepathPng = pngCacheDir </> (quickHash descr ++ ".png")
-      let filepathXpm = pngCacheDir </> (quickHash descr ++ ".xpm")
-
-      let colors = [
-             -- (1.0, 1.0, 1.0),
-             -- (0.9, 0.9, 1.0),
-             -- (0.8, 0.8, 1.0),
-             -- (0.7, 0.7, 1.0),
-             (0.8, 0.6, 0.6),
-             (0.8, 0.5, 0.5),
-             (0.8, 0.4, 0.4),
-             (0.8, 0.3, 0.3),
-             (0.8, 0.2, 0.2),
-             (0.8, 0.1, 0.1),
-             (0.8, 0.0, 0.0)
-            ]
-
-      exists <- doesFileExist filepathXpm
-      when (not exists) $ do
-          withImageSurface FormatARGB32 64 32 $ \surface -> do
-              renderWith surface $ do
-                setLineCap LineCapButt
-                setLineJoin LineJoinMiter
-
-                forM_ (reverse $ zip (map (second extraPad) rects) colors) $
-                  \((wind, Rectangle x y w h), (r, g, b)) -> do
-                    setSourceRGBA r g b 1
-
-                    rectangle
-                      (fromIntegral $ floor (fromIntegral x / 30.0))
-                      (fromIntegral $ floor (fromIntegral y / 30.0))
-                      (fromIntegral $ floor (fromIntegral w / 30.0))
-                      (fromIntegral $ floor (fromIntegral h / 30.0))
-
-                    fill
-
-              surfaceWriteToPNG surface filepathPng
-
-              _ <- handle (\(e :: SomeException) -> return ()) $ void $ readProcessWithExitCode
-                     "/usr/bin/convert"
-                     [filepathPng, filepathXpm]
-                     ""
-              return ()
-
-      return (exists, filepathXpm)
-    where
-      extraPad (Rectangle x y w h) =
-        Rectangle (x + 100) (y + 100) (w - 100) (h - 100)
-      -- padR (Rectangle x y w h) =
-      --   Rectangle x y (max 1 $ w - 120) (max 1 $ h - 120)
-
-newtype InterceptLayout l a =
-    InterceptLayout {
-       unIntercept :: (l a)
-    } deriving (Show, Read)
-
-instance (LayoutClass l Window) => LayoutClass (InterceptLayout l) Window where
-    runLayout (Workspace t l s) rect = do
-      (rects, mr) <- runLayout (Workspace t (unIntercept l) s) rect
-      return (rects, fmap InterceptLayout mr)
-
-    handleMessage this mesg = do
-      ret <- handleMessage (unIntercept this) mesg
-      -- mapM_ drawThing ret
-      return (InterceptLayout <$> ret)
-
-    description = ("Intercepted "++) . description . unIntercept
+pointInRect :: (Dimension, Dimension) -> Rectangle -> Bool
+pointInRect (x, y) (Rectangle x' y' w h) =
+  x <= (fi x' + fi w) && x >= fi x' && y <= (fi y' + fi h) && y >= fi y'
+  where
+    fi :: (Integral a, Num b) => a -> b
+    fi = fromIntegral
+
+sf :: (Integral a) => a
+sf = 1024
+
+drawXpmIO :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
+drawXpmIO l = do
+  dir <- getXMonadDir
+
+  let shrinkAmt = 4
+
+  let (w, h) = (56 + shrinkAmt, 28 + shrinkAmt)
+  let descr = description l
+  let iconCacheDir = dir </> "icons" </> "cache"
+  let iconPath = iconCacheDir </> (quickHash descr ++ ".xpm")
+
+  let colors = [
+        "#cc9a9a",
+        "#cc9999",
+        "#cc8080",
+        "#cc6666",
+        "#cc4c4c",
+        "#cc3232",
+        "#cc1818"
+        ]
+
+  (rects', _) <-
+    runLayout
+      (Workspace "0" l (differentiate [1 .. 6]))
+      (Rectangle 0 0 (w * sf) (h * sf))
+
+  let rects = flip map rects' $ \(_, (Rectangle x y w h)) ->
+                Rectangle (x `div` sf) (y `div` sf) (w `div` sf) (h `div` sf)
+
+  liftIO $ do
+    exists <- doesFileExist iconPath
+    createDirectoryIfMissing True iconCacheDir
+
+    when (not exists) $ do
+      let xpmText = drawXpm (w, h) (zip (cycle colors) rects) 4
+      writeFile iconPath xpmText
+
+    return (exists, iconPath)
+
+drawXpm :: (Dimension, Dimension) -> [(String, Rectangle)] -> Dimension -> String
+drawXpm (w, h) rects' shrinkAmt = execWriter $ do
+    tell "/* XPM */\n"
+    tell "static char *out[] = {\n"
+    forM_ rects' $ \(_, rect) -> do
+      tell $ "/* " ++ show rect ++ " */\n"
+    tell $ "/* --------------------------- */\n"
+    forM_ rects $ \(_, rect) -> do
+      tell $ "/* " ++ show rect ++ " */\n"
+      
+    tell $ printf "\"%d %d %d 1 \",\n" (w - shrinkAmt) (h - shrinkAmt) (length rects + 1)
+
+    let zipRects = (zip ['A' .. 'Z'] rects)
+
+    forM_ zipRects $ \(char, (color, _)) -> do
+      tell $ printf "\"%c c %s\",\n" char color
+    tell "\"% c None\"a,\n"
+
+    forM_ [0 .. h - 1 - shrinkAmt] $ \y -> do
+      tell "\""
+      forM_ [0 .. w - 1 - shrinkAmt] $ \x -> 
+        (case find (matches x y) zipRects of
+          Nothing -> tell "%"
+          Just (chr, _) -> tell [chr])
+      tell "\""
+      when (y /= h - 1 - shrinkAmt) (tell ",")
+      tell "\n"
+    tell "};"
+
+  where
+    matches x y (_, (_, r)) = pointInRect (x, y) r
+    rects = map (second (shrink shrinkAmt)) rects'
+    guard a b = if a <= shrinkAmt then 1 else b
+    shrink amt (Rectangle x y w h) =
+      Rectangle
+        x
+        y
+        (guard w $ w - fromIntegral amt)
+        (guard h $ h - fromIntegral amt)
diff --git a/stack.yaml b/stack.yaml
index e8e9582..81e3e0b 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -71,7 +71,3 @@ packages:
 #
 # Allow a newer minor version of GHC than the snapshot specifies
 # compiler-check: newer-minor
-
-extra-deps:
-  - gtk2hs-buildtools-0.13.8.1@sha256:78e0dc8e3ae2d3ebe01d8d65e5f3f463102ea13a66be6bb1bff7a20a3d93486d,5238
-  - cairo-0.13.8.1@sha256:1938aaeb5d3504678d995774dfe870f6b66cbd43d336b692fa8779b23b2b67a9,4075
-- 
cgit 


From 59f501a195ab437954c748b2feaedbe60b3d4cd5 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 3 Nov 2021 17:18:57 -0600
Subject: Add ability to truncate xmobar output.

This is done by removing all visible characters after a certain point. Right now
that's set to 70, which was found just via trial-and-error.

This will break if something has '>' or '<' and this will not be able to handle
xmobar's 'raw' tag, but it's good enough.
---
 src/Internal/Keys.hs |  2 ++
 src/Main.hs          | 33 +++++++++++++++++----------------
 2 files changed, 19 insertions(+), 16 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index cf7846d..75c70a3 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -101,6 +101,8 @@ newKeys markContext =
         , ((modm,               xK_t),          (void $ spawn (terminal config)))
         , ((modm,               xK_m),          (submap $ mapAlpha modm (markCurrentWindow markContext)))
         , ((modm,               xK_w),          runXPlus markContext config windowJump)
+        , ((modm,               xK_space),      sendMessage NextLayout)
+        , ((modm .|. shiftMask, xK_space),      sendMessage FirstLayout)
         , ((modm,               xK_apostrophe), (submap $
               Map.insert
                 (modm, xK_apostrophe)
diff --git a/src/Main.hs b/src/Main.hs
index 47a00e2..689411c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -67,15 +67,13 @@ main = do
              , ppHidden  = xmobarColor "#888888" "" . printf "<fn=2>%s</fn>"
              , ppWsSep = "<fn=1><fc=#808080> </fc></fn>"
              , ppTitle =
-                 xmobarColor "#808080" "" .
-                    printf "<fn=3><fc=#bbbbbb>%s</fc></fn>" .
-                      parseOut .
-                        trunc 50
+                 xmobarColor "#a0a0a0" "" .
+                    printf "<fn=3><fc=#bbbbbb>%s</fc></fn>"
 
              , ppSep = xmobarColor "#404040" "" " │ "
              , ppLayout = const (fromMaybe "" layout)
              , ppExtras = []
-             , ppOutput = hPutStrLn xmproc
+             , ppOutput = hPutStrLn xmproc . reverse . trunc 80
              , ppOrder =  \ss ->
                  let (icons, etc) = partition ("<icon"`isPrefixOf`) ss
                      in icons ++ etc
@@ -87,17 +85,20 @@ main = do
   xmonad config
 
   where
-    parseOut :: String -> String
-    parseOut str =
-      let colors = ["#ff878f", "#e187ff", "#8f87ff", "#87fff7", "#8bff87", "#ffe987", "#ff8787"]
-          components = zip (cycle colors) (splitOnAll [" - ", " | ", " · ", " "] str)
-          in  concatMap (\(color, str) ->
-                  printf "<fc=%s>%s</fc> " color str) components
-
-    trunc amt str =
-      if length str > amt - 4
-        then take (amt - 4) str ++ " ..."
-        else str
+    trunc amt str = trunc' False amt str []
+    trunc' _ _ [] acc = acc
+    trunc' ignore amt (a:as) acc =
+      case a of
+        '<' -> trunc' True amt as (a : acc)
+        '>' -> trunc' False amt as (a : acc)
+        _ ->
+          if ignore
+            then trunc' True amt as (a : acc)
+            else
+              case amt of
+                0 -> trunc' False 0 as acc
+                4 -> trunc' False 0 as ("... " ++ acc)
+                _ -> trunc' False (amt - 1) as (a : acc)
 
     splitOnAll arr str = splitOnAll' arr [str]
     splitOnAll' [] str = str
-- 
cgit 


From 63b6a57db25652853b574239dc1b8f1f5f614a9e Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 3 Nov 2021 17:23:42 -0600
Subject: Display stdin ellipsis only if it makes the string shorter.

i.e. would rather show 'My Title' rather than 'My Titl ...'
---
 src/Main.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Main.hs b/src/Main.hs
index 689411c..020c0f8 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -97,7 +97,7 @@ main = do
             else
               case amt of
                 0 -> trunc' False 0 as acc
-                4 -> trunc' False 0 as ("... " ++ acc)
+                4 | length as > 3 -> trunc' False 0 as ("... " ++ acc)
                 _ -> trunc' False (amt - 1) as (a : acc)
 
     splitOnAll arr str = splitOnAll' arr [str]
-- 
cgit 


From 3464c1dbb093b8a5729c40cc51f4448fd3e43337 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 3 Nov 2021 17:34:26 -0600
Subject: Change the strut behavior.

It wasn't working as expected for flips. This is because the
avoidStructs layout modifier was too low in the layout stack.
---
 src/Internal/Keys.hs   | 2 ++
 src/Internal/Layout.hs | 2 +-
 src/Main.hs            | 2 +-
 3 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 75c70a3..09d0cc8 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys where
 
+import XMonad.Hooks.ManageDocks
 import XMonad.Layout.MosaicAlt
 import Graphics.X11.ExtraTypes.XorgDefault
 import System.Process
@@ -159,6 +160,7 @@ newKeys markContext =
         , ((modm .|. mod1Mask, xK_a), runXPlus markContext config (withScreen W.greedyView 0))
         , ((modm .|. mod1Mask, xK_o), runXPlus markContext config (withScreen W.greedyView 1))
         , ((modm .|. mod1Mask, xK_e), runXPlus markContext config (withScreen W.greedyView 2))
+        , ((modm,              xK_b), sendMessage ToggleStruts)
 
         -- Buttons programmed on my mouse.
         , ((shiftMask, xK_F1), click >> (withFocused $ windows . W.sink))
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index eb33a5e..2b66f06 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -26,7 +26,7 @@ myLayout =
   ModifiedLayout (Zoomable False 0.05 0.05) $
     ModifiedLayout (Flippable False) $
       ModifiedLayout (HFlippable False) $
-        spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ avoidStruts $
+        spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
           spiral (6/7) |||
           ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |||
           ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |||
diff --git a/src/Main.hs b/src/Main.hs
index 020c0f8..6129839 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -41,7 +41,7 @@ main = do
        , focusedBorderColor = "#ff6c00"
        -- , normalBorderColor = "#ffd9bf"
        , normalBorderColor = "#000000"
-       , layoutHook = myLayout
+       , layoutHook = avoidStruts myLayout
        , startupHook = do
           ewmhDesktopsStartup
           spawn fp
-- 
cgit 


From 1705eeae8e3c14aa188dcd073e8875aab40e888c Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 4 Nov 2021 02:17:24 -0600
Subject: Fixed huuuuge bug related to dynamicLogWithPP.

dynamicLogWithPP does not support Unicode properly!! It was encoding
each "Char" (32 bits in Haskell, mind you!) to a utf-8 byte instead of a
codepoint. The result was a butchared faux-utf8 encoded string.

This was causing xmobar to crash with unicode + my truncating code. I
have now moved away from dynamicLogWithPP and am writing my own log
string manually. It's better this way anyway; less hacky; more
fine-grained control.
---
 src/Internal/Layout.hs |  25 ++++++-----
 src/Main.hs            | 118 ++++++++++++++++++++++++++++++-------------------
 2 files changed, 86 insertions(+), 57 deletions(-)

diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index 2b66f06..06ac7d6 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -23,18 +23,19 @@ import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
 myLayout =
-  ModifiedLayout (Zoomable False 0.05 0.05) $
-    ModifiedLayout (Flippable False) $
-      ModifiedLayout (HFlippable False) $
-        spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
-          spiral (6/7) |||
-          ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |||
-          ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |||
-          Full |||
-          Grid |||
-          Dishes 2 (1/6) |||
-          (MosaicAlt M.empty :: MosaicAlt Window) |||
-          (D.Dwindle D.R D.CW 1.5 1.1)
+  avoidStruts $ 
+    ModifiedLayout (Zoomable False 0.05 0.05) $
+      ModifiedLayout (Flippable False) $
+        ModifiedLayout (HFlippable False) $
+          spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
+            spiral (6/7) |||
+            ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |||
+            ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |||
+            Full |||
+            Grid |||
+            Dishes 2 (1/6) |||
+            (MosaicAlt M.empty :: MosaicAlt Window) |||
+            (D.Dwindle D.R D.CW 1.5 1.1)
 
 data ModifyDescription m l a = ModifyDescription m (l a)
   deriving (Show, Read)
diff --git a/src/Main.hs b/src/Main.hs
index 6129839..9785b52 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,28 +1,44 @@
 import XMonad
-import Control.Exception
-import XMonad.Hooks.DynamicLog
+
 import Control.Concurrent
-import XMonad.Layout.Spacing
-import XMonad.Actions.WindowNavigation
-import XMonad.Util.CustomKeys
+import Control.Exception
+import Control.Monad
+import Control.Monad (when)
+import Control.Monad.Writer
+import Data.Ord
+import Data.List (partition, isPrefixOf, sortBy)
+import Data.List.Split
+import Data.Maybe
+import Internal.Keys
+import Internal.Layout
+import Internal.LayoutDraw
 import System.Directory
 import System.FilePath
+import System.IO
 import System.Process
-import Internal.Layout
-import XMonad.Hooks.ManageHelpers
-import XMonad.Layout.IndependentScreens
 import Text.Printf
-import Data.List.Split
+import XMonad.Actions.WindowNavigation
+import XMonad.Hooks.DynamicLog
 import XMonad.Hooks.EwmhDesktops
 import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers
+import XMonad.Layout.IndependentScreens
+import XMonad.Layout.Spacing
+import XMonad.Util.CustomKeys
+import XMonad.Util.NamedWindows
 import XMonad.Util.Run (spawnPipe)
-import Control.Monad (when)
-import System.IO
 
-import Internal.Keys
-import Internal.LayoutDraw
-import Data.List (partition, isPrefixOf)
-import Data.Maybe
+import qualified XMonad.StackSet as S
+
+data WorkspaceState = Current | Hidden | Visible
+
+getWorkspaces :: (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, i)]
+getWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
+  sortBy (comparing snd) $
+    mapMaybe (\(a, S.Workspace t _ s) -> fmap (const (a, t)) s) $
+      map (\w -> (Hidden, w)) hi ++
+        map (\(S.Screen w _ _) -> (Visible, w)) vis ++
+          [(Current, cur)]
 
 
 main = do
@@ -31,9 +47,15 @@ main = do
   let fp = homeDir </> ".xmonad" </> "startup"
 
   xmproc <- spawnPipe "xmobar"
+  hSetEncoding xmproc utf8
+
+  logFile <- openFile "/tmp/xmonad.log" WriteMode 
+
+  hPutStrLn logFile "·······························"
+  hFlush logFile
 
   config <-
-    applyKeys $ docks $ def
+    applyKeys $ def
        { terminal    = "alacritty"
        , modMask     = mod3Mask
        , borderWidth = 2
@@ -41,10 +63,10 @@ main = do
        , focusedBorderColor = "#ff6c00"
        -- , normalBorderColor = "#ffd9bf"
        , normalBorderColor = "#000000"
-       , layoutHook = avoidStruts myLayout
+       , layoutHook = myLayout
        , startupHook = do
           ewmhDesktopsStartup
-          spawn fp
+          spawn fp  
        , manageHook = composeAll [
            isFullscreen --> doFullFloat
          , className =? "Tilda" --> doFloat
@@ -61,44 +83,50 @@ main = do
        , logHook = do
            (_, _, layout) <- showLayout
 
-           dynamicLogWithPP $ xmobarPP {
-               ppCurrent = xmobarColor "#ff8888" "red" . printf "<fn=1>%s</fn>"
-             , ppVisible = xmobarColor "#8888ff" "" . printf "<fn=6>%s</fn>"
-             , ppHidden  = xmobarColor "#888888" "" . printf "<fn=2>%s</fn>"
-             , ppWsSep = "<fn=1><fc=#808080> </fc></fn>"
-             , ppTitle =
-                 xmobarColor "#a0a0a0" "" .
-                    printf "<fn=3><fc=#bbbbbb>%s</fc></fn>"
-
-             , ppSep = xmobarColor "#404040" "" " │ "
-             , ppLayout = const (fromMaybe "" layout)
-             , ppExtras = []
-             , ppOutput = hPutStrLn xmproc . reverse . trunc 80
-             , ppOrder =  \ss ->
-                 let (icons, etc) = partition ("<icon"`isPrefixOf`) ss
-                     in icons ++ etc
-             }
+           winset <- gets windowset
+           title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
+           let wss = getWorkspaces winset
+
+           liftIO $ do
+             hPutStrLn xmproc $ trunc 80 $ execWriter $ do
+               mapM_ tell layout
+               tell $ xmobarColor "#404040" "" " │ "
+
+               forM_ wss $ \(t, name) -> do
+                 case t of
+                   Current -> tell "<fn=1><fc=#ff8888>"
+                   Visible -> tell "<fn=6><fc=#8888ff>"
+                   Hidden -> tell "<fn=2><fc=#888888>"
+                 tell name
+                 tell " </fc></fn>"
+
+               tell $ xmobarColor "#404040" "" "│ "
+               tell $ "<fc=#808080><fn=3>"
+               tell $ title
+               tell $ "</fn></fc>"
        }
 
   -- let toggleStructsKey XConfig {XMonad.modMask = modMask} = (modMask, xK_b)
 
-  xmonad config
+  xmonad (docks config)
 
   where
-    trunc amt str = trunc' False amt str []
-    trunc' _ _ [] acc = acc
-    trunc' ignore amt (a:as) acc =
+    trunc amt str = trunc' False amt str
+
+    trunc' :: Bool -> Int -> String -> String
+    trunc' _ _ [] = []
+    trunc' ignore amt (a:as) =
       case a of
-        '<' -> trunc' True amt as (a : acc)
-        '>' -> trunc' False amt as (a : acc)
+        '<' -> a : trunc' True amt as
+        '>' -> a : trunc' False amt as
         _ ->
           if ignore
-            then trunc' True amt as (a : acc)
+            then a : trunc' True amt as
             else
               case amt of
-                0 -> trunc' False 0 as acc
-                4 | length as > 3 -> trunc' False 0 as ("... " ++ acc)
-                _ -> trunc' False (amt - 1) as (a : acc)
+                0 -> trunc' False 0 as
+                3 -> "..." ++ trunc' False 0 as
+                _ ->  a : trunc' False (amt - 1) as
 
     splitOnAll arr str = splitOnAll' arr [str]
     splitOnAll' [] str = str
-- 
cgit 


From a4252311bd14ab0c053b5a6c5a47c47a886103f7 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 4 Nov 2021 10:44:49 -0600
Subject: Remove extra log. Change trunc to be TCO-able.

---
 extras/HOME/.xmobarrc |  2 +-
 src/Main.hs           | 29 ++++++++++++-----------------
 2 files changed, 13 insertions(+), 18 deletions(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index 5a5d4a4..5f4af3c 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -57,7 +57,7 @@ Config
          "--high", "red"
        ] 10,
        Run WeatherX "KLMO"
-             [ ("clear", "<fc=#00a3c4>")
+             [ ("clear", "<fc=#ddcf04>")
              , ("sunny", "<fc=#ddcf04>")
              , ("mostly clear", "<fc=#00a3c4>")
              , ("mostly sunny", "<fc=#ddcf04>")
diff --git a/src/Main.hs b/src/Main.hs
index 9785b52..e18c1d8 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -49,11 +49,6 @@ main = do
   xmproc <- spawnPipe "xmobar"
   hSetEncoding xmproc utf8
 
-  logFile <- openFile "/tmp/xmonad.log" WriteMode 
-
-  hPutStrLn logFile "·······························"
-  hFlush logFile
-
   config <-
     applyKeys $ def
        { terminal    = "alacritty"
@@ -101,7 +96,7 @@ main = do
                  tell " </fc></fn>"
 
                tell $ xmobarColor "#404040" "" "│ "
-               tell $ "<fc=#808080><fn=3>"
+               tell $ "<fc=#a0a0a0><fn=3>"
                tell $ title
                tell $ "</fn></fc>"
        }
@@ -111,22 +106,22 @@ main = do
   xmonad (docks config)
 
   where
-    trunc amt str = trunc' False amt str
-
-    trunc' :: Bool -> Int -> String -> String
-    trunc' _ _ [] = []
-    trunc' ignore amt (a:as) =
+    trunc amt str = reverse $ trunc' False amt str []
+    
+    trunc' :: Bool -> Int -> String -> String -> String
+    trunc' _ _ [] acc = acc
+    trunc' ignore amt (a:as) acc =
       case a of
-        '<' -> a : trunc' True amt as
-        '>' -> a : trunc' False amt as
+        '<' -> trunc' True amt as (a : acc)
+        '>' -> trunc' False amt as (a : acc)
         _ ->
           if ignore
-            then a : trunc' True amt as
+            then trunc' True amt as (a : acc)
             else
               case amt of
-                0 -> trunc' False 0 as
-                3 -> "..." ++ trunc' False 0 as
-                _ ->  a : trunc' False (amt - 1) as
+                0 -> trunc' False 0 as acc
+                3 -> trunc' False 0 as ("..." ++ acc)
+                _ -> trunc' False (amt - 1) as (a : acc)
 
     splitOnAll arr str = splitOnAll' arr [str]
     splitOnAll' [] str = str
-- 
cgit 


From 79df73d81c4b7b6b0676360b34f668fb9502f0d4 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 4 Nov 2021 11:36:18 -0600
Subject: Break out the XMobar logging subroutines into its own module.

---
 src/Internal/LayoutDraw.hs |  12 +---
 src/Internal/XMobarLog.hs  |  78 ++++++++++++++++++++++++++
 src/Main.hs                | 137 ++++++++++++++-------------------------------
 3 files changed, 124 insertions(+), 103 deletions(-)
 create mode 100644 src/Internal/XMobarLog.hs

diff --git a/src/Internal/LayoutDraw.hs b/src/Internal/LayoutDraw.hs
index 7f960f2..78ff59d 100644
--- a/src/Internal/LayoutDraw.hs
+++ b/src/Internal/LayoutDraw.hs
@@ -62,18 +62,12 @@ drawXpmIO l = do
   let iconPath = iconCacheDir </> (quickHash descr ++ ".xpm")
 
   let colors = [
-        "#cc9a9a",
-        "#cc9999",
-        "#cc8080",
-        "#cc6666",
-        "#cc4c4c",
-        "#cc3232",
-        "#cc1818"
-        ]
+        "#cc9a9a", "#cc9999", "#cc8080", "#cc6666",
+        "#cc4c4c", "#cc3232", "#cc1818", "#cc0000" ]
 
   (rects', _) <-
     runLayout
-      (Workspace "0" l (differentiate [1 .. 6]))
+      (Workspace "0" l (differentiate [1 .. 7]))
       (Rectangle 0 0 (w * sf) (h * sf))
 
   let rects = flip map rects' $ \(_, (Rectangle x y w h)) ->
diff --git a/src/Internal/XMobarLog.hs b/src/Internal/XMobarLog.hs
new file mode 100644
index 0000000..b36ba27
--- /dev/null
+++ b/src/Internal/XMobarLog.hs
@@ -0,0 +1,78 @@
+module Internal.XMobarLog ( XMobarLog, spawnXMobar, xMobarLogHook ) where
+
+import Control.Monad (forM_)
+import Control.Monad.Writer (tell, execWriter)
+import Data.List (sortBy)
+import Data.Maybe (mapMaybe)
+import Data.Ord (comparing)
+import Internal.LayoutDraw (showLayout)
+import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
+import XMonad.Util.NamedWindows (getName)
+import XMonad.Util.Run (spawnPipe)
+import XMonad (X)
+
+import qualified XMonad as X
+import qualified XMonad.StackSet as S
+
+data WorkspaceState = Current | Hidden | Visible
+
+data XMobarLog = XMobarLog Handle
+
+-- The log hook for XMobar. This is a custom log hook that does not use any
+-- of the Xmonad dynamic log libraries.
+
+spawnXMobar :: IO XMobarLog
+spawnXMobar = do
+  pipe <- spawnPipe "xmobar"
+  hSetEncoding pipe utf8
+  return (XMobarLog pipe)
+
+xMobarLogHook :: XMobarLog -> X ()
+xMobarLogHook (XMobarLog xmproc) = do
+  (_, _, layout) <- showLayout
+
+  winset <- X.gets X.windowset
+  title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
+  let wss = getWorkspaces winset
+
+  X.liftIO $ do
+    hPutStrLn xmproc $ trunc 80 $ execWriter $ do
+      mapM_ tell layout
+      tell $ "<fc=#404040> │ </fc>"
+
+      forM_ wss $ \(t, name) -> do
+        case t of
+          Current -> tell "<fn=1><fc=#ff8888>"
+          Visible -> tell "<fn=6><fc=#8888ff>"
+          Hidden -> tell "<fn=2><fc=#888888>"
+        tell name
+        tell " </fc></fn>"
+
+      tell $ "<fc=#404040>│ </fc><fc=#a0a0a0><fn=3>"
+      tell $ title
+      tell $ "</fn></fc>"
+
+trunc :: Int -> String -> String
+trunc amt str = reverse $ trunc' False amt str []
+  where
+    trunc' _ _ [] acc = acc
+    trunc' ignore amt (a:as) acc =
+      case a of
+        '<' -> trunc' True amt as (a : acc)
+        '>' -> trunc' False amt as (a : acc)
+        _ ->
+          if ignore
+            then trunc' True amt as (a : acc)
+            else
+              case amt of
+                0 -> trunc' False 0 as acc
+                3 -> trunc' False 0 as ("..." ++ acc)
+                _ -> trunc' False (amt - 1) as (a : acc)
+
+getWorkspaces :: (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, i)]
+getWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
+  sortBy (comparing snd) $
+    mapMaybe (\(a, S.Workspace t _ s) -> fmap (const (a, t)) s) $
+      map (\w -> (Hidden, w)) hi ++
+        map (\(S.Screen w _ _) -> (Visible, w)) vis ++
+          [(Current, cur)]
diff --git a/src/Main.hs b/src/Main.hs
index e18c1d8..86bc2dc 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,63 +1,63 @@
 import XMonad
 
-import Control.Concurrent
-import Control.Exception
-import Control.Monad
-import Control.Monad (when)
-import Control.Monad.Writer
-import Data.Ord
-import Data.List (partition, isPrefixOf, sortBy)
-import Data.List.Split
-import Data.Maybe
+-- import Control.Concurrent
+-- import Control.Exception
+-- import Control.Monad
+-- import Control.Monad (when)
+-- import Control.Monad.Writer
+-- import Data.Ord
+-- import Data.List (partition, isPrefixOf, sortBy)
+-- import Data.List.Split
+-- import Data.Maybe
+-- import Internal.Keys
+-- import Internal.Layout
+-- import Internal.LayoutDraw
+-- import Internal.XMobarLog
+-- import System.Directory
+-- import System.FilePath
+-- import System.IO
+-- import System.Process
+-- import Text.Printf
+-- import XMonad.Actions.WindowNavigation
+-- import XMonad.Hooks.DynamicLog
+-- import XMonad.Hooks.EwmhDesktops
+-- import XMonad.Hooks.ManageDocks
+-- import XMonad.Hooks.ManageHelpers
+-- import XMonad.Layout.IndependentScreens
+-- import XMonad.Layout.Spacing
+-- import XMonad.Util.CustomKeys
+-- import XMonad.Util.NamedWindows
+-- import XMonad.Util.Run (spawnPipe)
+
+import XMonad.Hooks.ManageDocks (docks)
+import System.Directory (getHomeDirectory)
+import System.FilePath ((</>))
+import XMonad.Hooks.EwmhDesktops (ewmhDesktopsStartup)
+import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat)
+import XMonad.Layout.Fullscreen (fullscreenEventHook)
+
+import Internal.XMobarLog
 import Internal.Keys
 import Internal.Layout
-import Internal.LayoutDraw
-import System.Directory
-import System.FilePath
-import System.IO
-import System.Process
-import Text.Printf
-import XMonad.Actions.WindowNavigation
-import XMonad.Hooks.DynamicLog
-import XMonad.Hooks.EwmhDesktops
-import XMonad.Hooks.ManageDocks
-import XMonad.Hooks.ManageHelpers
-import XMonad.Layout.IndependentScreens
-import XMonad.Layout.Spacing
-import XMonad.Util.CustomKeys
-import XMonad.Util.NamedWindows
-import XMonad.Util.Run (spawnPipe)
 
+import qualified XMonad as X
 import qualified XMonad.StackSet as S
 
-data WorkspaceState = Current | Hidden | Visible
-
-getWorkspaces :: (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, i)]
-getWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
-  sortBy (comparing snd) $
-    mapMaybe (\(a, S.Workspace t _ s) -> fmap (const (a, t)) s) $
-      map (\w -> (Hidden, w)) hi ++
-        map (\(S.Screen w _ _) -> (Visible, w)) vis ++
-          [(Current, cur)]
-
-
 main = do
   -- Execute some commands.
   homeDir <- getHomeDirectory
   let fp = homeDir </> ".xmonad" </> "startup"
 
-  xmproc <- spawnPipe "xmobar"
-  hSetEncoding xmproc utf8
+  xmobar <- spawnXMobar
 
-  config <-
-    applyKeys $ def
+  (=<<) X.xmonad $
+    applyKeys $ docks $ def
        { terminal    = "alacritty"
        , modMask     = mod3Mask
        , borderWidth = 2
        , keys = \config -> mempty
        , focusedBorderColor = "#ff6c00"
-       -- , normalBorderColor = "#ffd9bf"
-       , normalBorderColor = "#000000"
+       , normalBorderColor = "#404040"
        , layoutHook = myLayout
        , startupHook = do
           ewmhDesktopsStartup
@@ -75,56 +75,5 @@ main = do
        , handleEventHook = fullscreenEventHook
        , focusFollowsMouse = False
        , clickJustFocuses = False
-       , logHook = do
-           (_, _, layout) <- showLayout
-
-           winset <- gets windowset
-           title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
-           let wss = getWorkspaces winset
-
-           liftIO $ do
-             hPutStrLn xmproc $ trunc 80 $ execWriter $ do
-               mapM_ tell layout
-               tell $ xmobarColor "#404040" "" " │ "
-
-               forM_ wss $ \(t, name) -> do
-                 case t of
-                   Current -> tell "<fn=1><fc=#ff8888>"
-                   Visible -> tell "<fn=6><fc=#8888ff>"
-                   Hidden -> tell "<fn=2><fc=#888888>"
-                 tell name
-                 tell " </fc></fn>"
-
-               tell $ xmobarColor "#404040" "" "│ "
-               tell $ "<fc=#a0a0a0><fn=3>"
-               tell $ title
-               tell $ "</fn></fc>"
+       , logHook = xMobarLogHook xmobar
        }
-
-  -- let toggleStructsKey XConfig {XMonad.modMask = modMask} = (modMask, xK_b)
-
-  xmonad (docks config)
-
-  where
-    trunc amt str = reverse $ trunc' False amt str []
-    
-    trunc' :: Bool -> Int -> String -> String -> String
-    trunc' _ _ [] acc = acc
-    trunc' ignore amt (a:as) acc =
-      case a of
-        '<' -> trunc' True amt as (a : acc)
-        '>' -> trunc' False amt as (a : acc)
-        _ ->
-          if ignore
-            then trunc' True amt as (a : acc)
-            else
-              case amt of
-                0 -> trunc' False 0 as acc
-                3 -> trunc' False 0 as ("..." ++ acc)
-                _ -> trunc' False (amt - 1) as (a : acc)
-
-    splitOnAll arr str = splitOnAll' arr [str]
-    splitOnAll' [] str = str
-    splitOnAll' (a:as) [str] = splitOnAll' as (splitOn a str)
-    splitOnAll' _ lst = lst
-
-- 
cgit 


From 9b110e385c262f70d49bd5d21913864ed0e6847c Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 4 Nov 2021 13:25:11 -0600
Subject: Clean up LayoutDraw.hs

---
 src/Internal/Layout.hs     |  11 +++-
 src/Internal/LayoutDraw.hs | 145 +++++++++++++++++++++++++++------------------
 src/Internal/XMobarLog.hs  |  16 ++++-
 src/Main.hs                |  29 ---------
 4 files changed, 110 insertions(+), 91 deletions(-)

diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index 06ac7d6..cb8c19b 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -97,14 +97,19 @@ data HFlipLayout = HFlipLayout deriving (Typeable)
 data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
   deriving (Show, Read)
 
-data ToggleZoom = ToggleZoom
+-- Toggles if the current window should be zoomed or not. Set the boolean
+-- to set the zoom.
+data ZoomModifier =
+       ToggleZoom |
+       Zoom |
+       Unzoom
   deriving (Typeable)
 
 instance Message FlipLayout where
 
 instance Message HFlipLayout where
 
-instance Message ToggleZoom where
+instance Message ZoomModifier where
 
 instance (Eq a) => LayoutModifier Flippable a where
   pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
@@ -179,6 +184,8 @@ instance (Eq a) => LayoutModifier Zoomable a where
                       ExpandZoom -> 1) * 0.02
 
         handleZoom ToggleZoom = Zoomable (not showing) sw sh
+        handleZoom Zoom = Zoomable True sw sh
+        handleZoom Unzoom = Zoomable False sw sh
 
         guard f | f > 1 = 1
                 | f < 0 = 0
diff --git a/src/Internal/LayoutDraw.hs b/src/Internal/LayoutDraw.hs
index 78ff59d..8b029bd 100644
--- a/src/Internal/LayoutDraw.hs
+++ b/src/Internal/LayoutDraw.hs
@@ -1,45 +1,61 @@
 {-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
 ScopedTypeVariables, BangPatterns #-}
-module Internal.LayoutDraw where
+module Internal.LayoutDraw (drawLayout) where
 
-import System.IO
-
-import Control.Monad.Writer
-import XMonad.Layout.Spacing
-import System.Process
-import Text.Printf
-import Control.Arrow
-import Control.Exception
 import Control.Monad
-import Control.Concurrent (threadDelay)
-
-import System.FilePath
-import XMonad
-import XMonad.StackSet as S
-import Data.Maybe
-import Data.Foldable
-import System.Directory
-
-import Internal.Layout
-import Internal.Hash
-
-showLayout :: X (Bool, String, Maybe String)
-showLayout = do
-    winset <- gets windowset
-    let layout = S.layout . S.workspace . S.current $ winset
-
-    layout' <- handleMessage layout (
-       SomeMessage $ ModifyWindowBorder (
-          const (Border 0 0 0 0)))
-
-    let layout'' = layout'
-
-    (cached, xpm) <-
-        case layout'' of
-          Just l -> drawXpmIO l
-          Nothing -> drawXpmIO layout
-    return $ (cached, description layout, Just $ printf "<icon=%s/>" xpm)
 
+import Control.Arrow (second)
+import Control.Concurrent (threadDelay)
+import Control.Exception (handle)
+import Control.Monad.Writer (execWriter, tell)
+import Data.Foldable (find)
+import Data.Maybe (fromMaybe)
+import Internal.Hash (quickHash)
+import Internal.Layout (ZoomModifier(..))
+import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+import XMonad.Layout.Spacing (SpacingModifier(..), Border(..))
+
+import XMonad (X,
+               Rectangle(..),
+               Dimension,
+               LayoutClass,
+               Message,
+               Window,
+               SomeMessage(..))
+
+import qualified XMonad as X
+import qualified XMonad.StackSet as S
+
+-- Draws and returns an XPM for the current layout.
+--
+-- Returns
+--  - Bool   - true if the xpm has already been written, and is thus cached.
+--  - String - description of the current layout
+--  - String - the text to send to XMobar
+--
+-- This function actually runs the current layout's doLayout function to
+-- generate the XPM, so it's completely portable to all layouts.
+--
+-- Note this function is impure and running the layout to create the XPM is also
+-- impure. While in-practice most layouts are pure, it should be kept in mind.
+drawLayout :: X (Bool, String, String)
+drawLayout = do
+    winset <- X.gets X.windowset
+    let layout = S.layout $ S.workspace $ S.current $ winset
+
+    -- Gotta reset the layout to a consistent state.
+    layout' <- foldM (flip ($)) layout $ [
+         handleMessage' $ ModifyWindowBorder $ const $ Border 0 0 0 0,
+         handleMessage' $ Unzoom
+       ]
+
+    (cached, xpm) <- drawXpmIO layout'
+
+    return $ (cached, X.description layout, printf "<icon=%s/>" xpm)
+
+-- Returns true if a point is inside a rectangle (inclusive).
 pointInRect :: (Dimension, Dimension) -> Rectangle -> Bool
 pointInRect (x, y) (Rectangle x' y' w h) =
   x <= (fi x' + fi w) && x >= fi x' && y <= (fi y' + fi h) && y >= fi y'
@@ -47,17 +63,29 @@ pointInRect (x, y) (Rectangle x' y' w h) =
     fi :: (Integral a, Num b) => a -> b
     fi = fromIntegral
 
+-- Scale factory. Scaling the rectangles before writing the XPM helps to reduce
+-- noise from things like AvoidStruts, as there is unfortunately no way to force
+-- avoid struts to be off, one can only toggle it.
 sf :: (Integral a) => a
 sf = 1024
 
+handleMessage' ::
+    (LayoutClass layout a, Message m) => m -> layout a -> X (layout a)
+handleMessage' message layout  = do
+  fromMaybe layout <$> X.handleMessage layout (SomeMessage message)
+
+-- Creates the XPM for the given layout and returns the path to it.
+--
+-- This function does run doLayout on the given layout, and that should be
+-- accounted for.
 drawXpmIO :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
 drawXpmIO l = do
-  dir <- getXMonadDir
+  dir <- X.getXMonadDir
 
-  let shrinkAmt = 4
+  let shrinkAmt = 5 -- amount to shrink the windows by to make pretty gaps.
 
-  let (w, h) = (56 + shrinkAmt, 28 + shrinkAmt)
-  let descr = description l
+  let (w, h) = (56, 24)
+  let descr = X.description l
   let iconCacheDir = dir </> "icons" </> "cache"
   let iconPath = iconCacheDir </> (quickHash descr ++ ".xpm")
 
@@ -66,14 +94,14 @@ drawXpmIO l = do
         "#cc4c4c", "#cc3232", "#cc1818", "#cc0000" ]
 
   (rects', _) <-
-    runLayout
-      (Workspace "0" l (differentiate [1 .. 7]))
-      (Rectangle 0 0 (w * sf) (h * sf))
+    X.runLayout
+      (S.Workspace "0" l (S.differentiate [1 .. 5]))
+      (Rectangle 0 0 ((w + shrinkAmt) * sf) ((h + shrinkAmt) * sf))
 
   let rects = flip map rects' $ \(_, (Rectangle x y w h)) ->
                 Rectangle (x `div` sf) (y `div` sf) (w `div` sf) (h `div` sf)
 
-  liftIO $ do
+  X.liftIO $ do
     exists <- doesFileExist iconPath
     createDirectoryIfMissing True iconCacheDir
 
@@ -83,34 +111,37 @@ drawXpmIO l = do
 
     return (exists, iconPath)
 
-drawXpm :: (Dimension, Dimension) -> [(String, Rectangle)] -> Dimension -> String
+--
+-- Create's an XPM, purely. Returns a string with the XPM contents.
+-- Takes as arguments
+-- 
+--   - dimensions of the icon.
+--   - list of (color, rectangle) pairs.
+--   - The amount to shrink the windows by for those pretty gaps.
+--
+drawXpm ::
+    (Dimension, Dimension) -> [(String, Rectangle)] -> Dimension -> String
 drawXpm (w, h) rects' shrinkAmt = execWriter $ do
     tell "/* XPM */\n"
     tell "static char *out[] = {\n"
-    forM_ rects' $ \(_, rect) -> do
-      tell $ "/* " ++ show rect ++ " */\n"
-    tell $ "/* --------------------------- */\n"
-    forM_ rects $ \(_, rect) -> do
-      tell $ "/* " ++ show rect ++ " */\n"
-      
-    tell $ printf "\"%d %d %d 1 \",\n" (w - shrinkAmt) (h - shrinkAmt) (length rects + 1)
+    tell $ printf "\"%d %d %d 1 \",\n" w h (length rects + 1)
 
-    let zipRects = (zip ['A' .. 'Z'] rects)
+    let zipRects = zip ['A' .. 'Z'] rects
 
     forM_ zipRects $ \(char, (color, _)) -> do
       tell $ printf "\"%c c %s\",\n" char color
     tell "\"% c None\"a,\n"
 
-    forM_ [0 .. h - 1 - shrinkAmt] $ \y -> do
+    forM_ [0 .. h - 1] $ \y -> do
       tell "\""
-      forM_ [0 .. w - 1 - shrinkAmt] $ \x -> 
+      forM_ [0 .. w - 1] $ \x -> 
         (case find (matches x y) zipRects of
           Nothing -> tell "%"
           Just (chr, _) -> tell [chr])
       tell "\""
       when (y /= h - 1 - shrinkAmt) (tell ",")
       tell "\n"
-    tell "};"
+    tell "};\n"
 
   where
     matches x y (_, (_, r)) = pointInRect (x, y) r
diff --git a/src/Internal/XMobarLog.hs b/src/Internal/XMobarLog.hs
index b36ba27..d0ff8f8 100644
--- a/src/Internal/XMobarLog.hs
+++ b/src/Internal/XMobarLog.hs
@@ -5,7 +5,7 @@ import Control.Monad.Writer (tell, execWriter)
 import Data.List (sortBy)
 import Data.Maybe (mapMaybe)
 import Data.Ord (comparing)
-import Internal.LayoutDraw (showLayout)
+import Internal.LayoutDraw (drawLayout)
 import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
 import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Run (spawnPipe)
@@ -20,6 +20,10 @@ data XMobarLog = XMobarLog Handle
 
 -- The log hook for XMobar. This is a custom log hook that does not use any
 -- of the Xmonad dynamic log libraries.
+--
+-- This is because the given dynamic log libraries don't handle unicode properly
+-- and this has been causing issues. It is also more flexible and frankly easier
+-- to just DIY.
 
 spawnXMobar :: IO XMobarLog
 spawnXMobar = do
@@ -27,9 +31,11 @@ spawnXMobar = do
   hSetEncoding pipe utf8
   return (XMobarLog pipe)
 
+
+-- XMonad Log Hook meant to be used with the XMonad config logHook.
 xMobarLogHook :: XMobarLog -> X ()
 xMobarLogHook (XMobarLog xmproc) = do
-  (_, _, layout) <- showLayout
+  (_, _, layoutXpm) <- drawLayout
 
   winset <- X.gets X.windowset
   title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
@@ -37,7 +43,7 @@ xMobarLogHook (XMobarLog xmproc) = do
 
   X.liftIO $ do
     hPutStrLn xmproc $ trunc 80 $ execWriter $ do
-      mapM_ tell layout
+      tell layoutXpm
       tell $ "<fc=#404040> │ </fc>"
 
       forM_ wss $ \(t, name) -> do
@@ -52,6 +58,8 @@ xMobarLogHook (XMobarLog xmproc) = do
       tell $ title
       tell $ "</fn></fc>"
 
+-- Truncate an XMobar string to the provided number of _visible_ characters.
+-- This is to keep long window titles from overrunning the whole bar.
 trunc :: Int -> String -> String
 trunc amt str = reverse $ trunc' False amt str []
   where
@@ -69,6 +77,8 @@ trunc amt str = reverse $ trunc' False amt str []
                 3 -> trunc' False 0 as ("..." ++ acc)
                 _ -> trunc' False (amt - 1) as (a : acc)
 
+-- Returns all the workspaces with a stack on them and if that workspace is
+-- Visible, Current or Hidden.
 getWorkspaces :: (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, i)]
 getWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
   sortBy (comparing snd) $
diff --git a/src/Main.hs b/src/Main.hs
index 86bc2dc..0d49e21 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,34 +1,5 @@
 import XMonad
 
--- import Control.Concurrent
--- import Control.Exception
--- import Control.Monad
--- import Control.Monad (when)
--- import Control.Monad.Writer
--- import Data.Ord
--- import Data.List (partition, isPrefixOf, sortBy)
--- import Data.List.Split
--- import Data.Maybe
--- import Internal.Keys
--- import Internal.Layout
--- import Internal.LayoutDraw
--- import Internal.XMobarLog
--- import System.Directory
--- import System.FilePath
--- import System.IO
--- import System.Process
--- import Text.Printf
--- import XMonad.Actions.WindowNavigation
--- import XMonad.Hooks.DynamicLog
--- import XMonad.Hooks.EwmhDesktops
--- import XMonad.Hooks.ManageDocks
--- import XMonad.Hooks.ManageHelpers
--- import XMonad.Layout.IndependentScreens
--- import XMonad.Layout.Spacing
--- import XMonad.Util.CustomKeys
--- import XMonad.Util.NamedWindows
--- import XMonad.Util.Run (spawnPipe)
-
 import XMonad.Hooks.ManageDocks (docks)
 import System.Directory (getHomeDirectory)
 import System.FilePath ((</>))
-- 
cgit 


From ebf78e8e8c33ee03d63123a4b4d9cb099485ff4c Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 4 Nov 2021 13:51:13 -0600
Subject: update xmobar config. Can't quite make up my mind.

---
 extras/HOME/.xmobarrc | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index 5f4af3c..52798af 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -3,17 +3,17 @@ Config
    , additionalFonts = [
        "xft:Monofur bold Nerd Font:style=bold:size=12",
        "xft:Monofur Nerd Font:size=9",
-       "xft:Monofur bold Nerd Font:size=9",
+       "xft:Monofur Nerd Font:size=9",
        "xft:Monofur Nerd Font:size=6",
        "xft:Monofur bold Nerd Font:size=15",
-       "xft:Monofur Nerd Font:style=bold:size=12"
+       "xft:Monofur Nerd Font:style=bold:size=10"
        ]
    , borderColor = "black"
    , border = FullBM -1
    , borderWidth = 2
-   , bgColor = "#17171b"
+   , bgColor = "#000000"
    , fgColor = "white"
-   , alpha = 250                 -- default: 255
+   , alpha = 220                 -- default: 255
    , position = TopSize L 100 40
    , textOffset = -1             -- default: -1
    , iconOffset = -1             -- default: -1
@@ -29,7 +29,7 @@ Config
    , template =
       " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc><fc=#404040> │\
       \</fc><fc=#a0a0a0> %date%</fc><fc=#404040> │ \
-      \</fc>%StdinReader%}<fn=1><fc=#8888ff>%time%</fc></fn>\
+      \</fc>%StdinReader%}<fn=6><fc=#909090>%time%</fc></fn>\
       \{ %cpu% %memory% <fc=#404040>\
       \│</fc> %KLMO% <fc=#404040>│\
       \</fc> <fc=#a0a0a0>%mpris2%</fc> <fc=#404040>│ \
@@ -44,8 +44,8 @@ Config
          "-H", "50",
          "-b", "-",
          "-f", "-",
-         "--normal", "green",
-         "--high", "red"
+         "--normal", "#88ff88",
+         "--high", "#ff8888"
        ] 10,
        Run Memory [
          "-t", "<fn=3><fc=#000000><usedbar></fc></fn>",
@@ -53,8 +53,8 @@ Config
          "-H", "50",
          "-b", "-",
          "-f", "-",
-         "--normal", "green",
-         "--high", "red"
+         "--normal", "#88ff88",
+         "--high", "#ff8888"
        ] 10,
        Run WeatherX "KLMO"
              [ ("clear", "<fc=#ddcf04>")
-- 
cgit 


From 523ef127e36d91560851d912a2765fa408ce1100 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 4 Nov 2021 14:10:52 -0600
Subject: Fix old bug.

Old bug where shifting workspaces relatively using mod-n/p would not
work as expected where visible workspaces without any windows would be
skipped over or plain not work.
---
 src/Internal/Lib.hs       | 22 +++++++++++++++++++++-
 src/Internal/XMobarLog.hs | 20 +++++---------------
 2 files changed, 26 insertions(+), 16 deletions(-)

diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index feb5f26..3ba1eca 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -21,6 +21,9 @@ import XMonad hiding (workspaces, Screen)
 import XMonad.StackSet hiding (filter, focus)
 import qualified Data.Map as Map
 import Internal.DMenu
+import Data.Ord (comparing)
+
+import qualified XMonad.StackSet as S
 
 type WorkspaceName = Char
 newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a)
@@ -31,6 +34,23 @@ instance XPrompt WinPrompt where
     showXPrompt _ = "[Window] "
     commandToComplete _ = id
 
+data WorkspaceState = Current | Hidden | Visible
+
+-- Returns all the workspaces that are either visible, current or Hidden but
+-- have windows and that workspace's state.
+--
+-- In other words, filters out workspaces that have no windows and are not
+-- visible.
+--
+-- This function will sort the result by the workspace tag.
+getPopulatedWorkspaces ::
+  (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, S.Workspace i l a)]
+getPopulatedWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
+  sortBy (comparing (tag . snd)) $
+    mapMaybe (\w@(S.Workspace _ _ s) -> fmap (const (Hidden, w)) s) hi ++
+      map (\(S.Screen w _ _) -> (Visible, w)) vis ++
+        [(Current, cur)]
+
 getHorizontallyOrderedScreens ::
   StackSet wid l a ScreenId ScreenDetail ->
     [Screen wid l a ScreenId ScreenDetail]
@@ -91,7 +111,7 @@ getString = runQuery $ do
 relativeWorkspaceShift :: Selector -> X ()
 relativeWorkspaceShift (Selector selector) = do
   windows $ \ss ->
-    let tags = sort $ (tag <$> filter (isJust . stack) (workspaces ss))
+    let tags = sort $ (tag . snd <$> getPopulatedWorkspaces ss)
         from = tag $ workspace $ current ss
         to = selector from tags
     in greedyView to ss
diff --git a/src/Internal/XMobarLog.hs b/src/Internal/XMobarLog.hs
index d0ff8f8..c0aa2a7 100644
--- a/src/Internal/XMobarLog.hs
+++ b/src/Internal/XMobarLog.hs
@@ -1,5 +1,6 @@
 module Internal.XMobarLog ( XMobarLog, spawnXMobar, xMobarLogHook ) where
 
+import Control.Arrow (second)
 import Control.Monad (forM_)
 import Control.Monad.Writer (tell, execWriter)
 import Data.List (sortBy)
@@ -10,12 +11,11 @@ import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
 import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Run (spawnPipe)
 import XMonad (X)
+import Internal.Lib (getPopulatedWorkspaces, WorkspaceState(..))
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as S
 
-data WorkspaceState = Current | Hidden | Visible
-
 data XMobarLog = XMobarLog Handle
 
 -- The log hook for XMobar. This is a custom log hook that does not use any
@@ -39,19 +39,19 @@ xMobarLogHook (XMobarLog xmproc) = do
 
   winset <- X.gets X.windowset
   title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
-  let wss = getWorkspaces winset
+  let wss = getPopulatedWorkspaces winset
 
   X.liftIO $ do
     hPutStrLn xmproc $ trunc 80 $ execWriter $ do
       tell layoutXpm
       tell $ "<fc=#404040> │ </fc>"
 
-      forM_ wss $ \(t, name) -> do
+      forM_ wss $ \(t, ws) -> do
         case t of
           Current -> tell "<fn=1><fc=#ff8888>"
           Visible -> tell "<fn=6><fc=#8888ff>"
           Hidden -> tell "<fn=2><fc=#888888>"
-        tell name
+        tell (S.tag ws)
         tell " </fc></fn>"
 
       tell $ "<fc=#404040>│ </fc><fc=#a0a0a0><fn=3>"
@@ -76,13 +76,3 @@ trunc amt str = reverse $ trunc' False amt str []
                 0 -> trunc' False 0 as acc
                 3 -> trunc' False 0 as ("..." ++ acc)
                 _ -> trunc' False (amt - 1) as (a : acc)
-
--- Returns all the workspaces with a stack on them and if that workspace is
--- Visible, Current or Hidden.
-getWorkspaces :: (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, i)]
-getWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
-  sortBy (comparing snd) $
-    mapMaybe (\(a, S.Workspace t _ s) -> fmap (const (a, t)) s) $
-      map (\w -> (Hidden, w)) hi ++
-        map (\(S.Screen w _ _) -> (Visible, w)) vis ++
-          [(Current, cur)]
-- 
cgit 


From ca930a42071050d46a7242a36ea244fab191097c Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Thu, 4 Nov 2021 17:32:30 -0600
Subject: Change keys to use mod+shift+/- to change the size for Mosaic.

---
 src/Internal/Keys.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 09d0cc8..bc27750 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -95,8 +95,8 @@ newKeys markContext =
         , ((modm .|. mod1Mask,  xK_s),          (void $ spawn "sudo systemctl suspend && xsecurelock"))
         , ((modm .|. shiftMask, xK_c),          kill)
         , ((modm .|. shiftMask, xK_t),          withFocused $ windows . W.sink)
-        , ((modm,               xK_comma),      withFocused $ sendMessage . shrinkWindowAlt)
-        , ((modm,               xK_period),     withFocused $ sendMessage . expandWindowAlt)
+        , ((modm .|. shiftMask, xK_plus),       withFocused $ sendMessage . expandWindowAlt)
+        , ((modm .|. shiftMask, xK_minus),      withFocused $ sendMessage . shrinkWindowAlt)
         , ((mod4Mask,           xK_BackSpace),  (void $ spawn "xterm"))
         , ((modm,               xK_BackSpace),  (void $ spawn "pkill -SIGUSR1 xmobar"))
         , ((modm,               xK_t),          (void $ spawn (terminal config)))
@@ -130,8 +130,8 @@ newKeys markContext =
 
         , ((modm, xK_minus), sendMessage (IncMasterN (-1)))
         , ((modm, xK_plus), sendMessage (IncMasterN 1))
-        , ((modm .|. shiftMask, xK_bracketleft), sendMessage (modifyWindowBorder (-1)))
-        , ((modm .|. shiftMask, xK_bracketright), sendMessage (modifyWindowBorder 1))
+        , ((modm .|. shiftMask, xK_bracketleft), sendMessage (modifyWindowBorder (-5)))
+        , ((modm .|. shiftMask, xK_bracketright), sendMessage (modifyWindowBorder 5))
         , ((modm, xK_bracketleft), sendMessage ShrinkZoom)
         , ((modm, xK_bracketright), sendMessage ExpandZoom)
 
-- 
cgit 


From 6bf7c66bf222d901821a6c51ca5739e17704c953 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Thu, 4 Nov 2021 17:41:26 -0600
Subject: Make inactive bluetooth the same color as everything else

---
 extras/HOME/.xmonad/xmobar-bluetooth | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extras/HOME/.xmonad/xmobar-bluetooth b/extras/HOME/.xmonad/xmobar-bluetooth
index 3024cfe..30903e3 100755
--- a/extras/HOME/.xmonad/xmobar-bluetooth
+++ b/extras/HOME/.xmonad/xmobar-bluetooth
@@ -15,4 +15,4 @@ bluetoothctl -- info | while read line ; do
   fi
 done
 
-exec echo "<fc=#a0a0a0></fc> <fc=#404040>│</fc> "
+exec echo "<fc=#404040></fc> <fc=#404040>│</fc> "
-- 
cgit 


From ea44b017950cbab49a68959190ab0a859d45e7b1 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Thu, 4 Nov 2021 17:52:47 -0600
Subject: Clean up spotify-control script.

---
 extras/HOME/.local/bin/spotify-control | 50 +++++++++++++++++++++++++++++-----
 1 file changed, 43 insertions(+), 7 deletions(-)

diff --git a/extras/HOME/.local/bin/spotify-control b/extras/HOME/.local/bin/spotify-control
index 751f562..e001eb6 100755
--- a/extras/HOME/.local/bin/spotify-control
+++ b/extras/HOME/.local/bin/spotify-control
@@ -12,27 +12,63 @@ then
   exit
 fi
 
+function mpris2_dbus_player_do {
+  dbus-send \
+    --print-reply \
+    --dest=org.mpris.MediaPlayer2.spotify \
+    /org/mpris/MediaPlayer2 \
+    "org.mpris.MediaPlayer2.Player.$1"
+}
+
+function mpris2_dbus_get_player_property {
+  dbus-send \
+    --print-reply \
+    --dest=org.mpris.MediaPlayer2.spotify \
+    /org/mpris/MediaPlayer2 \
+    org.freedesktop.DBus.Properties.Get \
+    string:'org.mpris.MediaPlayer2.Player' "string:$1"
+}
+
 case $1 in
     "play")
-        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.PlayPause
+        mpris2_dbus_player_do PlayPause
         ;;
     "next")
-        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.Next
+        mpris2_dbus_player_do Next
         ;;
     "prev")
-        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.Previous
+        mpris2_dbus_player_do Previous
         ;;
     "getTitle")
-        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'Metadata'|egrep -A 1 "title"|egrep -v "title"|cut -b 44-|cut -d '"' -f 1|egrep -v ^$
+        mpris2_dbus_get_player_property 'Metadata' | \
+          egrep -A 1 "title" | \
+          egrep -v "title" | \
+          cut -b 44- | \
+          cut -d '"' -f 1 | \
+          egrep -v ^$
         ;;
     "getArtist")
-        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'Metadata'|egrep -A 2 "artist"|egrep -v "artist"|egrep -v "array"|cut -b 27-|cut -d '"' -f 1|egrep -v ^$
+        mpris2_dbus_get_player_property 'Metadata' | \
+          -A 2 "artist" | \
+          egrep -v "artist" | \
+          egrep -v "array" | \
+          cut -b 27- | \
+          cut -d '"' -f 1 | \
+          egrep -v ^$
         ;;
     "getAlbum")
-        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'Metadata'|egrep -A 2 "album"|egrep -v "album"|egrep -v "array"|cut -b 44-|cut -d '"' -f 1|egrep -v ^$
+        mpris2_dbus_get_player_property 'Metadata' | \
+          egrep -A 2 "album" | \
+          egrep -v "album" | \
+          egrep -v "array" | \
+          cut -b 44- | \
+          cut -d '"' -f 1 | \
+          egrep -v ^$
         ;;
     "getStatus")
-        dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'PlaybackStatus'|grep 'string "[^"]*"'|sed 's/.*"\(.*\)"[^"]*$/\1/'
+        mpris_dbus_get_player_property 'PlaybackStatus' | \
+          grep 'string "[^"]*"' | \
+          sed 's/.*"\(.*\)"[^"]*$/\1/'
         ;;
     *)
         echo "Unknown command: " $1
-- 
cgit 


From db70d254688fbeca119ca29e4968513df07bd34b Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 5 Nov 2021 13:15:37 -0600
Subject: Add my own xmobar-weather perl script.

The builtin xmobar weather is not feature rich enough. My new script
will change icons depending on the time of day.
---
 extras/HOME/.xmobarrc              | 17 +-------
 extras/HOME/.xmonad/xmobar-weather | 86 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 88 insertions(+), 15 deletions(-)
 create mode 100755 extras/HOME/.xmonad/xmobar-weather

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index 52798af..90141e7 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -31,7 +31,7 @@ Config
       \</fc><fc=#a0a0a0> %date%</fc><fc=#404040> │ \
       \</fc>%StdinReader%}<fn=6><fc=#909090>%time%</fc></fn>\
       \{ %cpu% %memory% <fc=#404040>\
-      \│</fc> %KLMO% <fc=#404040>│\
+      \│</fc> %weather% <fc=#404040>│\
       \</fc> <fc=#a0a0a0>%mpris2%</fc> <fc=#404040>│ \
       \</fc>%bluetooth%%bat% "
    , commands = [
@@ -56,23 +56,10 @@ Config
          "--normal", "#88ff88",
          "--high", "#ff8888"
        ] 10,
-       Run WeatherX "KLMO"
-             [ ("clear", "<fc=#ddcf04>")
-             , ("sunny", "<fc=#ddcf04>")
-             , ("mostly clear", "<fc=#00a3c4>")
-             , ("mostly sunny", "<fc=#ddcf04>")
-             , ("partly sunny", "<fc=#ddcf04>")
-             , ("fair", "<fc=#a0a0a0>🌑")
-             , ("cloudy","<fc=#a0a0a0>摒")
-             , ("overcast","<fc=#808080>")
-             , ("partly cloudy", "<fc=#a0a0a0>杖")
-             , ("mostly cloudy", "<fc=#808080>")
-             , ("considerable cloudiness", "<fc=#a0a0a0>ﭽ")]
-             ["--template", "<skyConditionS></fc><fn=3><fc=#a0a0a0>   \
-             \<tempF>°F</fc></fn>"] 360000,
        Run Mpris2 "spotify" [
            "-t", "<fc=#1aa54b></fc>  <fn=3><title></fn>",
            "--nastring", "<fc=#404040> </fc>"] 20,
+       Run Com ".xmonad/xmobar-weather" [] "weather" 9000,
        Run Com ".xmonad/xmobar-logo" [] "logo" 0,
        Run Com "uname" ["-r"] "uname" 0,
        Run Com ".xmonad/xmobar-bluetooth" [] "bluetooth" 50,
diff --git a/extras/HOME/.xmonad/xmobar-weather b/extras/HOME/.xmonad/xmobar-weather
new file mode 100755
index 0000000..bf84870
--- /dev/null
+++ b/extras/HOME/.xmonad/xmobar-weather
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+
+use LWP::Simple;
+use Time::Local;
+use POSIX;
+
+$content = get(
+  "https://api.sunrise-sunset.org/json?lat=40.1672117&lng=-105.1019286&formatted=0");
+
+die "Unable to get sunrise/sunset data" unless defined $content;
+
+$sunrise_str=$content;
+$sunset_str=$content;
+$sunrise_str =~ s#.*"sunrise":"([^"]*)".*#\1#;
+$sunset_str =~ s#.*"sunset":"([^"]*)".*#\1#;
+$current_str=strftime "%Y-%m-%dT%H:%M:%S+00:00", gmtime();
+
+$content = get(
+  "https://tgftp.nws.noaa.gov/data/observations/metar/decoded/KLMO.TXT");
+
+die "Unable to get weather data" unless defined $content;
+
+$sky_conditions = $content;
+$sky_conditions =~ s#.*Sky conditions:\s+([^\n]+).*#\1#ims;
+$sky_conditions =~ s#\s#_#g;
+
+$wind = $content;
+$wind =~ s#.*Wind:\s+([^\n]+).*#\1#ims;
+($wind_direction, $wind_speed) =
+    ($wind =~ m/from the ([A-Z]+).*at (\d+) MPH.*/g);
+
+
+$temp = $content;
+$temp =~ s#.*Temperature:\s+(-?[0-9.]+) F.*#\1#ims;
+
+if ($current_str gt $sunrise_str and $current_str lt $sunset_str) {
+  $is_day = 1;
+} else {
+  $is_day = 0;
+}
+
+%directions = (
+  NE => "↙",
+  SE => "↖",
+  NW => "↘",
+  SW => "↗",
+  N => "↓",
+  S => "↑",
+  W => "→",
+  E => "←" );
+
+$dir=%directions{$wind_direction};
+
+%conditions_day = (
+  clear => "<fc=#ddcf04>",
+  sunny => "<fc=#ddcf04>",
+  mostly_clear => "<fc=#00a3c4>",
+  mostly_sunny => "<fc=#ddcf04>",
+  partly_sunny => "<fc=#ddcf04>",
+  fair => "<fc=#a0a0a0>🌑",
+  cloudy =>"<fc=#a0a0a0>摒",
+  overcast =>"<fc=#808080>",
+  partly_cloudy => "<fc=#a0a0a0>杖",
+  mostly_cloudy => "<fc=#808080>",
+  considerable_cloudiness => "<fc=#a0a0a0>ﭽ" );
+
+%conditions_night = (
+  clear => "<fc=#00a3c4>",
+  sunny => "<fc=#00a3c4>",
+  mostly_clear => "<fc=#00a3c4>",
+  mostly_sunny => "<fc=#00a3c4>",
+  partly_sunny => "<fc=#00a3c4>",
+  fair => "<fc=#808080>🌑",
+  cloudy =>"<fc=#808080>摒",
+  overcast =>"<fc=#404040>",
+  partly_cloudy => "<fc=#a0a0a0>",
+  mostly_cloudy => "<fc=#808080>",
+  considerable_cloudiness => "<fc=#a0a0a0>ﭽ" );
+
+if ($is_day) {
+  $conditions = %conditions_day{$sky_conditions};
+} else {
+  $conditions = %conditions_night{$sky_conditions};  
+}
+
+printf("<fc=#a0a0a0>$dir <fn=3>${wind_speed}mph</fn></fc> $conditions</fc><fn=3>   <fc=#a0a0a0>%.0f°F</fc></fn>\n", $temp);
-- 
cgit 


From 168b02cfea52164379c59ae77e44d34ce8409974 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 5 Nov 2021 16:20:28 -0600
Subject: Add new Corner layout to keep the master window in the corner.

As a part of this add the Rotatable layout modifier that can rotate the
windows 90 degrees using Shift+Mod+r.
---
 src/Internal/CornerLayout.hs | 58 ++++++++++++++++++++++++++++++++++++++++++++
 src/Internal/Keys.hs         |  2 +-
 src/Internal/Layout.hs       | 58 +++++++++++++++++++++++++++++++++++---------
 3 files changed, 105 insertions(+), 13 deletions(-)
 create mode 100644 src/Internal/CornerLayout.hs

diff --git a/src/Internal/CornerLayout.hs b/src/Internal/CornerLayout.hs
new file mode 100644
index 0000000..10fbe5b
--- /dev/null
+++ b/src/Internal/CornerLayout.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+-- Creates a layout, the "corner layout" that keeps the master window in the
+-- corner and the other windows go around it.
+module Internal.CornerLayout where
+
+import Data.Typeable (Typeable)
+import XMonad (LayoutClass(..), Rectangle(..), Resize(..), fromMessage)
+import qualified XMonad.StackSet as S
+
+data Corner a = Corner Rational Rational
+  deriving (Show, Typeable, Read)
+
+instance LayoutClass Corner a where
+  pureLayout (Corner frac _) screen@(Rectangle x y w h) ss =
+    let w' = floor $ fromIntegral w * frac
+        h' = floor $ fromIntegral h * frac
+        corner = Rectangle 0 0 w' h'
+        vertRect = Rectangle (fromIntegral w') 0 (w - w') h
+        horizRect = Rectangle 0 (fromIntegral h') w' (h - h')
+        ws = S.integrate ss
+
+        vn = (length ws - 1) `div` 2
+        hn = (length ws - 1) - vn
+      in 
+        case ws of
+          [a] -> [(a, screen)]
+          [a, b] -> [
+            (a, Rectangle x y w' h),
+            (b, Rectangle (x + fromIntegral w') y (w - w') h)]
+          _ -> 
+            zip ws $ map (
+                \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h) $ 
+              corner :
+                (splitVert vertRect vn) ++
+                (splitHoriz horizRect hn)
+
+  pureMessage (Corner frac delta) m = fmap resize (fromMessage m)
+    where
+      resize Shrink = Corner (frac - delta) delta
+      resize Expand = Corner (frac + delta) delta
+
+splitVert :: Rectangle -> Int -> [Rectangle]
+splitVert (Rectangle x y w h) i' =
+  map
+    (\i -> Rectangle x (y + fromIntegral (step * i)) w step)
+    [0 .. i - 1]
+  where
+    i = fromIntegral i'
+    step = h `div` i
+
+splitHoriz :: Rectangle -> Int -> [Rectangle]
+splitHoriz (Rectangle x y w h) i' =
+  map
+    (\i -> Rectangle (x + fromIntegral (step * i)) y step h)
+    [0 .. i - 1]
+  where
+    step = w `div` i
+    i = fromIntegral i'
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index bc27750..d02e1f4 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -90,7 +90,7 @@ newKeys markContext =
         , ((modm              , xK_Return),     windows W.swapMaster)
         , ((modm,               xK_j),          sendMessage Shrink)
         , ((modm,               xK_k),          sendMessage Expand)
-        , ((modm .|. shiftMask, xK_r),          (void $ spawn "gmrun"))
+        , ((modm .|. shiftMask, xK_r),          sendMessage DoRotate)
         , ((modm .|. mod1Mask,  xK_l),          (void $ spawn "xsecurelock"))
         , ((modm .|. mod1Mask,  xK_s),          (void $ spawn "sudo systemctl suspend && xsecurelock"))
         , ((modm .|. shiftMask, xK_c),          kill)
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index cb8c19b..632e912 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
 module Internal.Layout where 
 
+import Internal.CornerLayout (Corner(..))
 import Control.Arrow (second)
 import XMonad.Hooks.ManageDocks
 import XMonad.Layout.Circle
@@ -24,18 +25,20 @@ import qualified XMonad.StackSet as W
 
 myLayout =
   avoidStruts $ 
-    ModifiedLayout (Zoomable False 0.05 0.05) $
-      ModifiedLayout (Flippable False) $
-        ModifiedLayout (HFlippable False) $
-          spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
-            spiral (6/7) |||
-            ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |||
-            ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |||
-            Full |||
-            Grid |||
-            Dishes 2 (1/6) |||
-            (MosaicAlt M.empty :: MosaicAlt Window) |||
-            (D.Dwindle D.R D.CW 1.5 1.1)
+    spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
+      ModifiedLayout (Zoomable False 0.05 0.05) $
+        ModifiedLayout (Flippable False) $
+          ModifiedLayout (HFlippable False) $
+            ModifiedLayout (Rotateable False) $
+              spiral (6/7) |||
+              (Corner (3/4) (3/100) :: Corner Window) |||
+              ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |||
+              ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |||
+              Full |||
+              Grid |||
+              Dishes 2 (1/6) |||
+              (MosaicAlt M.empty :: MosaicAlt Window) |||
+              (D.Dwindle D.R D.CW 1.5 1.1)
 
 data ModifyDescription m l a = ModifyDescription m (l a)
   deriving (Show, Read)
@@ -90,10 +93,15 @@ data Flippable a = Flippable Bool -- True if flipped
 data HFlippable a = HFlippable Bool -- True if flipped
   deriving (Show, Read)
 
+data Rotateable a = Rotateable Bool -- True if rotated
+  deriving (Show, Read)
+
 data FlipLayout = FlipLayout deriving (Typeable)
 
 data HFlipLayout = HFlipLayout deriving (Typeable)
 
+data DoRotate = DoRotate deriving (Typeable)
+
 data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
   deriving (Show, Read)
 
@@ -111,6 +119,32 @@ instance Message HFlipLayout where
 
 instance Message ZoomModifier where
 
+instance Message DoRotate where
+
+instance (Eq a) => LayoutModifier Rotateable a where
+  pureModifier (Rotateable rotate) (Rectangle _ _ sw sh) _ returned =
+    if rotate
+      then (map (second (scaleRect . mirrorRect)) returned, Nothing)
+      else (returned, Nothing)
+    where
+      scaleRect (Rectangle x y w h) = 
+        Rectangle (x * fi sw `div` fi sh)
+                  (y * fi sh `div` fi sw)
+                  (w * sw `div` sh)
+                  (h * sh `div` sw)
+
+      fi = fromIntegral
+
+
+  pureMess (Rotateable rot) mess =
+    fmap (\(DoRotate) -> Rotateable (not rot)) (fromMessage mess)
+
+  modifyDescription (Rotateable rot) underlying =
+    let descr = description underlying in
+      if rot
+        then descr ++ " Rotated"
+        else descr
+
 instance (Eq a) => LayoutModifier Flippable a where
   pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
     if flip 
-- 
cgit 


From 62eccced2d4a756b719dae9c25dc3859360608c2 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 5 Nov 2021 16:23:46 -0600
Subject: Fix more things with the weather.

---
 extras/HOME/.config/compton.conf   |  4 ++--
 extras/HOME/.xmobarrc              |  7 ++++---
 extras/HOME/.xmonad/xmobar-weather | 35 +++++++++++++++++++++++++----------
 3 files changed, 31 insertions(+), 15 deletions(-)

diff --git a/extras/HOME/.config/compton.conf b/extras/HOME/.config/compton.conf
index 828d949..c669100 100644
--- a/extras/HOME/.config/compton.conf
+++ b/extras/HOME/.config/compton.conf
@@ -13,8 +13,8 @@ shadow-red = 0.0;
 shadow-green = 0.0;
 shadow-blue = 0.0;
 
-inactive-dim=0.1
-inactive-opacity=0.99
+inactive-dim=0.2
+inactive-opacity=0.98
 
 shadow-exclude = [
   # From the Ubuntu forums link ('screaminj3sus')
diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index 90141e7..e2a3e9f 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -1,12 +1,13 @@
 Config
-   { font = "xft:Monofur Nerd Font:size=15"
+   { font = "xft:Monofur Nerd Font:size=12"
    , additionalFonts = [
        "xft:Monofur bold Nerd Font:style=bold:size=12",
        "xft:Monofur Nerd Font:size=9",
        "xft:Monofur Nerd Font:size=9",
        "xft:Monofur Nerd Font:size=6",
        "xft:Monofur bold Nerd Font:size=15",
-       "xft:Monofur Nerd Font:style=bold:size=10"
+       "xft:Monofur Nerd Font:style=bold:size=10",
+       "xft:Noto Sans Mono CJK JP:style=bold:size=10"
        ]
    , borderColor = "black"
    , border = FullBM -1
@@ -14,7 +15,7 @@ Config
    , bgColor = "#000000"
    , fgColor = "white"
    , alpha = 220                 -- default: 255
-   , position = TopSize L 100 40
+   , position = TopSize L 100 50
    , textOffset = -1             -- default: -1
    , iconOffset = -1             -- default: -1
    , lowerOnStart = True
diff --git a/extras/HOME/.xmonad/xmobar-weather b/extras/HOME/.xmonad/xmobar-weather
index bf84870..d9dc88b 100755
--- a/extras/HOME/.xmonad/xmobar-weather
+++ b/extras/HOME/.xmonad/xmobar-weather
@@ -4,8 +4,15 @@ use LWP::Simple;
 use Time::Local;
 use POSIX;
 
+$content = get("https://ipinfo.io");
+
+die "Unable to get IP info" unless defined $content;
+
+($city, $lat, $lon) =
+  ($content =~ m/.*"city":\s+"([^"]+)".*"loc":\s+"(-?[0-9.]+),(-?[0-9.]+).*"/ims);
+
 $content = get(
-  "https://api.sunrise-sunset.org/json?lat=40.1672117&lng=-105.1019286&formatted=0");
+  "https://api.sunrise-sunset.org/json?lat=$lat&lng=$lon&formatted=0");
 
 die "Unable to get sunrise/sunset data" unless defined $content;
 
@@ -40,14 +47,22 @@ if ($current_str gt $sunrise_str and $current_str lt $sunset_str) {
 }
 
 %directions = (
-  NE => "↙",
-  SE => "↖",
-  NW => "↘",
-  SW => "↗",
-  N => "↓",
-  S => "↑",
-  W => "→",
-  E => "←" );
+  NE => "",
+  NNE => "",
+  ENE => "",
+  SE => "",
+  SSE => "",
+  ESE => "",
+  NW => "",
+  NNW => "",
+  WNW => "",
+  SW => "",
+  SSW => "",
+  WSW => "",
+  N => "",
+  S => "",
+  W => "",
+  E => "" );
 
 $dir=%directions{$wind_direction};
 
@@ -83,4 +98,4 @@ if ($is_day) {
   $conditions = %conditions_night{$sky_conditions};  
 }
 
-printf("<fc=#a0a0a0>$dir <fn=3>${wind_speed}mph</fn></fc> $conditions</fc><fn=3>   <fc=#a0a0a0>%.0f°F</fc></fn>\n", $temp);
+printf("<fc=#a0a0a0><fn=3>$city</fn> <fn=3>$dir</fn> <fn=3>${wind_speed}</fn></fc> $conditions</fc><fn=3>   <fc=#a0a0a0>%.0f°F</fc></fn>\n", $temp);
-- 
cgit 


From efef2ad31b0a1ce7ebcc2a635114f5a1d3f82ec8 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 8 Nov 2021 01:02:01 -0700
Subject: minor fixes and whatnot

---
 extras/HOME/.xmobarrc              |  4 ++--
 extras/HOME/.xmonad/xmobar-weather |  9 +++------
 src/Internal/Layout.hs             | 19 ++++++++++---------
 src/Main.hs                        |  2 +-
 stack.yaml                         |  2 +-
 5 files changed, 17 insertions(+), 19 deletions(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index e2a3e9f..916ba21 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -2,7 +2,7 @@ Config
    { font = "xft:Monofur Nerd Font:size=12"
    , additionalFonts = [
        "xft:Monofur bold Nerd Font:style=bold:size=12",
-       "xft:Monofur Nerd Font:size=9",
+       "xft:Monofur Bold Nerd Font:size=9",
        "xft:Monofur Nerd Font:size=9",
        "xft:Monofur Nerd Font:size=6",
        "xft:Monofur bold Nerd Font:size=15",
@@ -30,7 +30,7 @@ Config
    , template =
       " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc><fc=#404040> │\
       \</fc><fc=#a0a0a0> %date%</fc><fc=#404040> │ \
-      \</fc>%StdinReader%}<fn=6><fc=#909090>%time%</fc></fn>\
+      \</fc>%StdinReader%}<fn=2><fc=#606060>%time%</fc></fn>\
       \{ %cpu% %memory% <fc=#404040>\
       \│</fc> %weather% <fc=#404040>│\
       \</fc> <fc=#a0a0a0>%mpris2%</fc> <fc=#404040>│ \
diff --git a/extras/HOME/.xmonad/xmobar-weather b/extras/HOME/.xmonad/xmobar-weather
index d9dc88b..e8ce28e 100755
--- a/extras/HOME/.xmonad/xmobar-weather
+++ b/extras/HOME/.xmonad/xmobar-weather
@@ -1,18 +1,16 @@
 #!/usr/bin/perl
 
-use LWP::Simple;
 use Time::Local;
 use POSIX;
 
-$content = get("https://ipinfo.io");
+$content = `curl https://ipinfo.io`;
 
 die "Unable to get IP info" unless defined $content;
 
 ($city, $lat, $lon) =
   ($content =~ m/.*"city":\s+"([^"]+)".*"loc":\s+"(-?[0-9.]+),(-?[0-9.]+).*"/ims);
 
-$content = get(
-  "https://api.sunrise-sunset.org/json?lat=$lat&lng=$lon&formatted=0");
+$content = `curl "https://api.sunrise-sunset.org/json?lat=$lat&lng=$lon&formatted=0"`;
 
 die "Unable to get sunrise/sunset data" unless defined $content;
 
@@ -22,8 +20,7 @@ $sunrise_str =~ s#.*"sunrise":"([^"]*)".*#\1#;
 $sunset_str =~ s#.*"sunset":"([^"]*)".*#\1#;
 $current_str=strftime "%Y-%m-%dT%H:%M:%S+00:00", gmtime();
 
-$content = get(
-  "https://tgftp.nws.noaa.gov/data/observations/metar/decoded/KLMO.TXT");
+$content = `curl "https://tgftp.nws.noaa.gov/data/observations/metar/decoded/KLMO.TXT"`;
 
 die "Unable to get weather data" unless defined $content;
 
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index 632e912..4166b8f 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -38,7 +38,7 @@ myLayout =
               Grid |||
               Dishes 2 (1/6) |||
               (MosaicAlt M.empty :: MosaicAlt Window) |||
-              (D.Dwindle D.R D.CW 1.5 1.1)
+              D.Dwindle D.R D.CW 1.5 1.1
 
 data ModifyDescription m l a = ModifyDescription m (l a)
   deriving (Show, Read)
@@ -82,18 +82,19 @@ instance DescriptionModifier TallDescriptionModifier Tall where
 
 instance DescriptionModifier ThreeColDescMod ThreeCol where
   newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
+  newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
 
 data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
 
 instance Message ResizeZoom where
 
-data Flippable a = Flippable Bool -- True if flipped
+newtype Flippable a = Flippable Bool -- True if flipped
   deriving (Show, Read)
 
-data HFlippable a = HFlippable Bool -- True if flipped
+newtype HFlippable a = HFlippable Bool -- True if flipped
   deriving (Show, Read)
 
-data Rotateable a = Rotateable Bool -- True if rotated
+newtype Rotateable a = Rotateable Bool -- True if rotated
   deriving (Show, Read)
 
 data FlipLayout = FlipLayout deriving (Typeable)
@@ -137,7 +138,7 @@ instance (Eq a) => LayoutModifier Rotateable a where
 
 
   pureMess (Rotateable rot) mess =
-    fmap (\(DoRotate) -> Rotateable (not rot)) (fromMessage mess)
+    fmap (\DoRotate -> Rotateable (not rot)) (fromMessage mess)
 
   modifyDescription (Rotateable rot) underlying =
     let descr = description underlying in
@@ -194,17 +195,17 @@ instance (Eq a) => LayoutModifier Zoomable a where
             (zoomed, rest) = partition ((==focused) . Just . fst) returned
          in case zoomed of
               [] -> return (rest, Nothing)
-              ((fwin, _):_) ->  return $ ((fwin, Rectangle (x + wp) (y + hp) (w - fromIntegral (wp * 2)) (h - fromIntegral (hp * 2))) : rest, Nothing)
+              ((fwin, _):_) ->  return ((fwin, Rectangle (x + wp) (y + hp) (w - fromIntegral (wp * 2)) (h - fromIntegral (hp * 2))) : rest, Nothing)
 
       else return (returned, Nothing)
     where
-      wp = floor $ (fromIntegral w) * ws
-      hp = floor $ (fromIntegral h) * hs
+      wp = floor $ fromIntegral w * ws
+      hp = floor $ fromIntegral h * hs
 
   handleMessOrMaybeModifyIt self@(Zoomable showing sw sh) mess =
     return $
       (handleResize <$> fromMessage mess)
-        <|> ((Left . handleZoom) <$> fromMessage mess)
+        <|> (Left . handleZoom <$> fromMessage mess)
       where
         handleResize r =
           if showing
diff --git a/src/Main.hs b/src/Main.hs
index 0d49e21..741e6dc 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -26,7 +26,7 @@ main = do
        { terminal    = "alacritty"
        , modMask     = mod3Mask
        , borderWidth = 2
-       , keys = \config -> mempty
+       , keys = const mempty
        , focusedBorderColor = "#ff6c00"
        , normalBorderColor = "#404040"
        , layoutHook = myLayout
diff --git a/stack.yaml b/stack.yaml
index 81e3e0b..e592062 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-18.13
+resolver: lts-18.15
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
-- 
cgit 


From 278cf20058ad788676a7abe82a65083f41f84e17 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 8 Nov 2021 09:43:34 -0700
Subject: Fix calculating position for rotation layout modifier

---
 src/Internal/Layout.hs | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index 632e912..f28ae4d 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -106,7 +106,7 @@ data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused
   deriving (Show, Read)
 
 -- Toggles if the current window should be zoomed or not. Set the boolean
--- to set the zoom.
+-- to set the zoom.mhar
 data ZoomModifier =
        ToggleZoom |
        Zoom |
@@ -122,11 +122,14 @@ instance Message ZoomModifier where
 instance Message DoRotate where
 
 instance (Eq a) => LayoutModifier Rotateable a where
-  pureModifier (Rotateable rotate) (Rectangle _ _ sw sh) _ returned =
+  pureModifier (Rotateable rotate) (Rectangle x' y' sw sh) _ returned =
     if rotate
-      then (map (second (scaleRect . mirrorRect)) returned, Nothing)
+      then (map (second (unzero . scaleRect . mirrorRect . zero)) returned, Nothing)
       else (returned, Nothing)
     where
+      zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
+      unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h
+
       scaleRect (Rectangle x y w h) = 
         Rectangle (x * fi sw `div` fi sh)
                   (y * fi sh `div` fi sw)
-- 
cgit 


From a6ff366f93d8123e5b897da6fbc74bfac64c1b2f Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 10 Nov 2021 10:36:21 -0700
Subject: Minor changes to xmobar. C-S-q now restarts xmonad.

---
 extras/HOME/.xmobarrc | 4 ++--
 src/Internal/Keys.hs  | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index 916ba21..a2b8a6e 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -5,7 +5,7 @@ Config
        "xft:Monofur Bold Nerd Font:size=9",
        "xft:Monofur Nerd Font:size=9",
        "xft:Monofur Nerd Font:size=6",
-       "xft:Monofur bold Nerd Font:size=15",
+       "xft:Monofur bold Nerd Font:size=20",
        "xft:Monofur Nerd Font:style=bold:size=10",
        "xft:Noto Sans Mono CJK JP:style=bold:size=10"
        ]
@@ -15,7 +15,7 @@ Config
    , bgColor = "#000000"
    , fgColor = "white"
    , alpha = 220                 -- default: 255
-   , position = TopSize L 100 50
+   , position = TopSize L 100 40
    , textOffset = -1             -- default: -1
    , iconOffset = -1             -- default: -1
    , lowerOnStart = True
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index d02e1f4..64a7506 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -140,7 +140,7 @@ newKeys markContext =
         , ((modm, xK_n), relativeWorkspaceShift next)
         , ((modm, xK_p), relativeWorkspaceShift prev)
 
-        , ((modm, xK_q), spawn "xmonad --recompile && xmonad --restart")
+        , ((modm .|. shiftMask, xK_q), spawn "xmonad --recompile && xmonad --restart")
         , ((modm, xK_z), sendMessage ToggleZoom)
 
         , ((modm, xK_x), spawn "bluetooth-select.sh")
-- 
cgit 


From ebc4b4be4a5a361c2b4376ab2c1b92b052b61b8a Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 10 Nov 2021 10:54:06 -0700
Subject: Upgrade to XMonad v0.17

---
 package.yaml            |  4 ++--
 src/Internal/Layout.hs  |  2 +-
 src/Internal/Marking.hs | 11 +++++++----
 stack.yaml              |  4 ++++
 4 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/package.yaml b/package.yaml
index bc8e530..e9e59d9 100644
--- a/package.yaml
+++ b/package.yaml
@@ -8,8 +8,8 @@ executables:
 
 dependencies:
   - base >= 4.0.0
-  - xmonad
-  - xmonad-contrib
+  - xmonad >= 0.17
+  - xmonad-contrib >= 0.17
   - directory
   - filepath
   - process
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index 8903fed..fed0fd9 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -52,7 +52,7 @@ data ThreeColDescMod = ThreeColDescMod
 class DescriptionModifier m l where
   newDescription :: m -> l a -> String -> String
 
-instance (Show m, DescriptionModifier m l, LayoutClass l a) => LayoutClass (ModifyDescription m l) a where
+instance (Typeable m, Show m, DescriptionModifier m l, LayoutClass l a) => LayoutClass (ModifyDescription m l) a where
   runLayout (W.Workspace t (ModifyDescription m l) a) rect = do
     (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
     return (rects, fmap (ModifyDescription m) maybeNewLayout)
diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index 606b55e..f9083d2 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -9,6 +9,7 @@ import Data.Map (Map)
 import System.FilePath
 import System.IO
 import Control.Exception
+import System.Environment
 
 import qualified Data.Map as Map
 
@@ -26,16 +27,18 @@ data MarkContext = MarkContext (IORef MarkState)
 
 readMarkState :: IO MarkState
 readMarkState = do
-  dir <- getXMonadDir
-  let markstate = dir </> "markstate"
+  -- TODO(rahm) The mark state should use the extensible state constructs in the
+  -- XState rather than relying on IO.
+  dir <- getEnv "HOME"
+  let markstate = dir </> ".xmonad" </> "markstate"
   catch
     (read <$> (hGetContents =<< openFile markstate ReadMode))
     (\(e :: IOError) -> return (MarkState mempty Nothing))
 
 saveMarkState :: MarkState -> X ()
 saveMarkState ms = do
-  dir <- getXMonadDir
-  let markstate = dir </> "markstate"
+  dir <- io $ getEnv "HOME"
+  let markstate = dir </> ".xmonad" </> "markstate"
   liftIO $ writeFile markstate (show ms)
 
 
diff --git a/stack.yaml b/stack.yaml
index e592062..9c394eb 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -71,3 +71,7 @@ packages:
 #
 # Allow a newer minor version of GHC than the snapshot specifies
 # compiler-check: newer-minor
+
+extra-deps:
+  - xmonad-0.17.0@sha256:fc90c8fa647390c68c902912a5a7417f04025dfe72f7de51b248217f7ca0d484,5533
+  - xmonad-contrib-0.17.0@sha256:defd04a9ca0e031eb7280b734ccd6d6b73f757babfe4a561a7ff718e75211749,20357
-- 
cgit 


From 215d1d9f84dc3f9f5bdd1f87f340336bbf931bac Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 10 Nov 2021 11:13:01 -0700
Subject: Change the next-prev keybindings to cycle through only hidden
 workspaces.

This keeps the other monitors stable, which I prefer.
---
 src/Internal/Lib.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index 3ba1eca..08ba2b7 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -35,6 +35,7 @@ instance XPrompt WinPrompt where
     commandToComplete _ = id
 
 data WorkspaceState = Current | Hidden | Visible
+  deriving (Ord, Eq, Enum)
 
 -- Returns all the workspaces that are either visible, current or Hidden but
 -- have windows and that workspace's state.
@@ -111,7 +112,7 @@ getString = runQuery $ do
 relativeWorkspaceShift :: Selector -> X ()
 relativeWorkspaceShift (Selector selector) = do
   windows $ \ss ->
-    let tags = sort $ (tag . snd <$> getPopulatedWorkspaces ss)
+    let tags = sort $ (tag . snd  <$> filter (\x -> fst x /= Visible ) (getPopulatedWorkspaces ss))
         from = tag $ workspace $ current ss
         to = selector from tags
     in greedyView to ss
-- 
cgit 


From 01413256aeccdbfbbea1c10c2688322af8c8dc54 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 12 Nov 2021 11:06:37 -0700
Subject: Use XMonad's EtensibleState

Change the Marking to use XMonad's extensible state rather than
hand-rolling it myself. Allowed me to delete the XPlus monad.
---
 src/Internal/Keys.hs    | 55 ++++++++++++++++------------------
 src/Internal/Lib.hs     | 67 ++++++++++++++---------------------------
 src/Internal/Marking.hs | 80 +++++++++++++++++--------------------------------
 src/Internal/XPlus.hs   | 53 --------------------------------
 4 files changed, 75 insertions(+), 180 deletions(-)
 delete mode 100644 src/Internal/XPlus.hs

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 64a7506..591861f 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -7,7 +7,6 @@ import Graphics.X11.ExtraTypes.XorgDefault
 import System.Process
 import XMonad.Util.Ungrab
 import XMonad.Layout.Spacing
-import Internal.XPlus
 import Data.Maybe (isJust)
 import Debug.Trace
 import Control.Applicative
@@ -40,14 +39,13 @@ import Internal.PassMenu
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 
 applyKeys :: XConfig l -> IO (XConfig l)
-applyKeys config@(XConfig {modMask = modm}) =
-  withNewMarkContext $ \markContext -> do
-    ks <- newKeys markContext
-    ms <- newMouse markContext
+applyKeys config@(XConfig {modMask = modm}) = do
+    ks <- newKeys
+    ms <- newMouse
     return $ config { keys = ks, mouseBindings = ms }
 
-newMouse :: MarkContext -> IO (XConfig l -> Map (KeyMask, Button) (Window -> X ()))
-newMouse markContext =
+newMouse :: IO (XConfig l -> Map (KeyMask, Button) (Window -> X ()))
+newMouse =
     return $ \config@(XConfig {modMask = modm}) ->
       Map.fromList [
         ((modm, button1), \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster)
@@ -71,8 +69,8 @@ modifyWindowBorder :: Integer -> SpacingModifier
 modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
   (Border (a + i) (b + i) (c + i) (d + i))
 
-newKeys :: MarkContext -> IO (KeyMap l)
-newKeys markContext =
+newKeys :: IO (KeyMap l)
+newKeys =
     return $ \config@(XConfig {modMask = modm}) ->
       Map.fromList
         [ ((modm,               xK_F12),        (void $ spawn "spotify-control next"))
@@ -100,33 +98,30 @@ newKeys markContext =
         , ((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_m),          (submap $ mapAlpha modm markCurrentWindow))
+        , ((modm,               xK_w),          windowJump)
         , ((modm,               xK_space),      sendMessage NextLayout)
         , ((modm .|. shiftMask, xK_space),      sendMessage FirstLayout)
         , ((modm,               xK_apostrophe), (submap $
               Map.insert
                 (modm, xK_apostrophe)
-                (jumpToLast markContext)
-                (mapAlpha modm (jumpToMark markContext))))
+                jumpToLast
+                (mapAlpha modm jumpToMark)))
 
         , ((modm .|. shiftMask, xK_apostrophe), (submap $
               Map.insert
                 (modm .|. shiftMask, xK_apostrophe)
-                (swapWithLastMark markContext)
-                (mapAlpha (modm .|. shiftMask) (swapWithMark markContext))))
+                swapWithLastMark
+                (mapAlpha (modm .|. shiftMask) swapWithMark)))
 
         , ((modm, xK_g), (submap $
-            mapNumbersAndAlpha 0 (
-              runXPlus markContext config . gotoWorkspace)))
+            mapNumbersAndAlpha 0 gotoWorkspace))
 
         , ((modm .|. shiftMask, xK_g), (submap $
-            mapNumbersAndAlpha 0 (
-              runXPlus markContext config . shiftToWorkspace)))
+            mapNumbersAndAlpha 0 shiftToWorkspace))
 
         , ((modm .|. shiftMask .|. mod1Mask, xK_g), (submap $
-            mapNumbersAndAlpha 0 (
-              runXPlus markContext config . swapWorkspace)))
+            mapNumbersAndAlpha 0 swapWorkspace))
 
         , ((modm, xK_minus), sendMessage (IncMasterN (-1)))
         , ((modm, xK_plus), sendMessage (IncMasterN 1))
@@ -149,17 +144,17 @@ newKeys markContext =
         , ((modm, xK_Tab), windows W.focusDown)
         , ((modm .|. shiftMask, xK_Tab), windows W.focusUp)
 
-        , ((modm, xK_a), runXPlus markContext config (withScreen W.view 0))
-        , ((modm, xK_o), runXPlus markContext config (withScreen W.view 1))
-        , ((modm, xK_e), runXPlus markContext config (withScreen W.view 2))
+        , ((modm, xK_a), withScreen W.view 0)
+        , ((modm, xK_o), withScreen W.view 1)
+        , ((modm, xK_e), withScreen W.view 2)
 
-        , ((modm .|. shiftMask, xK_a), runXPlus markContext config (withScreen W.shift 0))
-        , ((modm .|. shiftMask, xK_o), runXPlus markContext config (withScreen W.shift 1))
-        , ((modm .|. shiftMask, xK_e), runXPlus markContext config (withScreen W.shift 2))
+        , ((modm .|. shiftMask, xK_a), withScreen W.shift 0)
+        , ((modm .|. shiftMask, xK_o), withScreen W.shift 1)
+        , ((modm .|. shiftMask, xK_e), withScreen W.shift 2)
 
-        , ((modm .|. mod1Mask, xK_a), runXPlus markContext config (withScreen W.greedyView 0))
-        , ((modm .|. mod1Mask, xK_o), runXPlus markContext config (withScreen W.greedyView 1))
-        , ((modm .|. mod1Mask, xK_e), runXPlus markContext config (withScreen W.greedyView 2))
+        , ((modm .|. mod1Mask, xK_a), withScreen W.greedyView 0)
+        , ((modm .|. mod1Mask, xK_o), withScreen W.greedyView 1)
+        , ((modm .|. mod1Mask, xK_e), withScreen W.greedyView 2)
         , ((modm,              xK_b), sendMessage ToggleStruts)
 
         -- Buttons programmed on my mouse.
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index 08ba2b7..1a1d602 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -15,7 +15,6 @@ import Data.List hiding ((!!))
 import Data.List.Safe ((!!))
 import Data.Maybe
 import Internal.Marking
-import Internal.XPlus
 import Text.Printf
 import XMonad hiding (workspaces, Screen)
 import XMonad.StackSet hiding (filter, focus)
@@ -65,18 +64,16 @@ getHorizontallyOrderedScreens windowSet =
       screens = current windowSet : visible windowSet
 
 
-gotoWorkspace :: WorkspaceName -> XPlus l ()
+gotoWorkspace :: WorkspaceName -> X ()
 gotoWorkspace ch = do
-  mc <- getMarkContext
-  liftXPlus $ do
-    saveLastMark mc
-    windows $ greedyView $ return ch
+  saveLastMark
+  windows $ greedyView $ return ch
 
-shiftToWorkspace :: WorkspaceName -> XPlus l ()
-shiftToWorkspace = liftXPlus . windows . shift . return
+shiftToWorkspace :: WorkspaceName -> X ()
+shiftToWorkspace = windows . shift . return
 
-swapWorkspace :: WorkspaceName -> XPlus l ()
-swapWorkspace toWorkspaceName = liftXPlus $ do
+swapWorkspace :: WorkspaceName -> X ()
+swapWorkspace toWorkspaceName = do
   windows $ \ss -> do
     let fromWorkspace = tag $ workspace $ current ss
         toWorkspace = [toWorkspaceName] in
@@ -128,40 +125,22 @@ prev :: Selector
 prev = Selector $ \a l ->
   let (Selector fn) = next in fn a (reverse l)
 
-withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> XPlus l ()
+withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
 withScreen fn n = do
-  markContext <- getMarkContext
+  windows $ \windowSet ->
+    case (getHorizontallyOrderedScreens windowSet !! n) of
+      Nothing -> windowSet
+      Just screen -> fn (tag $ workspace screen) windowSet
 
-  liftXPlus $
-    windows $ \windowSet ->
-      case (getHorizontallyOrderedScreens windowSet !! n) of
-        Nothing -> windowSet
-        Just screen -> fn (tag $ workspace screen) windowSet
-
-windowJump :: XPlus l ()
+windowJump :: X ()
 windowJump = do
-  markContext <- getMarkContext
-
-  liftXPlus $ do
-    windowTitlesToWinId <- withWindowSet $ \ss ->
-      Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
-
-    windowId <- runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
-
-    case windowId of
-      Nothing -> return ()
-      Just wid -> do
-        saveLastMark markContext
-        focus wid
-    -- mkXPrompt
-    --   WinPrompt
-    --   xpConfig
-    --   (\input -> return $ filter (fuzzyCompletion input) (Map.keys windowTitlesToWinId)) $
-    --   \str -> do
-    --     saveLastMark markContext
-    --     case Map.lookup str windowTitlesToWinId of
-    --       Just w -> focus w
-    --       Nothing ->
-    --         case filter (fuzzyCompletion str) (Map.keys windowTitlesToWinId) of
-    --           [s] -> mapM_ focus (Map.lookup s windowTitlesToWinId)
-    --           _ -> return ()
+  windowTitlesToWinId <- withWindowSet $ \ss ->
+    Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
+
+  windowId <- runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
+
+  case windowId of
+    Nothing -> return ()
+    Just wid -> do
+      saveLastMark
+      focus wid
diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index f9083d2..229ea02 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -11,6 +11,8 @@ import System.IO
 import Control.Exception
 import System.Environment
 
+import qualified XMonad.Util.ExtensibleState as XS
+
 import qualified Data.Map as Map
 
 {- Submodule that handles marking windows so they can be jumped back to. -}
@@ -23,65 +25,38 @@ data MarkState =
   , markLast :: Maybe Window
   } deriving (Read, Show)
 
-data MarkContext = MarkContext (IORef MarkState)
-
-readMarkState :: IO MarkState
-readMarkState = do
-  -- TODO(rahm) The mark state should use the extensible state constructs in the
-  -- XState rather than relying on IO.
-  dir <- getEnv "HOME"
-  let markstate = dir </> ".xmonad" </> "markstate"
-  catch
-    (read <$> (hGetContents =<< openFile markstate ReadMode))
-    (\(e :: IOError) -> return (MarkState mempty Nothing))
-
-saveMarkState :: MarkState -> X ()
-saveMarkState ms = do
-  dir <- io $ getEnv "HOME"
-  let markstate = dir </> ".xmonad" </> "markstate"
-  liftIO $ writeFile markstate (show ms)
-
 
-withNewMarkContext :: (MarkContext -> IO a) -> IO a
-withNewMarkContext fn = do
-  ioref <- newIORef =<< readMarkState
-  fn (MarkContext ioref)
+instance ExtensionClass MarkState where
+  initialValue = MarkState Map.empty Nothing
 
-markCurrentWindow :: MarkContext -> Mark -> X ()
-markCurrentWindow (MarkContext ioref) mark = do
+markCurrentWindow :: Mark -> X ()
+markCurrentWindow mark = do
   withFocused $ \win ->
-    liftIO $
-      modifyIORef ioref $ \state@(MarkState {markStateMap = ms}) ->
+    XS.modify $ \state@(MarkState {markStateMap = ms}) ->
         state {
           markStateMap = Map.insert mark win ms
         }
 
-  saveMarkState =<< liftIO (readIORef ioref)
-
-saveLastMark :: MarkContext -> X ()
-saveLastMark (MarkContext ioref) =
-  withFocused $ \win -> do
-      liftIO $ modifyIORef ioref (\state -> state { markLast = Just win })
+saveLastMark :: X ()
+saveLastMark =
+  withFocused $ \win ->
+      XS.modify $ \state -> state { markLast = Just win }
 
-jumpToLast :: MarkContext -> X ()
-jumpToLast ctx@(MarkContext ioref) = do
-  m <- markLast <$> (liftIO $ readIORef ioref)
-  saveLastMark ctx
+jumpToLast :: X ()
+jumpToLast = do
+  m <- markLast <$> XS.get
+  saveLastMark
   mapM_ focus m
 
-  saveMarkState =<< liftIO (readIORef ioref)
-
-jumpToMark :: MarkContext -> Mark -> X ()
-jumpToMark ctx@(MarkContext ioref) mark = do
-  MarkState {markStateMap = m} <- liftIO $ readIORef ioref
+jumpToMark :: Mark -> X ()
+jumpToMark mark = do
+  MarkState {markStateMap = m} <- XS.get
   case Map.lookup mark m of
     Nothing -> return ()
     Just w -> do
-      saveLastMark ctx
+      saveLastMark
       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
@@ -117,20 +92,19 @@ swapWithFocused winToSwap stackSet =
           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
+swapWithLastMark :: X ()
+swapWithLastMark = do
+  m <- markLast <$> XS.get
+  saveLastMark
 
   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
+swapWithMark :: Mark -> X ()
+swapWithMark mark = do
+  MarkState {markStateMap = m} <- XS.get
+  saveLastMark
 
   case Map.lookup mark m of
     Nothing -> return ()
diff --git a/src/Internal/XPlus.hs b/src/Internal/XPlus.hs
deleted file mode 100644
index c546665..0000000
--- a/src/Internal/XPlus.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-module Internal.XPlus where
-
-import Internal.Marking
-import XMonad
-
--- The X Monad with additional information. Used for configuring the system.
-
-data XPlusState l =
-    XPlusState {
-      markContext :: MarkContext
-    , xConfig :: XConfig l
-    }
-
-data XPlus l a = XPlus (XPlusState l -> X (a, XPlusState l))
-
-instance Functor (XPlus l) where
-  fmap fn (XPlus xfn) =
-    XPlus $ \st -> do
-      (a, b) <- xfn st
-      return (fn a, b)
-
-instance Applicative (XPlus l) where
-  pure = return
-  (<*>) afn aarg = do
-    fn <- afn
-    arg <- aarg
-    return (fn arg)
-
-instance Monad (XPlus l) where
-   -- (>>=) :: XPlus l a -> (a -> XPlus l b) -> XPlus l b
-    (>>=) (XPlus afn) bfn = do
-       XPlus $ \s0 -> do
-         (a, s1) <- afn s0
-         let (XPlus xBFn) = bfn a
-         xBFn s1
-
-    return x = XPlus $ \s -> return (x, s)
-
-getXPlusState :: XPlus l (XPlusState l)
-getXPlusState = XPlus $ \s -> return (s, s)
-
-getXConfig :: XPlus l (XConfig l)
-getXConfig = xConfig <$> getXPlusState
-
-getMarkContext :: XPlus l MarkContext
-getMarkContext = markContext <$> getXPlusState
-
-runXPlus :: MarkContext -> XConfig l -> XPlus l a -> X a
-runXPlus markCtx cfg (XPlus fn) = do
-  fst <$> fn (XPlusState markCtx cfg)
-
-liftXPlus :: X a -> XPlus l a
-liftXPlus xa = XPlus $ \s -> (\a -> (a, s)) <$> xa
-- 
cgit 


From 389950cb75a818f958f0df0b3a43365934a7c07a Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 12 Nov 2021 13:08:24 -0700
Subject: Change swapMaster.

Swap master now swaps the master window with the prior master window if
swapMaster is called while the master window is focused.
---
 package.yaml               |  1 +
 src/Internal/Keys.hs       |  3 ++-
 src/Internal/Marking.hs    | 17 +----------------
 src/Internal/SwapMaster.hs | 41 +++++++++++++++++++++++++++++++++++++++++
 src/Internal/Windows.hs    | 32 ++++++++++++++++++++++++++++++++
 5 files changed, 77 insertions(+), 17 deletions(-)
 create mode 100644 src/Internal/SwapMaster.hs
 create mode 100644 src/Internal/Windows.hs

diff --git a/package.yaml b/package.yaml
index e9e59d9..318a3af 100644
--- a/package.yaml
+++ b/package.yaml
@@ -20,3 +20,4 @@ dependencies:
   - X11
   - split
   - mtl
+  - transformers
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 591861f..3b61dac 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys where
 
+import Internal.SwapMaster (swapMaster)
 import XMonad.Hooks.ManageDocks
 import XMonad.Layout.MosaicAlt
 import Graphics.X11.ExtraTypes.XorgDefault
@@ -85,7 +86,7 @@ newKeys =
         , ((modm .|. shiftMask, xK_l),          windows W.swapDown)
         , ((modm              , xK_f),          sendMessage FlipLayout)
         , ((modm .|. shiftMask, xK_f),          sendMessage HFlipLayout)
-        , ((modm              , xK_Return),     windows W.swapMaster)
+        , ((modm              , xK_Return),     swapMaster)
         , ((modm,               xK_j),          sendMessage Shrink)
         , ((modm,               xK_k),          sendMessage Expand)
         , ((modm .|. shiftMask, xK_r),          sendMessage DoRotate)
diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index 229ea02..fc1c082 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Internal.Marking where
 
+import Internal.Windows (mapWindows)
 import XMonad
 import XMonad.StackSet hiding (focus)
 import Data.IORef
@@ -57,22 +58,6 @@ jumpToMark mark = do
       saveLastMark
       focus w
 
-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
diff --git a/src/Internal/SwapMaster.hs b/src/Internal/SwapMaster.hs
new file mode 100644
index 0000000..c73cbd9
--- /dev/null
+++ b/src/Internal/SwapMaster.hs
@@ -0,0 +1,41 @@
+{- Swap window with the master, but save it. -}
+module Internal.SwapMaster (swapMaster) where
+
+import qualified XMonad.StackSet as W
+
+import Internal.Windows (mapWindows, getMaster, swapWindows)
+import Control.Monad.Trans.Maybe
+import XMonad (Window, ExtensionClass(..), X(..), windows, windowset)
+import Control.Monad (void)
+import Control.Monad.Trans (lift)
+import Data.Maybe (fromMaybe)
+import Control.Monad.State (get)
+
+import qualified XMonad.Util.ExtensibleState as XS
+
+data LastWindow = LastWindow {
+    lastWindow :: (Maybe Window)
+  } deriving (Show, Read)
+
+instance ExtensionClass LastWindow where
+  initialValue = LastWindow Nothing
+
+hoist :: (Monad m) => Maybe a -> MaybeT m a
+hoist = MaybeT . return
+
+swapMaster :: X ()
+swapMaster = void $ runMaybeT $ do
+    ss <- lift $ windowset <$> get
+
+    focused <- hoist $ W.peek ss
+    master <- hoist $ getMaster ss
+
+    if focused == master
+        then do
+          lw <- MaybeT $ lastWindow <$> XS.get
+          lift $ windows (swapWindows focused lw)
+        else lift $ windows (swapWindows focused master)
+
+    lift $ do
+      XS.put (LastWindow $ Just master)
+      windows W.focusMaster
diff --git a/src/Internal/Windows.hs b/src/Internal/Windows.hs
new file mode 100644
index 0000000..0f109b7
--- /dev/null
+++ b/src/Internal/Windows.hs
@@ -0,0 +1,32 @@
+module Internal.Windows where
+
+import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), integrate)
+import Data.Maybe (listToMaybe)
+import qualified Data.Map as Map
+
+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)
+
+getMaster :: StackSet i l a s sd -> Maybe a
+getMaster (StackSet (Screen (Workspace _ _ ss) _ _) _ _ _) =
+  head . integrate <$> ss
+
+swapWindows :: (Ord a) => a -> a -> StackSet i l a s d -> StackSet i l a s d
+swapWindows wa wb = mapWindows $ \w ->
+  case w of
+    _ | w == wa -> wb
+    _ | w == wb -> wa
+    _ -> w
-- 
cgit 


From b286c60f3c46209e61cdb5c46c5c35e2e4ad8ddb Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 15 Nov 2021 16:48:28 -0700
Subject: Change marking to use greedy viewing.

---
 src/Internal/Marking.hs | 13 ++++++++++---
 src/Internal/Windows.hs | 47 +++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 55 insertions(+), 5 deletions(-)

diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index fc1c082..c1234ec 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Internal.Marking where
 
-import Internal.Windows (mapWindows)
+import Internal.Windows (mapWindows, findWindow, getLocationWorkspace)
 import XMonad
 import XMonad.StackSet hiding (focus)
 import Data.IORef
@@ -30,6 +30,13 @@ data MarkState =
 instance ExtensionClass MarkState where
   initialValue = MarkState Map.empty Nothing
 
+greedyFocus :: Window -> X ()
+greedyFocus win = do
+    ws <- withWindowSet $ \ss ->
+            return $ getLocationWorkspace =<< findWindow ss win
+    mapM_ (windows . greedyView . tag) ws
+    focus win
+
 markCurrentWindow :: Mark -> X ()
 markCurrentWindow mark = do
   withFocused $ \win ->
@@ -47,7 +54,7 @@ jumpToLast :: X ()
 jumpToLast = do
   m <- markLast <$> XS.get
   saveLastMark
-  mapM_ focus m
+  mapM_ greedyFocus m
 
 jumpToMark :: Mark -> X ()
 jumpToMark mark = do
@@ -56,7 +63,7 @@ jumpToMark mark = do
     Nothing -> return ()
     Just w -> do
       saveLastMark
-      focus w
+      greedyFocus w
 
 setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
 setFocusedWindow
diff --git a/src/Internal/Windows.hs b/src/Internal/Windows.hs
index 0f109b7..b6f5335 100644
--- a/src/Internal/Windows.hs
+++ b/src/Internal/Windows.hs
@@ -1,7 +1,8 @@
 module Internal.Windows where
 
-import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), integrate)
-import Data.Maybe (listToMaybe)
+import Control.Applicative ((<|>))
+import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), integrate, integrate')
+import Data.Maybe (listToMaybe, catMaybes)
 import qualified Data.Map as Map
 
 mapWindows :: (Ord a, Ord b) => (a -> b) -> StackSet i l a s sd -> StackSet i l b s sd
@@ -30,3 +31,45 @@ swapWindows wa wb = mapWindows $ \w ->
     _ | w == wa -> wb
     _ | w == wb -> wa
     _ -> w
+
+data WindowLocation i l a s sd =
+  OnScreen (Screen i l a s sd) |
+  OnHiddenWorkspace (Workspace i l a) |
+  Floating
+
+getLocationWorkspace :: WindowLocation i l a s sd -> Maybe (Workspace i l a)
+getLocationWorkspace (OnScreen (Screen w _ _)) = Just w
+getLocationWorkspace (OnHiddenWorkspace w) = Just w
+getLocationWorkspace _ = Nothing
+
+workspaceMember :: (Eq a) => Workspace i l a -> a -> Bool
+workspaceMember (Workspace _ _ s) w = w `elem` integrate' s
+
+{- Finds a Window and returns the screen its on and the workspace its on.
+ - Returns nothing if the window doesn't exist. 
+ -
+ - If the window is not a screen Just (Nothing, workspace) is returned.
+ - If the window is a floating window Just (Nothing, Nothing) is returned. -}
+findWindow ::
+    (Eq a) => StackSet i l a s sd -> a -> Maybe (WindowLocation i l a s sd)
+findWindow (StackSet cur vis hid float) win =
+    listToMaybe . catMaybes $
+      map findWindowScreen (cur : vis) ++
+        map findWindowWorkspace hid ++
+          [findWindowFloat]
+
+  where
+    findWindowScreen s@(Screen ws _ _) =
+      if workspaceMember ws win
+        then Just (OnScreen s)
+        else Nothing
+
+    findWindowWorkspace w =
+      if workspaceMember w win
+        then Just (OnHiddenWorkspace w)
+        else Nothing
+
+    findWindowFloat =
+      if win `elem` Map.keys float
+        then Just Floating
+        else Nothing
-- 
cgit 


From ec4bed82680706c055bf2a29616274e61ea9363e Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 16 Nov 2021 22:27:18 -0700
Subject: Some changes to compton

---
 extras/HOME/.config/compton.conf | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/extras/HOME/.config/compton.conf b/extras/HOME/.config/compton.conf
index c669100..0b17b5c 100644
--- a/extras/HOME/.config/compton.conf
+++ b/extras/HOME/.config/compton.conf
@@ -47,3 +47,5 @@ wintypes:
 }
 # shadow-exclude-reg = "x10+0+0";
 # xinerama-shadow-crop = true;
+xrender-sync-fence = true;
+vsync = true;
-- 
cgit 


From b5d09f06709cd5c93cb3d31629655fb87d68ee67 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 22 Nov 2021 10:58:03 -0700
Subject: Add keybindings to

- Copy window to another Workspace.
- Launch a floating terminal.
---
 src/Internal/Keys.hs | 16 ++++++++++++----
 src/Main.hs          |  1 +
 2 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 3b61dac..c3c8db5 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE RankNTypes #-}
-module Internal.Keys where
+module Internal.Keys (applyKeys) where
 
 import Internal.SwapMaster (swapMaster)
 import XMonad.Hooks.ManageDocks
@@ -30,6 +30,10 @@ import XMonad.Prompt.Input
 import XMonad.Prompt.Shell
 import XMonad.Util.CustomKeys
 import XMonad.Util.Scratchpad
+import XMonad.Actions.RotSlaves
+import XMonad.Actions.CopyWindow as CopyWindow
+import XMonad.Actions.SpawnOn as SpawnOn
+
 import qualified Data.Map as Map
 import qualified XMonad.StackSet as W
 
@@ -82,6 +86,8 @@ newKeys =
         , ((modm,               xK_c),          runPassMenu)
         , ((modm,               xK_h),          windows W.focusDown)
         , ((modm,               xK_l),          windows W.focusUp)
+        , ((modm .|. controlMask, xK_h),          rotAllDown)
+        , ((modm .|. controlMask, xK_l),          rotAllUp)
         , ((modm .|. shiftMask, xK_h),          windows W.swapUp)
         , ((modm .|. shiftMask, xK_l),          windows W.swapDown)
         , ((modm              , xK_f),          sendMessage FlipLayout)
@@ -99,6 +105,7 @@ newKeys =
         , ((mod4Mask,           xK_BackSpace),  (void $ spawn "xterm"))
         , ((modm,               xK_BackSpace),  (void $ spawn "pkill -SIGUSR1 xmobar"))
         , ((modm,               xK_t),          (void $ spawn (terminal config)))
+        , ((modm .|. mod1Mask,  xK_t),          (void $ spawn (terminal config ++ " -t Floating\\ Term")))
         , ((modm,               xK_m),          (submap $ mapAlpha modm markCurrentWindow))
         , ((modm,               xK_w),          windowJump)
         , ((modm,               xK_space),      sendMessage NextLayout)
@@ -121,6 +128,9 @@ newKeys =
         , ((modm .|. shiftMask, xK_g), (submap $
             mapNumbersAndAlpha 0 shiftToWorkspace))
 
+        , ((modm .|. shiftMask, xK_g), (submap $
+            mapNumbersAndAlpha shiftMask (\i -> windows $ CopyWindow.copy [i])))
+
         , ((modm .|. shiftMask .|. mod1Mask, xK_g), (submap $
             mapNumbersAndAlpha 0 swapWorkspace))
 
@@ -165,9 +175,7 @@ newKeys =
         ]
 
 mapNumbersAndAlpha :: KeyMask -> (Char -> X ()) -> Map (KeyMask, KeySym) (X ())
-mapNumbersAndAlpha km fn =
-    mapNumbers km fn
-      <> mapAlpha km fn
+mapNumbersAndAlpha km fn = mapNumbers km fn <> mapAlpha km fn
 
 mapNumbers :: KeyMask -> (Char -> X ()) -> Map (KeyMask, KeySym) (X ())
 mapNumbers km fn =
diff --git a/src/Main.hs b/src/Main.hs
index 741e6dc..5b4d5e1 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -39,6 +39,7 @@ main = do
          , className =? "yakuake" --> doFloat
          , className =? "MPlayer" --> doFloat
          , title =? "Event Tester" --> doFloat
+         , title =? "Floating Term" --> doFloat
          , className =? "mpv" --> doFloat
          , className =? "gnubby_ssh_prompt" --> doFloat
          ]
-- 
cgit 


From 4661b9e7c78e556adc3cf998b65808a4d7886746 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 22 Nov 2021 12:22:54 -0700
Subject: Fix bug where moving window to workspace stopped working.

---
 src/Internal/Keys.hs | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index c3c8db5..d50b371 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -126,9 +126,7 @@ newKeys =
             mapNumbersAndAlpha 0 gotoWorkspace))
 
         , ((modm .|. shiftMask, xK_g), (submap $
-            mapNumbersAndAlpha 0 shiftToWorkspace))
-
-        , ((modm .|. shiftMask, xK_g), (submap $
+            mapNumbersAndAlpha 0 shiftToWorkspace <>
             mapNumbersAndAlpha shiftMask (\i -> windows $ CopyWindow.copy [i])))
 
         , ((modm .|. shiftMask .|. mod1Mask, xK_g), (submap $
-- 
cgit 


From 6b91a961e2951f40359af1fe2f1702970edac879 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 22 Nov 2021 16:03:16 -0700
Subject: Compeletely change how KeyBindings are done.

Created new KeysM and ButtonsM monads to make configuring
keybindings and button bindings more readable through a DSL.

Before bindings would just be a giant list, but that
made it difficult to read and repetitive.

Now the syntax follows the pattern

bind key-to-bind
  mask1 : action
  mask2 : action

i.e.

bind xK_a $ do
  justMod  $ doSomeAction a b c
  shiftMod $ doSomeOtherAction a b c

This makes it a lot cleaner to see all the bindings allocated
to a specific key. That way, when adding a new binding,
I can easily see what bindings already exist for that key.
---
 src/Internal/Keys.hs  | 337 +++++++++++++++++++++--------------------
 src/Internal/KeysM.hs | 408 ++++++++++++++++++++++++++++++++++++++++++++++++++
 src/Main.hs           |   3 +
 3 files changed, 587 insertions(+), 161 deletions(-)
 create mode 100644 src/Internal/KeysM.hs

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index d50b371..ae2b9bd 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys (applyKeys) where
 
+import Internal.KeysM
 import Internal.SwapMaster (swapMaster)
 import XMonad.Hooks.ManageDocks
 import XMonad.Layout.MosaicAlt
@@ -42,12 +43,183 @@ import Internal.DMenu
 import Internal.PassMenu
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
+type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
+
+keymap :: KeyMap l
+keymap = runKeys $ do
+  config <- getConfig
+
+  let subkeys = submap . flip runKeys config
+
+  bind xK_apostrophe $ do
+    justMod $ subkeys $ do
+      bind xK_apostrophe $
+        justMod jumpToLast
+      mapAlpha 0 jumpToMark
+
+    shiftMod $ subkeys $ do
+      bind xK_apostrophe $
+        shiftMod swapWithLastMark
+      mapAlpha shiftMask swapWithMark
+
+  bind xK_BackSpace $ do
+    -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
+    -- something goes wrong with the keyboard layout and for first-time boots
+    -- where dmenu/alacritty may not be installed.
+    rawMask mod4Mask $ spawn "xterm"
+    justMod $ spawn "pkill -SIGUSR 1 xmobar"
+
+  bind xK_F1 $
+    -- Button programmed on mouse
+    shiftMod $ click >> withFocused (windows . W.sink)
+
+  bind xK_F2 $
+    -- Button programmed on mouse
+    shiftMod $ click >> sendMessage ToggleZoom
+
+  bind xK_F3 $
+    -- Button programmed on mouse
+    shiftMod $ click >> kill
+
+  bind xK_F10 $ do
+    justMod $ spawn "spotify-control play"
+
+  bind xK_F11 $ do
+    justMod $ spawn "spotify-control prev"
+
+  bind xK_F12 $ do
+    justMod $ spawn "spotify-control next"
+
+  bind xK_Return $ do
+    justMod swapMaster
+
+  bind xK_Tab $ do
+    justMod  $ windows W.focusDown
+    shiftMod $ windows W.focusUp
+
+  -- Switch between different screens. These are the leftmost keys on the home
+  -- row in a Dvorak layout. One might want to switch these to ASD for QWERTY.
+  forM_ (zip [xK_a, xK_o, xK_e] [0..]) $ \(key, idx) ->
+    bind key $ do
+      -- Move focus to that screen.
+      justMod  $ withScreen W.view idx
+      -- Swap the current screen with the one given
+      altMod   $ withScreen W.greedyView idx
+      -- Move the current window to the select screen.
+      shiftMod $ withScreen W.shift idx
+
+  bind xK_bracketright $ do
+    justMod $ sendMessage $ modifyWindowBorder (-1)
+
+  bind xK_bracketleft $ do
+    justMod $ sendMessage $ modifyWindowBorder 1
+
+  bind xK_b $ do
+    justMod $ spawn "bluetooth-select.sh"
+
+  bind xK_c $ do
+    justMod runPassMenu
+    shiftMod kill
+
+  bind xK_f $ do
+    justMod  $ sendMessage FlipLayout
+    shiftMod $ sendMessage HFlipLayout
+
+  bind xK_g $ do
+    justMod $ subkeys $ do
+      mapNumbersAndAlpha 0 gotoWorkspace
+    shiftMod $ subkeys $ do
+      mapNumbersAndAlpha 0 shiftToWorkspace
+      mapNumbersAndAlpha shiftMask (\i -> windows (CopyWindow.copy [i]))
+    shiftAltMod $ subkeys $ do
+      mapNumbersAndAlpha 0 swapWorkspace
+
+  bind xK_h $ do
+    justMod    $ windows W.focusDown
+    shiftMod   $ windows W.swapDown
+    controlMod $ rotAllDown
+
+  bind xK_j $ do
+    justMod $ sendMessage ShrinkZoom
+
+  bind xK_k $ do
+    justMod $ sendMessage ExpandZoom
+
+  bind xK_l $ do
+    justMod    $ windows W.focusUp
+    shiftMod   $ windows W.swapUp
+    controlMod $ rotAllUp
+    altMod     $ spawn "xsecurelock"
+
+  bind xK_minus $ do
+    justMod  $ sendMessage (IncMasterN (-1))
+    shiftMod $ withFocused $ sendMessage . expandWindowAlt
+
+  bind xK_m $ do
+    justMod $ subkeys $
+      mapAlpha 0 markCurrentWindow
+
+  bind xK_n $ do
+    justMod $ relativeWorkspaceShift next
+
+  bind xK_plus $ do
+    justMod  $ sendMessage (IncMasterN 1)
+    shiftMod $ withFocused $ sendMessage . expandWindowAlt
+
+  bind xK_q $ do
+    shiftMod $ spawn "xmonad --recompile && xmonad --restart"
+
+  bind xK_r $ do
+    justMod runDMenu
+    shiftMod $ sendMessage DoRotate
+
+  bind xK_s $ do
+    altMod $ spawn "sudo -A systemctl suspend && xsecurelock"
+
+  bind xK_space $ do
+    justMod  $ sendMessage NextLayout
+    shiftMod $ sendMessage NextLayout
+
+  bind xK_t $ do
+    justMod  $ spawn (terminal config)
+    shiftMod $ withFocused $ windows . W.sink 
+    altMod   $ spawn (terminal config ++ " -t Floating\\ Term")
+
+  bind xK_w $ do
+    justMod windowJump
+
+  bind xK_x $ do
+    justMod $ sendMessage ToggleStruts
+
+  bind xK_z $ do
+    justMod $ sendMessage ToggleZoom
+
+mouseMap :: ButtonsMap l
+mouseMap = runButtons $ do
+  bind button1 $ do
+    justMod $ \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster
+
+  bind button2 $ do
+    justMod $ windows . (W.shiftMaster .) . W.focusWindow
+
+  bind button3 $ do
+    justMod $ \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster
+
+  bind (6 :: Button) $
+    justMod $ const (relativeWorkspaceShift prev)
+
+  bind (7 :: Button) $
+    justMod $ const (relativeWorkspaceShift next)
+
+  bind (8 :: Button) $
+    justMod $ const (relativeWorkspaceShift prev)
+
+  bind (9 :: Button) $
+    justMod $ const (relativeWorkspaceShift next)
 
 applyKeys :: XConfig l -> IO (XConfig l)
-applyKeys config@(XConfig {modMask = modm}) = do
-    ks <- newKeys
-    ms <- newMouse
-    return $ config { keys = ks, mouseBindings = ms }
+applyKeys config@(XConfig {modMask = modm}) =
+    return $ config { keys = keymap, mouseBindings = mouseMap }
 
 newMouse :: IO (XConfig l -> Map (KeyMask, Button) (Window -> X ()))
 newMouse =
@@ -73,160 +245,3 @@ click = do
 modifyWindowBorder :: Integer -> SpacingModifier
 modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
   (Border (a + i) (b + i) (c + i) (d + i))
-
-newKeys :: IO (KeyMap l)
-newKeys =
-    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_h),          windows W.focusDown)
-        , ((modm,               xK_l),          windows W.focusUp)
-        , ((modm .|. controlMask, xK_h),          rotAllDown)
-        , ((modm .|. controlMask, xK_l),          rotAllUp)
-        , ((modm .|. shiftMask, xK_h),          windows W.swapUp)
-        , ((modm .|. shiftMask, xK_l),          windows W.swapDown)
-        , ((modm              , xK_f),          sendMessage FlipLayout)
-        , ((modm .|. shiftMask, xK_f),          sendMessage HFlipLayout)
-        , ((modm              , xK_Return),     swapMaster)
-        , ((modm,               xK_j),          sendMessage Shrink)
-        , ((modm,               xK_k),          sendMessage Expand)
-        , ((modm .|. shiftMask, xK_r),          sendMessage DoRotate)
-        , ((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)
-        , ((modm .|. shiftMask, xK_plus),       withFocused $ sendMessage . expandWindowAlt)
-        , ((modm .|. shiftMask, xK_minus),      withFocused $ sendMessage . shrinkWindowAlt)
-        , ((mod4Mask,           xK_BackSpace),  (void $ spawn "xterm"))
-        , ((modm,               xK_BackSpace),  (void $ spawn "pkill -SIGUSR1 xmobar"))
-        , ((modm,               xK_t),          (void $ spawn (terminal config)))
-        , ((modm .|. mod1Mask,  xK_t),          (void $ spawn (terminal config ++ " -t Floating\\ Term")))
-        , ((modm,               xK_m),          (submap $ mapAlpha modm markCurrentWindow))
-        , ((modm,               xK_w),          windowJump)
-        , ((modm,               xK_space),      sendMessage NextLayout)
-        , ((modm .|. shiftMask, xK_space),      sendMessage FirstLayout)
-        , ((modm,               xK_apostrophe), (submap $
-              Map.insert
-                (modm, xK_apostrophe)
-                jumpToLast
-                (mapAlpha modm jumpToMark)))
-
-        , ((modm .|. shiftMask, xK_apostrophe), (submap $
-              Map.insert
-                (modm .|. shiftMask, xK_apostrophe)
-                swapWithLastMark
-                (mapAlpha (modm .|. shiftMask) swapWithMark)))
-
-        , ((modm, xK_g), (submap $
-            mapNumbersAndAlpha 0 gotoWorkspace))
-
-        , ((modm .|. shiftMask, xK_g), (submap $
-            mapNumbersAndAlpha 0 shiftToWorkspace <>
-            mapNumbersAndAlpha shiftMask (\i -> windows $ CopyWindow.copy [i])))
-
-        , ((modm .|. shiftMask .|. mod1Mask, xK_g), (submap $
-            mapNumbersAndAlpha 0 swapWorkspace))
-
-        , ((modm, xK_minus), sendMessage (IncMasterN (-1)))
-        , ((modm, xK_plus), sendMessage (IncMasterN 1))
-        , ((modm .|. shiftMask, xK_bracketleft), sendMessage (modifyWindowBorder (-5)))
-        , ((modm .|. shiftMask, xK_bracketright), sendMessage (modifyWindowBorder 5))
-        , ((modm, xK_bracketleft), sendMessage ShrinkZoom)
-        , ((modm, xK_bracketright), sendMessage ExpandZoom)
-
-        , ((modm, xK_space), sendMessage NextLayout)
-
-        , ((modm, xK_n), relativeWorkspaceShift next)
-        , ((modm, xK_p), relativeWorkspaceShift prev)
-
-        , ((modm .|. shiftMask, xK_q), spawn "xmonad --recompile && xmonad --restart")
-        , ((modm, xK_z), sendMessage ToggleZoom)
-
-        , ((modm, xK_x), spawn "bluetooth-select.sh")
-        , ((modm .|. shiftMask, xK_x), spawn "bluetoothctl -- disconnect")
-
-        , ((modm, xK_Tab), windows W.focusDown)
-        , ((modm .|. shiftMask, xK_Tab), windows W.focusUp)
-
-        , ((modm, xK_a), withScreen W.view 0)
-        , ((modm, xK_o), withScreen W.view 1)
-        , ((modm, xK_e), withScreen W.view 2)
-
-        , ((modm .|. shiftMask, xK_a), withScreen W.shift 0)
-        , ((modm .|. shiftMask, xK_o), withScreen W.shift 1)
-        , ((modm .|. shiftMask, xK_e), withScreen W.shift 2)
-
-        , ((modm .|. mod1Mask, xK_a), withScreen W.greedyView 0)
-        , ((modm .|. mod1Mask, xK_o), withScreen W.greedyView 1)
-        , ((modm .|. mod1Mask, xK_e), withScreen W.greedyView 2)
-        , ((modm,              xK_b), sendMessage ToggleStruts)
-
-        -- Buttons programmed on my mouse.
-        , ((shiftMask, xK_F1), click >> (withFocused $ windows . W.sink))
-        , ((shiftMask, xK_F2), click >> sendMessage ToggleZoom)
-        , ((shiftMask, xK_F3), click >> kill)
-        ]
-
-mapNumbersAndAlpha :: KeyMask -> (Char -> X ()) -> Map (KeyMask, KeySym) (X ())
-mapNumbersAndAlpha km fn = mapNumbers km fn <> mapAlpha km fn
-
-mapNumbers :: KeyMask -> (Char -> X ()) -> Map (KeyMask, KeySym) (X ())
-mapNumbers km fn =
-  Map.fromList [
-    ((km, xK_0), fn '0')
-  , ((km, xK_1), fn '1')
-  , ((km, xK_2), fn '2')
-  , ((km, xK_3), fn '3')
-  , ((km, xK_4), fn '4')
-  , ((km, xK_5), fn '5')
-  , ((km, xK_6), fn '6')
-  , ((km, xK_7), fn '7')
-  , ((km, xK_8), fn '8')
-  , ((km, xK_9), fn '9')
-  , ((km, xK_bracketright), fn '6')
-  , ((km, xK_exclam), fn '8')
-  , ((km, xK_bracketleft), fn '7')
-  , ((km, xK_braceleft), fn '5')
-  , ((km, xK_braceright), fn '3')
-  , ((km, xK_parenleft), fn '1')
-  , ((km, xK_equal), fn '9')
-  , ((km, xK_asterisk), fn '0')
-  , ((km, xK_parenright), fn '2')
-  , ((km, xK_plus), fn '4')
-  ]
-
-mapAlpha :: KeyMask -> (Char -> X ()) -> Map (KeyMask, KeySym) (X ())
-mapAlpha km fn =
-  Map.fromList [
-    ((km, xK_a), fn 'a')
-  , ((km, xK_b), fn 'b')
-  , ((km, xK_c), fn 'c')
-  , ((km, xK_d), fn 'd')
-  , ((km, xK_e), fn 'e')
-  , ((km, xK_f), fn 'f')
-  , ((km, xK_g), fn 'g')
-  , ((km, xK_h), fn 'h')
-  , ((km, xK_i), fn 'i')
-  , ((km, xK_j), fn 'j')
-  , ((km, xK_k), fn 'k')
-  , ((km, xK_l), fn 'l')
-  , ((km, xK_m), fn 'm')
-  , ((km, xK_n), fn 'n')
-  , ((km, xK_o), fn 'o')
-  , ((km, xK_p), fn 'p')
-  , ((km, xK_q), fn 'q')
-  , ((km, xK_r), fn 'r')
-  , ((km, xK_s), fn 's')
-  , ((km, xK_t), fn 't')
-  , ((km, xK_u), fn 'u')
-  , ((km, xK_v), fn 'v')
-  , ((km, xK_w), fn 'w')
-  , ((km, xK_x), fn 'x')
-  , ((km, xK_y), fn 'y')
-  , ((km, xK_z), fn 'z')
-  ]
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
new file mode 100644
index 0000000..de48bee
--- /dev/null
+++ b/src/Internal/KeysM.hs
@@ -0,0 +1,408 @@
+{-# Language GeneralizedNewtypeDeriving, MultiParamTypeClasses,
+   FunctionalDependencies, FlexibleInstances, TypeFamilies #-}
+module Internal.KeysM where
+
+import Control.Arrow (second)
+import Control.Monad (void)
+import Control.Monad.State (State(..), modify', get, execState)
+import XMonad
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+{- Module that defines a DSL for binding keys. -}
+newtype KeysM l a = KeysM (State (XConfig l, Map (KeyMask, KeySym) (X ())) a)
+  deriving (Functor, Applicative, Monad)
+
+newtype ButtonsM l a = ButtonsM (State (XConfig l, Map (KeyMask, Button) (Window -> X ())) a)
+  deriving (Functor, Applicative, Monad)
+
+newtype BindingBuilder b a = BindingBuilder (State (KeyMask, [(KeyMask, b)]) a)
+  deriving (Functor, Applicative, Monad)
+
+class HasConfig m where
+  getConfig :: m l (XConfig l)
+
+class Bindable k where
+  type BindableValue k :: *
+  type BindableMonad k :: (* -> *) -> * -> *
+
+  bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
+
+runKeys :: KeysM l a -> XConfig l -> Map (KeyMask, KeySym) (X ())
+runKeys (KeysM stateM) config =
+  snd $ execState stateM (config, Map.empty)
+
+runButtons :: ButtonsM l a -> XConfig l -> Map (KeyMask, Button) (Window -> X ())
+runButtons (ButtonsM stateM) config =
+  snd $ execState stateM (config, Map.empty)
+
+instance HasConfig KeysM where
+  getConfig = fst <$> KeysM get
+
+instance HasConfig ButtonsM where
+  getConfig = fst <$> ButtonsM get
+
+{- Generally it is assumed that the mod key shoud be pressed, but not always. -}
+naked :: f -> BindingBuilder f ()
+naked = rawMask 0
+
+rawMask :: KeyMask -> f -> BindingBuilder f ()
+rawMask m x = BindingBuilder $ modify' (second ((m, x):))
+
+maskMod :: KeyMask -> f -> BindingBuilder f ()
+maskMod mask action = do
+  modMask <- fst <$> BindingBuilder get
+  rawMask (modMask .|. mask) action
+
+altMask :: KeyMask
+altMask = mod1Mask
+
+hyperMask :: KeyMask
+hyperMask = mod3Mask
+
+altgrMask :: KeyMask
+altgrMask = mod2Mask
+
+superMask :: KeyMask
+superMask = mod4Mask
+
+justMod :: f -> BindingBuilder f ()
+justMod = maskMod 0
+
+instance Bindable KeySym where
+  type BindableValue KeySym = X ()
+  type BindableMonad KeySym = KeysM
+
+  -- bind :: KeySym -> BindingBuilder (X x) a -> KeysM l ()
+  bind key (BindingBuilder stM) = do
+    m <- modMask <$> getConfig
+    let (_, values) = execState stM (m, [])
+
+    KeysM $ modify' $ second $
+      flip (<>) (Map.fromList (map (\(m, v) -> ((m, key), v)) values))
+
+instance Bindable Button where
+  type BindableValue Button = Window -> X ()
+  type BindableMonad Button = ButtonsM
+
+  -- bind :: KeySym -> BindingBuilder (Window -> X ()) a -> ButtonsM l ()
+  bind button (BindingBuilder stM) = do
+    m <- modMask <$> getConfig
+    let (_, values) = execState stM (m, [])
+
+    ButtonsM $ modify' $ second $
+      flip (<>) (Map.fromList (map (\(m, v) -> ((m, button), v)) values))
+
+shiftControlAltSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltSuperHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftControlAltSuperHyperMod :: f -> BindingBuilder f ()
+shiftControlAltSuperHyperMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask)
+
+shiftControlAltSuperAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltSuperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. altgrMask)
+
+shiftControlAltSuperMod :: f -> BindingBuilder f ()
+shiftControlAltSuperMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask)
+
+shiftControlAltHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask .|. altgrMask)
+
+shiftControlAltHyperMod :: f -> BindingBuilder f ()
+shiftControlAltHyperMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask)
+
+shiftControlAltAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. altgrMask)
+
+shiftControlAltMod :: f -> BindingBuilder f ()
+shiftControlAltMod =
+  maskMod (shiftMask .|. controlMask .|. altMask)
+
+shiftControlSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlSuperHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftControlSuperHyperMod :: f -> BindingBuilder f ()
+shiftControlSuperHyperMod =
+  maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask)
+
+shiftControlSuperAltgrMod :: f -> BindingBuilder f ()
+shiftControlSuperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. superMask .|. altgrMask)
+
+shiftControlSuperMod :: f -> BindingBuilder f ()
+shiftControlSuperMod =
+  maskMod (shiftMask .|. controlMask .|. superMask)
+
+shiftControlHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. hyperMask .|. altgrMask)
+
+shiftControlHyperMod :: f -> BindingBuilder f ()
+shiftControlHyperMod =
+  maskMod (shiftMask .|. controlMask .|. hyperMask)
+
+shiftControlAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altgrMask)
+
+shiftControlMod :: f -> BindingBuilder f ()
+shiftControlMod =
+  maskMod (shiftMask .|. controlMask)
+
+shiftAltSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftAltSuperHyperAltgrMod =
+  maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftAltSuperHyperMod :: f -> BindingBuilder f ()
+shiftAltSuperHyperMod =
+  maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask)
+
+shiftAltSuperAltgrMod :: f -> BindingBuilder f ()
+shiftAltSuperAltgrMod =
+  maskMod (shiftMask .|. altMask .|. superMask .|. altgrMask)
+
+shiftAltSuperMod :: f -> BindingBuilder f ()
+shiftAltSuperMod =
+  maskMod (shiftMask .|. altMask .|. superMask)
+
+shiftAltHyperAltgrMod :: f -> BindingBuilder f ()
+shiftAltHyperAltgrMod =
+  maskMod (shiftMask .|. altMask .|. hyperMask .|. altgrMask)
+
+shiftAltHyperMod :: f -> BindingBuilder f ()
+shiftAltHyperMod =
+  maskMod (shiftMask .|. altMask .|. hyperMask)
+
+shiftAltAltgrMod :: f -> BindingBuilder f ()
+shiftAltAltgrMod =
+  maskMod (shiftMask .|. altMask .|. altgrMask)
+
+shiftAltMod :: f -> BindingBuilder f ()
+shiftAltMod =
+  maskMod (shiftMask .|. altMask)
+
+shiftSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftSuperHyperAltgrMod =
+  maskMod (shiftMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftSuperHyperMod :: f -> BindingBuilder f ()
+shiftSuperHyperMod =
+  maskMod (shiftMask .|. superMask .|. hyperMask)
+
+shiftSuperAltgrMod :: f -> BindingBuilder f ()
+shiftSuperAltgrMod =
+  maskMod (shiftMask .|. superMask .|. altgrMask)
+
+shiftSuperMod :: f -> BindingBuilder f ()
+shiftSuperMod =
+  maskMod (shiftMask .|. superMask)
+
+shiftHyperAltgrMod :: f -> BindingBuilder f ()
+shiftHyperAltgrMod =
+  maskMod (shiftMask .|. hyperMask .|. altgrMask)
+
+shiftHyperMod :: f -> BindingBuilder f ()
+shiftHyperMod =
+  maskMod (shiftMask .|. hyperMask)
+
+shiftAltgrMod :: f -> BindingBuilder f ()
+shiftAltgrMod =
+  maskMod (shiftMask .|. altgrMask)
+
+shiftMod :: f -> BindingBuilder f ()
+shiftMod = maskMod shiftMask
+
+controlAltSuperHyperAltgrMod :: f -> BindingBuilder f ()
+controlAltSuperHyperAltgrMod =
+  maskMod (controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+controlAltSuperHyperMod :: f -> BindingBuilder f ()
+controlAltSuperHyperMod =
+  maskMod (controlMask .|. altMask .|. superMask .|. hyperMask)
+
+controlAltSuperAltgrMod :: f -> BindingBuilder f ()
+controlAltSuperAltgrMod =
+  maskMod (controlMask .|. altMask .|. superMask .|. altgrMask)
+
+controlAltSuperMod :: f -> BindingBuilder f ()
+controlAltSuperMod =
+  maskMod (controlMask .|. altMask .|. superMask)
+
+controlAltHyperAltgrMod :: f -> BindingBuilder f ()
+controlAltHyperAltgrMod =
+  maskMod (controlMask .|. altMask .|. hyperMask .|. altgrMask)
+
+controlAltHyperMod :: f -> BindingBuilder f ()
+controlAltHyperMod =
+  maskMod (controlMask .|. altMask .|. hyperMask)
+
+controlAltAltgrMod :: f -> BindingBuilder f ()
+controlAltAltgrMod =
+  maskMod (controlMask .|. altMask .|. altgrMask)
+
+controlAltMod :: f -> BindingBuilder f ()
+controlAltMod =
+  maskMod (controlMask .|. altMask)
+
+controlSuperHyperAltgrMod :: f -> BindingBuilder f ()
+controlSuperHyperAltgrMod =
+  maskMod (controlMask .|. superMask .|. hyperMask .|. altgrMask)
+
+controlSuperHyperMod :: f -> BindingBuilder f ()
+controlSuperHyperMod =
+  maskMod (controlMask .|. superMask .|. hyperMask)
+
+controlSuperAltgrMod :: f -> BindingBuilder f ()
+controlSuperAltgrMod =
+  maskMod (controlMask .|. superMask .|. altgrMask)
+
+controlSuperMod :: f -> BindingBuilder f ()
+controlSuperMod =
+  maskMod (controlMask .|. superMask)
+
+controlHyperAltgrMod :: f -> BindingBuilder f ()
+controlHyperAltgrMod =
+  maskMod (controlMask .|. hyperMask .|. altgrMask)
+
+controlHyperMod :: f -> BindingBuilder f ()
+controlHyperMod =
+  maskMod (controlMask .|. hyperMask)
+
+controlAltgrMod :: f -> BindingBuilder f ()
+controlAltgrMod =
+  maskMod (controlMask .|. altgrMask)
+
+controlMod :: f -> BindingBuilder f ()
+controlMod = maskMod controlMask
+
+altSuperHyperAltgrMod :: f -> BindingBuilder f ()
+altSuperHyperAltgrMod =
+  maskMod (altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+altSuperHyperMod :: f -> BindingBuilder f ()
+altSuperHyperMod =
+  maskMod (altMask .|. superMask .|. hyperMask)
+
+altSuperAltgrMod :: f -> BindingBuilder f ()
+altSuperAltgrMod =
+  maskMod (altMask .|. superMask .|. altgrMask)
+
+altSuperMod :: f -> BindingBuilder f ()
+altSuperMod =
+  maskMod (altMask .|. superMask)
+
+altHyperAltgrMod :: f -> BindingBuilder f ()
+altHyperAltgrMod =
+  maskMod (altMask .|. hyperMask .|. altgrMask)
+
+altHyperMod :: f -> BindingBuilder f ()
+altHyperMod =
+  maskMod (altMask .|. hyperMask)
+
+altAltgrMod :: f -> BindingBuilder f ()
+altAltgrMod =
+  maskMod (altMask .|. altgrMask)
+
+altMod :: f -> BindingBuilder f ()
+altMod = maskMod altMask
+
+superHyperAltgrMod :: f -> BindingBuilder f ()
+superHyperAltgrMod =
+  maskMod (superMask .|. hyperMask .|. altgrMask)
+
+superHyperMod :: f -> BindingBuilder f ()
+superHyperMod =
+  maskMod (superMask .|. hyperMask)
+
+superAltgrMod :: f -> BindingBuilder f ()
+superAltgrMod =
+  maskMod (superMask .|. altgrMask)
+
+superMod :: f -> BindingBuilder f ()
+superMod = maskMod superMask
+
+hyperAltgrMod :: f -> BindingBuilder f ()
+hyperAltgrMod =
+  maskMod (hyperMask .|. altgrMask)
+
+hyperMod :: f -> BindingBuilder f ()
+hyperMod = maskMod hyperMask
+
+altgrMod :: f -> BindingBuilder f ()
+altgrMod = maskMod altgrMask
+
+
+{- Meant for submapping, binds all alphanumeric charactes to (fn c). -}
+mapNumbersAndAlpha :: KeyMask -> (Char -> X ()) -> KeysM l ()
+mapNumbersAndAlpha km fn = do
+  mapNumbers km fn
+  mapAlpha km fn
+
+{- Meant for submapping. This binds all numbers to (fn x) where x is the number
+ - pressed and fn is the function provided. -}
+mapNumbers :: KeyMask -> (Char -> X ()) -> KeysM l ()
+mapNumbers km fn = do
+  mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch))
+    [ (xK_0, '0')
+    , (xK_1, '1')
+    , (xK_2, '2')
+    , (xK_3, '3')
+    , (xK_4, '4')
+    , (xK_5, '5')
+    , (xK_6, '6')
+    , (xK_7, '7')
+    , (xK_8, '8')
+    , (xK_9, '9')
+    -- Programmer Dvorak shifts the numbers so I have to map to their unshifted
+    -- form.
+    , (xK_bracketright, '6')
+    , (xK_exclam, '8')
+    , (xK_bracketleft, '7')
+    , (xK_braceleft, '5')
+    , (xK_braceright, '3')
+    , (xK_parenleft, '1')
+    , (xK_equal, '9')
+    , (xK_asterisk, '0')
+    , (xK_parenright, '2')
+    , (xK_plus, '4') ]
+
+{- Meant for submapping. This binds all alpha charactes to (fn c) where c is the
+ - character pressed and fn is the function provided. -}
+mapAlpha :: KeyMask -> (Char -> X ()) -> KeysM l ()
+mapAlpha km fn =
+  mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch)) [
+    (xK_a, 'a')
+  , (xK_b, 'b')
+  , (xK_c, 'c')
+  , (xK_d, 'd')
+  , (xK_e, 'e')
+  , (xK_f, 'f')
+  , (xK_g, 'g')
+  , (xK_h, 'h')
+  , (xK_i, 'i')
+  , (xK_j, 'j')
+  , (xK_k, 'k')
+  , (xK_l, 'l')
+  , (xK_m, 'm')
+  , (xK_n, 'n')
+  , (xK_o, 'o')
+  , (xK_p, 'p')
+  , (xK_q, 'q')
+  , (xK_r, 'r')
+  , (xK_s, 's')
+  , (xK_t, 't')
+  , (xK_u, 'u')
+  , (xK_v, 'v')
+  , (xK_w, 'w')
+  , (xK_x, 'x')
+  , (xK_y, 'y')
+  , (xK_z, 'z')
+  ]
diff --git a/src/Main.hs b/src/Main.hs
index 5b4d5e1..94fb5a7 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -6,6 +6,7 @@ import System.FilePath ((</>))
 import XMonad.Hooks.EwmhDesktops (ewmhDesktopsStartup)
 import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat)
 import XMonad.Layout.Fullscreen (fullscreenEventHook)
+import System.Environment (setEnv)
 
 import Internal.XMobarLog
 import Internal.Keys
@@ -19,6 +20,8 @@ main = do
   homeDir <- getHomeDirectory
   let fp = homeDir </> ".xmonad" </> "startup"
 
+  setEnv "SUDO_ASKPASS" "/usr/bin/ssh-askpass"
+
   xmobar <- spawnXMobar
 
   (=<<) X.xmonad $
-- 
cgit 


From 245e135bf003ca9420f21dc82727a9b9b4f0bdcf Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 22 Nov 2021 16:11:23 -0700
Subject: Delete newMouse. It's not used.

---
 src/Internal/Keys.hs | 15 ---------------
 1 file changed, 15 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index ae2b9bd..88b90dc 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -221,21 +221,6 @@ applyKeys :: XConfig l -> IO (XConfig l)
 applyKeys config@(XConfig {modMask = modm}) =
     return $ config { keys = keymap, mouseBindings = mouseMap }
 
-newMouse :: IO (XConfig l -> Map (KeyMask, Button) (Window -> X ()))
-newMouse =
-    return $ \config@(XConfig {modMask = modm}) ->
-      Map.fromList [
-        ((modm, button1), \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster)
-      , ((modm, button2), windows . (W.shiftMaster .) . W.focusWindow)
-      , ((modm, button3), \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster)
-
-      , ((modm, 6), const (relativeWorkspaceShift prev))
-      , ((modm, 7), const (relativeWorkspaceShift next))
-
-      , ((modm, 8), const (relativeWorkspaceShift prev))
-      , ((modm, 9), const (relativeWorkspaceShift next))
-      ]
-
 click :: X ()
 click = do
   (dpy, root) <- asks $ (,) <$> display <*> theRoot
-- 
cgit 


From 0c8f4b67032a6bb226665bad60417f1007cd60ee Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 22 Nov 2021 17:09:47 -0700
Subject: Mess with some other keybindings.

---
 src/Internal/Keys.hs  | 44 +++++++++++++++++++++++++++++++++-----------
 src/Internal/KeysM.hs | 10 ++++++++--
 2 files changed, 41 insertions(+), 13 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 88b90dc..dec7f44 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -54,12 +54,12 @@ keymap = runKeys $ do
   bind xK_apostrophe $ do
     justMod $ subkeys $ do
       bind xK_apostrophe $
-        justMod jumpToLast
+        (noMod -|- justMod) jumpToLast
       mapAlpha 0 jumpToMark
 
     shiftMod $ subkeys $ do
       bind xK_apostrophe $
-        shiftMod swapWithLastMark
+        (noMod -|- shiftMod -|- rawMask shiftMask) swapWithLastMark
       mapAlpha shiftMask swapWithMark
 
   bind xK_BackSpace $ do
@@ -69,17 +69,28 @@ keymap = runKeys $ do
     rawMask mod4Mask $ spawn "xterm"
     justMod $ spawn "pkill -SIGUSR 1 xmobar"
 
-  bind xK_F1 $
+  bind xK_F1 $ do
     -- Button programmed on mouse
-    shiftMod $ click >> withFocused (windows . W.sink)
+    rawMask shiftMask $ click >> withFocused (windows . W.sink)
+
+    shiftMod $ spawn "spotify-control play"
 
   bind xK_F2 $
     -- Button programmed on mouse
-    shiftMod $ click >> sendMessage ToggleZoom
+    rawMask shiftMask $ click >> sendMessage ToggleZoom
 
   bind xK_F3 $
     -- Button programmed on mouse
-    shiftMod $ click >> kill
+    rawMask shiftMask $ subkeys $ do
+
+      bind xK_F1 $ -- Make it harder to close so I don't accidentally git it.
+        rawMask shiftMask $ click >> kill
+
+      -- I Don't really use these, but they could be bound to something cool!
+      bind xK_F2 $
+        rawMask shiftMask $ spawn "spotify-control next"
+      bind xK_F3 $
+        rawMask shiftMask $ spawn "spotify-control prev"
 
   bind xK_F10 $ do
     justMod $ spawn "spotify-control play"
@@ -109,10 +120,10 @@ keymap = runKeys $ do
       shiftMod $ withScreen W.shift idx
 
   bind xK_bracketright $ do
-    justMod $ sendMessage $ modifyWindowBorder (-1)
+    justMod $ sendMessage $ modifyWindowBorder 5
 
   bind xK_bracketleft $ do
-    justMod $ sendMessage $ modifyWindowBorder 1
+    justMod $ sendMessage $ modifyWindowBorder (-5)
 
   bind xK_b $ do
     justMod $ spawn "bluetooth-select.sh"
@@ -192,7 +203,18 @@ keymap = runKeys $ do
     justMod $ sendMessage ToggleStruts
 
   bind xK_z $ do
-    justMod $ sendMessage ToggleZoom
+    justMod $ subkeys $ do
+      -- Z is reserved to create sub keybindings to do various things.
+      -- I don't really use these at the moment.
+      bind xK_h $ do
+        noMod $ spawn "spotify-control prev"
+
+      bind xK_l $ do
+        noMod $ spawn "spotify-control next"
+
+    -- Centers the current focused window. i.e. toggles the Zoom layout
+    -- modifier.
+    shiftMod $ sendMessage ToggleZoom
 
 mouseMap :: ButtonsMap l
 mouseMap = runButtons $ do
@@ -212,10 +234,10 @@ mouseMap = runButtons $ do
     justMod $ const (relativeWorkspaceShift next)
 
   bind (8 :: Button) $
-    justMod $ const (relativeWorkspaceShift prev)
+    justMod $ const $ spawn "spotify-control prev"
 
   bind (9 :: Button) $
-    justMod $ const (relativeWorkspaceShift next)
+    justMod $ const $ spawn "spotify-control next"
 
 applyKeys :: XConfig l -> IO (XConfig l)
 applyKeys config@(XConfig {modMask = modm}) =
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
index de48bee..0d7adce 100644
--- a/src/Internal/KeysM.hs
+++ b/src/Internal/KeysM.hs
@@ -43,8 +43,8 @@ instance HasConfig ButtonsM where
   getConfig = fst <$> ButtonsM get
 
 {- Generally it is assumed that the mod key shoud be pressed, but not always. -}
-naked :: f -> BindingBuilder f ()
-naked = rawMask 0
+noMod :: f -> BindingBuilder f ()
+noMod = rawMask 0
 
 rawMask :: KeyMask -> f -> BindingBuilder f ()
 rawMask m x = BindingBuilder $ modify' (second ((m, x):))
@@ -339,6 +339,12 @@ hyperMod = maskMod hyperMask
 altgrMod :: f -> BindingBuilder f ()
 altgrMod = maskMod altgrMask
 
+{- Can combine two or more of the functions above to apply the same action to
+ - multiple masks. -}
+(-|-) :: (f -> BindingBuilder f ()) ->
+          (f -> BindingBuilder f ()) ->
+          f -> BindingBuilder f ()
+(-|-) fn1 fn2 f = fn1 f >> fn2 f
 
 {- Meant for submapping, binds all alphanumeric charactes to (fn c). -}
 mapNumbersAndAlpha :: KeyMask -> (Char -> X ()) -> KeysM l ()
-- 
cgit 


From 2f663366c82f158e1716e0c5e40875b714b7e35f Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 22 Nov 2021 22:08:15 -0700
Subject: Added a couple of bindings.

---
 src/Internal/Keys.hs | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index dec7f44..439986c 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -148,7 +148,7 @@ keymap = runKeys $ do
   bind xK_h $ do
     justMod    $ windows W.focusDown
     shiftMod   $ windows W.swapDown
-    controlMod $ rotAllDown
+    controlMod rotAllDown
 
   bind xK_j $ do
     justMod $ sendMessage ShrinkZoom
@@ -159,7 +159,7 @@ keymap = runKeys $ do
   bind xK_l $ do
     justMod    $ windows W.focusUp
     shiftMod   $ windows W.swapUp
-    controlMod $ rotAllUp
+    controlMod rotAllUp
     altMod     $ spawn "xsecurelock"
 
   bind xK_minus $ do
@@ -173,6 +173,9 @@ keymap = runKeys $ do
   bind xK_n $ do
     justMod $ relativeWorkspaceShift next
 
+  bind xK_p $ do
+    justMod $ relativeWorkspaceShift prev
+
   bind xK_plus $ do
     justMod  $ sendMessage (IncMasterN 1)
     shiftMod $ withFocused $ sendMessage . expandWindowAlt
@@ -204,6 +207,10 @@ keymap = runKeys $ do
 
   bind xK_z $ do
     justMod $ subkeys $ do
+      bind xK_z $ do
+        noMod -|- justMod $ sendMessage ToggleZoom
+
+
       -- Z is reserved to create sub keybindings to do various things.
       -- I don't really use these at the moment.
       bind xK_h $ do
@@ -240,7 +247,7 @@ mouseMap = runButtons $ do
     justMod $ const $ spawn "spotify-control next"
 
 applyKeys :: XConfig l -> IO (XConfig l)
-applyKeys config@(XConfig {modMask = modm}) =
+applyKeys config =
     return $ config { keys = keymap, mouseBindings = mouseMap }
 
 click :: X ()
@@ -251,4 +258,4 @@ click = do
 
 modifyWindowBorder :: Integer -> SpacingModifier
 modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
-  (Border (a + i) (b + i) (c + i) (d + i))
+  Border (a + i) (b + i) (c + i) (d + i)
-- 
cgit 


From 1e17c5fba39c00d22fe0bd1530c93c56b37a20c8 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 22 Nov 2021 23:29:16 -0700
Subject: Add some support of the XF86 keys.

---
 src/Internal/Keys.hs  | 27 ++++++++++++++++++++++++++-
 src/Internal/KeysM.hs |  1 +
 src/Main.hs           | 11 ++++++-----
 3 files changed, 33 insertions(+), 6 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 439986c..0dd8760 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys (applyKeys) where
 
+import Graphics.X11.ExtraTypes.XF86;
 import Internal.KeysM
 import Internal.SwapMaster (swapMaster)
 import XMonad.Hooks.ManageDocks
@@ -207,10 +208,11 @@ keymap = runKeys $ do
 
   bind xK_z $ do
     justMod $ subkeys $ do
+
+      -- Double-tap Z to toggle zoom.
       bind xK_z $ do
         noMod -|- justMod $ sendMessage ToggleZoom
 
-
       -- Z is reserved to create sub keybindings to do various things.
       -- I don't really use these at the moment.
       bind xK_h $ do
@@ -223,6 +225,29 @@ keymap = runKeys $ do
     -- modifier.
     shiftMod $ sendMessage ToggleZoom
 
+  bind xF86XK_AudioLowerVolume $ do
+    noMod $ spawn "pactl set-sink-volume @DEFAULT_SINK@ -1%"
+    justMod $ spawn "spotify-control prev"
+
+  bind xF86XK_AudioRaiseVolume $ do
+    noMod $ spawn "pactl set-sink-volume @DEFAULT_SINK@ +1%"
+    justMod $ spawn "spotify-control next"
+
+  bind xF86XK_AudioMute $ do
+    noMod $ spawn "pactl set-sink-mute @DEFAULT_SINK@ toggle"
+
+  bind xF86XK_AudioPlay $ do
+    noMod $ spawn "spotify-control play"
+
+  bind xF86XK_AudioNext $ do
+    noMod $ spawn "spotify-control next"
+
+  bind xF86XK_AudioPrev $ do
+    noMod $ spawn "spotify-control prev"
+
+  bind xF86XK_AudioPrev $ do
+    noMod $ spawn "spotify-control prev"
+
 mouseMap :: ButtonsMap l
 mouseMap = runButtons $ do
   bind button1 $ do
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
index 0d7adce..f834796 100644
--- a/src/Internal/KeysM.hs
+++ b/src/Internal/KeysM.hs
@@ -412,3 +412,4 @@ mapAlpha km fn =
   , (xK_y, 'y')
   , (xK_z, 'z')
   ]
+
diff --git a/src/Main.hs b/src/Main.hs
index 94fb5a7..2b9baf3 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -3,7 +3,7 @@ import XMonad
 import XMonad.Hooks.ManageDocks (docks)
 import System.Directory (getHomeDirectory)
 import System.FilePath ((</>))
-import XMonad.Hooks.EwmhDesktops (ewmhDesktopsStartup)
+import XMonad.Hooks.EwmhDesktops (ewmh)
 import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat)
 import XMonad.Layout.Fullscreen (fullscreenEventHook)
 import System.Environment (setEnv)
@@ -16,6 +16,7 @@ import qualified XMonad as X
 import qualified XMonad.StackSet as S
 
 main = do
+
   -- Execute some commands.
   homeDir <- getHomeDirectory
   let fp = homeDir </> ".xmonad" </> "startup"
@@ -25,7 +26,7 @@ main = do
   xmobar <- spawnXMobar
 
   (=<<) X.xmonad $
-    applyKeys $ docks $ def
+    applyKeys $ ewmh $ docks $ def
        { terminal    = "alacritty"
        , modMask     = mod3Mask
        , borderWidth = 2
@@ -33,9 +34,7 @@ main = do
        , focusedBorderColor = "#ff6c00"
        , normalBorderColor = "#404040"
        , layoutHook = myLayout
-       , startupHook = do
-          ewmhDesktopsStartup
-          spawn fp  
+       , startupHook = spawn fp  
        , manageHook = composeAll [
            isFullscreen --> doFullFloat
          , className =? "Tilda" --> doFloat
@@ -43,6 +42,8 @@ main = do
          , className =? "MPlayer" --> doFloat
          , title =? "Event Tester" --> doFloat
          , title =? "Floating Term" --> doFloat
+         , title =? "xmessage" --> doFloat
+         , title =? "gxmessage" --> doFloat
          , className =? "mpv" --> doFloat
          , className =? "gnubby_ssh_prompt" --> doFloat
          ]
-- 
cgit 


From 498412a3543494c5a17327bfcc868b966bd28639 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 23 Nov 2021 00:00:28 -0700
Subject: Started to update the readme with better documentation.

---
 README.md      |  26 +++++++++++++++++---------
 screenshot.jpg | Bin 0 -> 930524 bytes
 2 files changed, 17 insertions(+), 9 deletions(-)
 create mode 100644 screenshot.jpg

diff --git a/README.md b/README.md
index 7cb15fd..24bd08d 100644
--- a/README.md
+++ b/README.md
@@ -1,14 +1,22 @@
-# My XMonad Configuration
+# Rahm's Rice'd Desktop Environment
 
-Configuration for my XMonad.
+This is Rahm's desktop environment. Namely it's an amalgamation of scripts,
+executables, scum, villany, and configuration all duct-taped together to create
+a marginally functional desktop environment of dubious stability, but it seems
+to be pretty good.
 
-Dependencies are:
+[![Screenshot](screenshot.jpg)](https://git.josher.dev/cgit/rde.git/)
 
-- XMonad
-- Compton
-- XMobar
+# Configuration
 
-## Installation
+## Window Manager
 
-Simply run `install.sh` and it should provide install everything provided the
-dependencies have already been installed.
+The window manager is XMonad, obviously, but _heavily_ configured.
+
+## Bar
+
+The Bar Is XMobar, of course, but again, heavily modified.
+
+## Compositor
+
+Picom/Compton is my compositor, and it mostly works, but sometimes doesn't.
diff --git a/screenshot.jpg b/screenshot.jpg
new file mode 100644
index 0000000..b92d7b0
Binary files /dev/null and b/screenshot.jpg differ
-- 
cgit 


From e1348d91338891be4dd3f7a8d335a5b0452db742 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 23 Nov 2021 01:28:19 -0700
Subject: Added more to the README. More on the way!!

---
 README.md | 104 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 104 insertions(+)

diff --git a/README.md b/README.md
index 24bd08d..a3783d6 100644
--- a/README.md
+++ b/README.md
@@ -7,16 +7,120 @@ to be pretty good.
 
 [![Screenshot](screenshot.jpg)](https://git.josher.dev/cgit/rde.git/)
 
+(BTW, I'm not actually in Dallas, I'm in the same place as Mr. Money Moustache,
+and yes, I use Arch btw)
+
+# Requirements
+
+* Definitely need GHC. If you use Hugs, you deserve the pain.
+* X11, duh!
+* Xinerama is helpful
+* Monofur NERD Font. Should be included with the NERD fonts package.
+* GCC, because when I take off my Functional Programmer hat, I put on my
+  systems-dev glasses.
+* Perl, because when I take off my systems-dev glasses, I put on my UNIX beard.
+* Not Python, because when I take off the UNIX beard I skip the Soy latte and go
+  back to the FP hat.
+* Knowledge of Linux/Unix or an intense desire for masochism (which, as
+  long as it's consensual, I'm totally fine with.)
+* Linux. BSD support is coming, be patient!!
+  * Not Winblows -- Get out of here
+  * Not MacOS -- I don't have a clever pejorative.
+
+
 # Configuration
 
 ## Window Manager
 
 The window manager is XMonad, obviously, but _heavily_ configured.
 
+The way I configured XMonad is to be similar to Vim in that some keys are
+actually modal. I.e. require another key-press to effectuate the system
+
+Probably the biggest difference between this configuration and standard
+configurations is that there are _many_ workspaces. Actually, there are 36
+workspaces, one for each letter and digit (in the English alphabet).
+
+Navigating between all these workspaces is easy, though, just type Mod+g
+followed by the workspace you're trying to go to! (G stands for 'go' btw).
+
+### Some things to note
+
+I type in Programmer Dvorak (because of course I do) so many of the key bindings
+make little to no sense on QWERTY layout and should probably be changed by the
+user. It's in my TODO list to make a QWERTY variant, but I haven't gotten to it.
+
+_Also_ my ModKey is the Hyper key (because of course it is!), which the astute
+among you might notice does not actually exist on the keyboard. Aha! [Rahm's XKb
+Layout](https://git.josher.dev/cgit/rkb.git) strikes again! I have remapped
+pretty much all my modifier keys and reanimated the long-dead Hyper key! "But,
+Rahm, you handsome, yet dark and mysterious \*nix landchad, why would you use
+such a key no one uses?", I hear you ask. Well, my delightful, yet young
+compatriot, it is precisely because no one uses it that I use it. See, it is a
+decent way of preventing conflicting bindings in other applications! Plus it
+opens the door for using the Super key is [Rahm's patched
+Alacritty](https://git.josher.dev/cgit/r-alacritty.git) and thus use it in
+[Rahm's patched Neovim](https://git.josher.dev/cgit/rneovim.git) to potentially
+program some of [Rahm's STM32 Christmas
+Lights](https://git.josher.dev/cgit/stm34l4.git). **Anyway**, the salient point
+is that I recommend you learn Programmer Dvorak and switch your keyboard layout
+to [Rahm's XKb Layout](https://git.josher.dev/cgit/rkb.git), but in the off
+chance you decide against that, you can change the mod key to Super in
+`Main.hs`.
+
 ## Bar
 
 The Bar Is XMobar, of course, but again, heavily modified.
 
+### Features
+
+  * OS Logo
+    * For Debian, Arch, Ubuntu and BSD
+  * Kernel version
+  * Date
+  * Shows workspace layout as icon (I'm quite proud of this! It took forever to
+    get working!)
+  * Workspaces
+    * Red is current
+    * Blue is not current, but visible
+    * Gray is not visible
+  * Window Name
+  * Time
+  * CPU and Mem Usage displayed as dashes.
+  * Weather Info
+  * Spotify Info
+  * Bluetooth Info
+  * Battery Info
+
+## Battery
+
+XMobar's battery plugin is not quite good enough. I want to be able to display
+an icon as I'm charging, etc. So, I included a battery monitor C program
+designed to interface with XMobar. Namely the program is in
+`xmobar/extras/battery/battery.c`.
+
+## Weather
+
+The Weather is controlled by a barely functional Perl script which Hard Codes
+the weather station to KLMO (Longmont, CO). Maybe you should change that? The
+TODO here is to use wttr.in, but I'm too lazy to fix it.
+
+## Spotify
+
+If you don't use Spotify, then I'm sorry. It's one of the pieces of proprietary
+garbage (PG, for short)  I allow on my system (along with the Nvidia Drivers and
+Intel Management Sytem, ick).
+
+Rde is admittedly coupled with Spotify, and contains a spotify-control
+script to work with it. Maybe you should make that script work with your media
+player?
+
+## Bluetooth
+
+The `bluetooth-select` script allows the user to connect to bluetooth devices.
+If you haven't paired your bluetooth device yet, maybe you should use
+`bluetoothctl`?
+
 ## Compositor
 
 Picom/Compton is my compositor, and it mostly works, but sometimes doesn't.
-- 
cgit 


From e41358263a211bb651ebfdeedeef28c013494960 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 23 Nov 2021 12:32:00 -0700
Subject: Added ability to submap based on the lookupString.

This changes how workspaces work. There are now as many workspaces as
there are AlphaNumeric characters. I'm not really sure how I like it,
but it's interesting. I'll keep it for a bit and see how I like it.
---
 src/Internal/Keys.hs   | 42 ++++++++++++++++++++++++++++++++----------
 src/Internal/Lib.hs    |  7 ++++++-
 src/Internal/Submap.hs | 28 ++++++++++++++++++++++++++++
 3 files changed, 66 insertions(+), 11 deletions(-)
 create mode 100644 src/Internal/Submap.hs

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 0dd8760..89e2cf1 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -25,7 +25,7 @@ import Internal.PromptConfig
 import System.IO
 import Text.Printf
 import XMonad
-import XMonad.Actions.Submap
+import Internal.Submap
 import XMonad.Actions.WindowNavigation
 import XMonad.Prompt
 import XMonad.Prompt.Input
@@ -85,7 +85,7 @@ keymap = runKeys $ do
     rawMask shiftMask $ subkeys $ do
 
       bind xK_F1 $ -- Make it harder to close so I don't accidentally git it.
-        rawMask shiftMask $ click >> kill
+        rawMask shiftMask $ click >> CopyWindow.kill1
 
       -- I Don't really use these, but they could be bound to something cool!
       bind xK_F2 $
@@ -131,20 +131,25 @@ keymap = runKeys $ do
 
   bind xK_c $ do
     justMod runPassMenu
-    shiftMod kill
+    shiftMod CopyWindow.kill1
 
   bind xK_f $ do
     justMod  $ sendMessage FlipLayout
     shiftMod $ sendMessage HFlipLayout
 
   bind xK_g $ do
-    justMod $ subkeys $ do
-      mapNumbersAndAlpha 0 gotoWorkspace
-    shiftMod $ subkeys $ do
-      mapNumbersAndAlpha 0 shiftToWorkspace
-      mapNumbersAndAlpha shiftMask (\i -> windows (CopyWindow.copy [i]))
-    shiftAltMod $ subkeys $ do
-      mapNumbersAndAlpha 0 swapWorkspace
+    justMod $ mapNextString $ \_ str ->
+      case str of
+        [ch] | isAlphaNum ch -> gotoWorkspace ch
+        _ -> return ()
+    shiftMod $ mapNextString $ \_ str ->
+      case str of
+        [ch] | isAlphaNum ch -> shiftToWorkspace ch
+        _ -> return ()
+    shiftAltMod $ mapNextString $ \_ str ->
+      case str of
+        [ch] | isAlphaNum ch -> swapWorkspace ch
+        _ -> return ()
 
   bind xK_h $ do
     justMod    $ windows W.focusDown
@@ -207,7 +212,24 @@ keymap = runKeys $ do
     justMod $ sendMessage ToggleStruts
 
   bind xK_z $ do
+
     justMod $ subkeys $ do
+      
+      bind xK_g $ do
+        (justMod -|- noMod) $ mapNextString $ \_ s ->
+          case s of
+            [ch] | isAlphaNum ch -> windows (CopyWindow.copy s)
+            _ -> return ()
+
+      bind xK_p $ do
+        (justMod -|- noMod) $ mapNextString $ \_ str ->
+          spawn $ printf "gxmessage 'typed: \"%s\"\ncodes: \"%s\"\nunicode: á\n'"
+            str
+            (show (map ord str))
+
+      bind xK_c $ do
+        shiftMod $ CopyWindow.killAllOtherCopies
+        
 
       -- Double-tap Z to toggle zoom.
       bind xK_z $ do
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index 1a1d602..c3bdeb9 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -3,6 +3,7 @@ module Internal.Lib where
 
 import Prelude hiding ((!!))
 
+import XMonad.Actions.DynamicWorkspaces
 import XMonad.Util.Run
 import XMonad.Prompt
 import XMonad.Prompt.Input
@@ -67,13 +68,17 @@ getHorizontallyOrderedScreens windowSet =
 gotoWorkspace :: WorkspaceName -> X ()
 gotoWorkspace ch = do
   saveLastMark
+  addHiddenWorkspace [ch]
   windows $ greedyView $ return ch
 
 shiftToWorkspace :: WorkspaceName -> X ()
-shiftToWorkspace = windows . shift . return
+shiftToWorkspace ch = do
+  addHiddenWorkspace [ch]
+  (windows . shift . return) ch
 
 swapWorkspace :: WorkspaceName -> X ()
 swapWorkspace toWorkspaceName = do
+  addHiddenWorkspace [toWorkspaceName]
   windows $ \ss -> do
     let fromWorkspace = tag $ workspace $ current ss
         toWorkspace = [toWorkspaceName] in
diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
new file mode 100644
index 0000000..cdc2f95
--- /dev/null
+++ b/src/Internal/Submap.hs
@@ -0,0 +1,28 @@
+module Internal.Submap (mapNextString, module X) where
+
+import XMonad hiding (keys)
+import Control.Monad.Fix (fix)
+
+import XMonad.Actions.Submap as X
+
+{- Like submap fram XMonad.Actions.Submap, but sends the string from
+ - XLookupString to the function rather than the KeySym.
+ -}
+mapNextString :: (KeyMask -> String -> X a) -> X a
+mapNextString fn = do
+  XConf { theRoot = root, display = d } <- ask
+  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+
+  (m, str) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
+    maskEvent d keyPressMask p
+    KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
+    keysym <- keycodeToKeysym d code 0
+    (_, str) <- lookupString (asKeyEvent p)
+
+    if isModifierKey keysym
+        then nextkey
+        else return $ (m, str)
+
+  io $ ungrabKeyboard d currentTime
+
+  fn m str
-- 
cgit 


From c5a27bb21f012a521e90350d4322c458f3a3e618 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@boson.lan>
Date: Wed, 24 Nov 2021 12:48:13 -0700
Subject: Added some better support for Void Linux.

Void Linux doesn't have spotify in its official repos. Going with open
source solutions, I can use spotifyd, but had to hack my spotify-control
scripts to get it to work.

Void linux also puts all its binaries in /bin for some reason. Not sure
I like that, but I had to change the DMenu module to support that.
---
 extras/HOME/.xmonad/xmobar-logo | 2 +-
 src/Internal/DMenu.hs           | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/extras/HOME/.xmonad/xmobar-logo b/extras/HOME/.xmonad/xmobar-logo
index bf48047..aca1846 100755
--- a/extras/HOME/.xmonad/xmobar-logo
+++ b/extras/HOME/.xmonad/xmobar-logo
@@ -4,6 +4,6 @@ case "$(uname -a)" in
   *-arch*) exec echo '<fn=5><fc=#1785bd></fc></fn>' ;;
   *Debian*) exec echo '<fn=5><fc=#c00649></fc></fn>' ;;
   *Ubuntu*) exec echo '<fn=5><fc=#ff8888></fc></fn>' ;;
-  *Linux*)  exec echo '<fn=5><fc=#ffffff></fc></fn>' ;;
+  *Linux*)  exec echo '<icon=/home/rahm/.xmonad/void.xpm/>' ;;
   *BSD*)    exec echo '<fn=5><fc=#ff4444></fc></fn>' ;;
 esac
diff --git a/src/Internal/DMenu.hs b/src/Internal/DMenu.hs
index d91c7ba..850612e 100644
--- a/src/Internal/DMenu.hs
+++ b/src/Internal/DMenu.hs
@@ -17,7 +17,7 @@ data Colors =
 
 runDMenu :: X ()
 runDMenu = void $
-  safeSpawn "/usr/bin/dmenu_run" [
+  safeSpawn "dmenu_run" [
     "-p", "Execute ", "-l", "12", "-dim", "0.4"]
 
 runDMenuPrompt :: String -> Maybe String -> [String] -> X String
-- 
cgit 


From edf2bd9db98a367261debe56ad2f4f6fb61b6c09 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 29 Nov 2021 13:11:54 -0700
Subject: Add some changes.

1. Make the spotify control work for both Spotify and Spotifyd
2. Xmobar weather not break xmobar when not connected to the internet
3. Add g<space> keybinding to go to the toogle-cased version of the
   current workspace.
---
 extras/HOME/.local/bin/set-backlight.sh | 35 +++++++++++++++++++++++++++++++++
 extras/HOME/.local/bin/spotify-control  | 31 ++++++++++++++++++++++-------
 extras/HOME/.xmobarrc                   | 10 +++++-----
 extras/HOME/.xmonad/xmobar-bluetooth    |  2 +-
 extras/HOME/.xmonad/xmobar-weather      |  5 +++++
 src/Internal/Keys.hs                    |  1 +
 src/Internal/Lib.hs                     | 11 +++++++++++
 7 files changed, 82 insertions(+), 13 deletions(-)
 create mode 100755 extras/HOME/.local/bin/set-backlight.sh

diff --git a/extras/HOME/.local/bin/set-backlight.sh b/extras/HOME/.local/bin/set-backlight.sh
new file mode 100755
index 0000000..d0b8e3b
--- /dev/null
+++ b/extras/HOME/.local/bin/set-backlight.sh
@@ -0,0 +1,35 @@
+#!/bin/bash
+
+frac="$1"
+
+if [[ "$frac" == -* ]] ; then
+  frac=${frac//-}
+  t='sub'
+elif [[ "$frac" == +* ]] ; then
+  frac=${frac//+}
+  t='add'
+else
+  t='abs'
+fi
+
+max="$(cat /sys/class/backlight/intel_backlight/max_brightness)"
+to_set="$(bc <<< "$max * $frac")"
+to_set=$(cut -d. -f1 <<< "$to_set") # Cut off the fractional part.
+
+if [[ "$t" == 'sub' ]] ; then
+  cur="$(cat /sys/class/backlight/intel_backlight/brightness)"
+  to_set=$((cur - to_set))
+elif [[ "$t" == 'add' ]] ; then
+  cur="$(cat /sys/class/backlight/intel_backlight/brightness)"
+  to_set=$((cur + to_set))
+fi
+
+if [ "$to_set" -gt "$max" ] ; then
+  to_set="$max"
+fi
+
+if [ "$to_set" -lt 0 ] ; then
+  to_set=0
+fi
+
+echo "$to_set" | tee /sys/class/backlight/intel_backlight/brightness
diff --git a/extras/HOME/.local/bin/spotify-control b/extras/HOME/.local/bin/spotify-control
index e001eb6..ac921c7 100755
--- a/extras/HOME/.local/bin/spotify-control
+++ b/extras/HOME/.local/bin/spotify-control
@@ -6,16 +6,17 @@ then
         exit
 fi
 
-if [ "$(pidof spotify)" = "" ] 
+if [ "$(pidof spotifyd)" != "" ] 
 then
-  echo "Spotify is not running"
-  exit
+  target=spotifyd
+else
+  target=spotify
 fi
 
 function mpris2_dbus_player_do {
   dbus-send \
     --print-reply \
-    --dest=org.mpris.MediaPlayer2.spotify \
+    --dest=org.mpris.MediaPlayer2."$target" \
     /org/mpris/MediaPlayer2 \
     "org.mpris.MediaPlayer2.Player.$1"
 }
@@ -23,7 +24,7 @@ function mpris2_dbus_player_do {
 function mpris2_dbus_get_player_property {
   dbus-send \
     --print-reply \
-    --dest=org.mpris.MediaPlayer2.spotify \
+    --dest=org.mpris.MediaPlayer2."$target" \
     /org/mpris/MediaPlayer2 \
     org.freedesktop.DBus.Properties.Get \
     string:'org.mpris.MediaPlayer2.Player' "string:$1"
@@ -31,11 +32,27 @@ function mpris2_dbus_get_player_property {
 
 case $1 in
     "play")
-        mpris2_dbus_player_do PlayPause
+        status="$("$0" getStatus)"
+        if [[ "$target" == "spotifyd" ]] ; then
+          # Spotifyd doesn't support play/pause
+          if [[ "$status" == "Playing" ]] ; then
+            "$0" pause
+          else
+            "$0" justplay
+          fi
+        else
+          mpris2_dbus_player_do PlayPause
+        fi
         ;;
     "next")
         mpris2_dbus_player_do Next
         ;;
+    "pause")
+        mpris2_dbus_player_do Pause
+        ;;
+    "justplay")
+        mpris2_dbus_player_do Play
+        ;;
     "prev")
         mpris2_dbus_player_do Previous
         ;;
@@ -66,7 +83,7 @@ case $1 in
           egrep -v ^$
         ;;
     "getStatus")
-        mpris_dbus_get_player_property 'PlaybackStatus' | \
+        mpris2_dbus_get_player_property 'PlaybackStatus' | \
           grep 'string "[^"]*"' | \
           sed 's/.*"\(.*\)"[^"]*$/\1/'
         ;;
diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index a2b8a6e..8f17c72 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -14,8 +14,8 @@ Config
    , borderWidth = 2
    , bgColor = "#000000"
    , fgColor = "white"
-   , alpha = 220                 -- default: 255
-   , position = TopSize L 100 40
+   , alpha = 230                 -- default: 255
+   , position = TopSize L 100 50
    , textOffset = -1             -- default: -1
    , iconOffset = -1             -- default: -1
    , lowerOnStart = True
@@ -30,11 +30,11 @@ Config
    , template =
       " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc><fc=#404040> │\
       \</fc><fc=#a0a0a0> %date%</fc><fc=#404040> │ \
-      \</fc>%StdinReader%}<fn=2><fc=#606060>%time%</fc></fn>\
+      \</fc>%StdinReader%}\
       \{ %cpu% %memory% <fc=#404040>\
       \│</fc> %weather% <fc=#404040>│\
       \</fc> <fc=#a0a0a0>%mpris2%</fc> <fc=#404040>│ \
-      \</fc>%bluetooth%%bat% "
+      \</fc>%bluetooth%%bat% <fc=#404040>│</fc> <fn=2><fc=#606060>%time%</fc></fn> "
    , commands = [
        Run StdinReader,
        Run Date "%H:%M:%S" "time" 10,
@@ -57,7 +57,7 @@ Config
          "--normal", "#88ff88",
          "--high", "#ff8888"
        ] 10,
-       Run Mpris2 "spotify" [
+       Run Mpris2 "spotifyd" [
            "-t", "<fc=#1aa54b></fc>  <fn=3><title></fn>",
            "--nastring", "<fc=#404040> </fc>"] 20,
        Run Com ".xmonad/xmobar-weather" [] "weather" 9000,
diff --git a/extras/HOME/.xmonad/xmobar-bluetooth b/extras/HOME/.xmonad/xmobar-bluetooth
index 30903e3..9b4f5cc 100755
--- a/extras/HOME/.xmonad/xmobar-bluetooth
+++ b/extras/HOME/.xmonad/xmobar-bluetooth
@@ -1,4 +1,4 @@
-#!/bin/sh
+#!/usr/bin/env bash
 
 cur=""
 
diff --git a/extras/HOME/.xmonad/xmobar-weather b/extras/HOME/.xmonad/xmobar-weather
index e8ce28e..6b5c409 100755
--- a/extras/HOME/.xmonad/xmobar-weather
+++ b/extras/HOME/.xmonad/xmobar-weather
@@ -14,6 +14,11 @@ $content = `curl "https://api.sunrise-sunset.org/json?lat=$lat&lng=$lon&formatte
 
 die "Unable to get sunrise/sunset data" unless defined $content;
 
+if (length($content) == 0) {
+  printf("<fc=#404040>X</fc>");
+  exit
+}
+
 $sunrise_str=$content;
 $sunset_str=$content;
 $sunrise_str =~ s#.*"sunrise":"([^"]*)".*#\1#;
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 89e2cf1..2905ba0 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -141,6 +141,7 @@ keymap = runKeys $ do
     justMod $ mapNextString $ \_ str ->
       case str of
         [ch] | isAlphaNum ch -> gotoWorkspace ch
+        [' '] -> gotoAccompaningWorkspace
         _ -> return ()
     shiftMod $ mapNextString $ \_ str ->
       case str of
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index c3bdeb9..3beb640 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -64,6 +64,17 @@ getHorizontallyOrderedScreens windowSet =
     where
       screens = current windowSet : visible windowSet
 
+getCurrentWorkspace :: X WorkspaceName
+getCurrentWorkspace = withWindowSet $
+  \(StackSet (Screen (Workspace t _ _) _ _) _ _ _) -> do
+    return (head t)
+
+gotoAccompaningWorkspace :: X ()
+gotoAccompaningWorkspace = do
+  cur <- getCurrentWorkspace
+  if isUpper cur
+    then gotoWorkspace (toLower cur)
+    else gotoWorkspace (toUpper cur)
 
 gotoWorkspace :: WorkspaceName -> X ()
 gotoWorkspace ch = do
-- 
cgit 


From aad7b05664ddacf826f26f3190db3015dbc4d29b Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 29 Nov 2021 15:06:45 -0700
Subject: Added Emoji select.

The fonts still leave much to be desired. Unfortunately dmenu2 does not
support fallback fonts from what I can tell, and dmenu1 doesn't support
all the nice features dmenu2 supports. Oh well.
---
 extras/HOME/.local/bin/emoji-select.sh |   9 +++++++++
 extras/HOME/.xmonad/unicode.gz         | Bin 0 -> 297505 bytes
 src/Internal/Keys.hs                   |   5 ++++-
 3 files changed, 13 insertions(+), 1 deletion(-)
 create mode 100755 extras/HOME/.local/bin/emoji-select.sh
 create mode 100644 extras/HOME/.xmonad/unicode.gz

diff --git a/extras/HOME/.local/bin/emoji-select.sh b/extras/HOME/.local/bin/emoji-select.sh
new file mode 100755
index 0000000..2eeeb64
--- /dev/null
+++ b/extras/HOME/.local/bin/emoji-select.sh
@@ -0,0 +1,9 @@
+#!/bin/bash
+
+selection="$(
+  zcat $HOME/.xmonad/unicode.gz | sed 's@\([^;]\+\);\([^;]\+\).*@\1 \2 @g' |
+    dmenu -fn NotoSans:size=24 -i -nf "#ffff88" -sb "#ffff88" -p "Select Character" -l 12 -dim 0.4)"
+
+emoji="${selection%% *}"
+
+echo "$emoji" | xclip -selection clipboard
diff --git a/extras/HOME/.xmonad/unicode.gz b/extras/HOME/.xmonad/unicode.gz
new file mode 100644
index 0000000..5dd0826
Binary files /dev/null and b/extras/HOME/.xmonad/unicode.gz differ
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 2905ba0..d4a856c 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -229,7 +229,10 @@ keymap = runKeys $ do
             (show (map ord str))
 
       bind xK_c $ do
-        shiftMod $ CopyWindow.killAllOtherCopies
+        shiftMod CopyWindow.killAllOtherCopies
+
+      bind xK_e $
+        (justMod -|- noMod) $ spawn "emoji-select.sh"
         
 
       -- Double-tap Z to toggle zoom.
-- 
cgit 


From 1f52c828569f043f17dde6b63af3fd2a2d530046 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 29 Nov 2021 15:08:21 -0700
Subject: Add dimming to bluetooth-select

---
 extras/HOME/.local/bin/bluetooth-select.sh | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extras/HOME/.local/bin/bluetooth-select.sh b/extras/HOME/.local/bin/bluetooth-select.sh
index a0b8559..9a42ce5 100755
--- a/extras/HOME/.local/bin/bluetooth-select.sh
+++ b/extras/HOME/.local/bin/bluetooth-select.sh
@@ -3,7 +3,7 @@
 devices="$(bluetoothctl -- devices | sed 's#^Device ##')"
 selection="$(
   echo -e "$devices\nDisconnect" |
-    dmenu -i -nf "#8888ff" -sb "#8888ff" -p "Connect Bluetooth" -l 12)"
+    dmenu -i -nf "#8888ff" -sb "#8888ff" -p "Connect Bluetooth" -l 12 -dim 0.4)"
 
 macaddr="${selection%% *}"
 
-- 
cgit 


From 649ae8c5b537d702707fc7f900a0d1eccfe48ff8 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Wed, 29 Dec 2021 18:41:16 -0700
Subject: minor aesthetic changes

---
 extras/HOME/.xmobarrc       | 2 +-
 extras/HOME/.xmonad/startup | 4 ++++
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index 8f17c72..299877f 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -15,7 +15,7 @@ Config
    , bgColor = "#000000"
    , fgColor = "white"
    , alpha = 230                 -- default: 255
-   , position = TopSize L 100 50
+   , position = TopSize C 99 50
    , textOffset = -1             -- default: -1
    , iconOffset = -1             -- default: -1
    , lowerOnStart = True
diff --git a/extras/HOME/.xmonad/startup b/extras/HOME/.xmonad/startup
index 59621af..07b164d 100755
--- a/extras/HOME/.xmonad/startup
+++ b/extras/HOME/.xmonad/startup
@@ -32,6 +32,10 @@ hostname_photon() {
   feh --bg-scale "/usr/share/backgrounds/archlinux/mountain.jpg"
 }
 
+hostname_boson() {
+  ~/.fehbg
+}
+
 
 common
 
-- 
cgit 


From caf6dfb8ec9b032017f9bf1675238be3f6179e16 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 7 Jan 2022 14:59:52 -0700
Subject: Fix fullscreen issues.

---
 src/Internal/Layout.hs | 33 ++++++++++++++++++---------------
 src/Main.hs            |  2 ++
 2 files changed, 20 insertions(+), 15 deletions(-)

diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index fed0fd9..a077872 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -14,31 +14,34 @@ import XMonad.Layout.ThreeColumns
 import XMonad.Layout.Grid
 import XMonad.Layout.Dishes
 import XMonad.Layout.MosaicAlt
+import XMonad.Layout.Fullscreen
 import qualified XMonad.Layout.Dwindle as D
 import XMonad.Layout
 import XMonad.Layout.LayoutModifier
 import XMonad
 import XMonad.Core
+import XMonad.Layout.NoBorders (smartBorders, noBorders)
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
 myLayout =
-  avoidStruts $ 
-    spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
-      ModifiedLayout (Zoomable False 0.05 0.05) $
-        ModifiedLayout (Flippable False) $
-          ModifiedLayout (HFlippable False) $
-            ModifiedLayout (Rotateable False) $
-              spiral (6/7) |||
-              (Corner (3/4) (3/100) :: Corner Window) |||
-              ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |||
-              ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |||
-              Full |||
-              Grid |||
-              Dishes 2 (1/6) |||
-              (MosaicAlt M.empty :: MosaicAlt Window) |||
-              D.Dwindle D.R D.CW 1.5 1.1
+  fullscreenFull $
+    avoidStruts $ 
+      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
+        ModifiedLayout (Zoomable False 0.05 0.05) $
+          ModifiedLayout (Flippable False) $
+            ModifiedLayout (HFlippable False) $
+              ModifiedLayout (Rotateable False) $
+                spiral (6/7) |||
+                (Corner (3/4) (3/100) :: Corner Window) |||
+                ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |||
+                ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |||
+                Full |||
+                Grid |||
+                Dishes 2 (1/6) |||
+                (MosaicAlt M.empty :: MosaicAlt Window) |||
+                D.Dwindle D.R D.CW 1.5 1.1
 
 data ModifyDescription m l a = ModifyDescription m (l a)
   deriving (Show, Read)
diff --git a/src/Main.hs b/src/Main.hs
index 2b9baf3..da3b4f1 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,5 +1,6 @@
 import XMonad
 
+import Control.Monad.Trans.Class
 import XMonad.Hooks.ManageDocks (docks)
 import System.Directory (getHomeDirectory)
 import System.FilePath ((</>))
@@ -7,6 +8,7 @@ import XMonad.Hooks.EwmhDesktops (ewmh)
 import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat)
 import XMonad.Layout.Fullscreen (fullscreenEventHook)
 import System.Environment (setEnv)
+import Data.Monoid
 
 import Internal.XMobarLog
 import Internal.Keys
-- 
cgit 


From c64b0a5eb6de97da0d7bb9f744b61e88291bb062 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 10 Jan 2022 11:37:29 -0700
Subject: Fix sending the SIGUSR to Xmobar syntax

---
 src/Internal/Keys.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index d4a856c..44a7c9f 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -68,7 +68,7 @@ keymap = runKeys $ do
     -- something goes wrong with the keyboard layout and for first-time boots
     -- where dmenu/alacritty may not be installed.
     rawMask mod4Mask $ spawn "xterm"
-    justMod $ spawn "pkill -SIGUSR 1 xmobar"
+    justMod $ spawn "pkill -SIGUSR1 xmobar"
 
   bind xK_F1 $ do
     -- Button programmed on mouse
-- 
cgit 


From 7ead6ec18df2b8d45d977540ccfbd698e2ddce94 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 10 Jan 2022 11:38:33 -0700
Subject: For the work laptop, fix it so that picom does not run with multiple
 monitors (it slows things down way too much)

---
 extras/HOME/.xmonad/startup | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/extras/HOME/.xmonad/startup b/extras/HOME/.xmonad/startup
index 07b164d..78603c7 100755
--- a/extras/HOME/.xmonad/startup
+++ b/extras/HOME/.xmonad/startup
@@ -15,8 +15,13 @@ hostname_rahm1() {
   xinput set-prop "TPPS/2 Elan TrackPoint" "Coordinate Transformation Matrix" 3 0 0 0 3 0 0 0 1
   xinput set-prop "SYNA8004:00 06CB:CD8B Touchpad" "Coordinate Transformation Matrix" 3 0 0 0 3 0 0 0 1
 
-  if [ -z "$(ps aux | grep compton | grep -v grep)" ] ; then
-    __GL_SYNC_TO_VBLANK=1 nohup compton --backend=glx &>/dev/null &
+  n_displays=$(xrandr | grep '\<connected\>' | wc -l)
+  if [[ "$n_displays" -le "2" ]] ; then
+    if [ -z "$(ps aux | grep compton | grep -v grep)" ] ; then
+      __GL_SYNC_TO_VBLANK=1 nohup picom --backend=glx &>/dev/null &
+    fi
+  else 
+    killall picom
   fi
 
   feh --bg-scale "$HOME/wp.jpg"
-- 
cgit 


From 665d9c0afeb46035959d9b16de4f7010a812a354 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 10 Jan 2022 11:44:08 -0700
Subject: Add script to set the PulseAudio sink for the current window.

This binding is set to <C-z>a. It creates a dmenu prompting the user to
select which output device the current application should send audio to.

In the future I might create an analog for input devices, but as things
stand, I change input so much more infrequently that pavucontrol is
probably fine for that.
---
 extras/HOME/.local/bin/set-sink.sh | 45 ++++++++++++++++++++++++++++++++++++++
 src/Internal/Keys.hs               |  3 +++
 2 files changed, 48 insertions(+)
 create mode 100755 extras/HOME/.local/bin/set-sink.sh

diff --git a/extras/HOME/.local/bin/set-sink.sh b/extras/HOME/.local/bin/set-sink.sh
new file mode 100755
index 0000000..be04833
--- /dev/null
+++ b/extras/HOME/.local/bin/set-sink.sh
@@ -0,0 +1,45 @@
+#!/bin/bash
+
+current_pid=$(xdotool getactivewindow getwindowpid)
+DMENU=(dmenu -i -nf "#88ff88" -sb "#88ff88" -p "Move Audio" -l 12 -dim 0.4)
+
+sinks="$(
+  pactl list sinks | while read line ; do
+    case "$line" in
+      Sink\ \#*)
+        name="${line//*#}" ;;
+      Description:\ *)
+        description="${line//*: }"
+        echo "$description "'#'"$name"
+        ;;
+      *) ;;
+    esac
+  done)"
+
+client_input="$(
+  pactl list sink-inputs | while read line ; do
+    case "$line" in
+      application.process.id\ =*)
+        app="${line//*= \"}"
+        app="${app%%\"}"
+        ;;
+      object.id\ =*)
+        obj="${line//*= \"}"
+        obj="${obj%%\"}"
+        echo "$obj $app"
+        ;;
+    esac
+  done
+)"
+
+input_sink=$(echo "$client_input" | grep  "$current_pid\$")
+input_sink=${input_sink%% *}
+
+selected_sink=$(echo "$sinks" | "${DMENU[@]}")
+sink_num=${selected_sink//*#}
+
+#echo "$sinks"
+#echo "$client_input"
+
+echo "pactl move-sink-input $input_sink $sink_num"
+pactl move-sink-input "$input_sink" "$sink_num"
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 44a7c9f..fc0244b 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -233,6 +233,9 @@ keymap = runKeys $ do
 
       bind xK_e $
         (justMod -|- noMod) $ spawn "emoji-select.sh"
+
+      bind xK_a $
+        (justMod -|- noMod) $ spawn "set-sink.sh"
         
 
       -- Double-tap Z to toggle zoom.
-- 
cgit 


From 16c92a6f4b2072db37022b7176ad44d108dfa42a Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 10 Jan 2022 12:35:00 -0700
Subject: If rofi is installed on the system, use that for emoji selection.
 Rofi has much better unicode support than dmenu. I might switch over to it at
 some point.

---
 extras/HOME/.local/bin/emoji-select.sh |  9 ++++++++-
 extras/HOME/.xmonad/rde.rasi           | 37 ++++++++++++++++++++++++++++++++++
 2 files changed, 45 insertions(+), 1 deletion(-)
 create mode 100644 extras/HOME/.xmonad/rde.rasi

diff --git a/extras/HOME/.local/bin/emoji-select.sh b/extras/HOME/.local/bin/emoji-select.sh
index 2eeeb64..1cf8152 100755
--- a/extras/HOME/.local/bin/emoji-select.sh
+++ b/extras/HOME/.local/bin/emoji-select.sh
@@ -1,8 +1,15 @@
 #!/bin/bash
 
+if ( which rofi ) ; then
+  menu=(rofi -dmenu -i -p "Select Character:  " -font "Fira Code 32")
+else
+  menu=(dmenu -fn NotoSans:size=24 -i -nf "#ffff88" -sb "#ffff88" -p "Select Character" -l 12 -dim 0.4)
+fi
+
+
 selection="$(
   zcat $HOME/.xmonad/unicode.gz | sed 's@\([^;]\+\);\([^;]\+\).*@\1 \2 @g' |
-    dmenu -fn NotoSans:size=24 -i -nf "#ffff88" -sb "#ffff88" -p "Select Character" -l 12 -dim 0.4)"
+    "${menu[@]}")"
 
 emoji="${selection%% *}"
 
diff --git a/extras/HOME/.xmonad/rde.rasi b/extras/HOME/.xmonad/rde.rasi
new file mode 100644
index 0000000..4270085
--- /dev/null
+++ b/extras/HOME/.xmonad/rde.rasi
@@ -0,0 +1,37 @@
+* {
+    background-color:      Black;
+    border-color:          White;
+    text-color:           White;
+    font:            "NotoMono 24";
+}
+
+#window {
+    anchor:     north;
+    location:   north;
+    width:      100%;
+    padding:    10px;
+    children:   [ horibox ];
+}
+
+#horibox {
+    orientation: horizontal;
+    children:   [ prompt, entry, listview ];
+}
+
+#listview {
+    layout:     vertical;
+    spacing:    5px;
+    lines:      15;
+}
+
+#entry {
+    expand:     false;
+    width:      10em;
+}
+
+#element {
+    padding: 0px 2px;
+}
+#element selected {
+    background-color: SteelBlue;
+}
-- 
cgit 


From 8ff5dec689c3f4577960c25e284add5a5e9a9fcf Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 10 Jan 2022 14:07:32 -0700
Subject: Change set-sink.sh

Before this script would use the PID of the current window to infer the
input to switch. However some frontends use a daemon to output the
sound, so it doesn't work in that case.

Instead, now, set-sink will prompt the user to select the active sink to
switch. If there is only one active sink it will automatically move
that one.
---
 extras/HOME/.local/bin/set-sink.sh | 30 ++++++++++++++++++------------
 1 file changed, 18 insertions(+), 12 deletions(-)

diff --git a/extras/HOME/.local/bin/set-sink.sh b/extras/HOME/.local/bin/set-sink.sh
index be04833..aa0b91c 100755
--- a/extras/HOME/.local/bin/set-sink.sh
+++ b/extras/HOME/.local/bin/set-sink.sh
@@ -1,7 +1,6 @@
 #!/bin/bash
 
-current_pid=$(xdotool getactivewindow getwindowpid)
-DMENU=(dmenu -i -nf "#88ff88" -sb "#88ff88" -p "Move Audio" -l 12 -dim 0.4)
+DMENU=(dmenu -i -nf "#88ff88" -sb "#88ff88" -p "Move Audio To" -l 12 -dim 0.4)
 
 sinks="$(
   pactl list sinks | while read line ; do
@@ -19,27 +18,34 @@ sinks="$(
 client_input="$(
   pactl list sink-inputs | while read line ; do
     case "$line" in
-      application.process.id\ =*)
+      application.name\ =*)
         app="${line//*= \"}"
         app="${app%%\"}"
+        echo "$app: $media "'#'"$obj"
         ;;
-      object.id\ =*)
-        obj="${line//*= \"}"
-        obj="${obj%%\"}"
-        echo "$obj $app"
+      media.name\ =*)
+        media="${line//*= \"}"
+        media="${media%%\"}"
+        ;;
+      Sink\ Input\ \#*)
+        obj="${line//*#}"
         ;;
     esac
   done
 )"
 
-input_sink=$(echo "$client_input" | grep  "$current_pid\$")
-input_sink=${input_sink%% *}
+echo "Client Input: $client_input"
+
+if [[ "$(wc -l <<< "$client_input")" -gt 1 ]] ; then
+  client_input="$("${DMENU[@]}" -p "Move Audio From" <<< "$client_input")"
+fi
+
+input_sink=${client_input//*#}
 
-selected_sink=$(echo "$sinks" | "${DMENU[@]}")
+selected_sink=$("${DMENU[@]}" <<< "$sinks")
 sink_num=${selected_sink//*#}
 
-#echo "$sinks"
-#echo "$client_input"
+echo "Sinks: $sinks"
 
 echo "pactl move-sink-input $input_sink $sink_num"
 pactl move-sink-input "$input_sink" "$sink_num"
-- 
cgit 


From 8f4949e51a5b4c563d4e5fc9ddf7123561cdf234 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 10 Jan 2022 14:21:20 -0700
Subject: Change the Prompt for setting the sink.

---
 extras/HOME/.local/bin/set-sink.sh | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/extras/HOME/.local/bin/set-sink.sh b/extras/HOME/.local/bin/set-sink.sh
index aa0b91c..bbbdc8d 100755
--- a/extras/HOME/.local/bin/set-sink.sh
+++ b/extras/HOME/.local/bin/set-sink.sh
@@ -1,6 +1,6 @@
 #!/bin/bash
 
-DMENU=(dmenu -i -nf "#88ff88" -sb "#88ff88" -p "Move Audio To" -l 12 -dim 0.4)
+DMENU=(dmenu -i -nf "#88ff88" -sb "#88ff88" -l 12 -dim 0.4)
 
 sinks="$(
   pactl list sinks | while read line ; do
@@ -40,9 +40,14 @@ if [[ "$(wc -l <<< "$client_input")" -gt 1 ]] ; then
   client_input="$("${DMENU[@]}" -p "Move Audio From" <<< "$client_input")"
 fi
 
+if [[ "$client_input" == "" ]] ; then
+  exit 1
+fi
+
 input_sink=${client_input//*#}
+input_sink_name=${client_input%% #*}
 
-selected_sink=$("${DMENU[@]}" <<< "$sinks")
+selected_sink=$("${DMENU[@]}" -p "Move '$input_sink_name' To" <<< "$sinks")
 sink_num=${selected_sink//*#}
 
 echo "Sinks: $sinks"
-- 
cgit 


From 0e4b0187167e43c3c00371cbcca5cc892521bdb2 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 10 Jan 2022 14:57:47 -0700
Subject: Add emoticon-select.

It's the same as emoji select, but with emoticons.

Key bound to <C-z>E (capital E, as opposed to <C-z>e for emojis)
---
 extras/HOME/.local/bin/emoticon-select.sh | 13 +++++++++++++
 extras/HOME/.xmonad/emoticons.txt         | 16 ++++++++++++++++
 src/Internal/Keys.hs                      |  3 ++-
 3 files changed, 31 insertions(+), 1 deletion(-)
 create mode 100755 extras/HOME/.local/bin/emoticon-select.sh
 create mode 100644 extras/HOME/.xmonad/emoticons.txt

diff --git a/extras/HOME/.local/bin/emoticon-select.sh b/extras/HOME/.local/bin/emoticon-select.sh
new file mode 100755
index 0000000..bf10318
--- /dev/null
+++ b/extras/HOME/.local/bin/emoticon-select.sh
@@ -0,0 +1,13 @@
+#!/bin/bash
+
+if ( which rofi ) ; then
+  menu=(rofi -dmenu -i -p "Select Emoticon:  " -font "Fira Code 32")
+else
+  menu=(dmenu -fn NotoSans:size=24 -i -nf "#ffff88" -sb "#ffff88" -p "Select Emoticon" -l 12 -dim 0.4)
+fi
+
+
+selection="$("${menu[@]}" < $HOME/.xmonad/emoticons.txt)"
+emoticon="$(echo ${selection/*-})"
+
+echo "$emoticon" | xclip -selection clipboard
diff --git a/extras/HOME/.xmonad/emoticons.txt b/extras/HOME/.xmonad/emoticons.txt
new file mode 100644
index 0000000..40b83c5
--- /dev/null
+++ b/extras/HOME/.xmonad/emoticons.txt
@@ -0,0 +1,16 @@
+Deal with it     -     (•_•) ( •_•)>⌐■-■ (⌐■_■) 
+Deal with it.    -     (▀̿Ĺ̯▀̿ ̿)                   
+Do It Right      -     (☞ﾟヮﾟ)☞                 
+Do it Left       -     ☜(ﾟヮﾟ☜)                 
+Happy Gary       -     ᕕ( ᐛ )ᕗ                  
+Happy Lenny      -     ( ͡ᵔ ͜ʖ ͡ᵔ )                
+IDFK             -     ¯\(°_o)/¯                
+Lenny            -     ( ͡° ͜ʖ ͡°)                 
+Mad Lenny        -     ( ͡° ʖ̯ ͡°)                 
+Person Flip      -     (╯°□°）╯︵ (\ .o.)\      
+Shrug            -     ¯\_(ツ)_/¯               
+Smiley           -     :-)                      
+Tableback        -     ┬─┬ノ(ಠ_ಠノ)             
+Tableflip        -     (╯°□°）╯︵ ┻━┻           
+Unamused         -     ಠ_ಠ                      
+Y u no           -     ლ(ಠ益ಠ)ლ                 
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index fc0244b..bf9b62c 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -231,8 +231,9 @@ keymap = runKeys $ do
       bind xK_c $ do
         shiftMod CopyWindow.killAllOtherCopies
 
-      bind xK_e $
+      bind xK_e $ do
         (justMod -|- noMod) $ spawn "emoji-select.sh"
+        (shiftMod -|- rawMask shiftMask) $ spawn "emoticon-select.sh"
 
       bind xK_a $
         (justMod -|- noMod) $ spawn "set-sink.sh"
-- 
cgit 


From 863514ef9c4da3cce8410f89e1b4c547cc31cf6f Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 10 Jan 2022 21:22:19 -0700
Subject: Convert run menus over to Rofi.

This makes things prettier and rofi is more feature rich than DMenu.
---
 extras/HOME/.config/rofi/config.rasi       | 53 ++++++++++++++++++++++++++++++
 extras/HOME/.local/bin/bluetooth-select.sh |  5 +--
 extras/HOME/.local/bin/emoji-select.sh     |  2 +-
 extras/HOME/.local/bin/emoticon-select.sh  |  2 +-
 extras/HOME/.local/bin/rofi-pass           | 35 ++++++++++++++++++++
 extras/HOME/.local/bin/set-sink.sh         |  2 +-
 src/Internal/DMenu.hs                      | 13 ++++----
 src/Internal/PassMenu.hs                   |  8 ++---
 8 files changed, 103 insertions(+), 17 deletions(-)
 create mode 100644 extras/HOME/.config/rofi/config.rasi
 create mode 100755 extras/HOME/.local/bin/rofi-pass

diff --git a/extras/HOME/.config/rofi/config.rasi b/extras/HOME/.config/rofi/config.rasi
new file mode 100644
index 0000000..d804f7a
--- /dev/null
+++ b/extras/HOME/.config/rofi/config.rasi
@@ -0,0 +1,53 @@
+@theme "/usr/share/rofi/themes/DarkBlue.rasi"
+
+* {
+ theme-color: #8888ff;
+ selected-normal-background:  @theme-color;
+ normal-foreground:  @theme-color;
+ alternate-normal-foreground:  @theme-color;
+ textbox-background: #202020;
+
+ font: "Monofur Bold Nerd Font 34";
+}
+
+window {
+  border: 0;
+  width: 100%;
+  height: 100%;
+  padding: 20%;
+  background-color:                  rgba ( 0, 0, 0, 75 % );
+}
+
+#case-indicator {
+  background-color: @theme-color;
+  text-color: #202020;
+  padding: 10px;
+}
+
+#prompt {
+  background-color: @theme-color;
+  text-color: #202020;
+  padding: 10px;
+}
+
+inputbar {
+    children:   [ prompt,entry,case-indicator ];
+}
+
+#entry {
+  background-color: #202020;
+  padding: 10px;
+}
+
+#listview {
+    fixed-height: 0;
+    border:       50px 0px 0px ;
+    border-color: #000000;
+    scrollbar:    true;
+    background-color: #202020;
+}
+
+element {
+    border:  0;
+    padding: 10px 10px 20px 10px ;
+}
diff --git a/extras/HOME/.local/bin/bluetooth-select.sh b/extras/HOME/.local/bin/bluetooth-select.sh
index 9a42ce5..a39ead1 100755
--- a/extras/HOME/.local/bin/bluetooth-select.sh
+++ b/extras/HOME/.local/bin/bluetooth-select.sh
@@ -2,8 +2,9 @@
 
 devices="$(bluetoothctl -- devices | sed 's#^Device ##')"
 selection="$(
-  echo -e "$devices\nDisconnect" |
-    dmenu -i -nf "#8888ff" -sb "#8888ff" -p "Connect Bluetooth" -l 12 -dim 0.4)"
+  echo -e "$devices\nDisconnect" | rofi -p "Connect Bluetooth" \
+    -theme-str '* {theme-color: #8888ff;}' \
+    -dmenu)"
 
 macaddr="${selection%% *}"
 
diff --git a/extras/HOME/.local/bin/emoji-select.sh b/extras/HOME/.local/bin/emoji-select.sh
index 1cf8152..5d244d8 100755
--- a/extras/HOME/.local/bin/emoji-select.sh
+++ b/extras/HOME/.local/bin/emoji-select.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 if ( which rofi ) ; then
-  menu=(rofi -dmenu -i -p "Select Character:  " -font "Fira Code 32")
+  menu=(rofi -dmenu -i -p "Select Character" -theme-str '* {theme-color: #ffff88;}' -show run)
 else
   menu=(dmenu -fn NotoSans:size=24 -i -nf "#ffff88" -sb "#ffff88" -p "Select Character" -l 12 -dim 0.4)
 fi
diff --git a/extras/HOME/.local/bin/emoticon-select.sh b/extras/HOME/.local/bin/emoticon-select.sh
index bf10318..ed6cddc 100755
--- a/extras/HOME/.local/bin/emoticon-select.sh
+++ b/extras/HOME/.local/bin/emoticon-select.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 if ( which rofi ) ; then
-  menu=(rofi -dmenu -i -p "Select Emoticon:  " -font "Fira Code 32")
+  menu=(rofi -theme-str '* {theme-color: #ffa050;}' -p "Select Emoticon" -dmenu)
 else
   menu=(dmenu -fn NotoSans:size=24 -i -nf "#ffff88" -sb "#ffff88" -p "Select Emoticon" -l 12 -dim 0.4)
 fi
diff --git a/extras/HOME/.local/bin/rofi-pass b/extras/HOME/.local/bin/rofi-pass
new file mode 100755
index 0000000..57a4704
--- /dev/null
+++ b/extras/HOME/.local/bin/rofi-pass
@@ -0,0 +1,35 @@
+#!/usr/bin/env bash
+
+shopt -s nullglob globstar
+
+typeit=0
+if [[ $1 == "--type" ]]; then
+	typeit=1
+	shift
+fi
+
+if [[ -n $WAYLAND_DISPLAY ]]; then
+	dmenu=dmenu-wl
+	xdotool="ydotool type --file -"
+elif [[ -n $DISPLAY ]]; then
+  dmenu=(rofi -dmenu -p 'Password')
+	xdotool="xdotool type --clearmodifiers --file -"
+else
+	echo "Error: No Wayland or X11 display detected" >&2
+	exit 1
+fi
+
+prefix=${PASSWORD_STORE_DIR-~/.password-store}
+password_files=( "$prefix"/**/*.gpg )
+password_files=( "${password_files[@]#"$prefix"/}" )
+password_files=( "${password_files[@]%.gpg}" )
+
+password=$(printf '%s\n' "${password_files[@]}" | "${dmenu[@]}" "$@")
+
+[[ -n $password ]] || exit
+
+if [[ $typeit -eq 0 ]]; then
+	pass show -c "$password" 2>/dev/null
+else
+	pass show "$password" | { IFS= read -r pass; printf %s "$pass"; } | $xdotool
+fi
diff --git a/extras/HOME/.local/bin/set-sink.sh b/extras/HOME/.local/bin/set-sink.sh
index bbbdc8d..71054d8 100755
--- a/extras/HOME/.local/bin/set-sink.sh
+++ b/extras/HOME/.local/bin/set-sink.sh
@@ -1,6 +1,6 @@
 #!/bin/bash
 
-DMENU=(dmenu -i -nf "#88ff88" -sb "#88ff88" -l 12 -dim 0.4)
+DMENU=(rofi -theme-str '* {theme-color: #88ff88;}' -dmenu)
 
 sinks="$(
   pactl list sinks | while read line ; do
diff --git a/src/Internal/DMenu.hs b/src/Internal/DMenu.hs
index 850612e..360ad58 100644
--- a/src/Internal/DMenu.hs
+++ b/src/Internal/DMenu.hs
@@ -8,6 +8,7 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 import XMonad.Util.Run
 import Data.List (intercalate)
+import Text.Printf (printf)
 
 data Colors =
   Colors {
@@ -17,8 +18,7 @@ data Colors =
 
 runDMenu :: X ()
 runDMenu = void $
-  safeSpawn "dmenu_run" [
-    "-p", "Execute ", "-l", "12", "-dim", "0.4"]
+  safeSpawn "rofi" ["-p", "Execute ", "-show", "run"]
 
 runDMenuPrompt :: String -> Maybe String -> [String] -> X String
 runDMenuPrompt prompt color select =
@@ -32,8 +32,7 @@ runDMenuPrompt prompt color select =
 
 runDMenuPromptWithMap :: String -> Maybe String -> Map String a -> X (Maybe a)
 runDMenuPromptWithMap prompt color map = do
-  let realColor = maybe [] (\c -> ["-sb", c, "-nf", c]) color
-  menuMapArgs "dmenu"([
-      "-p", prompt,
-      "-l", "12",
-      "-dim", "0.4" ]  ++ realColor) map
+  let realColor = maybe [] (
+          \c -> ["-theme-str", printf "* {theme-color: %s;}" c]) color
+  menuMapArgs "rofi"
+    (["-p", prompt, "-dmenu"] ++ realColor) map
diff --git a/src/Internal/PassMenu.hs b/src/Internal/PassMenu.hs
index 7374bed..bb3bc4d 100644
--- a/src/Internal/PassMenu.hs
+++ b/src/Internal/PassMenu.hs
@@ -6,10 +6,8 @@ import Control.Monad
 
 runPassMenu :: X ()
 runPassMenu = void $
-  safeSpawn "passmenu" [
+  safeSpawn "rofi-pass" [
     "-p", "Password ", 
-    "-l", "12",
-    "-dim", "0.4",
-    "-sb", "#f54245",
-    "-nf", "#f54245" ]
+    "-theme-str",
+    "* {theme-color: #f54245;}"]
     
-- 
cgit 


From 45e294be50d35cafbddf47ba4ec0301067a2eb76 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 10 Jan 2022 21:38:34 -0700
Subject: minor changes with rofi

---
 extras/HOME/.config/rofi/config.rasi       | 10 +++++-----
 extras/HOME/.local/bin/bluetooth-select.sh |  2 +-
 extras/HOME/.local/bin/emoticon-select.sh  |  2 +-
 extras/HOME/.local/bin/rofi-pass           |  2 +-
 extras/HOME/.local/bin/set-sink.sh         |  2 +-
 src/Internal/DMenu.hs                      |  2 +-
 6 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/extras/HOME/.config/rofi/config.rasi b/extras/HOME/.config/rofi/config.rasi
index d804f7a..b78665e 100644
--- a/extras/HOME/.config/rofi/config.rasi
+++ b/extras/HOME/.config/rofi/config.rasi
@@ -5,7 +5,7 @@
  selected-normal-background:  @theme-color;
  normal-foreground:  @theme-color;
  alternate-normal-foreground:  @theme-color;
- textbox-background: #202020;
+ main-background: #202020e0;
 
  font: "Monofur Bold Nerd Font 34";
 }
@@ -20,13 +20,13 @@ window {
 
 #case-indicator {
   background-color: @theme-color;
-  text-color: #202020;
+  text-color: @main-background;
   padding: 10px;
 }
 
 #prompt {
   background-color: @theme-color;
-  text-color: #202020;
+  text-color: @main-background;
   padding: 10px;
 }
 
@@ -35,7 +35,7 @@ inputbar {
 }
 
 #entry {
-  background-color: #202020;
+  background-color: @main-background;
   padding: 10px;
 }
 
@@ -44,7 +44,7 @@ inputbar {
     border:       50px 0px 0px ;
     border-color: #000000;
     scrollbar:    true;
-    background-color: #202020;
+    background-color: @main-background;
 }
 
 element {
diff --git a/extras/HOME/.local/bin/bluetooth-select.sh b/extras/HOME/.local/bin/bluetooth-select.sh
index a39ead1..8c901ee 100755
--- a/extras/HOME/.local/bin/bluetooth-select.sh
+++ b/extras/HOME/.local/bin/bluetooth-select.sh
@@ -2,7 +2,7 @@
 
 devices="$(bluetoothctl -- devices | sed 's#^Device ##')"
 selection="$(
-  echo -e "$devices\nDisconnect" | rofi -p "Connect Bluetooth" \
+  echo -e "$devices\nDisconnect" | rofi -i -p "Connect Bluetooth" \
     -theme-str '* {theme-color: #8888ff;}' \
     -dmenu)"
 
diff --git a/extras/HOME/.local/bin/emoticon-select.sh b/extras/HOME/.local/bin/emoticon-select.sh
index ed6cddc..cb593b4 100755
--- a/extras/HOME/.local/bin/emoticon-select.sh
+++ b/extras/HOME/.local/bin/emoticon-select.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 if ( which rofi ) ; then
-  menu=(rofi -theme-str '* {theme-color: #ffa050;}' -p "Select Emoticon" -dmenu)
+  menu=(rofi -i -theme-str '* {theme-color: #ffa050;}' -p "Select Emoticon" -dmenu)
 else
   menu=(dmenu -fn NotoSans:size=24 -i -nf "#ffff88" -sb "#ffff88" -p "Select Emoticon" -l 12 -dim 0.4)
 fi
diff --git a/extras/HOME/.local/bin/rofi-pass b/extras/HOME/.local/bin/rofi-pass
index 57a4704..6eb58b7 100755
--- a/extras/HOME/.local/bin/rofi-pass
+++ b/extras/HOME/.local/bin/rofi-pass
@@ -12,7 +12,7 @@ if [[ -n $WAYLAND_DISPLAY ]]; then
 	dmenu=dmenu-wl
 	xdotool="ydotool type --file -"
 elif [[ -n $DISPLAY ]]; then
-  dmenu=(rofi -dmenu -p 'Password')
+  dmenu=(rofi -i -dmenu -p 'Password')
 	xdotool="xdotool type --clearmodifiers --file -"
 else
 	echo "Error: No Wayland or X11 display detected" >&2
diff --git a/extras/HOME/.local/bin/set-sink.sh b/extras/HOME/.local/bin/set-sink.sh
index 71054d8..9cd6f93 100755
--- a/extras/HOME/.local/bin/set-sink.sh
+++ b/extras/HOME/.local/bin/set-sink.sh
@@ -1,6 +1,6 @@
 #!/bin/bash
 
-DMENU=(rofi -theme-str '* {theme-color: #88ff88;}' -dmenu)
+DMENU=(rofi -i -theme-str '* {theme-color: #88ff88;}' -dmenu)
 
 sinks="$(
   pactl list sinks | while read line ; do
diff --git a/src/Internal/DMenu.hs b/src/Internal/DMenu.hs
index 360ad58..f964544 100644
--- a/src/Internal/DMenu.hs
+++ b/src/Internal/DMenu.hs
@@ -18,7 +18,7 @@ data Colors =
 
 runDMenu :: X ()
 runDMenu = void $
-  safeSpawn "rofi" ["-p", "Execute ", "-show", "run"]
+  safeSpawn "rofi" ["-display-run", "Execute", "-show", "run"]
 
 runDMenuPrompt :: String -> Maybe String -> [String] -> X String
 runDMenuPrompt prompt color select =
-- 
cgit 


From 39bda6b806461d879f96c25e9886022ebcc5a4c6 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 10 Jan 2022 21:52:54 -0700
Subject: minor changes to rofi config

---
 extras/HOME/.config/rofi/config.rasi | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/extras/HOME/.config/rofi/config.rasi b/extras/HOME/.config/rofi/config.rasi
index b78665e..1fec00f 100644
--- a/extras/HOME/.config/rofi/config.rasi
+++ b/extras/HOME/.config/rofi/config.rasi
@@ -5,7 +5,7 @@
  selected-normal-background:  @theme-color;
  normal-foreground:  @theme-color;
  alternate-normal-foreground:  @theme-color;
- main-background: #202020e0;
+ main-background: #202020f0;
 
  font: "Monofur Bold Nerd Font 34";
 }
@@ -41,8 +41,9 @@ inputbar {
 
 #listview {
     fixed-height: 0;
-    border:       50px 0px 0px ;
-    border-color: #000000;
+    margin: 50px 0px 0px 0px;
+    border:       0px 0px 0px 0px ;
+    border-color:                  rgba ( 0, 0, 0, 75 % );
     scrollbar:    true;
     background-color: @main-background;
 }
-- 
cgit 


From b3692bd5a676f07e926f7a0b36b43d4efaaa5c1c Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 10 Jan 2022 22:08:28 -0700
Subject: merged.

---
 extras/HOME/.xmobarrc       | 2 +-
 extras/HOME/.xmonad/startup | 3 ++-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index 299877f..cef2154 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -16,7 +16,7 @@ Config
    , fgColor = "white"
    , alpha = 230                 -- default: 255
    , position = TopSize C 99 50
-   , textOffset = -1             -- default: -1
+  , textOffset = -1             -- default: -1
    , iconOffset = -1             -- default: -1
    , lowerOnStart = True
    , pickBroadest = False        -- default: False
diff --git a/extras/HOME/.xmonad/startup b/extras/HOME/.xmonad/startup
index 07b164d..31e510b 100755
--- a/extras/HOME/.xmonad/startup
+++ b/extras/HOME/.xmonad/startup
@@ -29,7 +29,8 @@ hostname_photon() {
     __GL_SYNC_TO_VBLANK=1 nohup compton --backend=glx &>/dev/null &
   fi
   # xrandr --output DVI-I-1 --right-of DP-5 --mode 2560x1440
-  feh --bg-scale "/usr/share/backgrounds/archlinux/mountain.jpg"
+  $HOME/.fehbg
+  $HOME/.screenlayout/layout.sh
 }
 
 hostname_boson() {
-- 
cgit 


From 1e364ec0f24e4a3033ad54fab8e911e56448b26d Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 10 Jan 2022 23:40:19 -0700
Subject: changes to rofi config

---
 extras/HOME/.config/rofi/config.rasi | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/extras/HOME/.config/rofi/config.rasi b/extras/HOME/.config/rofi/config.rasi
index 1fec00f..440194b 100644
--- a/extras/HOME/.config/rofi/config.rasi
+++ b/extras/HOME/.config/rofi/config.rasi
@@ -4,6 +4,7 @@
  theme-color: #8888ff;
  selected-normal-background:  @theme-color;
  normal-foreground:  @theme-color;
+ selected-normal-foreground:  @main-background;
  alternate-normal-foreground:  @theme-color;
  main-background: #202020f0;
 
@@ -14,8 +15,10 @@ window {
   border: 0;
   width: 100%;
   height: 100%;
-  padding: 20%;
+  padding: 5% 20% 5% 20%;
   background-color:                  rgba ( 0, 0, 0, 75 % );
+  anchor:north;
+  location:   north;
 }
 
 #case-indicator {
@@ -31,6 +34,7 @@ window {
 }
 
 inputbar {
+    border-radius:  10px 10px 10px 10px;
     children:   [ prompt,entry,case-indicator ];
 }
 
@@ -46,9 +50,12 @@ inputbar {
     border-color:                  rgba ( 0, 0, 0, 75 % );
     scrollbar:    true;
     background-color: @main-background;
+    padding: 50px;
+    border-radius:  10px 10px 10px 10px;
 }
 
 element {
     border:  0;
     padding: 10px 10px 20px 10px ;
+    border-radius:  5px 5px 5px 5px;
 }
-- 
cgit 


From 663657bc5c691d0d08f9069e6918842af7735090 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 11 Jan 2022 19:45:24 -0700
Subject: Better Rofi integration

---
 extras/HOME/.config/rofi/config.rasi       |  2 +-
 extras/HOME/.local/bin/bluetooth-select.sh |  6 +-
 extras/HOME/.local/bin/emoji-select.sh     |  6 +-
 extras/HOME/.local/bin/emoticon-select.sh  |  6 +-
 extras/HOME/.local/bin/rofi-pass           |  6 +-
 extras/HOME/.local/bin/set-sink.sh         |  6 +-
 extras/HOME/.local/bin/set-volume.sh       | 95 ++++++++++++++++++++++++++++++
 src/Internal/DMenu.hs                      | 14 ++++-
 src/Internal/Keys.hs                       | 10 ++++
 src/Main.hs                                | 14 ++++-
 10 files changed, 154 insertions(+), 11 deletions(-)
 create mode 100755 extras/HOME/.local/bin/set-volume.sh

diff --git a/extras/HOME/.config/rofi/config.rasi b/extras/HOME/.config/rofi/config.rasi
index 440194b..fe47aa6 100644
--- a/extras/HOME/.config/rofi/config.rasi
+++ b/extras/HOME/.config/rofi/config.rasi
@@ -8,7 +8,7 @@
  alternate-normal-foreground:  @theme-color;
  main-background: #202020f0;
 
- font: "Monofur Bold Nerd Font 34";
+ font: "Monofur Nerd Font 24";
 }
 
 window {
diff --git a/extras/HOME/.local/bin/bluetooth-select.sh b/extras/HOME/.local/bin/bluetooth-select.sh
index 8c901ee..3a25387 100755
--- a/extras/HOME/.local/bin/bluetooth-select.sh
+++ b/extras/HOME/.local/bin/bluetooth-select.sh
@@ -1,8 +1,12 @@
 #!/bin/bash
 
+if [[ -z "$ROFI" ]] ; then
+  ROFI='rofi -dmenu'
+fi
+
 devices="$(bluetoothctl -- devices | sed 's#^Device ##')"
 selection="$(
-  echo -e "$devices\nDisconnect" | rofi -i -p "Connect Bluetooth" \
+  echo -e "$devices\nDisconnect" | $ROFI -i -p "Connect Bluetooth" \
     -theme-str '* {theme-color: #8888ff;}' \
     -dmenu)"
 
diff --git a/extras/HOME/.local/bin/emoji-select.sh b/extras/HOME/.local/bin/emoji-select.sh
index 5d244d8..a64a6e9 100755
--- a/extras/HOME/.local/bin/emoji-select.sh
+++ b/extras/HOME/.local/bin/emoji-select.sh
@@ -1,7 +1,11 @@
 #!/bin/bash
 
+if [[ -z "$ROFI" ]] ; then
+  ROFI='rofi -dmenu'
+fi
+
 if ( which rofi ) ; then
-  menu=(rofi -dmenu -i -p "Select Character" -theme-str '* {theme-color: #ffff88;}' -show run)
+  menu=($ROFI -i -p "Select Character" -theme-str '* {theme-color: #ffff88;}' -show run)
 else
   menu=(dmenu -fn NotoSans:size=24 -i -nf "#ffff88" -sb "#ffff88" -p "Select Character" -l 12 -dim 0.4)
 fi
diff --git a/extras/HOME/.local/bin/emoticon-select.sh b/extras/HOME/.local/bin/emoticon-select.sh
index cb593b4..e1637d1 100755
--- a/extras/HOME/.local/bin/emoticon-select.sh
+++ b/extras/HOME/.local/bin/emoticon-select.sh
@@ -1,7 +1,11 @@
 #!/bin/bash
 
+if [[ -z "$ROFI" ]] ; then
+  ROFI='rofi -dmenu'
+fi
+
 if ( which rofi ) ; then
-  menu=(rofi -i -theme-str '* {theme-color: #ffa050;}' -p "Select Emoticon" -dmenu)
+  menu=($ROFI -i -theme-str '* {theme-color: #ffa050;}' -p "Select Emoticon")
 else
   menu=(dmenu -fn NotoSans:size=24 -i -nf "#ffff88" -sb "#ffff88" -p "Select Emoticon" -l 12 -dim 0.4)
 fi
diff --git a/extras/HOME/.local/bin/rofi-pass b/extras/HOME/.local/bin/rofi-pass
index 6eb58b7..d78870a 100755
--- a/extras/HOME/.local/bin/rofi-pass
+++ b/extras/HOME/.local/bin/rofi-pass
@@ -2,6 +2,10 @@
 
 shopt -s nullglob globstar
 
+if [[ -z "$ROFI" ]] ; then
+  ROFI='rofi -dmenu'
+fi
+
 typeit=0
 if [[ $1 == "--type" ]]; then
 	typeit=1
@@ -12,7 +16,7 @@ if [[ -n $WAYLAND_DISPLAY ]]; then
 	dmenu=dmenu-wl
 	xdotool="ydotool type --file -"
 elif [[ -n $DISPLAY ]]; then
-  dmenu=(rofi -i -dmenu -p 'Password')
+  dmenu=($ROFI -i -p 'Password')
 	xdotool="xdotool type --clearmodifiers --file -"
 else
 	echo "Error: No Wayland or X11 display detected" >&2
diff --git a/extras/HOME/.local/bin/set-sink.sh b/extras/HOME/.local/bin/set-sink.sh
index 9cd6f93..cca8746 100755
--- a/extras/HOME/.local/bin/set-sink.sh
+++ b/extras/HOME/.local/bin/set-sink.sh
@@ -1,6 +1,10 @@
 #!/bin/bash
 
-DMENU=(rofi -i -theme-str '* {theme-color: #88ff88;}' -dmenu)
+if [[ -z "$ROFI" ]] ; then
+  ROFI='rofi -dmenu'
+fi
+
+DMENU=($ROFI -i -theme-str '* {theme-color: #88ff88;}')
 
 sinks="$(
   pactl list sinks | while read line ; do
diff --git a/extras/HOME/.local/bin/set-volume.sh b/extras/HOME/.local/bin/set-volume.sh
new file mode 100755
index 0000000..94423d0
--- /dev/null
+++ b/extras/HOME/.local/bin/set-volume.sh
@@ -0,0 +1,95 @@
+#!/bin/bash
+
+rofi=($ROFI -theme-str "* {theme-color: #88ffff;}")
+
+if [[ "$1" == "-a" ]] ; then
+  sinks="$(pactl list sinks | (while read line ; do
+       case $line in
+         Description:*)
+           descr=${line//*: }
+           ;;
+         Sink\ \#*)
+           if [ ! -z "$sink" ] ; then
+             echo "$state $descr ($volume)|$sink"
+           fi
+           sink=${line//*#} ;;
+         Volume:*)
+           volume=$(sed 's/.* \([0-9]\+%\).*/\1/g' <<< "$line")
+           ;;
+         *State:*)
+           state=${line//*: }
+           if [[ "$state" == 'RUNNING' ]] ; then
+             state='⏺'
+           else
+             state='  '
+           fi ;;
+       esac
+    done
+    echo "$state $descr ($volume)|$sink"))"
+  sinks="$(grep "^⏺" <<< "$sinks" ; grep -v "^⏺" <<< "$sinks")"
+
+  sink_inputs="$(pactl list sink-inputs | (while read line ; do
+       case $line in
+         *application.name\ =*)
+           app="${line//*= \"}"
+           app="${app%%\"}"
+           ;;
+         *media.name\ =*)
+           media="${line//*= \"}"
+           media="${media%%\"}"
+           ;;
+         *Volume:*)
+           volume=$(sed 's/.* \([0-9]\+%\).*/\1/g' <<< "$line")
+           ;;
+         Sink\ Input\ \#*)
+           if [ ! -z "$sink" ] ; then
+             echo "⏺ $app: $media ($volume)|$sink"
+           fi
+           sink=${line//*#} ;;
+       esac
+    done
+    echo "⏺ $app: $media ($volume)|$sink"))"
+
+    selection=$(
+        (echo "$sinks" ; echo '' ; echo "$sink_inputs") | \
+          cut -d'|' -f1 | \
+          "${rofi[@]}" -p "Set Volume For")
+
+    if [[ -z "$selection" ]] ; then
+      echo "Cancelled" >&2
+      exit 0
+    fi
+
+    value=$(grep "$selection" <<< "$sinks")
+    command="set-sink-volume"
+    if [[ -z "$value" ]] ; then
+      command="set-sink-input-volume"
+      value=$(grep "$selection" <<< "$sink_inputs")
+      if [[ -z "$value" ]] ; then
+        echo "Invalid Selection" >&2
+        exit 1
+      fi
+    fi
+    echo "Setting $value"
+    value=${value//*|}
+else
+  command="set-sink-volume"
+  value="@DEFAULT_SINK@"
+fi
+
+volume=$(echo '10%
+ 20%
+ 30%
+ 40%
+ 50%
+ 60%
+ 70%
+ 80%
+ 90%
+ 100%
+ 110%
+ 120%
+ 130%' | "${rofi[@]}" -p 'Set Volume To')
+
+echo pactl "$command" "$value" "$volume"
+pactl "$command" "$value" $volume
diff --git a/src/Internal/DMenu.hs b/src/Internal/DMenu.hs
index f964544..b611d87 100644
--- a/src/Internal/DMenu.hs
+++ b/src/Internal/DMenu.hs
@@ -16,9 +16,17 @@ data Colors =
     bg :: String
   }  | DefaultColors
 
+menuCommand :: [String]
+menuCommand = ["rofi", "-monitor", "-4", "-dmenu"]
+
+menuCommandString :: String
+menuCommandString = unwords menuCommand
+
 runDMenu :: X ()
 runDMenu = void $
-  safeSpawn "rofi" ["-display-run", "Execute", "-show", "run"]
+  safeSpawn
+    "rofi"
+    ["-monitor", "-4", "-display-run", "Execute", "-show", "run"]
 
 runDMenuPrompt :: String -> Maybe String -> [String] -> X String
 runDMenuPrompt prompt color select =
@@ -34,5 +42,5 @@ runDMenuPromptWithMap :: String -> Maybe String -> Map String a -> X (Maybe a)
 runDMenuPromptWithMap prompt color map = do
   let realColor = maybe [] (
           \c -> ["-theme-str", printf "* {theme-color: %s;}" c]) color
-  menuMapArgs "rofi"
-    (["-p", prompt, "-dmenu"] ++ realColor) map
+  menuMapArgs (head menuCommand)
+    (tail menuCommand ++ ["-p", prompt] ++ realColor) map
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index bf9b62c..51a1453 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -228,6 +228,9 @@ keymap = runKeys $ do
             str
             (show (map ord str))
 
+      bind xK_n $ do
+        (justMod -|- noMod) $ spawn (terminal config ++ " -t Notes -e notes new")
+
       bind xK_c $ do
         shiftMod CopyWindow.killAllOtherCopies
 
@@ -237,6 +240,13 @@ keymap = runKeys $ do
 
       bind xK_a $
         (justMod -|- noMod) $ spawn "set-sink.sh"
+
+      bind xK_w $
+        (justMod -|- noMod) $ spawn "networkmanager_dmenu"
+
+      bind xK_v $ do
+        (justMod -|- noMod) $ spawn "set-volume.sh"
+        (shiftMod -|- rawMask shiftMask) $ spawn "set-volume.sh -a"
         
 
       -- Double-tap Z to toggle zoom.
diff --git a/src/Main.hs b/src/Main.hs
index da3b4f1..f70496c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -13,9 +13,10 @@ import Data.Monoid
 import Internal.XMobarLog
 import Internal.Keys
 import Internal.Layout
+import Internal.DMenu (menuCommandString)
 
 import qualified XMonad as X
-import qualified XMonad.StackSet as S
+import qualified XMonad.StackSet as W
 
 main = do
 
@@ -24,6 +25,7 @@ main = do
   let fp = homeDir </> ".xmonad" </> "startup"
 
   setEnv "SUDO_ASKPASS" "/usr/bin/ssh-askpass"
+  setEnv "ROFI" menuCommandString
 
   xmobar <- spawnXMobar
 
@@ -43,7 +45,8 @@ main = do
          , className =? "yakuake" --> doFloat
          , className =? "MPlayer" --> doFloat
          , title =? "Event Tester" --> doFloat
-         , title =? "Floating Term" --> doFloat
+         , title =? "Floating Term" --> doCenterFloat
+         , title =? "Notes" --> doCenterFloat
          , title =? "xmessage" --> doFloat
          , title =? "gxmessage" --> doFloat
          , className =? "mpv" --> doFloat
@@ -55,3 +58,10 @@ main = do
        , clickJustFocuses = False
        , logHook = xMobarLogHook xmobar
        }
+
+doCenterFloat :: ManageHook
+doCenterFloat =
+  ask >>= \w -> doF . W.float w . centerRect . snd =<< liftX (floatLocation w)
+
+centerRect :: W.RationalRect -> W.RationalRect
+centerRect (W.RationalRect x y w h) = W.RationalRect ((1 - w) / 2) ((1 - h) / 2) w h
-- 
cgit 


From a0cce47b957501e61c27eea247a48d6eccbd5559 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 11 Jan 2022 19:58:18 -0700
Subject: added more emoticons

---
 extras/HOME/.xmonad/emoticons.txt | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/extras/HOME/.xmonad/emoticons.txt b/extras/HOME/.xmonad/emoticons.txt
index 40b83c5..51fdd2d 100644
--- a/extras/HOME/.xmonad/emoticons.txt
+++ b/extras/HOME/.xmonad/emoticons.txt
@@ -1,5 +1,7 @@
+Cry              -     ಥ_ಥ
 Deal with it     -     (•_•) ( •_•)>⌐■-■ (⌐■_■) 
 Deal with it.    -     (▀̿Ĺ̯▀̿ ̿)                   
+Disapprove       -     ಠ_ಠ                      
 Do It Right      -     (☞ﾟヮﾟ)☞                 
 Do it Left       -     ☜(ﾟヮﾟ☜)                 
 Happy Gary       -     ᕕ( ᐛ )ᕗ                  
@@ -8,9 +10,12 @@ IDFK             -     ¯\(°_o)/¯
 Lenny            -     ( ͡° ͜ʖ ͡°)                 
 Mad Lenny        -     ( ͡° ʖ̯ ͡°)                 
 Person Flip      -     (╯°□°）╯︵ (\ .o.)\      
+Raise Dongers    -     ヽ༼ຈل͜ຈ༽ﾉ
 Shrug            -     ¯\_(ツ)_/¯               
 Smiley           -     :-)                      
+Surprised        -     (⚆_⚆)
 Tableback        -     ┬─┬ノ(ಠ_ಠノ)             
 Tableflip        -     (╯°□°）╯︵ ┻━┻           
-Unamused         -     ಠ_ಠ                      
+Tears of Joy     -     ಥ‿ಥ
+Unamused         -     ( ͡ಠ ʖ̯ ͡ಠ)
 Y u no           -     ლ(ಠ益ಠ)ლ                 
-- 
cgit 


From e45c6c02ab92c3b4d4d8303ebfb11db513c29ece Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 11 Jan 2022 20:43:07 -0700
Subject: Fix so that <S--> shrinks the alt window, not expand it

---
 src/Internal/Keys.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 51a1453..3189ddb 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -171,7 +171,7 @@ keymap = runKeys $ do
 
   bind xK_minus $ do
     justMod  $ sendMessage (IncMasterN (-1))
-    shiftMod $ withFocused $ sendMessage . expandWindowAlt
+    shiftMod $ withFocused $ sendMessage . shrinkWindowAlt
 
   bind xK_m $ do
     justMod $ subkeys $
-- 
cgit 


From 66347d17f3f4afb6dfc9c6e43c7e8924634d64f8 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 11 Jan 2022 22:41:48 -0700
Subject: Add NERD font glyphs to unicode selector

---
 extras/HOME/.xmonad/unicode.gz | Bin 297505 -> 325355 bytes
 1 file changed, 0 insertions(+), 0 deletions(-)

diff --git a/extras/HOME/.xmonad/unicode.gz b/extras/HOME/.xmonad/unicode.gz
index 5dd0826..fa47bf1 100644
Binary files a/extras/HOME/.xmonad/unicode.gz and b/extras/HOME/.xmonad/unicode.gz differ
-- 
cgit 


From cd5f031e28ecda974e2f0515892e1b48a2a34170 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 12 Jan 2022 11:00:33 -0700
Subject: added more emoticons

---
 extras/HOME/.xmonad/emoticons.txt | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/extras/HOME/.xmonad/emoticons.txt b/extras/HOME/.xmonad/emoticons.txt
index 51fdd2d..65289c4 100644
--- a/extras/HOME/.xmonad/emoticons.txt
+++ b/extras/HOME/.xmonad/emoticons.txt
@@ -1,3 +1,4 @@
+Bear             -     (''')(0.0)(''')
 Cry              -     ಥ_ಥ
 Deal with it     -     (•_•) ( •_•)>⌐■-■ (⌐■_■) 
 Deal with it.    -     (▀̿Ĺ̯▀̿ ̿)                   
@@ -10,12 +11,18 @@ IDFK             -     ¯\(°_o)/¯
 Lenny            -     ( ͡° ͜ʖ ͡°)                 
 Mad Lenny        -     ( ͡° ʖ̯ ͡°)                 
 Person Flip      -     (╯°□°）╯︵ (\ .o.)\      
+Person Flip      -     (ノಠ益ಠ) ノ彡 (\ .o.)\
+Personback       -     (/ °o°)/ノ(ಠ_ಠノ)             
 Raise Dongers    -     ヽ༼ຈل͜ຈ༽ﾉ
 Shrug            -     ¯\_(ツ)_/¯               
 Smiley           -     :-)                      
 Surprised        -     (⚆_⚆)
 Tableback        -     ┬─┬ノ(ಠ_ಠノ)             
-Tableflip        -     (╯°□°）╯︵ ┻━┻           
+Tableflip        -     (╯°□°)╯︵ ┻━┻           
+Tableflip        -     (ノಠ益ಠ) ノ彡 ┻━┻
+Tableflip Shrug  -     ┻━┻ ︵ ¯\_(ᴼل͜ᴼ)_/¯ ︵ ┻━┻
+Table Flipped Me -     ┬─┬ ︵ /(.□. \)
 Tears of Joy     -     ಥ‿ಥ
 Unamused         -     ( ͡ಠ ʖ̯ ͡ಠ)
 Y u no           -     ლ(ಠ益ಠ)ლ                 
+LOL F U          -     ( ° ͜ʖ͡°)╭∩╮
-- 
cgit 


From bda81bc101bff7caf76d9a27aa31fccd24dcec84 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 13 Jan 2022 13:53:45 -0700
Subject: Added library-view.sh and bound it to <C-z>o

---
 extras/HOME/.local/bin/library-view.sh | 28 ++++++++++++++++++++++++++++
 src/Internal/Keys.hs                   |  3 +++
 2 files changed, 31 insertions(+)
 create mode 100755 extras/HOME/.local/bin/library-view.sh

diff --git a/extras/HOME/.local/bin/library-view.sh b/extras/HOME/.local/bin/library-view.sh
new file mode 100755
index 0000000..29925a8
--- /dev/null
+++ b/extras/HOME/.local/bin/library-view.sh
@@ -0,0 +1,28 @@
+#!/bin/bash
+
+MENU=(rofi -i -dmenu -sort -theme-str '* {theme-color: #ff88ff;}' -p "Library")
+
+if (which zathura) ; then
+  pdfviewer=zathura
+elif (which evince) ; then
+  pdfviewer=evince
+else
+  pdfviewer='xdg-open'
+fi
+
+
+cd ~/Library
+
+files=(*.pdf)
+
+file_with_title="$(for file in "${files[@]}" ; do
+  echo "$file| $(echo "$file" | sed 's#\(^\|_\|\s\)\([a-z]\)#\1\U\2#g' | tr '_' ' ' | sed 's/.[^.]*$//')"
+done)"
+
+selected=$(echo "$file_with_title" | (while read file ; do
+  echo "${file//*|}"
+done) | "${MENU[@]}")
+
+if [ ! -z "${selected}" ] ; then
+  $pdfviewer "$(echo "$file_with_title" | grep "$selected" | sed 's/|.*//')"
+fi
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 3189ddb..936b12a 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -244,6 +244,9 @@ keymap = runKeys $ do
       bind xK_w $
         (justMod -|- noMod) $ spawn "networkmanager_dmenu"
 
+      bind xK_o $
+        (justMod -|- noMod) $ spawn "library-view.sh"
+
       bind xK_v $ do
         (justMod -|- noMod) $ spawn "set-volume.sh"
         (shiftMod -|- rawMask shiftMask) $ spawn "set-volume.sh -a"
-- 
cgit 


From 0bde08d5180d08ef102d3d5bff0f50f2e7533e4e Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 13 Jan 2022 13:55:48 -0700
Subject: Added ability to control volume with <C-v>hhhh* and <C-v><C-llll*

---
 src/Internal/DMenu.hs |  2 +-
 src/Internal/Keys.hs  | 18 ++++++++++++++++++
 2 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/src/Internal/DMenu.hs b/src/Internal/DMenu.hs
index b611d87..0ec7927 100644
--- a/src/Internal/DMenu.hs
+++ b/src/Internal/DMenu.hs
@@ -17,7 +17,7 @@ data Colors =
   }  | DefaultColors
 
 menuCommand :: [String]
-menuCommand = ["rofi", "-monitor", "-4", "-dmenu"]
+menuCommand = ["rofi", "-monitor", "-4", "-dmenu", "-sort", "-levenshtein-sort"]
 
 menuCommandString :: String
 menuCommandString = unwords menuCommand
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 936b12a..27315cd 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys (applyKeys) where
 
+import Control.Monad.Fix (fix)
 import Graphics.X11.ExtraTypes.XF86;
 import Internal.KeysM
 import Internal.SwapMaster (swapMaster)
@@ -206,6 +207,23 @@ keymap = runKeys $ do
     shiftMod $ withFocused $ windows . W.sink 
     altMod   $ spawn (terminal config ++ " -t Floating\\ Term")
 
+  bind xK_v $
+    -- Allows repeated strokes of M-h and M-l to reduce and increase volume
+    -- respectively.
+    justMod $ fix $ \recur -> subkeys $ do
+      bind xK_h $ do
+        justMod $ do
+           spawn "pactl set-sink-volume @DEFAULT_SINK@ -5%"
+           recur
+
+      bind xK_l $ do
+        justMod $ do
+           spawn "pactl set-sink-volume @DEFAULT_SINK@ +5%"
+           recur
+
+      bind xK_v $ do
+        justMod $ recur
+
   bind xK_w $ do
     justMod windowJump
 
-- 
cgit 


From 6647209f708c09a2ab62ef3b5c77f9b4aa241c70 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 13 Jan 2022 14:28:47 -0700
Subject: Support for subdirectories in Library

---
 extras/HOME/.local/bin/library-view.sh | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/extras/HOME/.local/bin/library-view.sh b/extras/HOME/.local/bin/library-view.sh
index 29925a8..b2c5dd5 100755
--- a/extras/HOME/.local/bin/library-view.sh
+++ b/extras/HOME/.local/bin/library-view.sh
@@ -13,10 +13,9 @@ fi
 
 cd ~/Library
 
-files=(*.pdf)
-
-file_with_title="$(for file in "${files[@]}" ; do
-  echo "$file| $(echo "$file" | sed 's#\(^\|_\|\s\)\([a-z]\)#\1\U\2#g' | tr '_' ' ' | sed 's/.[^.]*$//')"
+file_with_title="$(find . -name '*.pdf' | while read file ; do
+  echo "$file| $(echo "$file" | sed \
+  's#\(^\|_\|\s\)\([a-z]\)#\1\U\2#g;s/\.[^.]*$//;s#^\(.*\)/\([^/]*\)$#\2 (\1)#' | tr '_' ' ')"
 done)"
 
 selected=$(echo "$file_with_title" | (while read file ; do
-- 
cgit 


From 913139d4b5fcf330fb67d4a9a4519d534131cb4f Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Sun, 16 Jan 2022 15:37:07 -0700
Subject: add more emoticons. Fix emoticon script.

---
 extras/HOME/.local/bin/emoticon-select.sh | 3 +--
 extras/HOME/.xmobarrc                     | 2 +-
 extras/HOME/.xmonad/emoticons.txt         | 1 +
 src/Internal/Keys.hs                      | 5 +++--
 4 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/extras/HOME/.local/bin/emoticon-select.sh b/extras/HOME/.local/bin/emoticon-select.sh
index e1637d1..5674e44 100755
--- a/extras/HOME/.local/bin/emoticon-select.sh
+++ b/extras/HOME/.local/bin/emoticon-select.sh
@@ -11,7 +11,6 @@ else
 fi
 
 
-selection="$("${menu[@]}" < $HOME/.xmonad/emoticons.txt)"
-emoticon="$(echo ${selection/*-})"
+emoticon="$("${menu[@]}" < $HOME/.xmonad/emoticons.txt | sed 's#^[^-]*-\s*##')"
 
 echo "$emoticon" | xclip -selection clipboard
diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index 299877f..4e7aed3 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -57,7 +57,7 @@ Config
          "--normal", "#88ff88",
          "--high", "#ff8888"
        ] 10,
-       Run Mpris2 "spotifyd" [
+       Run Mpris2 "spotify" [
            "-t", "<fc=#1aa54b></fc>  <fn=3><title></fn>",
            "--nastring", "<fc=#404040> </fc>"] 20,
        Run Com ".xmonad/xmobar-weather" [] "weather" 9000,
diff --git a/extras/HOME/.xmonad/emoticons.txt b/extras/HOME/.xmonad/emoticons.txt
index 65289c4..f919a81 100644
--- a/extras/HOME/.xmonad/emoticons.txt
+++ b/extras/HOME/.xmonad/emoticons.txt
@@ -1,5 +1,6 @@
 Bear             -     (''')(0.0)(''')
 Cry              -     ಥ_ಥ
+Cry              -     ಥ︵ಥ
 Deal with it     -     (•_•) ( •_•)>⌐■-■ (⌐■_■) 
 Deal with it.    -     (▀̿Ĺ̯▀̿ ̿)                   
 Disapprove       -     ಠ_ಠ                      
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 27315cd..8731f42 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -11,7 +11,7 @@ import Graphics.X11.ExtraTypes.XorgDefault
 import System.Process
 import XMonad.Util.Ungrab
 import XMonad.Layout.Spacing
-import Data.Maybe (isJust)
+import Data.Maybe (isJust, fromMaybe)
 import Debug.Trace
 import Control.Applicative
 import Prelude hiding ((!!))
@@ -51,7 +51,8 @@ keymap :: KeyMap l
 keymap = runKeys $ do
   config <- getConfig
 
-  let subkeys = submap . flip runKeys config
+  let defaultKey key = fromMaybe (return ()) $ Map.lookup key (keymap config)
+      subkeys = submapDefaultWithKey defaultKey . flip runKeys config
 
   bind xK_apostrophe $ do
     justMod $ subkeys $ do
-- 
cgit 


From 4f268190128b0e2bb56d57b99e808d1b0476eea6 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 17 Jan 2022 23:12:46 -0700
Subject: Better media

---
 extras/HOME/.xmobarrc            | 10 +++-------
 extras/HOME/.xmonad/xmobar-media |  9 +++++++++
 2 files changed, 12 insertions(+), 7 deletions(-)
 create mode 100755 extras/HOME/.xmonad/xmobar-media

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index 4e7aed3..6d4ab64 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -29,16 +29,14 @@ Config
    , alignSep = "}{"
    , template =
       " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc><fc=#404040> │\
-      \</fc><fc=#a0a0a0> %date%</fc><fc=#404040> │ \
       \</fc>%StdinReader%}\
       \{ %cpu% %memory% <fc=#404040>\
       \│</fc> %weather% <fc=#404040>│\
-      \</fc> <fc=#a0a0a0>%mpris2%</fc> <fc=#404040>│ \
+      \</fc> <fc=#a0a0a0>%media%</fc> <fc=#404040>│ \
       \</fc>%bluetooth%%bat% <fc=#404040>│</fc> <fn=2><fc=#606060>%time%</fc></fn> "
    , commands = [
        Run StdinReader,
-       Run Date "%H:%M:%S" "time" 10,
-       Run Date "<fn=3>%m/%d</fn>" "date" 10,
+       Run Date "%m/%d %H:%M:%S" "time" 10,
        Run Cpu [
            "-t", "<fn=3><fc=#000000><bar></fc></fn>",
            "-L", "3",
@@ -57,9 +55,7 @@ Config
          "--normal", "#88ff88",
          "--high", "#ff8888"
        ] 10,
-       Run Mpris2 "spotify" [
-           "-t", "<fc=#1aa54b></fc>  <fn=3><title></fn>",
-           "--nastring", "<fc=#404040> </fc>"] 20,
+       Run Com ".xmonad/xmobar-media" [] "media" 20,
        Run Com ".xmonad/xmobar-weather" [] "weather" 9000,
        Run Com ".xmonad/xmobar-logo" [] "logo" 0,
        Run Com "uname" ["-r"] "uname" 0,
diff --git a/extras/HOME/.xmonad/xmobar-media b/extras/HOME/.xmonad/xmobar-media
new file mode 100755
index 0000000..7232900
--- /dev/null
+++ b/extras/HOME/.xmonad/xmobar-media
@@ -0,0 +1,9 @@
+#!/bin/bash
+
+title="$(spotify-control getTitle)"
+
+if [[ "$?" -eq 0 ]] ; then
+  echo "<fc=#1aa54b></fc>  <fn=3>$title</fn>"
+else
+  echo "<fc=#404040> </fc>"
+fi
-- 
cgit 


From e2b8c1c7e934009e26ad640d75c689211f51cc1b Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 11 Feb 2022 12:22:30 -0700
Subject: Add set backlight keys. Have not yet committed the set-backlight.sh
 script yet

---
 src/Internal/Keys.hs | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 8731f42..ab8869e 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -310,6 +310,15 @@ keymap = runKeys $ do
   bind xF86XK_AudioPrev $ do
     noMod $ spawn "spotify-control prev"
 
+  bind xF86XK_MonBrightnessUp $ do
+    noMod $ spawn "set-backlight.sh +0.05"
+    justMod $ spawn "set-backlight.sh 1"
+
+  bind xF86XK_MonBrightnessDown $ do
+    noMod $ spawn "set-backlight.sh -0.05"
+    justMod $ spawn "set-backlight.sh 0.01"
+    rawMask shiftMask $ spawn "set-backlight.sh 0"
+
 mouseMap :: ButtonsMap l
 mouseMap = runButtons $ do
   bind button1 $ do
-- 
cgit 


From c6f882fe85e3766464cc68d4edd2abe9bd08217a Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 18 Mar 2022 10:15:13 -0600
Subject: Ability to submap the mouse. Added bindings for my Logitech G502
 Hero.

---
 src/Internal/Keys.hs   | 136 +++++++++++++++++++++++++++++++++++++++----------
 src/Internal/Logger.hs |  36 +++++++++++++
 src/Internal/Submap.hs |  31 ++++++++++-
 3 files changed, 175 insertions(+), 28 deletions(-)
 create mode 100644 src/Internal/Logger.hs

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 8731f42..0fd3d52 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -43,10 +43,49 @@ import qualified XMonad.StackSet as W
 import Internal.Lib
 import Internal.DMenu
 import Internal.PassMenu
+import Internal.Logger
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
 
+
+decreaseVolume = spawn "pactl set-sink-volume @DEFAULT_SINK@ -5%"
+increaseVolume = spawn "pactl set-sink-volume @DEFAULT_SINK@ +5%"
+playPause = spawn "spotify-control play"
+mediaPrev = spawn "spotify-control prev"
+mediaNext = spawn "spotify-control next"
+
+
+button6 :: Button
+button6 = 6
+
+button7 :: Button
+button7 = 7
+
+button8 :: Button
+button8 = 8
+
+button9 :: Button
+button9 = 9
+
+button10 :: Button
+button10 = 10
+
+button11 :: Button
+button11 = 11
+
+button12 :: Button
+button12 = 12
+
+button13 :: Button
+button13 = 13
+
+button14 :: Button
+button14 = 14
+
+button15 :: Button
+button15 = 15
+
 keymap :: KeyMap l
 keymap = runKeys $ do
   config <- getConfig
@@ -76,7 +115,7 @@ keymap = runKeys $ do
     -- Button programmed on mouse
     rawMask shiftMask $ click >> withFocused (windows . W.sink)
 
-    shiftMod $ spawn "spotify-control play"
+    shiftMod playPause
 
   bind xK_F2 $
     -- Button programmed on mouse
@@ -91,18 +130,18 @@ keymap = runKeys $ do
 
       -- I Don't really use these, but they could be bound to something cool!
       bind xK_F2 $
-        rawMask shiftMask $ spawn "spotify-control next"
+        rawMask shiftMask mediaNext
       bind xK_F3 $
-        rawMask shiftMask $ spawn "spotify-control prev"
+        rawMask shiftMask mediaPrev
 
   bind xK_F10 $ do
-    justMod $ spawn "spotify-control play"
+    justMod playPause
 
   bind xK_F11 $ do
-    justMod $ spawn "spotify-control prev"
+    justMod mediaPrev
 
   bind xK_F12 $ do
-    justMod $ spawn "spotify-control next"
+    justMod mediaNext
 
   bind xK_Return $ do
     justMod swapMaster
@@ -205,7 +244,7 @@ keymap = runKeys $ do
 
   bind xK_t $ do
     justMod  $ spawn (terminal config)
-    shiftMod $ withFocused $ windows . W.sink 
+    shiftMod $ withFocused $ windows . W.sink
     altMod   $ spawn (terminal config ++ " -t Floating\\ Term")
 
   bind xK_v $
@@ -214,12 +253,12 @@ keymap = runKeys $ do
     justMod $ fix $ \recur -> subkeys $ do
       bind xK_h $ do
         justMod $ do
-           spawn "pactl set-sink-volume @DEFAULT_SINK@ -5%"
+           decreaseVolume
            recur
 
       bind xK_l $ do
         justMod $ do
-           spawn "pactl set-sink-volume @DEFAULT_SINK@ +5%"
+           increaseVolume
            recur
 
       bind xK_v $ do
@@ -234,7 +273,7 @@ keymap = runKeys $ do
   bind xK_z $ do
 
     justMod $ subkeys $ do
-      
+
       bind xK_g $ do
         (justMod -|- noMod) $ mapNextString $ \_ s ->
           case s of
@@ -247,6 +286,9 @@ keymap = runKeys $ do
             str
             (show (map ord str))
 
+      bind xK_t $ do
+        (justMod -|- noMod) $ logs "Test Log"
+
       bind xK_n $ do
         (justMod -|- noMod) $ spawn (terminal config ++ " -t Notes -e notes new")
 
@@ -269,7 +311,6 @@ keymap = runKeys $ do
       bind xK_v $ do
         (justMod -|- noMod) $ spawn "set-volume.sh"
         (shiftMod -|- rawMask shiftMask) $ spawn "set-volume.sh -a"
-        
 
       -- Double-tap Z to toggle zoom.
       bind xK_z $ do
@@ -277,41 +318,50 @@ keymap = runKeys $ do
 
       -- Z is reserved to create sub keybindings to do various things.
       -- I don't really use these at the moment.
-      bind xK_h $ do
-        noMod $ spawn "spotify-control prev"
+      bind xK_h $ noMod mediaPrev
 
-      bind xK_l $ do
-        noMod $ spawn "spotify-control next"
+      bind xK_l $ noMod mediaNext
 
     -- Centers the current focused window. i.e. toggles the Zoom layout
     -- modifier.
     shiftMod $ sendMessage ToggleZoom
 
+  bind xF86XK_Calculator $ do
+    noMod $ spawn $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
+
   bind xF86XK_AudioLowerVolume $ do
     noMod $ spawn "pactl set-sink-volume @DEFAULT_SINK@ -1%"
-    justMod $ spawn "spotify-control prev"
+    justMod mediaPrev
 
   bind xF86XK_AudioRaiseVolume $ do
     noMod $ spawn "pactl set-sink-volume @DEFAULT_SINK@ +1%"
-    justMod $ spawn "spotify-control next"
+    justMod mediaNext
 
   bind xF86XK_AudioMute $ do
     noMod $ spawn "pactl set-sink-mute @DEFAULT_SINK@ toggle"
 
   bind xF86XK_AudioPlay $ do
-    noMod $ spawn "spotify-control play"
+    noMod playPause
 
   bind xF86XK_AudioNext $ do
-    noMod $ spawn "spotify-control next"
+    noMod mediaNext
 
   bind xF86XK_AudioPrev $ do
-    noMod $ spawn "spotify-control prev"
+    noMod mediaPrev
 
   bind xF86XK_AudioPrev $ do
-    noMod $ spawn "spotify-control prev"
+    noMod mediaPrev
 
 mouseMap :: ButtonsMap l
 mouseMap = runButtons $ do
+  config <- getConfig
+
+  let x button = Map.lookup button (mouseMap config)
+
+  let defaultButtons button = fromMaybe (\w -> return ()) $
+          Map.lookup button (mouseMap config)
+      subMouse = submapButtonsWithKey defaultButtons . flip runButtons config
+
   bind button1 $ do
     justMod $ \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster
 
@@ -321,17 +371,49 @@ mouseMap = runButtons $ do
   bind button3 $ do
     justMod $ \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster
 
-  bind (6 :: Button) $
+  bind button6 $
     justMod $ const (relativeWorkspaceShift prev)
 
-  bind (7 :: Button) $
+  bind button7 $
     justMod $ const (relativeWorkspaceShift next)
 
-  bind (8 :: Button) $
-    justMod $ const $ spawn "spotify-control prev"
+  bind button8 $
+    justMod $ const mediaPrev
+
+  bind button9 $
+    justMod $ const mediaNext
+
+  bind button14 $ do
+    noMod $ subMouse $ do
+
+      bind button13 $ do
+        noMod $ \_ -> click >> CopyWindow.kill1
+
+      bind button14 $ do
+        noMod $ \_ -> click >> sendMessage ToggleZoom
+
+      let mediaButtons = [
+            (button4, increaseVolume),
+            (button5, decreaseVolume),
+            (button2, playPause),
+            (button9, mediaNext),
+            (button8, mediaPrev),
+            (button6, mediaPrev),
+            (button7, mediaNext)
+            ]
+
+      let continuous :: [(Button, X ())] -> Button -> Window -> X ()
+          continuous actions button w = do
+            case find ((==button) . fst) actions of
+              Just (_, action) -> action
+              Nothing -> return ()
+
+            (subMouse $
+              forM_ (map fst mediaButtons) $ \b ->
+                bind b $ noMod $ \w -> continuous actions b w) w
 
-  bind (9 :: Button) $
-    justMod $ const $ spawn "spotify-control next"
+      forM_ (map fst mediaButtons) $ \b ->
+        bind b $ noMod $ continuous mediaButtons b
 
 applyKeys :: XConfig l -> IO (XConfig l)
 applyKeys config =
diff --git a/src/Internal/Logger.hs b/src/Internal/Logger.hs
new file mode 100644
index 0000000..f1960fb
--- /dev/null
+++ b/src/Internal/Logger.hs
@@ -0,0 +1,36 @@
+module Internal.Logger where
+
+import XMonad
+import qualified XMonad.Util.ExtensibleState as XS
+import System.IO
+
+data LoggerState =
+  LoggerState {
+    logHandle :: Maybe Handle
+  }
+
+instance Read LoggerState where
+  readsPrec i s = map (\(_, s) -> (LoggerState Nothing, s)) (readsPrec i s :: [((), String)])
+
+instance Show LoggerState where
+  show _ = show ()
+
+instance ExtensionClass LoggerState where
+  initialValue = LoggerState Nothing
+
+logs :: String -> X ()
+logs s = do
+  LoggerState handle' <- XS.get
+
+  handle <-
+    case handle' of
+      Nothing -> do
+        handle <- io $ openFile "/tmp/xmonad.log" AppendMode
+        XS.put $ LoggerState (Just handle)
+        return handle
+
+      Just h -> return h
+  
+  io $ do
+    hPutStrLn handle s
+    hFlush handle
diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
index cdc2f95..40becdc 100644
--- a/src/Internal/Submap.hs
+++ b/src/Internal/Submap.hs
@@ -1,7 +1,13 @@
-module Internal.Submap (mapNextString, module X) where
+module Internal.Submap (
+    mapNextString,
+    submapButtonsWithKey,
+    nextButton,
+    module X) where
 
 import XMonad hiding (keys)
 import Control.Monad.Fix (fix)
+import qualified Data.Map as Map
+import Data.Map (Map)
 
 import XMonad.Actions.Submap as X
 
@@ -26,3 +32,26 @@ mapNextString fn = do
   io $ ungrabKeyboard d currentTime
 
   fn m str
+
+nextButton :: X (ButtonMask, Button)
+nextButton = do
+  XConf { theRoot = root, display = d } <- ask
+  io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime
+
+  ret <- io $ allocaXEvent $ \xEv -> do
+    maskEvent d buttonPressMask xEv
+    ButtonEvent { ev_button = button, ev_state = m } <- getEvent xEv
+    return (m, button)
+
+  io $ ungrabPointer d currentTime
+
+  return ret
+
+submapButtonsWithKey ::
+    ((ButtonMask, Button) -> Window -> X ()) -> (Map (ButtonMask, Button) (Window -> X ())) -> Window -> X ()
+submapButtonsWithKey defaultAction actions window = do
+  arg <- nextButton
+
+  case Map.lookup arg actions of
+    Nothing -> defaultAction arg window
+    Just fn -> fn window
-- 
cgit 


From b810758e6a418db3eb6c5d1ab504273f01b7b00d Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 18 Mar 2022 10:17:09 -0600
Subject: Minor fixes to weather and bluetooth scripts.

---
 extras/HOME/.xmonad/xmobar-bluetooth | 24 +++++++++++--------
 extras/HOME/.xmonad/xmobar-weather   | 46 ++++++++++++++++++------------------
 2 files changed, 37 insertions(+), 33 deletions(-)

diff --git a/extras/HOME/.xmonad/xmobar-bluetooth b/extras/HOME/.xmonad/xmobar-bluetooth
index 9b4f5cc..16a6d70 100755
--- a/extras/HOME/.xmonad/xmobar-bluetooth
+++ b/extras/HOME/.xmonad/xmobar-bluetooth
@@ -2,17 +2,21 @@
 
 cur=""
 
-bluetoothctl -- info | while read line ; do
-  key=${line%%: *}
-  value=${line//*: }
+if [ -d /sys/class/bluetooth ] ; then
 
-  if [ "$key" == "Name" ] ; then
-    cur="$value"
-  fi
+  bluetoothctl -- info | while read line ; do
+    key=${line%%: *}
+    value=${line//*: }
 
-  if [ "$key" == "Connected" -a "$value" == "yes" ] ; then
-    exec echo "<fc=#4287f5></fc> <fc=#a0a0a0><fn=3>$cur</fn></fc> <fc=#404040>│</fc> "
-  fi
-done
+    if [ "$key" == "Name" ] ; then
+      cur="$value"
+    fi
+
+    if [ "$key" == "Connected" -a "$value" == "yes" ] ; then
+      exec echo "<fc=#4287f5></fc> <fc=#a0a0a0><fn=3>$cur</fn></fc> <fc=#404040>│</fc> "
+    fi
+  done
+
+fi
 
 exec echo "<fc=#404040></fc> <fc=#404040>│</fc> "
diff --git a/extras/HOME/.xmonad/xmobar-weather b/extras/HOME/.xmonad/xmobar-weather
index 6b5c409..0fee524 100755
--- a/extras/HOME/.xmonad/xmobar-weather
+++ b/extras/HOME/.xmonad/xmobar-weather
@@ -69,30 +69,30 @@ if ($current_str gt $sunrise_str and $current_str lt $sunset_str) {
 $dir=%directions{$wind_direction};
 
 %conditions_day = (
-  clear => "<fc=#ddcf04>",
-  sunny => "<fc=#ddcf04>",
-  mostly_clear => "<fc=#00a3c4>",
-  mostly_sunny => "<fc=#ddcf04>",
-  partly_sunny => "<fc=#ddcf04>",
-  fair => "<fc=#a0a0a0>🌑",
-  cloudy =>"<fc=#a0a0a0>摒",
-  overcast =>"<fc=#808080>",
-  partly_cloudy => "<fc=#a0a0a0>杖",
-  mostly_cloudy => "<fc=#808080>",
-  considerable_cloudiness => "<fc=#a0a0a0>ﭽ" );
+  clear => "<fc=#ddcf04></fc>",
+  sunny => "<fc=#ddcf04></fc>",
+  mostly_clear => "<fc=#00a3c4></fc>",
+  mostly_sunny => "<fc=#ddcf04></fc>",
+  partly_sunny => "<fc=#ddcf04></fc>",
+  fair => "<fc=#a0a0a0>🌑</fc>",
+  cloudy =>"<fc=#a0a0a0>摒</fc>",
+  overcast =>"<fc=#808080></fc>",
+  partly_cloudy => "<fc=#a0a0a0>杖</fc>",
+  mostly_cloudy => "<fc=#808080></fc>",
+  considerable_cloudiness => "<fc=#a0a0a0>ﭽ</fc>" );
 
 %conditions_night = (
-  clear => "<fc=#00a3c4>",
-  sunny => "<fc=#00a3c4>",
-  mostly_clear => "<fc=#00a3c4>",
-  mostly_sunny => "<fc=#00a3c4>",
-  partly_sunny => "<fc=#00a3c4>",
-  fair => "<fc=#808080>🌑",
-  cloudy =>"<fc=#808080>摒",
-  overcast =>"<fc=#404040>",
-  partly_cloudy => "<fc=#a0a0a0>",
-  mostly_cloudy => "<fc=#808080>",
-  considerable_cloudiness => "<fc=#a0a0a0>ﭽ" );
+  clear => "<fc=#00a3c4></fc>",
+  sunny => "<fc=#00a3c4></fc>",
+  mostly_clear => "<fc=#00a3c4></fc>",
+  mostly_sunny => "<fc=#00a3c4></fc>",
+  partly_sunny => "<fc=#00a3c4></fc>",
+  fair => "<fc=#808080>🌑</fc>",
+  cloudy =>"<fc=#808080>摒</fc>",
+  overcast =>"<fc=#404040></fc>",
+  partly_cloudy => "<fc=#a0a0a0></fc>",
+  mostly_cloudy => "<fc=#808080></fc>",
+  considerable_cloudiness => "<fc=#a0a0a0>ﭽ</fc>" );
 
 if ($is_day) {
   $conditions = %conditions_day{$sky_conditions};
@@ -100,4 +100,4 @@ if ($is_day) {
   $conditions = %conditions_night{$sky_conditions};  
 }
 
-printf("<fc=#a0a0a0><fn=3>$city</fn> <fn=3>$dir</fn> <fn=3>${wind_speed}</fn></fc> $conditions</fc><fn=3>   <fc=#a0a0a0>%.0f°F</fc></fn>\n", $temp);
+printf("<fc=#a0a0a0><fn=3>$city</fn> <fn=3>$dir</fn> <fn=3>${wind_speed}</fn></fc> $conditions<fn=3>   <fc=#a0a0a0>%.0f°F</fc></fn>\n", $temp);
-- 
cgit 


From a87cbc7357566b26c7dca7538d4b03da5f8b999a Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 18 Mar 2022 17:47:40 -0600
Subject: Add experimental motion events. Not super useful at the moment, but
 might be in the future.

---
 package.yaml           |  1 +
 src/Internal/Keys.hs   | 17 ++++++++++++++++-
 src/Internal/Submap.hs | 15 +++++++++++++++
 src/Main.hs            |  1 +
 4 files changed, 33 insertions(+), 1 deletion(-)

diff --git a/package.yaml b/package.yaml
index 318a3af..b07f2df 100644
--- a/package.yaml
+++ b/package.yaml
@@ -21,3 +21,4 @@ dependencies:
   - split
   - mtl
   - transformers
+  - monad-loops
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 0fd3d52..195e12f 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys (applyKeys) where
 
+import Control.Monad.Loops (iterateWhile)
 import Control.Monad.Fix (fix)
 import Graphics.X11.ExtraTypes.XF86;
 import Internal.KeysM
@@ -230,6 +231,19 @@ keymap = runKeys $ do
 
   bind xK_q $ do
     shiftMod $ spawn "xmonad --recompile && xmonad --restart"
+    
+    justMod $ subkeys $ do
+
+      bind xK_q $
+        (justMod -|- noMod) $ do
+          firstMotion@(x, y) <- nextMotion
+          (x', y') <- iterateWhile (==firstMotion) nextMotion
+
+          logs $ printf "Motion: (%d, %d) (%d, %d)" x y x' y'
+
+          if (x' - x) < 0
+            then mediaPrev
+            else mediaNext
 
   bind xK_r $ do
     justMod runDMenu
@@ -319,7 +333,7 @@ keymap = runKeys $ do
       -- Z is reserved to create sub keybindings to do various things.
       -- I don't really use these at the moment.
       bind xK_h $ noMod mediaPrev
-
+      bind xK_j $ noMod playPause
       bind xK_l $ noMod mediaNext
 
     -- Centers the current focused window. i.e. toggles the Zoom layout
@@ -402,6 +416,7 @@ mouseMap = runButtons $ do
             (button7, mediaNext)
             ]
 
+
       let continuous :: [(Button, X ())] -> Button -> Window -> X ()
           continuous actions button w = do
             case find ((==button) . fst) actions of
diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
index 40becdc..e5968ff 100644
--- a/src/Internal/Submap.hs
+++ b/src/Internal/Submap.hs
@@ -2,6 +2,7 @@ module Internal.Submap (
     mapNextString,
     submapButtonsWithKey,
     nextButton,
+    nextMotion,
     module X) where
 
 import XMonad hiding (keys)
@@ -47,6 +48,20 @@ nextButton = do
 
   return ret
 
+nextMotion :: X (Int, Int)
+nextMotion = do
+  XConf { theRoot = root, display = d } <- ask
+  io $ grabPointer d root False pointerMotionMask grabModeAsync grabModeAsync 0 0 currentTime
+
+  ret <- io $ allocaXEvent $ \xEv -> do
+    maskEvent d pointerMotionMask xEv
+    MotionEvent { ev_x = x, ev_y = y } <- getEvent xEv
+    return (fromIntegral x, fromIntegral y)
+
+  io $ ungrabPointer d currentTime
+
+  return ret
+
 submapButtonsWithKey ::
     ((ButtonMask, Button) -> Window -> X ()) -> (Map (ButtonMask, Button) (Window -> X ())) -> Window -> X ()
 submapButtonsWithKey defaultAction actions window = do
diff --git a/src/Main.hs b/src/Main.hs
index f70496c..cda3ae2 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -13,6 +13,7 @@ import Data.Monoid
 import Internal.XMobarLog
 import Internal.Keys
 import Internal.Layout
+import Internal.Logger
 import Internal.DMenu (menuCommandString)
 
 import qualified XMonad as X
-- 
cgit 


From 4e718217ada0367b220f0e2134dbf6cbdcb28977 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 24 Mar 2022 10:38:05 -0600
Subject: Add more mouse motions. Add bindings for navigation to button15+<>

---
 src/Internal/Keys.hs         | 48 +++++++++++++++++++++++++++++++++++---------
 src/Internal/ScreenRotate.hs | 19 ++++++++++++++++++
 src/Main.hs                  |  5 +++--
 3 files changed, 60 insertions(+), 12 deletions(-)
 create mode 100644 src/Internal/ScreenRotate.hs

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 195e12f..1118788 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -45,6 +45,7 @@ import Internal.Lib
 import Internal.DMenu
 import Internal.PassMenu
 import Internal.Logger
+import Internal.ScreenRotate (screenRotateForward, screenRotateBackward)
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
@@ -376,6 +377,17 @@ mouseMap = runButtons $ do
           Map.lookup button (mouseMap config)
       subMouse = submapButtonsWithKey defaultButtons . flip runButtons config
 
+
+  let continuous :: [(Button, X ())] -> Button -> Window -> X ()
+      continuous actions button w = do
+        case find ((==button) . fst) actions of
+          Just (_, action) -> action
+          Nothing -> return ()
+
+        (subMouse $
+          forM_ (map fst actions) $ \b ->
+            bind b $ noMod $ \w -> continuous actions b w) w
+
   bind button1 $ do
     justMod $ \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster
 
@@ -406,6 +418,9 @@ mouseMap = runButtons $ do
       bind button14 $ do
         noMod $ \_ -> click >> sendMessage ToggleZoom
 
+      bind button15 $ do
+        noMod $ \_ -> spawn "pavucontrol"
+
       let mediaButtons = [
             (button4, increaseVolume),
             (button5, decreaseVolume),
@@ -416,19 +431,32 @@ mouseMap = runButtons $ do
             (button7, mediaNext)
             ]
 
+      forM_ (map fst mediaButtons) $ \b ->
+        bind b $ noMod $ continuous mediaButtons b
 
-      let continuous :: [(Button, X ())] -> Button -> Window -> X ()
-          continuous actions button w = do
-            case find ((==button) . fst) actions of
-              Just (_, action) -> action
-              Nothing -> return ()
+  bind button15 $ do
 
-            (subMouse $
-              forM_ (map fst mediaButtons) $ \b ->
-                bind b $ noMod $ \w -> continuous actions b w) w
+    noMod $ subMouse $ do
+      
+      bind button15 $ do
+        noMod $ \_ -> jumpToLast
 
-      forM_ (map fst mediaButtons) $ \b ->
-        bind b $ noMod $ continuous mediaButtons b
+
+      let workspaceButtons = [
+            (button2, swapMaster),
+
+            (button9, relativeWorkspaceShift next),
+            (button8, relativeWorkspaceShift prev),
+
+            (button4, windows W.focusUp),
+            (button5, windows W.focusDown),
+
+            (button7, windows screenRotateForward),
+            (button6, windows screenRotateBackward)
+            ]
+
+      forM_ (map fst workspaceButtons) $ \b ->
+        bind b $ noMod $ continuous workspaceButtons b
 
 applyKeys :: XConfig l -> IO (XConfig l)
 applyKeys config =
diff --git a/src/Internal/ScreenRotate.hs b/src/Internal/ScreenRotate.hs
new file mode 100644
index 0000000..ff6417c
--- /dev/null
+++ b/src/Internal/ScreenRotate.hs
@@ -0,0 +1,19 @@
+module Internal.ScreenRotate where
+
+import XMonad.StackSet as W
+
+screenRotateForward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
+screenRotateForward (W.StackSet current visible others floating) = do
+  let screens = current : visible
+      workspaces = tail $ cycle $ map W.workspace screens
+      (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
+      in W.StackSet current' visible' others floating
+
+screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
+screenRotateBackward (W.StackSet current visible others floating) = do
+  let screens = current : visible
+      workspaces = rcycle $ map W.workspace screens
+      (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
+      in W.StackSet current' visible' others floating
+
+  where rcycle l = last l : l
diff --git a/src/Main.hs b/src/Main.hs
index cda3ae2..5433c2e 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -48,8 +48,9 @@ main = do
          , title =? "Event Tester" --> doFloat
          , title =? "Floating Term" --> doCenterFloat
          , title =? "Notes" --> doCenterFloat
-         , title =? "xmessage" --> doFloat
-         , title =? "gxmessage" --> doFloat
+         , title =? "xmessage" --> doCenterFloat
+         , title =? "gxmessage" --> doCenterFloat
+         , title =? "Volume Control" --> doCenterFloat
          , className =? "mpv" --> doFloat
          , className =? "gnubby_ssh_prompt" --> doFloat
          ]
-- 
cgit 


From e5f6b5109aab58b5d066ada7c542d0ecb991cafb Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 25 Mar 2022 15:32:06 -0600
Subject: Added a way to do per-window bindings in XMonad.

This is particularly great for Chrome where one cannot remap
the built-in bindings and some built-in bindings are really dumb
(looking at you Ctrl+w!!).
---
 package.yaml              |   1 +
 src/Internal/Intercept.hs | 157 ++++++++++++++++++++++++++++++++++++++++++++++
 src/Internal/Keys.hs      |  12 +++-
 src/Main.hs               |  31 ++++++++-
 4 files changed, 197 insertions(+), 4 deletions(-)
 create mode 100644 src/Internal/Intercept.hs

diff --git a/package.yaml b/package.yaml
index b07f2df..7cfb52c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -22,3 +22,4 @@ dependencies:
   - mtl
   - transformers
   - monad-loops
+  - data-default
diff --git a/src/Internal/Intercept.hs b/src/Internal/Intercept.hs
new file mode 100644
index 0000000..987733b
--- /dev/null
+++ b/src/Internal/Intercept.hs
@@ -0,0 +1,157 @@
+module Internal.Intercept where
+
+import XMonad
+
+import Text.Printf
+import Data.Monoid (Endo(..))
+import Control.Monad.Trans.Class (lift)
+import Control.Monad (forM, forM_)
+import Data.Default (Default, def)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified XMonad.Util.ExtensibleState as XS
+import Data.Monoid (All(..))
+
+import Internal.Logger
+
+type WindowHook = Query ()
+
+newtype NoPersist a = NoPersist a
+  deriving (Typeable)
+
+instance Show (NoPersist a) where
+  show (NoPersist _) = show ()
+
+instance (Default a) => Read (NoPersist a) where
+  readsPrec i s = map (\(_, s) -> (NoPersist def, s)) (readsPrec i s :: [((), String)])
+
+instance (Default a) => Default (NoPersist a) where
+  def = NoPersist def
+
+instance (Default a, Typeable a) => ExtensionClass (NoPersist a) where
+  initialValue = NoPersist def
+
+
+data InterceptState = InterceptState (NoPersist (Map (KeyMask, KeySym) (X ())))
+
+data RemapState = RemapState (NoPersist (Map (Window, (KeyMask, KeySym)) (X ())))
+
+instance ExtensionClass InterceptState where
+  initialValue = InterceptState def
+
+instance ExtensionClass RemapState where
+  initialValue = RemapState def
+
+remapHook :: Event -> X All
+remapHook event = do
+  RemapState (NoPersist map) <- XS.get
+
+  case event of
+    KeyEvent { ev_window = win, ev_event_type = typ, ev_keycode = code, ev_state = m }
+        | typ == keyPress-> do
+      XConf {display = dpy, theRoot = rootw} <- ask
+      keysym <- io $ keycodeToKeysym dpy code 0
+
+      case Map.lookup (win, (m, keysym)) map of
+
+        Just xdo -> do
+          xdo
+          return (All False)
+
+        Nothing -> return (All True)
+
+    _ -> return (All True)
+
+interceptHook :: Event -> X All
+interceptHook event = do
+  InterceptState (NoPersist map) <- XS.get
+  case event of
+    KeyEvent { ev_event_type = typ, ev_keycode = code, ev_state = m }
+        | typ == keyPress-> do
+      XConf {display = dpy, theRoot = rootw} <- ask
+      keysym <- io $ keycodeToKeysym dpy code 0
+
+      case Map.lookup (m, keysym) map of
+
+        Just xdo -> do
+          xdo
+          mapM_ (\m' -> io $ ungrabKey dpy code (m .|. m') rootw)
+              =<< extraModifiers
+          return (All False)
+
+        Nothing -> return (All True)
+
+    _ -> return (All True)
+
+setIntercept :: (KeyMask, KeySym) -> X () -> X ()
+setIntercept (keyMask, keysym) action = do
+  XS.modify $ \(InterceptState (NoPersist m)) -> InterceptState $ NoPersist $
+    Map.insert (keyMask, keysym) action m
+  XConf { display = dpy, theRoot = rootw } <- ask
+
+  doGrab dpy rootw (keyMask, keysym)
+
+
+getKeyCodesForKeysym :: Display -> KeySym -> IO [KeyCode]
+getKeyCodesForKeysym dpy keysym = do
+  let (minCode, maxCode) = displayKeycodes dpy
+      allCodes = [fromIntegral minCode .. fromIntegral maxCode]
+
+  syms <- forM allCodes $ \code -> keycodeToKeysym dpy code 0
+  let keysymMap' = Map.fromListWith (++) (zip syms [[code] | code <- allCodes])
+
+  -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
+  -- want to grab those whenever someone accidentally uses def :: KeySym
+  let keysymMap = Map.delete noSymbol keysymMap'
+  let keysymToKeycodes sym = Map.findWithDefault [] keysym keysymMap
+
+  return $ keysymToKeycodes keysym
+
+
+doGrab :: Display -> Window -> (KeyMask, KeySym) -> X ()
+doGrab dpy win (keyMask, keysym) = do
+  let grab kc m = io $ grabKey dpy kc m win True grabModeAsync grabModeAsync
+      (minCode, maxCode) = displayKeycodes dpy
+      allCodes = [fromIntegral minCode .. fromIntegral maxCode]
+
+  -- build a map from keysyms to lists of keysyms (doing what
+  -- XGetKeyboardMapping would do if the X11 package bound it)
+  syms <- forM allCodes $ \code -> io (keycodeToKeysym dpy code 0)
+  let keysymMap' = Map.fromListWith (++) (zip syms [[code] | code <- allCodes])
+  -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
+  -- want to grab those whenever someone accidentally uses def :: KeySym
+  let keysymMap = Map.delete noSymbol keysymMap'
+  let keysymToKeycodes sym = Map.findWithDefault [] keysym keysymMap
+
+  forM_ (keysymToKeycodes keysym) $ \kc ->
+    mapM_ (grab kc . (keyMask .|.)) =<< extraModifiers
+
+disableKey :: (KeyMask, KeySym) -> WindowHook
+disableKey key = remapKey key (return ())
+
+remapKey :: (KeyMask, KeySym) -> X () -> WindowHook
+remapKey keyFrom action = do
+  window <- ask
+  Query $ lift $ do
+    XConf { display = disp, theRoot = rootw } <- ask
+    doGrab disp window keyFrom
+
+    XS.modify $ \(RemapState (NoPersist keyMap)) -> RemapState $ NoPersist $
+      Map.insert (window, keyFrom) action keyMap
+
+rebindKey :: (KeyMask, KeySym) -> (KeyMask, KeySym) -> WindowHook
+rebindKey keyFrom keyTo = do
+  window <- ask
+  remapKey keyFrom $ do
+    XConf { display = disp, theRoot = rootw } <- ask
+    codes <- io $ getKeyCodesForKeysym disp (snd keyTo)
+    case codes of
+      (keyCode:_) -> do
+        io $ allocaXEvent $ \xEv -> do
+          setEventType xEv keyPress
+          setKeyEvent xEv window rootw none (fst keyTo) keyCode True
+          sendEvent disp window True keyPressMask xEv
+          setEventType xEv keyRelease
+          sendEvent disp window True keyPressMask xEv
+
+      _ -> return ()
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 1118788..c40c346 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys (applyKeys) where
 
+import Internal.Intercept (setIntercept)
 import Control.Monad.Loops (iterateWhile)
 import Control.Monad.Fix (fix)
 import Graphics.X11.ExtraTypes.XF86;
@@ -246,6 +247,12 @@ keymap = runKeys $ do
             then mediaPrev
             else mediaNext
 
+      bind xK_t $
+
+        (justMod -|- noMod) $
+          setIntercept (modMask config, xK_i) $
+            logs $ "Intercepted!"
+ 
   bind xK_r $ do
     justMod runDMenu
     shiftMod $ sendMessage DoRotate
@@ -470,4 +477,7 @@ click = do
 
 modifyWindowBorder :: Integer -> SpacingModifier
 modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
-  Border (a + i) (b + i) (c + i) (d + i)
+  Border (clip $ a + i) (clip $ b + i) (clip $ c + i) (clip $ d + i)
+
+  where clip i | i < 0 = 0
+        clip i | otherwise = i
diff --git a/src/Main.hs b/src/Main.hs
index 5433c2e..b2a20d7 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,6 +1,7 @@
 import XMonad
 
 import Control.Monad.Trans.Class
+import Control.Monad.Reader
 import XMonad.Hooks.ManageDocks (docks)
 import System.Directory (getHomeDirectory)
 import System.FilePath ((</>))
@@ -15,10 +16,13 @@ import Internal.Keys
 import Internal.Layout
 import Internal.Logger
 import Internal.DMenu (menuCommandString)
+import Internal.Intercept
+import XMonad.Actions.WithAll (withAll)
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as W
 
+
 main = do
 
   -- Execute some commands.
@@ -31,7 +35,15 @@ main = do
   xmobar <- spawnXMobar
 
   (=<<) X.xmonad $
-    applyKeys $ ewmh $ docks $ def
+    applyKeys $ ewmh $ docks $ windowHooks (composeAll [
+           className =? "Google-chrome" --> composeAll [
+             -- The geniuses that made chrome decided that Ctrl+W should kill
+             -- the current tab! This makes it consistent with the rest of the
+             -- world ... ctrl+w deletes the last word (ctrl+backspace).
+             rebindKey (controlMask, xK_w) (controlMask, xK_BackSpace),
+             rebindKey (controlMask, xK_h) (0, xK_BackSpace)
+           ]
+        ]) $ def
        { terminal    = "alacritty"
        , modMask     = mod3Mask
        , borderWidth = 2
@@ -39,7 +51,7 @@ main = do
        , focusedBorderColor = "#ff6c00"
        , normalBorderColor = "#404040"
        , layoutHook = myLayout
-       , startupHook = spawn fp  
+       , startupHook = spawn fp
        , manageHook = composeAll [
            isFullscreen --> doFullFloat
          , className =? "Tilda" --> doFloat
@@ -55,7 +67,8 @@ main = do
          , className =? "gnubby_ssh_prompt" --> doFloat
          ]
        , workspaces = map return (['0'..'9'] ++ ['a'..'z'])
-       , handleEventHook = fullscreenEventHook
+       , handleEventHook =
+           composeAll [fullscreenEventHook, interceptHook, remapHook]
        , focusFollowsMouse = False
        , clickJustFocuses = False
        , logHook = xMobarLogHook xmobar
@@ -67,3 +80,15 @@ doCenterFloat =
 
 centerRect :: W.RationalRect -> W.RationalRect
 centerRect (W.RationalRect x y w h) = W.RationalRect ((1 - w) / 2) ((1 - h) / 2) w h
+
+
+windowHooks :: WindowHook -> XConfig l -> XConfig l
+windowHooks (Query readerT) config = do
+
+  config {
+    startupHook = do
+      withAll $ \w -> runReaderT readerT w
+      startupHook config,
+
+    manageHook = mappend (Query readerT >> return (Endo id)) (manageHook config)
+  }
-- 
cgit 


From a7129b68fb7fa4f7cea52513fad7223dcbba9801 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 25 Mar 2022 15:55:54 -0600
Subject: Another Chrome binding added.

There's a bug where it seems the mappings are applied inconsistently
after a restart. Not sure what causes that. Seems bouncing XMonad again
fixes it.
---
 src/Internal/Intercept.hs | 17 ++++++-----------
 src/Main.hs               |  6 ++++--
 2 files changed, 10 insertions(+), 13 deletions(-)

diff --git a/src/Internal/Intercept.hs b/src/Internal/Intercept.hs
index 987733b..c99ce09 100644
--- a/src/Internal/Intercept.hs
+++ b/src/Internal/Intercept.hs
@@ -1,3 +1,7 @@
+
+-- Module for intercepting key presses not explicity mapped in the key bindings.
+-- This uses some deep magic with grabKey and windows and everything else, but
+-- it makes window-specific key bindings awesome!
 module Internal.Intercept where
 
 import XMonad
@@ -111,19 +115,10 @@ getKeyCodesForKeysym dpy keysym = do
 doGrab :: Display -> Window -> (KeyMask, KeySym) -> X ()
 doGrab dpy win (keyMask, keysym) = do
   let grab kc m = io $ grabKey dpy kc m win True grabModeAsync grabModeAsync
-      (minCode, maxCode) = displayKeycodes dpy
-      allCodes = [fromIntegral minCode .. fromIntegral maxCode]
 
-  -- build a map from keysyms to lists of keysyms (doing what
-  -- XGetKeyboardMapping would do if the X11 package bound it)
-  syms <- forM allCodes $ \code -> io (keycodeToKeysym dpy code 0)
-  let keysymMap' = Map.fromListWith (++) (zip syms [[code] | code <- allCodes])
-  -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
-  -- want to grab those whenever someone accidentally uses def :: KeySym
-  let keysymMap = Map.delete noSymbol keysymMap'
-  let keysymToKeycodes sym = Map.findWithDefault [] keysym keysymMap
+  codes <- io $ getKeyCodesForKeysym dpy keysym
 
-  forM_ (keysymToKeycodes keysym) $ \kc ->
+  forM_ codes $ \kc ->
     mapM_ (grab kc . (keyMask .|.)) =<< extraModifiers
 
 disableKey :: (KeyMask, KeySym) -> WindowHook
diff --git a/src/Main.hs b/src/Main.hs
index b2a20d7..19050ab 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -40,8 +40,10 @@ main = do
              -- The geniuses that made chrome decided that Ctrl+W should kill
              -- the current tab! This makes it consistent with the rest of the
              -- world ... ctrl+w deletes the last word (ctrl+backspace).
-             rebindKey (controlMask, xK_w) (controlMask, xK_BackSpace),
-             rebindKey (controlMask, xK_h) (0, xK_BackSpace)
+             rebindKey (controlMask, xK_w) (controlMask, xK_BackSpace)
+           , rebindKey (controlMask, xK_h) (0, xK_BackSpace)
+           , rebindKey (controlMask, xK_u) (controlMask .|. shiftMask, xK_BackSpace)
+           , rebindKey (controlMask, xK_b) (controlMask, xK_w)
            ]
         ]) $ def
        { terminal    = "alacritty"
-- 
cgit 


From 16661c33c638cc6b1aad5095e12f94e64d2a6bec Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 28 Mar 2022 00:24:45 -0600
Subject: Add Brave to list of browsers to intercept keystrokes. Add mouse
 bindingns for dragging and resizing.

button13+LeftMouse = Drag
button13+RightMouse = Resize
button13+button13 = retile
---
 src/Internal/Keys.hs | 8 +++++++-
 src/Main.hs          | 2 +-
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index c40c346..d03557c 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -441,12 +441,18 @@ mouseMap = runButtons $ do
       forM_ (map fst mediaButtons) $ \b ->
         bind b $ noMod $ continuous mediaButtons b
 
+  bind button13 $ noMod $ subMouse $ do
+    bind button1 $ noMod mouseMoveWindow
+    bind button3 $ noMod mouseResizeWindow
+    bind button13 $ noMod $ windows . W.sink
+
+
   bind button15 $ do
 
     noMod $ subMouse $ do
       
       bind button15 $ do
-        noMod $ \_ -> jumpToLast
+        noMod $ const jumpToLast
 
 
       let workspaceButtons = [
diff --git a/src/Main.hs b/src/Main.hs
index 19050ab..379131c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -36,7 +36,7 @@ main = do
 
   (=<<) X.xmonad $
     applyKeys $ ewmh $ docks $ windowHooks (composeAll [
-           className =? "Google-chrome" --> composeAll [
+           (className =? "Google-chrome" <||> className =? "Brave-browser") --> composeAll [
              -- The geniuses that made chrome decided that Ctrl+W should kill
              -- the current tab! This makes it consistent with the rest of the
              -- world ... ctrl+w deletes the last word (ctrl+backspace).
-- 
cgit 


From 19b26eaa2e72e3917bd4531a3e467cf58a721ac2 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 28 Mar 2022 10:26:20 -0600
Subject: Add NoPersist and use it in Logger.hs

---
 src/Internal/NoPersist.hs | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)
 create mode 100644 src/Internal/NoPersist.hs

diff --git a/src/Internal/NoPersist.hs b/src/Internal/NoPersist.hs
new file mode 100644
index 0000000..a67e649
--- /dev/null
+++ b/src/Internal/NoPersist.hs
@@ -0,0 +1,23 @@
+-- Module for not persisting XMonad state. To be used with ExtensibleState
+-- for data types that cannot be persisted.
+module Internal.NoPersist where
+
+import Data.Default (Default, def)
+import Data.Typeable
+
+import XMonad (ExtensionClass(..))
+
+newtype NoPersist a = NoPersist a
+  deriving (Typeable)
+
+instance Show (NoPersist a) where
+  show (NoPersist _) = show ()
+
+instance (Default a) => Read (NoPersist a) where
+  readsPrec i s = map (\(_, s) -> (NoPersist def, s)) (readsPrec i s :: [((), String)])
+
+instance (Default a) => Default (NoPersist a) where
+  def = NoPersist def
+
+instance (Default a, Typeable a) => ExtensionClass (NoPersist a) where
+  initialValue = NoPersist def
-- 
cgit 


From 3a87706dc6193636c8b5c5b37d1ca2d057a22f00 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 28 Mar 2022 10:51:02 -0600
Subject: Move Intercept to RebindKeys. Remove the intercept subsystem as it
 was experimental and I do not have a real use for it anymore.

---
 src/Internal/Intercept.hs    | 152 -------------------------------------------
 src/Internal/Keys.hs         |   8 +--
 src/Internal/Logger.hs       |  14 ++--
 src/Internal/RebindKeys.hs   | 114 ++++++++++++++++++++++++++++++++
 src/Internal/ScreenRotate.hs |   8 +--
 src/Main.hs                  |   4 +-
 6 files changed, 126 insertions(+), 174 deletions(-)
 delete mode 100644 src/Internal/Intercept.hs
 create mode 100644 src/Internal/RebindKeys.hs

diff --git a/src/Internal/Intercept.hs b/src/Internal/Intercept.hs
deleted file mode 100644
index c99ce09..0000000
--- a/src/Internal/Intercept.hs
+++ /dev/null
@@ -1,152 +0,0 @@
-
--- Module for intercepting key presses not explicity mapped in the key bindings.
--- This uses some deep magic with grabKey and windows and everything else, but
--- it makes window-specific key bindings awesome!
-module Internal.Intercept where
-
-import XMonad
-
-import Text.Printf
-import Data.Monoid (Endo(..))
-import Control.Monad.Trans.Class (lift)
-import Control.Monad (forM, forM_)
-import Data.Default (Default, def)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import qualified XMonad.Util.ExtensibleState as XS
-import Data.Monoid (All(..))
-
-import Internal.Logger
-
-type WindowHook = Query ()
-
-newtype NoPersist a = NoPersist a
-  deriving (Typeable)
-
-instance Show (NoPersist a) where
-  show (NoPersist _) = show ()
-
-instance (Default a) => Read (NoPersist a) where
-  readsPrec i s = map (\(_, s) -> (NoPersist def, s)) (readsPrec i s :: [((), String)])
-
-instance (Default a) => Default (NoPersist a) where
-  def = NoPersist def
-
-instance (Default a, Typeable a) => ExtensionClass (NoPersist a) where
-  initialValue = NoPersist def
-
-
-data InterceptState = InterceptState (NoPersist (Map (KeyMask, KeySym) (X ())))
-
-data RemapState = RemapState (NoPersist (Map (Window, (KeyMask, KeySym)) (X ())))
-
-instance ExtensionClass InterceptState where
-  initialValue = InterceptState def
-
-instance ExtensionClass RemapState where
-  initialValue = RemapState def
-
-remapHook :: Event -> X All
-remapHook event = do
-  RemapState (NoPersist map) <- XS.get
-
-  case event of
-    KeyEvent { ev_window = win, ev_event_type = typ, ev_keycode = code, ev_state = m }
-        | typ == keyPress-> do
-      XConf {display = dpy, theRoot = rootw} <- ask
-      keysym <- io $ keycodeToKeysym dpy code 0
-
-      case Map.lookup (win, (m, keysym)) map of
-
-        Just xdo -> do
-          xdo
-          return (All False)
-
-        Nothing -> return (All True)
-
-    _ -> return (All True)
-
-interceptHook :: Event -> X All
-interceptHook event = do
-  InterceptState (NoPersist map) <- XS.get
-  case event of
-    KeyEvent { ev_event_type = typ, ev_keycode = code, ev_state = m }
-        | typ == keyPress-> do
-      XConf {display = dpy, theRoot = rootw} <- ask
-      keysym <- io $ keycodeToKeysym dpy code 0
-
-      case Map.lookup (m, keysym) map of
-
-        Just xdo -> do
-          xdo
-          mapM_ (\m' -> io $ ungrabKey dpy code (m .|. m') rootw)
-              =<< extraModifiers
-          return (All False)
-
-        Nothing -> return (All True)
-
-    _ -> return (All True)
-
-setIntercept :: (KeyMask, KeySym) -> X () -> X ()
-setIntercept (keyMask, keysym) action = do
-  XS.modify $ \(InterceptState (NoPersist m)) -> InterceptState $ NoPersist $
-    Map.insert (keyMask, keysym) action m
-  XConf { display = dpy, theRoot = rootw } <- ask
-
-  doGrab dpy rootw (keyMask, keysym)
-
-
-getKeyCodesForKeysym :: Display -> KeySym -> IO [KeyCode]
-getKeyCodesForKeysym dpy keysym = do
-  let (minCode, maxCode) = displayKeycodes dpy
-      allCodes = [fromIntegral minCode .. fromIntegral maxCode]
-
-  syms <- forM allCodes $ \code -> keycodeToKeysym dpy code 0
-  let keysymMap' = Map.fromListWith (++) (zip syms [[code] | code <- allCodes])
-
-  -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
-  -- want to grab those whenever someone accidentally uses def :: KeySym
-  let keysymMap = Map.delete noSymbol keysymMap'
-  let keysymToKeycodes sym = Map.findWithDefault [] keysym keysymMap
-
-  return $ keysymToKeycodes keysym
-
-
-doGrab :: Display -> Window -> (KeyMask, KeySym) -> X ()
-doGrab dpy win (keyMask, keysym) = do
-  let grab kc m = io $ grabKey dpy kc m win True grabModeAsync grabModeAsync
-
-  codes <- io $ getKeyCodesForKeysym dpy keysym
-
-  forM_ codes $ \kc ->
-    mapM_ (grab kc . (keyMask .|.)) =<< extraModifiers
-
-disableKey :: (KeyMask, KeySym) -> WindowHook
-disableKey key = remapKey key (return ())
-
-remapKey :: (KeyMask, KeySym) -> X () -> WindowHook
-remapKey keyFrom action = do
-  window <- ask
-  Query $ lift $ do
-    XConf { display = disp, theRoot = rootw } <- ask
-    doGrab disp window keyFrom
-
-    XS.modify $ \(RemapState (NoPersist keyMap)) -> RemapState $ NoPersist $
-      Map.insert (window, keyFrom) action keyMap
-
-rebindKey :: (KeyMask, KeySym) -> (KeyMask, KeySym) -> WindowHook
-rebindKey keyFrom keyTo = do
-  window <- ask
-  remapKey keyFrom $ do
-    XConf { display = disp, theRoot = rootw } <- ask
-    codes <- io $ getKeyCodesForKeysym disp (snd keyTo)
-    case codes of
-      (keyCode:_) -> do
-        io $ allocaXEvent $ \xEv -> do
-          setEventType xEv keyPress
-          setKeyEvent xEv window rootw none (fst keyTo) keyCode True
-          sendEvent disp window True keyPressMask xEv
-          setEventType xEv keyRelease
-          sendEvent disp window True keyPressMask xEv
-
-      _ -> return ()
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index aeb3602..9a45f7e 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys (applyKeys) where
 
-import Internal.Intercept (setIntercept)
 import Control.Monad.Loops (iterateWhile)
 import Control.Monad.Fix (fix)
 import Graphics.X11.ExtraTypes.XF86;
@@ -46,6 +45,7 @@ import Internal.Lib
 import Internal.DMenu
 import Internal.PassMenu
 import Internal.Logger
+import Internal.RebindKeys
 import Internal.ScreenRotate (screenRotateForward, screenRotateBackward)
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -246,12 +246,6 @@ keymap = runKeys $ do
           if (x' - x) < 0
             then mediaPrev
             else mediaNext
-
-      bind xK_t $
-
-        (justMod -|- noMod) $
-          setIntercept (modMask config, xK_i) $
-            logs $ "Intercepted!"
  
   bind xK_r $ do
     justMod runDMenu
diff --git a/src/Internal/Logger.hs b/src/Internal/Logger.hs
index f1960fb..cc52c7e 100644
--- a/src/Internal/Logger.hs
+++ b/src/Internal/Logger.hs
@@ -4,17 +4,13 @@ import XMonad
 import qualified XMonad.Util.ExtensibleState as XS
 import System.IO
 
+import Internal.NoPersist
+
 data LoggerState =
   LoggerState {
-    logHandle :: Maybe Handle
+    logHandle :: Maybe (NoPersist Handle)
   }
 
-instance Read LoggerState where
-  readsPrec i s = map (\(_, s) -> (LoggerState Nothing, s)) (readsPrec i s :: [((), String)])
-
-instance Show LoggerState where
-  show _ = show ()
-
 instance ExtensionClass LoggerState where
   initialValue = LoggerState Nothing
 
@@ -26,10 +22,10 @@ logs s = do
     case handle' of
       Nothing -> do
         handle <- io $ openFile "/tmp/xmonad.log" AppendMode
-        XS.put $ LoggerState (Just handle)
+        XS.put $ LoggerState $ Just $ NoPersist handle
         return handle
 
-      Just h -> return h
+      Just (NoPersist h) -> return h
   
   io $ do
     hPutStrLn handle s
diff --git a/src/Internal/RebindKeys.hs b/src/Internal/RebindKeys.hs
new file mode 100644
index 0000000..22b0165
--- /dev/null
+++ b/src/Internal/RebindKeys.hs
@@ -0,0 +1,114 @@
+
+-- Module for intercepting key presses not explicity mapped in the key bindings.
+-- This uses some deep magic with grabKey and windows and everything else, but
+-- it makes window-specific key bindings awesome!
+module Internal.RebindKeys where
+
+import XMonad
+
+import Text.Printf
+import Data.Monoid (Endo(..))
+import Control.Monad.Trans.Class (lift)
+import Control.Monad (forM, forM_)
+import Data.Default (Default, def)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified XMonad.Util.ExtensibleState as XS
+import Data.Monoid (All(..))
+
+import Internal.Logger
+import Internal.NoPersist
+
+type WindowHook = Query ()
+
+data InterceptState =
+  InterceptState (NoPersist (Map (KeyMask, KeySym) (X ())))
+
+data RemapState =
+  RemapState (NoPersist (Map (Window, (KeyMask, KeySym)) (X ())))
+
+instance ExtensionClass InterceptState where
+  initialValue = InterceptState def
+
+instance ExtensionClass RemapState where
+  initialValue = RemapState def
+
+remapHook :: Event -> X All
+remapHook event = do
+  RemapState (NoPersist map) <- XS.get
+
+  case event of
+    KeyEvent { ev_window = win, ev_event_type = typ, ev_keycode = code, ev_state = m }
+        | typ == keyPress-> do
+      XConf {display = dpy, theRoot = rootw} <- ask
+      keysym <- io $ keycodeToKeysym dpy code 0
+
+      case Map.lookup (win, (m, keysym)) map of
+
+        Just xdo -> do
+          xdo
+          return (All False)
+
+        Nothing -> return (All True)
+
+    _ -> return (All True)
+
+getKeyCodesForKeysym :: Display -> KeySym -> IO [KeyCode]
+getKeyCodesForKeysym dpy keysym = do
+  let (minCode, maxCode) = displayKeycodes dpy
+      allCodes = [fromIntegral minCode .. fromIntegral maxCode]
+
+  syms <- forM allCodes $ \code -> keycodeToKeysym dpy code 0
+  let keysymMap' = Map.fromListWith (++) (zip syms [[code] | code <- allCodes])
+
+  -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
+  -- want to grab those whenever someone accidentally uses def :: KeySym
+  let keysymMap = Map.delete noSymbol keysymMap'
+  let keysymToKeycodes sym = Map.findWithDefault [] keysym keysymMap
+
+  return $ keysymToKeycodes keysym
+
+
+doGrab :: Display -> Window -> (KeyMask, KeySym) -> X ()
+doGrab dpy win (keyMask, keysym) = do
+  let grab kc m = io $ grabKey dpy kc m win True grabModeAsync grabModeAsync
+
+  codes <- io $ getKeyCodesForKeysym dpy keysym
+
+  forM_ codes $ \kc ->
+    mapM_ (grab kc . (keyMask .|.)) =<< extraModifiers
+
+disableKey :: (KeyMask, KeySym) -> WindowHook
+disableKey key = remapKey key (return ())
+
+remapKey :: (KeyMask, KeySym) -> X () -> WindowHook
+remapKey keyFrom action = do
+  window <- ask
+  Query $ lift $ do
+    XConf { display = disp, theRoot = rootw } <- ask
+    doGrab disp window keyFrom
+
+    XS.modify $ \(RemapState (NoPersist keyMap)) -> RemapState $ NoPersist $
+      Map.insert (window, keyFrom) action keyMap
+
+sendKey :: (KeyMask, KeySym) -> Window -> X ()
+sendKey (keymask, keysym) w = do
+  XConf { display = disp, theRoot = rootw } <- ask
+
+  codes <- io $ getKeyCodesForKeysym disp keysym
+
+  case codes of
+    (keycode:_) ->
+      io $ allocaXEvent $ \xEv -> do
+        setEventType xEv keyPress
+        setKeyEvent xEv w rootw none keymask keycode True
+        sendEvent disp w True keyPressMask xEv
+
+        setEventType xEv keyRelease
+        sendEvent disp w True keyReleaseMask xEv
+
+    _ -> return ()
+
+rebindKey :: (KeyMask, KeySym) -> (KeyMask, KeySym) -> WindowHook
+rebindKey keyFrom keyTo =
+  (remapKey keyFrom . sendKey keyTo) =<< ask
diff --git a/src/Internal/ScreenRotate.hs b/src/Internal/ScreenRotate.hs
index ff6417c..8108381 100644
--- a/src/Internal/ScreenRotate.hs
+++ b/src/Internal/ScreenRotate.hs
@@ -2,15 +2,15 @@ module Internal.ScreenRotate where
 
 import XMonad.StackSet as W
 
-screenRotateForward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
-screenRotateForward (W.StackSet current visible others floating) = do
+screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
+screenRotateBackward (W.StackSet current visible others floating) = do
   let screens = current : visible
       workspaces = tail $ cycle $ map W.workspace screens
       (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
       in W.StackSet current' visible' others floating
 
-screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
-screenRotateBackward (W.StackSet current visible others floating) = do
+screenRotateForward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
+screenRotateForward (W.StackSet current visible others floating) = do
   let screens = current : visible
       workspaces = rcycle $ map W.workspace screens
       (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
diff --git a/src/Main.hs b/src/Main.hs
index 379131c..b17f62a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -16,7 +16,7 @@ import Internal.Keys
 import Internal.Layout
 import Internal.Logger
 import Internal.DMenu (menuCommandString)
-import Internal.Intercept
+import Internal.RebindKeys
 import XMonad.Actions.WithAll (withAll)
 
 import qualified XMonad as X
@@ -70,7 +70,7 @@ main = do
          ]
        , workspaces = map return (['0'..'9'] ++ ['a'..'z'])
        , handleEventHook =
-           composeAll [fullscreenEventHook, interceptHook, remapHook]
+           composeAll [fullscreenEventHook, remapHook]
        , focusFollowsMouse = False
        , clickJustFocuses = False
        , logHook = xMobarLogHook xmobar
-- 
cgit 


From b8bb40af61fbbf1c13c4556832055304109311db Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 28 Mar 2022 10:51:39 -0600
Subject: Remove the bindings from the old mouse. Now I have a better, more
 programmable mouse I can use.

---
 src/Internal/Keys.hs | 23 -----------------------
 1 file changed, 23 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 9a45f7e..5d4e6fe 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -114,29 +114,6 @@ keymap = runKeys $ do
     rawMask mod4Mask $ spawn "xterm"
     justMod $ spawn "pkill -SIGUSR1 xmobar"
 
-  bind xK_F1 $ do
-    -- Button programmed on mouse
-    rawMask shiftMask $ click >> withFocused (windows . W.sink)
-
-    shiftMod playPause
-
-  bind xK_F2 $
-    -- Button programmed on mouse
-    rawMask shiftMask $ click >> sendMessage ToggleZoom
-
-  bind xK_F3 $
-    -- Button programmed on mouse
-    rawMask shiftMask $ subkeys $ do
-
-      bind xK_F1 $ -- Make it harder to close so I don't accidentally git it.
-        rawMask shiftMask $ click >> CopyWindow.kill1
-
-      -- I Don't really use these, but they could be bound to something cool!
-      bind xK_F2 $
-        rawMask shiftMask mediaNext
-      bind xK_F3 $
-        rawMask shiftMask mediaPrev
-
   bind xK_F10 $ do
     justMod playPause
 
-- 
cgit 


From d15ea771e45b60f32c83bfd90386c60d192299c0 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 28 Mar 2022 11:52:34 -0600
Subject: Add (some) ability to send keys to other windows

---
 src/Internal/Keys.hs       | 21 +++++++++++++++++++++
 src/Internal/RebindKeys.hs |  6 ++++++
 src/Internal/Windows.hs    |  9 ++++++++-
 src/Main.hs                |  4 ++--
 4 files changed, 37 insertions(+), 3 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 5d4e6fe..13112cb 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys (applyKeys) where
 
+import Control.Monad.Trans.Class
+import Control.Monad.Reader
 import Control.Monad.Loops (iterateWhile)
 import Control.Monad.Fix (fix)
 import Graphics.X11.ExtraTypes.XF86;
@@ -41,6 +43,7 @@ import XMonad.Actions.SpawnOn as SpawnOn
 import qualified Data.Map as Map
 import qualified XMonad.StackSet as W
 
+import Internal.Windows
 import Internal.Lib
 import Internal.DMenu
 import Internal.PassMenu
@@ -112,8 +115,26 @@ keymap = runKeys $ do
     -- something goes wrong with the keyboard layout and for first-time boots
     -- where dmenu/alacritty may not be installed.
     rawMask mod4Mask $ spawn "xterm"
+
+    -- Moves xmobar to different monitors.
     justMod $ spawn "pkill -SIGUSR1 xmobar"
 
+  bind xK_F1 $ do
+    -- Experimental. Sends 'a' to all windows.
+    --
+    -- I've discovered that many clients ignore such synthetic events, including
+    -- Spotify, Chrome and Gedit. Some, like Chrome, seem to honor them if it's
+    -- focused. It's pretty annoying because it keeps me from doing some cool
+    -- things all for BS security theater, but I guess there might be some way
+    -- to do this via XTest?
+    shiftMod $ forAllWindows  $ \w -> do
+      logs $ "Try send to " ++ show w
+      sendKey (0, xK_a) w
+
+    -- Experimental. Sends 'A' 10 times to the focused window.
+    justMod $
+      replicateM_ 10 $ withFocused (sendKey (shiftMask, xK_a))
+
   bind xK_F10 $ do
     justMod playPause
 
diff --git a/src/Internal/RebindKeys.hs b/src/Internal/RebindKeys.hs
index 22b0165..7c5d47c 100644
--- a/src/Internal/RebindKeys.hs
+++ b/src/Internal/RebindKeys.hs
@@ -91,6 +91,12 @@ remapKey keyFrom action = do
     XS.modify $ \(RemapState (NoPersist keyMap)) -> RemapState $ NoPersist $
       Map.insert (window, keyFrom) action keyMap
 
+-- sendKey, but as a query.
+sendKeyQ :: (KeyMask, KeySym) -> Query ()
+sendKeyQ key = do
+  win <- ask
+  liftX (sendKey key win)
+
 sendKey :: (KeyMask, KeySym) -> Window -> X ()
 sendKey (keymask, keysym) w = do
   XConf { display = disp, theRoot = rootw } <- ask
diff --git a/src/Internal/Windows.hs b/src/Internal/Windows.hs
index b6f5335..c6a2b8b 100644
--- a/src/Internal/Windows.hs
+++ b/src/Internal/Windows.hs
@@ -1,7 +1,9 @@
 module Internal.Windows where
 
+import XMonad (windowset, X, Window, get)
+
 import Control.Applicative ((<|>))
-import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), integrate, integrate')
+import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), integrate, integrate', allWindows)
 import Data.Maybe (listToMaybe, catMaybes)
 import qualified Data.Map as Map
 
@@ -45,6 +47,11 @@ getLocationWorkspace _ = Nothing
 workspaceMember :: (Eq a) => Workspace i l a -> a -> Bool
 workspaceMember (Workspace _ _ s) w = w `elem` integrate' s
 
+forAllWindows :: (Window -> X ()) -> X ()
+forAllWindows fn = do
+  stackSet <- windowset <$> get
+  mapM_ fn (allWindows stackSet)
+
 {- Finds a Window and returns the screen its on and the workspace its on.
  - Returns nothing if the window doesn't exist. 
  -
diff --git a/src/Main.hs b/src/Main.hs
index b17f62a..0514a99 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -12,12 +12,12 @@ import System.Environment (setEnv)
 import Data.Monoid
 
 import Internal.XMobarLog
+import Internal.Windows
 import Internal.Keys
 import Internal.Layout
 import Internal.Logger
 import Internal.DMenu (menuCommandString)
 import Internal.RebindKeys
-import XMonad.Actions.WithAll (withAll)
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as W
@@ -89,7 +89,7 @@ windowHooks (Query readerT) config = do
 
   config {
     startupHook = do
-      withAll $ \w -> runReaderT readerT w
+      forAllWindows $ \w -> runReaderT readerT w
       startupHook config,
 
     manageHook = mappend (Query readerT >> return (Endo id)) (manageHook config)
-- 
cgit 


From de4503f1b2a8167caaee34714b55da15dbc7128f Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 28 Mar 2022 12:11:48 -0600
Subject: Figured out the flakiness was due to withAll only applying to windows
 on the current workspace instead of _all_ windows. Poor naming.

---
 src/Main.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/src/Main.hs b/src/Main.hs
index 0514a99..8abee5e 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -11,8 +11,8 @@ import XMonad.Layout.Fullscreen (fullscreenEventHook)
 import System.Environment (setEnv)
 import Data.Monoid
 
-import Internal.XMobarLog
 import Internal.Windows
+import Internal.XMobarLog
 import Internal.Keys
 import Internal.Layout
 import Internal.Logger
@@ -41,8 +41,16 @@ main = do
              -- the current tab! This makes it consistent with the rest of the
              -- world ... ctrl+w deletes the last word (ctrl+backspace).
              rebindKey (controlMask, xK_w) (controlMask, xK_BackSpace)
+
+             -- Terminal Ctrl-H sends a backspace. (Technically not, but that's
+             -- usually the semantics). Make it this way in Chrome.
            , rebindKey (controlMask, xK_h) (0, xK_BackSpace)
+
+             -- Ctrl+u usually deletes the whole line. This is roughly
+             -- ctrl+shift+backspace
            , rebindKey (controlMask, xK_u) (controlMask .|. shiftMask, xK_BackSpace)
+
+             -- Make it to ctrl+b deletes the current tab instead of ctrl+w.
            , rebindKey (controlMask, xK_b) (controlMask, xK_w)
            ]
         ]) $ def
-- 
cgit 


From 6da70d9ad5c815a4cc185909434497350c14edbe Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 28 Mar 2022 14:05:30 -0600
Subject: add swallow behavior. Add more Chrome bindings.

---
 src/Internal/Keys.hs |  7 +++++++
 src/Main.hs          | 32 +++++++++++++++++++++++++++++---
 2 files changed, 36 insertions(+), 3 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 13112cb..b322eb4 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -49,6 +49,7 @@ import Internal.DMenu
 import Internal.PassMenu
 import Internal.Logger
 import Internal.RebindKeys
+import Internal.Swallow
 import Internal.ScreenRotate (screenRotateForward, screenRotateBackward)
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -322,6 +323,9 @@ keymap = runKeys $ do
       bind xK_o $
         (justMod -|- noMod) $ spawn "library-view.sh"
 
+      bind xK_s $
+        (justMod -|- noMod) toggleSwallowEnabled
+
       bind xK_v $ do
         (justMod -|- noMod) $ spawn "set-volume.sh"
         (shiftMod -|- rawMask shiftMask) $ spawn "set-volume.sh -a"
@@ -420,6 +424,9 @@ mouseMap = runButtons $ do
   bind button14 $ do
     noMod $ subMouse $ do
 
+      bind button3 $
+        noMod $ const (gotoWorkspace 's')
+
       bind button13 $ do
         noMod $ \_ -> click >> CopyWindow.kill1
 
diff --git a/src/Main.hs b/src/Main.hs
index 8abee5e..0018fa2 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -11,6 +11,7 @@ import XMonad.Layout.Fullscreen (fullscreenEventHook)
 import System.Environment (setEnv)
 import Data.Monoid
 
+import Internal.Swallow
 import Internal.Windows
 import Internal.XMobarLog
 import Internal.Keys
@@ -50,8 +51,30 @@ main = do
              -- ctrl+shift+backspace
            , rebindKey (controlMask, xK_u) (controlMask .|. shiftMask, xK_BackSpace)
 
-             -- Make it to ctrl+b deletes the current tab instead of ctrl+w.
-           , rebindKey (controlMask, xK_b) (controlMask, xK_w)
+             -- Make it to ctrl+d deletes the current tab instead of ctrl+w.
+           , rebindKey (controlMask, xK_e) (controlMask, xK_w)
+
+             -- Vim-ish keybindings to go back and forward.
+           , rebindKey (controlMask, xK_b) (controlMask, xK_Left)
+           , rebindKey (controlMask, xK_e) (controlMask, xK_Right)
+           , rebindKey (controlMask .|. shiftMask, xK_b) (controlMask .|. shiftMask, xK_Left)
+           , rebindKey (controlMask .|. shiftMask, xK_e) (controlMask .|. shiftMask, xK_Right)
+
+             -- Baskic Vim-like motion with the alt key.
+           , rebindKey (mod1Mask, xK_h) (0, xK_Left)
+           , rebindKey (mod1Mask, xK_j) (0, xK_Down)
+           , rebindKey (mod1Mask, xK_k) (0, xK_Up)
+           , rebindKey (mod1Mask, xK_l) (0, xK_Right)
+
+           , rebindKey (shiftMask .|. mod1Mask, xK_h) (shiftMask, xK_Left)
+           , rebindKey (shiftMask .|. mod1Mask, xK_j) (shiftMask, xK_Down)
+           , rebindKey (shiftMask .|. mod1Mask, xK_k) (shiftMask, xK_Up)
+           , rebindKey (shiftMask .|. mod1Mask, xK_l) (shiftMask, xK_Right)
+
+           , rebindKey (controlMask .|. mod1Mask, xK_h) (controlMask, xK_Left)
+           , rebindKey (controlMask .|. mod1Mask, xK_j) (controlMask, xK_Down)
+           , rebindKey (controlMask .|. mod1Mask, xK_k) (controlMask, xK_Up)
+           , rebindKey (controlMask .|. mod1Mask, xK_l) (controlMask, xK_Right)
            ]
         ]) $ def
        { terminal    = "alacritty"
@@ -78,7 +101,10 @@ main = do
          ]
        , workspaces = map return (['0'..'9'] ++ ['a'..'z'])
        , handleEventHook =
-           composeAll [fullscreenEventHook, remapHook]
+           composeAll [
+             fullscreenEventHook,
+             remapHook,
+             swallowHook]
        , focusFollowsMouse = False
        , clickJustFocuses = False
        , logHook = xMobarLogHook xmobar
-- 
cgit 


From 2a9c5414ffef1544cb0c7bd05e5a2f58ece064e6 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 28 Mar 2022 22:57:25 -0600
Subject: Add firefox to the browsers list

---
 src/Main.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 0018fa2..44fb358 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -23,7 +23,6 @@ import Internal.RebindKeys
 import qualified XMonad as X
 import qualified XMonad.StackSet as W
 
-
 main = do
 
   -- Execute some commands.
@@ -37,7 +36,9 @@ main = do
 
   (=<<) X.xmonad $
     applyKeys $ ewmh $ docks $ windowHooks (composeAll [
-           (className =? "Google-chrome" <||> className =? "Brave-browser") --> composeAll [
+           let browsers = ["Google-chrome", "Brave-browser", "firefox-default"] in
+
+           (flip elem browsers <$> className) --> composeAll [
              -- The geniuses that made chrome decided that Ctrl+W should kill
              -- the current tab! This makes it consistent with the rest of the
              -- world ... ctrl+w deletes the last word (ctrl+backspace).
-- 
cgit 


From f9515a7669976b8f2fe80e9b93ba1b97528954d2 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 28 Mar 2022 22:59:16 -0600
Subject: Forgot to add the Swallow.hs file

---
 src/Internal/Swallow.hs | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)
 create mode 100644 src/Internal/Swallow.hs

diff --git a/src/Internal/Swallow.hs b/src/Internal/Swallow.hs
new file mode 100644
index 0000000..3e4112f
--- /dev/null
+++ b/src/Internal/Swallow.hs
@@ -0,0 +1,29 @@
+module Internal.Swallow (
+  swallowHook, setSwallowEnabled, isSwallowEnabled, toggleSwallowEnabled) where
+
+import XMonad
+import Data.Monoid (All)
+import XMonad.Hooks.WindowSwallowing
+import XMonad.Util.ExtensibleState as XS
+
+data DisableSwallow = DisableSwallow Bool deriving (Show)
+
+swallowHook :: Event -> X All
+swallowHook = swallowEventHook (className =? "Alacritty") $
+  liftX $ do
+    (DisableSwallow disable) <- XS.get
+    return (not disable)
+
+isSwallowEnabled :: X Bool
+isSwallowEnabled = do
+  (DisableSwallow b) <- XS.get
+  return (not b)
+
+setSwallowEnabled :: Bool -> X ()
+setSwallowEnabled enable = XS.modify $ const $ DisableSwallow $ not enable
+
+toggleSwallowEnabled :: X ()
+toggleSwallowEnabled = (setSwallowEnabled . not) =<< isSwallowEnabled
+
+instance ExtensionClass DisableSwallow where
+  initialValue = DisableSwallow False
-- 
cgit 


From 685d67d19d2e94fc94ed7334e5e7ab19454426d7 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 28 Mar 2022 23:27:45 -0600
Subject: Fix things that Hlint is complaining about.

---
 src/Internal/CornerLayout.hs |  4 ++--
 src/Internal/DMenu.hs        |  1 -
 src/Internal/Hash.hs         |  2 +-
 src/Internal/Keys.hs         |  4 ++--
 src/Internal/LayoutDraw.hs   | 12 ++++++------
 src/Internal/Lib.hs          | 10 +++++-----
 src/Internal/Logger.hs       |  2 +-
 src/Internal/Marking.hs      |  4 ++--
 src/Internal/RebindKeys.hs   |  5 ++---
 src/Internal/Submap.hs       |  4 ++--
 src/Internal/SwapMaster.hs   |  8 ++++----
 11 files changed, 27 insertions(+), 29 deletions(-)

diff --git a/src/Internal/CornerLayout.hs b/src/Internal/CornerLayout.hs
index 10fbe5b..b3898fc 100644
--- a/src/Internal/CornerLayout.hs
+++ b/src/Internal/CornerLayout.hs
@@ -31,8 +31,8 @@ instance LayoutClass Corner a where
             zip ws $ map (
                 \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h) $ 
               corner :
-                (splitVert vertRect vn) ++
-                (splitHoriz horizRect hn)
+                splitVert vertRect vn ++
+                splitHoriz horizRect hn
 
   pureMessage (Corner frac delta) m = fmap resize (fromMessage m)
     where
diff --git a/src/Internal/DMenu.hs b/src/Internal/DMenu.hs
index 0ec7927..0d22b55 100644
--- a/src/Internal/DMenu.hs
+++ b/src/Internal/DMenu.hs
@@ -2,7 +2,6 @@ module Internal.DMenu where
 
 import XMonad.Util.Dmenu
 import XMonad
-import XMonad.Util.Run
 import Control.Monad
 import Data.Map (Map)
 import qualified Data.Map as Map
diff --git a/src/Internal/Hash.hs b/src/Internal/Hash.hs
index 63f6043..272808b 100644
--- a/src/Internal/Hash.hs
+++ b/src/Internal/Hash.hs
@@ -8,4 +8,4 @@ import qualified Crypto.Hash.SHA1 as SHA1
 
 quickHash :: String -> String
 quickHash str =
-    concatMap (flip showHex "") $ BS.unpack (SHA1.hash $ BC.pack str)
+    concatMap (`showHex` "") $ BS.unpack (SHA1.hash $ BC.pack str)
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index b322eb4..446b7b7 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -277,7 +277,7 @@ keymap = runKeys $ do
            recur
 
       bind xK_v $ do
-        justMod $ recur
+        justMod recur
 
   bind xK_w $ do
     justMod windowJump
@@ -494,4 +494,4 @@ modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
   Border (clip $ a + i) (clip $ b + i) (clip $ c + i) (clip $ d + i)
 
   where clip i | i < 0 = 0
-        clip i | otherwise = i
+        clip i = i
diff --git a/src/Internal/LayoutDraw.hs b/src/Internal/LayoutDraw.hs
index 8b029bd..131b32b 100644
--- a/src/Internal/LayoutDraw.hs
+++ b/src/Internal/LayoutDraw.hs
@@ -43,17 +43,17 @@ import qualified XMonad.StackSet as S
 drawLayout :: X (Bool, String, String)
 drawLayout = do
     winset <- X.gets X.windowset
-    let layout = S.layout $ S.workspace $ S.current $ winset
+    let layout = S.layout $ S.workspace $ S.current winset
 
     -- Gotta reset the layout to a consistent state.
-    layout' <- foldM (flip ($)) layout $ [
+    layout' <- foldM (flip ($)) layout [
          handleMessage' $ ModifyWindowBorder $ const $ Border 0 0 0 0,
-         handleMessage' $ Unzoom
+         handleMessage' Unzoom
        ]
 
     (cached, xpm) <- drawXpmIO layout'
 
-    return $ (cached, X.description layout, printf "<icon=%s/>" xpm)
+    return (cached , X.description layout, printf "<icon=%s/>" xpm)
 
 -- Returns true if a point is inside a rectangle (inclusive).
 pointInRect :: (Dimension, Dimension) -> Rectangle -> Bool
@@ -98,14 +98,14 @@ drawXpmIO l = do
       (S.Workspace "0" l (S.differentiate [1 .. 5]))
       (Rectangle 0 0 ((w + shrinkAmt) * sf) ((h + shrinkAmt) * sf))
 
-  let rects = flip map rects' $ \(_, (Rectangle x y w h)) ->
+  let rects = flip map rects' $ \(_, Rectangle x y w h) ->
                 Rectangle (x `div` sf) (y `div` sf) (w `div` sf) (h `div` sf)
 
   X.liftIO $ do
     exists <- doesFileExist iconPath
     createDirectoryIfMissing True iconCacheDir
 
-    when (not exists) $ do
+    unless exists $ do
       let xpmText = drawXpm (w, h) (zip (cycle colors) rects) 4
       writeFile iconPath xpmText
 
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index 3beb640..d8784ea 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -47,7 +47,7 @@ data WorkspaceState = Current | Hidden | Visible
 getPopulatedWorkspaces ::
   (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, S.Workspace i l a)]
 getPopulatedWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
-  sortBy (comparing (tag . snd)) $
+  sortOn (tag . snd) $
     mapMaybe (\w@(S.Workspace _ _ s) -> fmap (const (Hidden, w)) s) hi ++
       map (\(S.Screen w _ _) -> (Visible, w)) vis ++
         [(Current, cur)]
@@ -93,10 +93,10 @@ swapWorkspace toWorkspaceName = do
   windows $ \ss -> do
     let fromWorkspace = tag $ workspace $ current ss
         toWorkspace = [toWorkspaceName] in
-      (StackSet (swapSc fromWorkspace toWorkspace $ current ss)
+      StackSet (swapSc fromWorkspace toWorkspace $ current ss)
                 (map (swapSc fromWorkspace toWorkspace) $ visible ss)
                 (map (swapWs fromWorkspace toWorkspace) $ hidden ss)
-                (floating ss))
+                (floating ss)
   where
     swapSc fromWorkspace toWorkspace (Screen ws a b) =
         Screen (swapWs fromWorkspace toWorkspace ws) a b
@@ -125,7 +125,7 @@ getString = runQuery $ do
 relativeWorkspaceShift :: Selector -> X ()
 relativeWorkspaceShift (Selector selector) = do
   windows $ \ss ->
-    let tags = sort $ (tag . snd  <$> filter (\x -> fst x /= Visible ) (getPopulatedWorkspaces ss))
+    let tags = sort (tag . snd  <$> filter (\x -> fst x /= Visible ) (getPopulatedWorkspaces ss))
         from = tag $ workspace $ current ss
         to = selector from tags
     in greedyView to ss
@@ -144,7 +144,7 @@ prev = Selector $ \a l ->
 withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
 withScreen fn n = do
   windows $ \windowSet ->
-    case (getHorizontallyOrderedScreens windowSet !! n) of
+    case getHorizontallyOrderedScreens windowSet !! n of
       Nothing -> windowSet
       Just screen -> fn (tag $ workspace screen) windowSet
 
diff --git a/src/Internal/Logger.hs b/src/Internal/Logger.hs
index cc52c7e..1dbd493 100644
--- a/src/Internal/Logger.hs
+++ b/src/Internal/Logger.hs
@@ -6,7 +6,7 @@ import System.IO
 
 import Internal.NoPersist
 
-data LoggerState =
+newtype LoggerState =
   LoggerState {
     logHandle :: Maybe (NoPersist Handle)
   }
diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index c1234ec..e37e241 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -40,7 +40,7 @@ greedyFocus win = do
 markCurrentWindow :: Mark -> X ()
 markCurrentWindow mark = do
   withFocused $ \win ->
-    XS.modify $ \state@(MarkState {markStateMap = ms}) ->
+    XS.modify $ \state@MarkState {markStateMap = ms} ->
         state {
           markStateMap = Map.insert mark win ms
         }
@@ -73,7 +73,7 @@ setFocusedWindow
           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)
+    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 =
diff --git a/src/Internal/RebindKeys.hs b/src/Internal/RebindKeys.hs
index 7c5d47c..38af754 100644
--- a/src/Internal/RebindKeys.hs
+++ b/src/Internal/RebindKeys.hs
@@ -7,7 +7,6 @@ module Internal.RebindKeys where
 import XMonad
 
 import Text.Printf
-import Data.Monoid (Endo(..))
 import Control.Monad.Trans.Class (lift)
 import Control.Monad (forM, forM_)
 import Data.Default (Default, def)
@@ -21,10 +20,10 @@ import Internal.NoPersist
 
 type WindowHook = Query ()
 
-data InterceptState =
+newtype InterceptState =
   InterceptState (NoPersist (Map (KeyMask, KeySym) (X ())))
 
-data RemapState =
+newtype RemapState =
   RemapState (NoPersist (Map (Window, (KeyMask, KeySym)) (X ())))
 
 instance ExtensionClass InterceptState where
diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
index e5968ff..c51f9b6 100644
--- a/src/Internal/Submap.hs
+++ b/src/Internal/Submap.hs
@@ -28,7 +28,7 @@ mapNextString fn = do
 
     if isModifierKey keysym
         then nextkey
-        else return $ (m, str)
+        else return (m, str)
 
   io $ ungrabKeyboard d currentTime
 
@@ -63,7 +63,7 @@ nextMotion = do
   return ret
 
 submapButtonsWithKey ::
-    ((ButtonMask, Button) -> Window -> X ()) -> (Map (ButtonMask, Button) (Window -> X ())) -> Window -> X ()
+    ((ButtonMask, Button) -> Window -> X ()) -> Map (ButtonMask, Button) (Window -> X ()) -> Window -> X ()
 submapButtonsWithKey defaultAction actions window = do
   arg <- nextButton
 
diff --git a/src/Internal/SwapMaster.hs b/src/Internal/SwapMaster.hs
index c73cbd9..e7ade19 100644
--- a/src/Internal/SwapMaster.hs
+++ b/src/Internal/SwapMaster.hs
@@ -9,12 +9,12 @@ import XMonad (Window, ExtensionClass(..), X(..), windows, windowset)
 import Control.Monad (void)
 import Control.Monad.Trans (lift)
 import Data.Maybe (fromMaybe)
-import Control.Monad.State (get)
+import Control.Monad.State (gets)
 
 import qualified XMonad.Util.ExtensibleState as XS
 
-data LastWindow = LastWindow {
-    lastWindow :: (Maybe Window)
+newtype LastWindow = LastWindow {
+    lastWindow :: Maybe Window
   } deriving (Show, Read)
 
 instance ExtensionClass LastWindow where
@@ -25,7 +25,7 @@ hoist = MaybeT . return
 
 swapMaster :: X ()
 swapMaster = void $ runMaybeT $ do
-    ss <- lift $ windowset <$> get
+    ss <- gets windowset
 
     focused <- hoist $ W.peek ss
     master <- hoist $ getMaster ss
-- 
cgit 


From 8678e0b8e6e2d25db7eebf2a90c78687530eb711 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 29 Mar 2022 12:06:04 -0600
Subject: Add a DSL for configuring Window-Specific bindings and move it into
 the Keys.hs file.

---
 src/Internal/Keys.hs  | 116 +++++++++++++++++++++++++++++++++++++++++++++++++-
 src/Internal/KeysM.hs |   7 +++
 src/Main.hs           |  47 ++------------------
 3 files changed, 126 insertions(+), 44 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 446b7b7..21988f8 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Internal.Keys (applyKeys) where
 
+import Data.Monoid (Endo(..))
 import Control.Monad.Trans.Class
 import Control.Monad.Reader
 import Control.Monad.Loops (iterateWhile)
@@ -479,9 +480,122 @@ mouseMap = runButtons $ do
       forM_ (map fst workspaceButtons) $ \b ->
         bind b $ noMod $ continuous workspaceButtons b
 
+-- Bindings specific to a window. These are set similarly to th ekeymap above,
+-- but uses a Query monad to tell which windows the keys will apply to.
+--
+-- This is useful to create hotkeys in applications where hot keys are not
+-- configurable, or to remove keybindings that are irritating (looking at you,
+-- ctrl+w in Chrome!!).
+windowSpecificBindings :: Query (KeysM l ())
+windowSpecificBindings = do
+  w <- ask
+
+  configureIf (flip elem browsers <$> className) $ do
+
+    -- if the window is a browser, configure these bindings. Lots of browsers
+    -- make up their own garbage bindings that are not standard across many
+    -- other applications. This alleviates the issue.
+    --
+    -- Consistency with terminal:
+    --
+    --   Ctrl+h is backspace
+    --   Ctrl+w is ctrl+backspace
+    --   Ctrl+u is ctrl+shift+backspace
+    --
+    -- Consistency with Vim/Emacs-ish:
+    --
+    --   Alt+{Shift,Ctrl,}+{h,j,k,l} -> {Shift,Ctrl,}+{Left,Down,Up,Right}
+    --   Ctrl+b -> Ctrl+Left
+    --   Ctrl+e -> Ctrl+Right
+    --   Ctrl+$ -> End
+    --   Ctrl+^ -> Home
+    --
+    --   Ctrl+d -> Delete current tab.
+
+
+    let mods = permuteMods [shiftMask, controlMask, 0]
+
+    bind xK_h $ do
+      rawMask controlMask $ sendKey (0, xK_BackSpace) w
+      forM_ mods $ \mask ->
+        rawMask (altMask .|. mask) $ sendKey (mask, xK_Left) w
+
+    bind xK_j $
+      forM_ mods $ \mask ->
+        rawMask (altMask .|. mask) $ sendKey (mask, xK_Down) w
+
+    bind xK_k $
+      forM_ mods $ \mask ->
+        rawMask (altMask .|.mask) $ sendKey (mask, xK_Up) w
+
+    bind xK_l $
+      forM_ mods $ \mask ->
+        rawMask (altMask .|. mask) $ sendKey (mask, xK_Right) w
+
+    bind xK_u $
+      rawMask controlMask $ sendKey (controlMask .|. shiftMask, xK_BackSpace) w
+
+    bind xK_w $
+      rawMask controlMask $ sendKey (controlMask, xK_BackSpace) w
+
+    bind xK_b $ do
+      rawMask controlMask $ sendKey (controlMask, xK_Left) w
+      rawMask (controlMask .|. shiftMask) $
+        sendKey (controlMask .|. shiftMask, xK_Left) w
+
+    bind xK_e $ do
+      rawMask controlMask $ sendKey (controlMask, xK_Right) w
+      rawMask (controlMask .|. shiftMask) $
+        sendKey (controlMask .|. shiftMask, xK_Right) w
+
+    bind xK_dollar $
+      rawMask controlMask $ sendKey (0, xK_End) w
+
+    bind xK_at $
+      rawMask (controlMask .|. shiftMask) $ sendKey (0, xK_Home) w
+
+    bind xK_d $
+      rawMask controlMask $ sendKey (controlMask, xK_w) w
+
+    bind xK_F2 $
+      -- Experimental.
+      noMod $ logs "This is a test"
+
+
+  where
+    browsers = ["Google-chrome", "Brave-browser", "firefox-default"]
+
+    -- Create a permutation from a list of modifiers.
+    --
+    -- i.e. permuteMods [C, S, M] will return
+    --
+    -- [C, S, M, C + M, C + S, M + S, C + S + M, 0]
+    permuteMods = map (foldl' (.|.) 0) . filterM (const [True, False])
+
+
+    configureIf :: Query Bool -> KeysM l () -> Query (KeysM l ())
+    configureIf b k = b --> return k
+
+windowBindings :: XConfig l -> XConfig l
+windowBindings xconfig =
+  xconfig {
+    startupHook = do
+      forAllWindows (runQuery doQuery)
+      startupHook xconfig,
+
+    manageHook = (doQuery >> return (Endo id)) <> manageHook xconfig
+  }
+  
+  where
+    doQuery :: Query ()
+    doQuery = do
+      keysM <- windowSpecificBindings
+      forM_ (Map.toList $ runKeys keysM xconfig) $ \(key, action) -> do
+        remapKey key action
+
 applyKeys :: XConfig l -> IO (XConfig l)
 applyKeys config =
-    return $ config { keys = keymap, mouseBindings = mouseMap }
+    return $ windowBindings $ config { keys = keymap, mouseBindings = mouseMap }
 
 click :: X ()
 click = do
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
index f834796..dfb1429 100644
--- a/src/Internal/KeysM.hs
+++ b/src/Internal/KeysM.hs
@@ -28,6 +28,13 @@ class Bindable k where
 
   bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
 
+instance Semigroup (KeysM l ()) where
+  (<>) = mappend
+
+instance Monoid (KeysM l ()) where
+  mempty = return ()
+  mappend = (>>)
+
 runKeys :: KeysM l a -> XConfig l -> Map (KeyMask, KeySym) (X ())
 runKeys (KeysM stateM) config =
   snd $ execState stateM (config, Map.empty)
diff --git a/src/Main.hs b/src/Main.hs
index 44fb358..a83f1c3 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -10,6 +10,7 @@ import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat)
 import XMonad.Layout.Fullscreen (fullscreenEventHook)
 import System.Environment (setEnv)
 import Data.Monoid
+import qualified Data.Map as Map
 
 import Internal.Swallow
 import Internal.Windows
@@ -19,6 +20,7 @@ import Internal.Layout
 import Internal.Logger
 import Internal.DMenu (menuCommandString)
 import Internal.RebindKeys
+import Internal.KeysM
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as W
@@ -35,49 +37,7 @@ main = do
   xmobar <- spawnXMobar
 
   (=<<) X.xmonad $
-    applyKeys $ ewmh $ docks $ windowHooks (composeAll [
-           let browsers = ["Google-chrome", "Brave-browser", "firefox-default"] in
-
-           (flip elem browsers <$> className) --> composeAll [
-             -- The geniuses that made chrome decided that Ctrl+W should kill
-             -- the current tab! This makes it consistent with the rest of the
-             -- world ... ctrl+w deletes the last word (ctrl+backspace).
-             rebindKey (controlMask, xK_w) (controlMask, xK_BackSpace)
-
-             -- Terminal Ctrl-H sends a backspace. (Technically not, but that's
-             -- usually the semantics). Make it this way in Chrome.
-           , rebindKey (controlMask, xK_h) (0, xK_BackSpace)
-
-             -- Ctrl+u usually deletes the whole line. This is roughly
-             -- ctrl+shift+backspace
-           , rebindKey (controlMask, xK_u) (controlMask .|. shiftMask, xK_BackSpace)
-
-             -- Make it to ctrl+d deletes the current tab instead of ctrl+w.
-           , rebindKey (controlMask, xK_e) (controlMask, xK_w)
-
-             -- Vim-ish keybindings to go back and forward.
-           , rebindKey (controlMask, xK_b) (controlMask, xK_Left)
-           , rebindKey (controlMask, xK_e) (controlMask, xK_Right)
-           , rebindKey (controlMask .|. shiftMask, xK_b) (controlMask .|. shiftMask, xK_Left)
-           , rebindKey (controlMask .|. shiftMask, xK_e) (controlMask .|. shiftMask, xK_Right)
-
-             -- Baskic Vim-like motion with the alt key.
-           , rebindKey (mod1Mask, xK_h) (0, xK_Left)
-           , rebindKey (mod1Mask, xK_j) (0, xK_Down)
-           , rebindKey (mod1Mask, xK_k) (0, xK_Up)
-           , rebindKey (mod1Mask, xK_l) (0, xK_Right)
-
-           , rebindKey (shiftMask .|. mod1Mask, xK_h) (shiftMask, xK_Left)
-           , rebindKey (shiftMask .|. mod1Mask, xK_j) (shiftMask, xK_Down)
-           , rebindKey (shiftMask .|. mod1Mask, xK_k) (shiftMask, xK_Up)
-           , rebindKey (shiftMask .|. mod1Mask, xK_l) (shiftMask, xK_Right)
-
-           , rebindKey (controlMask .|. mod1Mask, xK_h) (controlMask, xK_Left)
-           , rebindKey (controlMask .|. mod1Mask, xK_j) (controlMask, xK_Down)
-           , rebindKey (controlMask .|. mod1Mask, xK_k) (controlMask, xK_Up)
-           , rebindKey (controlMask .|. mod1Mask, xK_l) (controlMask, xK_Right)
-           ]
-        ]) $ def
+    applyKeys $ ewmh $ docks $  def
        { terminal    = "alacritty"
        , modMask     = mod3Mask
        , borderWidth = 2
@@ -111,6 +71,7 @@ main = do
        , logHook = xMobarLogHook xmobar
        }
 
+
 doCenterFloat :: ManageHook
 doCenterFloat =
   ask >>= \w -> doF . W.float w . centerRect . snd =<< liftX (floatLocation w)
-- 
cgit 


From a9286e8c39cc8de56de7a723c9ddabd78ac64198 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 29 Mar 2022 12:32:25 -0600
Subject: Remove trailing whitespace

---
 src/Internal/CornerLayout.hs |  6 +++---
 src/Internal/Keys.hs         | 12 ++++++++----
 src/Internal/Layout.hs       | 16 ++++++++--------
 src/Internal/LayoutDraw.hs   |  4 ++--
 src/Internal/Lib.hs          |  2 +-
 src/Internal/Logger.hs       |  2 +-
 src/Internal/Marking.hs      |  2 +-
 src/Internal/PassMenu.hs     |  4 ++--
 src/Internal/Windows.hs      |  2 +-
 9 files changed, 27 insertions(+), 23 deletions(-)

diff --git a/src/Internal/CornerLayout.hs b/src/Internal/CornerLayout.hs
index b3898fc..5545aef 100644
--- a/src/Internal/CornerLayout.hs
+++ b/src/Internal/CornerLayout.hs
@@ -21,15 +21,15 @@ instance LayoutClass Corner a where
 
         vn = (length ws - 1) `div` 2
         hn = (length ws - 1) - vn
-      in 
+      in
         case ws of
           [a] -> [(a, screen)]
           [a, b] -> [
             (a, Rectangle x y w' h),
             (b, Rectangle (x + fromIntegral w') y (w - w') h)]
-          _ -> 
+          _ ->
             zip ws $ map (
-                \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h) $ 
+                \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h) $
               corner :
                 splitVert vertRect vn ++
                 splitHoriz horizRect hn
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 21988f8..ad3d6b8 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -233,7 +233,7 @@ keymap = runKeys $ do
 
   bind xK_q $ do
     shiftMod $ spawn "xmonad --recompile && xmonad --restart"
-    
+
     justMod $ subkeys $ do
 
       bind xK_q $
@@ -246,7 +246,7 @@ keymap = runKeys $ do
           if (x' - x) < 0
             then mediaPrev
             else mediaNext
- 
+
   bind xK_r $ do
     justMod runDMenu
     shiftMod $ sendMessage DoRotate
@@ -459,7 +459,7 @@ mouseMap = runButtons $ do
   bind button15 $ do
 
     noMod $ subMouse $ do
-      
+
       bind button15 $ do
         noMod $ const jumpToLast
 
@@ -561,6 +561,10 @@ windowSpecificBindings = do
       -- Experimental.
       noMod $ logs "This is a test"
 
+  -- Add a binding to xev as a test.
+  configureIf (title =? "Event Tester") $
+    bind xK_F2 $
+      noMod $ sendKey (controlMask, xK_F2) w
 
   where
     browsers = ["Google-chrome", "Brave-browser", "firefox-default"]
@@ -585,7 +589,7 @@ windowBindings xconfig =
 
     manageHook = (doQuery >> return (Endo id)) <> manageHook xconfig
   }
-  
+
   where
     doQuery :: Query ()
     doQuery = do
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index a077872..8613284 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-module Internal.Layout where 
+module Internal.Layout where
 
 import Internal.CornerLayout (Corner(..))
 import Control.Arrow (second)
@@ -27,7 +27,7 @@ import qualified XMonad.StackSet as W
 
 myLayout =
   fullscreenFull $
-    avoidStruts $ 
+    avoidStruts $
       spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
         ModifiedLayout (Zoomable False 0.05 0.05) $
           ModifiedLayout (Flippable False) $
@@ -134,7 +134,7 @@ instance (Eq a) => LayoutModifier Rotateable a where
       zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
       unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h
 
-      scaleRect (Rectangle x y w h) = 
+      scaleRect (Rectangle x y w h) =
         Rectangle (x * fi sw `div` fi sh)
                   (y * fi sh `div` fi sw)
                   (w * sw `div` sh)
@@ -154,14 +154,14 @@ instance (Eq a) => LayoutModifier Rotateable a where
 
 instance (Eq a) => LayoutModifier Flippable a where
   pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
-    if flip 
+    if flip
       then (map (second doFlip) returned, Nothing)
       else (returned, Nothing)
     where
       doFlip (Rectangle x y w h) =
         Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
 
-  pureMess (Flippable flip) message = 
+  pureMess (Flippable flip) message =
     case fromMessage message of
       Just FlipLayout -> Just (Flippable (not flip))
       Nothing -> Nothing
@@ -174,14 +174,14 @@ instance (Eq a) => LayoutModifier Flippable a where
 
 instance (Eq a) => LayoutModifier HFlippable a where
   pureModifier (HFlippable flip) (Rectangle _ sy _ sh) stack returned =
-    if flip 
+    if flip
       then (map (second doFlip) returned, Nothing)
       else (returned, Nothing)
     where
       doFlip (Rectangle x y w h) =
         Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
 
-  pureMess (HFlippable flip) message = 
+  pureMess (HFlippable flip) message =
     case fromMessage message of
       Just HFlipLayout -> Just (HFlippable (not flip))
       Nothing -> Nothing
@@ -191,7 +191,7 @@ instance (Eq a) => LayoutModifier HFlippable a where
       if flipped
         then descr ++ " HFlipped"
         else descr
-    
+
 
 instance (Eq a) => LayoutModifier Zoomable a where
   redoLayout (Zoomable doit ws hs) (Rectangle x y w h) stack returned =
diff --git a/src/Internal/LayoutDraw.hs b/src/Internal/LayoutDraw.hs
index 131b32b..a105c98 100644
--- a/src/Internal/LayoutDraw.hs
+++ b/src/Internal/LayoutDraw.hs
@@ -114,7 +114,7 @@ drawXpmIO l = do
 --
 -- Create's an XPM, purely. Returns a string with the XPM contents.
 -- Takes as arguments
--- 
+--
 --   - dimensions of the icon.
 --   - list of (color, rectangle) pairs.
 --   - The amount to shrink the windows by for those pretty gaps.
@@ -134,7 +134,7 @@ drawXpm (w, h) rects' shrinkAmt = execWriter $ do
 
     forM_ [0 .. h - 1] $ \y -> do
       tell "\""
-      forM_ [0 .. w - 1] $ \x -> 
+      forM_ [0 .. w - 1] $ \x ->
         (case find (matches x y) zipRects of
           Nothing -> tell "%"
           Just (chr, _) -> tell [chr])
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index d8784ea..e608bb0 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -132,7 +132,7 @@ relativeWorkspaceShift (Selector selector) = do
 
 next :: Selector
 next = Selector $ \a l -> select a l l
-  where select n (x:y:xs) _ | n == x = y 
+  where select n (x:y:xs) _ | n == x = y
         select n [x] (y:_) | n == x = y
         select n (x:xs) orig = select n xs orig
         select n _ _ = n
diff --git a/src/Internal/Logger.hs b/src/Internal/Logger.hs
index 1dbd493..e5824a4 100644
--- a/src/Internal/Logger.hs
+++ b/src/Internal/Logger.hs
@@ -26,7 +26,7 @@ logs s = do
         return handle
 
       Just (NoPersist h) -> return h
-  
+
   io $ do
     hPutStrLn handle s
     hFlush handle
diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index e37e241..dcf3c05 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -22,7 +22,7 @@ type Mark = Char
 
 data MarkState =
   MarkState {
-    markStateMap :: Map Mark Window 
+    markStateMap :: Map Mark Window
   , markLast :: Maybe Window
   } deriving (Read, Show)
 
diff --git a/src/Internal/PassMenu.hs b/src/Internal/PassMenu.hs
index bb3bc4d..5b031c0 100644
--- a/src/Internal/PassMenu.hs
+++ b/src/Internal/PassMenu.hs
@@ -7,7 +7,7 @@ import Control.Monad
 runPassMenu :: X ()
 runPassMenu = void $
   safeSpawn "rofi-pass" [
-    "-p", "Password ", 
+    "-p", "Password ",
     "-theme-str",
     "* {theme-color: #f54245;}"]
-    
+
diff --git a/src/Internal/Windows.hs b/src/Internal/Windows.hs
index c6a2b8b..98baa51 100644
--- a/src/Internal/Windows.hs
+++ b/src/Internal/Windows.hs
@@ -53,7 +53,7 @@ forAllWindows fn = do
   mapM_ fn (allWindows stackSet)
 
 {- Finds a Window and returns the screen its on and the workspace its on.
- - Returns nothing if the window doesn't exist. 
+ - Returns nothing if the window doesn't exist.
  -
  - If the window is not a screen Just (Nothing, workspace) is returned.
  - If the window is a floating window Just (Nothing, Nothing) is returned. -}
-- 
cgit 


From bfb70428f7791000239ac1d90635677ff577fee7 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 29 Mar 2022 14:26:40 -0600
Subject: Fixed bug where multiple configures would override previous
 configures for window-specific bindings

---
 src/Internal/Keys.hs  | 25 +++++++++++++++----------
 src/Internal/KeysM.hs |  7 -------
 src/Main.hs           |  4 ++++
 3 files changed, 19 insertions(+), 17 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index ad3d6b8..ce48dfd 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,9 +1,10 @@
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RankNTypes, FlexibleContexts #-}
 module Internal.Keys (applyKeys) where
 
 import Data.Monoid (Endo(..))
 import Control.Monad.Trans.Class
 import Control.Monad.Reader
+import Control.Monad.Writer
 import Control.Monad.Loops (iterateWhile)
 import Control.Monad.Fix (fix)
 import Graphics.X11.ExtraTypes.XF86;
@@ -486,9 +487,13 @@ mouseMap = runButtons $ do
 -- This is useful to create hotkeys in applications where hot keys are not
 -- configurable, or to remove keybindings that are irritating (looking at you,
 -- ctrl+w in Chrome!!).
-windowSpecificBindings :: Query (KeysM l ())
-windowSpecificBindings = do
-  w <- ask
+windowSpecificBindings ::
+  XConfig l -> WriterT (Map (KeyMask, KeySym) (X ())) Query ()
+windowSpecificBindings config = do
+
+  w <- lift ask
+
+  let configureIf b k = tell =<< lift (b --> return (runKeys k config))
 
   configureIf (flip elem browsers <$> className) $ do
 
@@ -576,10 +581,6 @@ windowSpecificBindings = do
     -- [C, S, M, C + M, C + S, M + S, C + S + M, 0]
     permuteMods = map (foldl' (.|.) 0) . filterM (const [True, False])
 
-
-    configureIf :: Query Bool -> KeysM l () -> Query (KeysM l ())
-    configureIf b k = b --> return k
-
 windowBindings :: XConfig l -> XConfig l
 windowBindings xconfig =
   xconfig {
@@ -593,8 +594,12 @@ windowBindings xconfig =
   where
     doQuery :: Query ()
     doQuery = do
-      keysM <- windowSpecificBindings
-      forM_ (Map.toList $ runKeys keysM xconfig) $ \(key, action) -> do
+      map <- execWriterT $ windowSpecificBindings xconfig
+      w <- ask
+
+      liftX $ logs $ printf "For Window: %s" (show w)
+      forM_ (Map.toList map) $ \(key, action) -> do
+        liftX $ logs $ printf "   -- remap: %s" (show key)
         remapKey key action
 
 applyKeys :: XConfig l -> IO (XConfig l)
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
index dfb1429..f834796 100644
--- a/src/Internal/KeysM.hs
+++ b/src/Internal/KeysM.hs
@@ -28,13 +28,6 @@ class Bindable k where
 
   bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
 
-instance Semigroup (KeysM l ()) where
-  (<>) = mappend
-
-instance Monoid (KeysM l ()) where
-  mempty = return ()
-  mappend = (>>)
-
 runKeys :: KeysM l a -> XConfig l -> Map (KeyMask, KeySym) (X ())
 runKeys (KeysM stateM) config =
   snd $ execState stateM (config, Map.empty)
diff --git a/src/Main.hs b/src/Main.hs
index a83f1c3..0b4a181 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -60,6 +60,10 @@ main = do
          , className =? "mpv" --> doFloat
          , className =? "gnubby_ssh_prompt" --> doFloat
          ]
+         -- This config uses dynamic workspaces, but I have to seed XMonad
+         -- with something. However, this configuration only supports 36
+         -- monitors on boot. If you need more than 36 monitors, you'll have to
+         -- configure those ones after starting XMonad.
        , workspaces = map return (['0'..'9'] ++ ['a'..'z'])
        , handleEventHook =
            composeAll [
-- 
cgit 


From 88e467e808e5ebec0d7dc963f1c6aeb2fea26ad4 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 29 Mar 2022 14:30:17 -0600
Subject: --amend

---
 src/Internal/Keys.hs | 31 ++++++++++++++++---------------
 1 file changed, 16 insertions(+), 15 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index ce48dfd..49b85d1 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -494,6 +494,7 @@ windowSpecificBindings config = do
   w <- lift ask
 
   let configureIf b k = tell =<< lift (b --> return (runKeys k config))
+      emitKey = flip sendKey w
 
   configureIf (flip elem browsers <$> className) $ do
 
@@ -521,46 +522,46 @@ windowSpecificBindings config = do
     let mods = permuteMods [shiftMask, controlMask, 0]
 
     bind xK_h $ do
-      rawMask controlMask $ sendKey (0, xK_BackSpace) w
+      rawMask controlMask $ emitKey (0, xK_BackSpace)
       forM_ mods $ \mask ->
-        rawMask (altMask .|. mask) $ sendKey (mask, xK_Left) w
+        rawMask (altMask .|. mask) $ emitKey (mask, xK_Left)
 
     bind xK_j $
       forM_ mods $ \mask ->
-        rawMask (altMask .|. mask) $ sendKey (mask, xK_Down) w
+        rawMask (altMask .|. mask) $ emitKey (mask, xK_Down)
 
     bind xK_k $
       forM_ mods $ \mask ->
-        rawMask (altMask .|.mask) $ sendKey (mask, xK_Up) w
+        rawMask (altMask .|.mask) $ emitKey (mask, xK_Up)
 
     bind xK_l $
       forM_ mods $ \mask ->
-        rawMask (altMask .|. mask) $ sendKey (mask, xK_Right) w
+        rawMask (altMask .|. mask) $ emitKey (mask, xK_Right)
 
     bind xK_u $
-      rawMask controlMask $ sendKey (controlMask .|. shiftMask, xK_BackSpace) w
+      rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_BackSpace)
 
     bind xK_w $
-      rawMask controlMask $ sendKey (controlMask, xK_BackSpace) w
+      rawMask controlMask $ emitKey (controlMask, xK_BackSpace)
 
     bind xK_b $ do
-      rawMask controlMask $ sendKey (controlMask, xK_Left) w
+      rawMask controlMask $ emitKey (controlMask, xK_Left)
       rawMask (controlMask .|. shiftMask) $
-        sendKey (controlMask .|. shiftMask, xK_Left) w
+        emitKey (controlMask .|. shiftMask, xK_Left)
 
     bind xK_e $ do
-      rawMask controlMask $ sendKey (controlMask, xK_Right) w
+      rawMask controlMask $ emitKey (controlMask, xK_Right)
       rawMask (controlMask .|. shiftMask) $
-        sendKey (controlMask .|. shiftMask, xK_Right) w
+        emitKey (controlMask .|. shiftMask, xK_Right)
 
     bind xK_dollar $
-      rawMask controlMask $ sendKey (0, xK_End) w
+      rawMask controlMask $ emitKey (0, xK_End)
 
     bind xK_at $
-      rawMask (controlMask .|. shiftMask) $ sendKey (0, xK_Home) w
+      rawMask (controlMask .|. shiftMask) $ emitKey (0, xK_Home)
 
     bind xK_d $
-      rawMask controlMask $ sendKey (controlMask, xK_w) w
+      rawMask controlMask $ emitKey (controlMask, xK_w)
 
     bind xK_F2 $
       -- Experimental.
@@ -569,7 +570,7 @@ windowSpecificBindings config = do
   -- Add a binding to xev as a test.
   configureIf (title =? "Event Tester") $
     bind xK_F2 $
-      noMod $ sendKey (controlMask, xK_F2) w
+      noMod $ emitKey (controlMask, xK_F2)
 
   where
     browsers = ["Google-chrome", "Brave-browser", "firefox-default"]
-- 
cgit 


From 45708cf4c2bf0f766114f30a934e30f63fd80834 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 30 Mar 2022 17:12:52 -0600
Subject: Starting new branch to experimentally add documentation to
 KeyBindings.

The hope is to get to a point where documentation can be automatically
generated for key bindings, while keeping as much of the existing
DSL unchanged as possible.

The goal is to have something like:

bind xK_h $ do

  doc "Set focus to the next window in the stack"
  justMod nextWindow

  doc "Swap this window with the next window in the stack."
  shiftMod shiftNextWindow

Then "theoretically" a markdown/latex/text file can be generated with
documentation for each of those bindings and have the documentation
automatically update if the keys change.
---
 src/Internal/Keys.hs  |  98 +++++++++++++++------------
 src/Internal/KeysM.hs | 179 ++++++++++++++++++++++++++++----------------------
 2 files changed, 156 insertions(+), 121 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 49b85d1..467ed24 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -58,11 +58,17 @@ type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
 
 
-decreaseVolume = spawn "pactl set-sink-volume @DEFAULT_SINK@ -5%"
-increaseVolume = spawn "pactl set-sink-volume @DEFAULT_SINK@ +5%"
-playPause = spawn "spotify-control play"
-mediaPrev = spawn "spotify-control prev"
-mediaNext = spawn "spotify-control next"
+spawnX :: String -> X ()
+spawnX = spawn
+
+noWindow :: b -> Window -> b
+noWindow = const
+
+decreaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ -5%"
+increaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ +5%"
+playPause = spawnX "spotify-control play"
+mediaPrev = spawnX "spotify-control prev"
+mediaNext = spawnX "spotify-control next"
 
 
 button6 :: Button
@@ -95,12 +101,18 @@ button14 = 14
 button15 :: Button
 button15 = 15
 
+resolveSubmaps :: (XConfig l -> KeyBindings) -> KeyMap l
+resolveSubmaps bindings config = (fmap $ \binding ->
+  case binding of
+    Action x -> x
+    Submap _ -> logs "") (bindings config)
+
 keymap :: KeyMap l
-keymap = runKeys $ do
+keymap = resolveSubmaps $ runKeys $ do
   config <- getConfig
 
   let defaultKey key = fromMaybe (return ()) $ Map.lookup key (keymap config)
-      subkeys = submapDefaultWithKey defaultKey . flip runKeys config
+      subkeys keysM = submapDefaultWithKey defaultKey $ (resolveSubmaps (runKeys keysM)) config
 
   bind xK_apostrophe $ do
     justMod $ subkeys $ do
@@ -117,10 +129,10 @@ keymap = runKeys $ do
     -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
     -- something goes wrong with the keyboard layout and for first-time boots
     -- where dmenu/alacritty may not be installed.
-    rawMask mod4Mask $ spawn "xterm"
+    rawMask mod4Mask $ spawnX "xterm"
 
     -- Moves xmobar to different monitors.
-    justMod $ spawn "pkill -SIGUSR1 xmobar"
+    justMod $ spawnX "pkill -SIGUSR1 xmobar"
 
   bind xK_F1 $ do
     -- Experimental. Sends 'a' to all windows.
@@ -172,7 +184,7 @@ keymap = runKeys $ do
     justMod $ sendMessage $ modifyWindowBorder (-5)
 
   bind xK_b $ do
-    justMod $ spawn "bluetooth-select.sh"
+    justMod $ spawnX "bluetooth-select.sh"
 
   bind xK_c $ do
     justMod runPassMenu
@@ -212,7 +224,7 @@ keymap = runKeys $ do
     justMod    $ windows W.focusUp
     shiftMod   $ windows W.swapUp
     controlMod rotAllUp
-    altMod     $ spawn "xsecurelock"
+    altMod     $ spawnX "xsecurelock"
 
   bind xK_minus $ do
     justMod  $ sendMessage (IncMasterN (-1))
@@ -233,7 +245,7 @@ keymap = runKeys $ do
     shiftMod $ withFocused $ sendMessage . expandWindowAlt
 
   bind xK_q $ do
-    shiftMod $ spawn "xmonad --recompile && xmonad --restart"
+    shiftMod $ spawnX "xmonad --recompile && xmonad --restart"
 
     justMod $ subkeys $ do
 
@@ -253,16 +265,16 @@ keymap = runKeys $ do
     shiftMod $ sendMessage DoRotate
 
   bind xK_s $ do
-    altMod $ spawn "sudo -A systemctl suspend && xsecurelock"
+    altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
   bind xK_space $ do
     justMod  $ sendMessage NextLayout
     shiftMod $ sendMessage NextLayout
 
   bind xK_t $ do
-    justMod  $ spawn (terminal config)
+    justMod  $ spawnX (terminal config)
     shiftMod $ withFocused $ windows . W.sink
-    altMod   $ spawn (terminal config ++ " -t Floating\\ Term")
+    altMod   $ spawnX (terminal config ++ " -t Floating\\ Term")
 
   bind xK_v $
     -- Allows repeated strokes of M-h and M-l to reduce and increase volume
@@ -299,7 +311,7 @@ keymap = runKeys $ do
 
       bind xK_p $ do
         (justMod -|- noMod) $ mapNextString $ \_ str ->
-          spawn $ printf "gxmessage 'typed: \"%s\"\ncodes: \"%s\"\nunicode: á\n'"
+          spawnX $ printf "gxmessage 'typed: \"%s\"\ncodes: \"%s\"\nunicode: á\n'"
             str
             (show (map ord str))
 
@@ -307,30 +319,30 @@ keymap = runKeys $ do
         (justMod -|- noMod) $ logs "Test Log"
 
       bind xK_n $ do
-        (justMod -|- noMod) $ spawn (terminal config ++ " -t Notes -e notes new")
+        (justMod -|- noMod) $ spawnX (terminal config ++ " -t Notes -e notes new")
 
       bind xK_c $ do
         shiftMod CopyWindow.killAllOtherCopies
 
       bind xK_e $ do
-        (justMod -|- noMod) $ spawn "emoji-select.sh"
-        (shiftMod -|- rawMask shiftMask) $ spawn "emoticon-select.sh"
+        (justMod -|- noMod) $ spawnX "emoji-select.sh"
+        (shiftMod -|- rawMask shiftMask) $ spawnX "emoticon-select.sh"
 
       bind xK_a $
-        (justMod -|- noMod) $ spawn "set-sink.sh"
+        (justMod -|- noMod) $ spawnX "set-sink.sh"
 
       bind xK_w $
-        (justMod -|- noMod) $ spawn "networkmanager_dmenu"
+        (justMod -|- noMod) $ spawnX "networkmanager_dmenu"
 
       bind xK_o $
-        (justMod -|- noMod) $ spawn "library-view.sh"
+        (justMod -|- noMod) $ spawnX "library-view.sh"
 
       bind xK_s $
         (justMod -|- noMod) toggleSwallowEnabled
 
       bind xK_v $ do
-        (justMod -|- noMod) $ spawn "set-volume.sh"
-        (shiftMod -|- rawMask shiftMask) $ spawn "set-volume.sh -a"
+        (justMod -|- noMod) $ spawnX "set-volume.sh"
+        (shiftMod -|- rawMask shiftMask) $ spawnX "set-volume.sh -a"
 
       -- Double-tap Z to toggle zoom.
       bind xK_z $ do
@@ -347,18 +359,18 @@ keymap = runKeys $ do
     shiftMod $ sendMessage ToggleZoom
 
   bind xF86XK_Calculator $ do
-    noMod $ spawn $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
+    noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
 
   bind xF86XK_AudioLowerVolume $ do
-    noMod $ spawn "pactl set-sink-volume @DEFAULT_SINK@ -1%"
+    noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ -1%"
     justMod mediaPrev
 
   bind xF86XK_AudioRaiseVolume $ do
-    noMod $ spawn "pactl set-sink-volume @DEFAULT_SINK@ +1%"
+    noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ +1%"
     justMod mediaNext
 
   bind xF86XK_AudioMute $ do
-    noMod $ spawn "pactl set-sink-mute @DEFAULT_SINK@ toggle"
+    noMod $ spawnX "pactl set-sink-mute @DEFAULT_SINK@ toggle"
 
   bind xF86XK_AudioPlay $ do
     noMod playPause
@@ -373,13 +385,13 @@ keymap = runKeys $ do
     noMod mediaPrev
 
   bind xF86XK_MonBrightnessUp $ do
-    noMod $ spawn "set-backlight.sh +0.05"
-    justMod $ spawn "set-backlight.sh 1"
+    noMod $ spawnX "set-backlight.sh +0.05"
+    justMod $ spawnX "set-backlight.sh 1"
 
   bind xF86XK_MonBrightnessDown $ do
-    noMod $ spawn "set-backlight.sh -0.05"
-    justMod $ spawn "set-backlight.sh 0.01"
-    rawMask shiftMask $ spawn "set-backlight.sh 0"
+    noMod $ spawnX "set-backlight.sh -0.05"
+    justMod $ spawnX "set-backlight.sh 0.01"
+    rawMask shiftMask $ spawnX "set-backlight.sh 0"
 
 mouseMap :: ButtonsMap l
 mouseMap = runButtons $ do
@@ -412,31 +424,31 @@ mouseMap = runButtons $ do
     justMod $ \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster
 
   bind button6 $
-    justMod $ const (relativeWorkspaceShift prev)
+    justMod $ noWindow (relativeWorkspaceShift prev)
 
   bind button7 $
-    justMod $ const (relativeWorkspaceShift next)
+    justMod $ noWindow (relativeWorkspaceShift next)
 
   bind button8 $
-    justMod $ const mediaPrev
+    justMod $ noWindow mediaPrev
 
   bind button9 $
-    justMod $ const mediaNext
+    justMod $ noWindow mediaNext
 
   bind button14 $ do
     noMod $ subMouse $ do
 
       bind button3 $
-        noMod $ const (gotoWorkspace 's')
+        noMod $ noWindow (gotoWorkspace 's')
 
       bind button13 $ do
-        noMod $ \_ -> click >> CopyWindow.kill1
+        noMod $ noWindow $ click >> CopyWindow.kill1
 
       bind button14 $ do
-        noMod $ \_ -> click >> sendMessage ToggleZoom
+        noMod $ noWindow $ click >> sendMessage ToggleZoom
 
       bind button15 $ do
-        noMod $ \_ -> spawn "pavucontrol"
+        noMod $ noWindow $ spawnX "pavucontrol"
 
       let mediaButtons = [
             (button4, increaseVolume),
@@ -462,7 +474,7 @@ mouseMap = runButtons $ do
     noMod $ subMouse $ do
 
       bind button15 $ do
-        noMod $ const jumpToLast
+        noMod $ noWindow jumpToLast
 
 
       let workspaceButtons = [
@@ -493,7 +505,7 @@ windowSpecificBindings config = do
 
   w <- lift ask
 
-  let configureIf b k = tell =<< lift (b --> return (runKeys k config))
+  let configureIf b k = tell =<< lift (b --> return (resolveSubmaps (runKeys k) config))
       emitKey = flip sendKey w
 
   configureIf (flip elem browsers <$> className) $ do
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
index f834796..b394552 100644
--- a/src/Internal/KeysM.hs
+++ b/src/Internal/KeysM.hs
@@ -9,11 +9,17 @@ import XMonad
 import Data.Map (Map)
 import qualified Data.Map as Map
 
+data KeyBinding =  Action (X ()) | Submap KeyBindings
+type KeyBindings = Map (KeyMask, KeySym) KeyBinding
+
+type ButtonBinding = Window -> X ()
+type ButtonBindings = Map (KeyMask, Button) ButtonBinding
+
 {- Module that defines a DSL for binding keys. -}
-newtype KeysM l a = KeysM (State (XConfig l, Map (KeyMask, KeySym) (X ())) a)
+newtype KeysM l a = KeysM (State (XConfig l, KeyBindings) a)
   deriving (Functor, Applicative, Monad)
 
-newtype ButtonsM l a = ButtonsM (State (XConfig l, Map (KeyMask, Button) (Window -> X ())) a)
+newtype ButtonsM l a = ButtonsM (State (XConfig l, ButtonBindings) a)
   deriving (Functor, Applicative, Monad)
 
 newtype BindingBuilder b a = BindingBuilder (State (KeyMask, [(KeyMask, b)]) a)
@@ -28,11 +34,30 @@ class Bindable k where
 
   bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
 
-runKeys :: KeysM l a -> XConfig l -> Map (KeyMask, KeySym) (X ())
+class Binding k b where
+  rawMask :: KeyMask -> k -> BindingBuilder b ()
+
+instance Binding (X ()) KeyBinding where
+  rawMask m x = BindingBuilder $ modify' (second ((m, Action x):))
+
+instance Binding KeyBindings KeyBinding where
+  rawMask m x = BindingBuilder $ modify' (second ((m, Submap x):))
+
+instance Binding a a where
+  rawMask m x = BindingBuilder $ modify' (second ((m, x):))
+
+instance Semigroup (KeysM l ()) where
+  (<>) = mappend
+
+instance Monoid (KeysM l ()) where
+  mempty = return ()
+  mappend = (>>)
+
+runKeys :: KeysM l a -> XConfig l -> KeyBindings
 runKeys (KeysM stateM) config =
   snd $ execState stateM (config, Map.empty)
 
-runButtons :: ButtonsM l a -> XConfig l -> Map (KeyMask, Button) (Window -> X ())
+runButtons :: ButtonsM l a -> XConfig l -> ButtonBindings
 runButtons (ButtonsM stateM) config =
   snd $ execState stateM (config, Map.empty)
 
@@ -43,13 +68,10 @@ instance HasConfig ButtonsM where
   getConfig = fst <$> ButtonsM get
 
 {- Generally it is assumed that the mod key shoud be pressed, but not always. -}
-noMod :: f -> BindingBuilder f ()
+noMod :: (Binding k b) => k -> BindingBuilder b ()
 noMod = rawMask 0
 
-rawMask :: KeyMask -> f -> BindingBuilder f ()
-rawMask m x = BindingBuilder $ modify' (second ((m, x):))
-
-maskMod :: KeyMask -> f -> BindingBuilder f ()
+maskMod :: (Binding k b) => KeyMask -> k -> BindingBuilder b ()
 maskMod mask action = do
   modMask <- fst <$> BindingBuilder get
   rawMask (modMask .|. mask) action
@@ -66,11 +88,11 @@ altgrMask = mod2Mask
 superMask :: KeyMask
 superMask = mod4Mask
 
-justMod :: f -> BindingBuilder f ()
+justMod :: (Binding k b) => k -> BindingBuilder b ()
 justMod = maskMod 0
 
 instance Bindable KeySym where
-  type BindableValue KeySym = X ()
+  type BindableValue KeySym = KeyBinding
   type BindableMonad KeySym = KeysM
 
   -- bind :: KeySym -> BindingBuilder (X x) a -> KeysM l ()
@@ -82,7 +104,7 @@ instance Bindable KeySym where
       flip (<>) (Map.fromList (map (\(m, v) -> ((m, key), v)) values))
 
 instance Bindable Button where
-  type BindableValue Button = Window -> X ()
+  type BindableValue Button = ButtonBinding
   type BindableMonad Button = ButtonsM
 
   -- bind :: KeySym -> BindingBuilder (Window -> X ()) a -> ButtonsM l ()
@@ -93,257 +115,258 @@ instance Bindable Button where
     ButtonsM $ modify' $ second $
       flip (<>) (Map.fromList (map (\(m, v) -> ((m, button), v)) values))
 
-shiftControlAltSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltSuperHyperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
 
-shiftControlAltSuperHyperMod :: f -> BindingBuilder f ()
+shiftControlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltSuperHyperMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask)
 
-shiftControlAltSuperAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltSuperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. altgrMask)
 
-shiftControlAltSuperMod :: f -> BindingBuilder f ()
+shiftControlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltSuperMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. superMask)
 
-shiftControlAltHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltHyperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask .|. altgrMask)
 
-shiftControlAltHyperMod :: f -> BindingBuilder f ()
+shiftControlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltHyperMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask)
 
-shiftControlAltAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltAltgrMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. altgrMask)
 
-shiftControlAltMod :: f -> BindingBuilder f ()
+shiftControlAltMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltMod =
   maskMod (shiftMask .|. controlMask .|. altMask)
 
-shiftControlSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlSuperHyperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask .|. altgrMask)
 
-shiftControlSuperHyperMod :: f -> BindingBuilder f ()
+shiftControlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlSuperHyperMod =
   maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask)
 
-shiftControlSuperAltgrMod :: f -> BindingBuilder f ()
+shiftControlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlSuperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. superMask .|. altgrMask)
 
-shiftControlSuperMod :: f -> BindingBuilder f ()
+shiftControlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlSuperMod =
   maskMod (shiftMask .|. controlMask .|. superMask)
 
-shiftControlHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlHyperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. hyperMask .|. altgrMask)
 
-shiftControlHyperMod :: f -> BindingBuilder f ()
+shiftControlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlHyperMod =
   maskMod (shiftMask .|. controlMask .|. hyperMask)
 
-shiftControlAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltgrMod =
   maskMod (shiftMask .|. controlMask .|. altgrMask)
 
-shiftControlMod :: f -> BindingBuilder f ()
+shiftControlMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlMod =
   maskMod (shiftMask .|. controlMask)
 
-shiftAltSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltSuperHyperAltgrMod =
   maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
 
-shiftAltSuperHyperMod :: f -> BindingBuilder f ()
+shiftAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltSuperHyperMod =
   maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask)
 
-shiftAltSuperAltgrMod :: f -> BindingBuilder f ()
+shiftAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltSuperAltgrMod =
   maskMod (shiftMask .|. altMask .|. superMask .|. altgrMask)
 
-shiftAltSuperMod :: f -> BindingBuilder f ()
+shiftAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltSuperMod =
   maskMod (shiftMask .|. altMask .|. superMask)
 
-shiftAltHyperAltgrMod :: f -> BindingBuilder f ()
+shiftAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltHyperAltgrMod =
   maskMod (shiftMask .|. altMask .|. hyperMask .|. altgrMask)
 
-shiftAltHyperMod :: f -> BindingBuilder f ()
+shiftAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltHyperMod =
   maskMod (shiftMask .|. altMask .|. hyperMask)
 
-shiftAltAltgrMod :: f -> BindingBuilder f ()
+shiftAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltAltgrMod =
   maskMod (shiftMask .|. altMask .|. altgrMask)
 
-shiftAltMod :: f -> BindingBuilder f ()
+shiftAltMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltMod =
   maskMod (shiftMask .|. altMask)
 
-shiftSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftSuperHyperAltgrMod =
   maskMod (shiftMask .|. superMask .|. hyperMask .|. altgrMask)
 
-shiftSuperHyperMod :: f -> BindingBuilder f ()
+shiftSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftSuperHyperMod =
   maskMod (shiftMask .|. superMask .|. hyperMask)
 
-shiftSuperAltgrMod :: f -> BindingBuilder f ()
+shiftSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftSuperAltgrMod =
   maskMod (shiftMask .|. superMask .|. altgrMask)
 
-shiftSuperMod :: f -> BindingBuilder f ()
+shiftSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftSuperMod =
   maskMod (shiftMask .|. superMask)
 
-shiftHyperAltgrMod :: f -> BindingBuilder f ()
+shiftHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftHyperAltgrMod =
   maskMod (shiftMask .|. hyperMask .|. altgrMask)
 
-shiftHyperMod :: f -> BindingBuilder f ()
+shiftHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftHyperMod =
   maskMod (shiftMask .|. hyperMask)
 
-shiftAltgrMod :: f -> BindingBuilder f ()
+shiftAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltgrMod =
   maskMod (shiftMask .|. altgrMask)
 
-shiftMod :: f -> BindingBuilder f ()
+shiftMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftMod = maskMod shiftMask
 
-controlAltSuperHyperAltgrMod :: f -> BindingBuilder f ()
+controlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltSuperHyperAltgrMod =
   maskMod (controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
 
-controlAltSuperHyperMod :: f -> BindingBuilder f ()
+controlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltSuperHyperMod =
   maskMod (controlMask .|. altMask .|. superMask .|. hyperMask)
 
-controlAltSuperAltgrMod :: f -> BindingBuilder f ()
+controlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltSuperAltgrMod =
   maskMod (controlMask .|. altMask .|. superMask .|. altgrMask)
 
-controlAltSuperMod :: f -> BindingBuilder f ()
+controlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltSuperMod =
   maskMod (controlMask .|. altMask .|. superMask)
 
-controlAltHyperAltgrMod :: f -> BindingBuilder f ()
+controlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltHyperAltgrMod =
   maskMod (controlMask .|. altMask .|. hyperMask .|. altgrMask)
 
-controlAltHyperMod :: f -> BindingBuilder f ()
+controlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltHyperMod =
   maskMod (controlMask .|. altMask .|. hyperMask)
 
-controlAltAltgrMod :: f -> BindingBuilder f ()
+controlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltAltgrMod =
   maskMod (controlMask .|. altMask .|. altgrMask)
 
-controlAltMod :: f -> BindingBuilder f ()
+controlAltMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltMod =
   maskMod (controlMask .|. altMask)
 
-controlSuperHyperAltgrMod :: f -> BindingBuilder f ()
+controlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlSuperHyperAltgrMod =
   maskMod (controlMask .|. superMask .|. hyperMask .|. altgrMask)
 
-controlSuperHyperMod :: f -> BindingBuilder f ()
+controlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlSuperHyperMod =
   maskMod (controlMask .|. superMask .|. hyperMask)
 
-controlSuperAltgrMod :: f -> BindingBuilder f ()
+controlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlSuperAltgrMod =
   maskMod (controlMask .|. superMask .|. altgrMask)
 
-controlSuperMod :: f -> BindingBuilder f ()
+controlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlSuperMod =
   maskMod (controlMask .|. superMask)
 
-controlHyperAltgrMod :: f -> BindingBuilder f ()
+controlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlHyperAltgrMod =
   maskMod (controlMask .|. hyperMask .|. altgrMask)
 
-controlHyperMod :: f -> BindingBuilder f ()
+controlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlHyperMod =
   maskMod (controlMask .|. hyperMask)
 
-controlAltgrMod :: f -> BindingBuilder f ()
+controlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltgrMod =
   maskMod (controlMask .|. altgrMask)
 
-controlMod :: f -> BindingBuilder f ()
+controlMod :: (Binding k b) => k -> BindingBuilder b ()
 controlMod = maskMod controlMask
 
-altSuperHyperAltgrMod :: f -> BindingBuilder f ()
+altSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 altSuperHyperAltgrMod =
   maskMod (altMask .|. superMask .|. hyperMask .|. altgrMask)
 
-altSuperHyperMod :: f -> BindingBuilder f ()
+altSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 altSuperHyperMod =
   maskMod (altMask .|. superMask .|. hyperMask)
 
-altSuperAltgrMod :: f -> BindingBuilder f ()
+altSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 altSuperAltgrMod =
   maskMod (altMask .|. superMask .|. altgrMask)
 
-altSuperMod :: f -> BindingBuilder f ()
+altSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 altSuperMod =
   maskMod (altMask .|. superMask)
 
-altHyperAltgrMod :: f -> BindingBuilder f ()
+altHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 altHyperAltgrMod =
   maskMod (altMask .|. hyperMask .|. altgrMask)
 
-altHyperMod :: f -> BindingBuilder f ()
+altHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 altHyperMod =
   maskMod (altMask .|. hyperMask)
 
-altAltgrMod :: f -> BindingBuilder f ()
+altAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 altAltgrMod =
   maskMod (altMask .|. altgrMask)
 
-altMod :: f -> BindingBuilder f ()
+altMod :: (Binding k b) => k -> BindingBuilder b ()
 altMod = maskMod altMask
 
-superHyperAltgrMod :: f -> BindingBuilder f ()
+superHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 superHyperAltgrMod =
   maskMod (superMask .|. hyperMask .|. altgrMask)
 
-superHyperMod :: f -> BindingBuilder f ()
+superHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 superHyperMod =
   maskMod (superMask .|. hyperMask)
 
-superAltgrMod :: f -> BindingBuilder f ()
+superAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 superAltgrMod =
   maskMod (superMask .|. altgrMask)
 
-superMod :: f -> BindingBuilder f ()
+superMod :: (Binding k b) => k -> BindingBuilder b ()
 superMod = maskMod superMask
 
-hyperAltgrMod :: f -> BindingBuilder f ()
+hyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 hyperAltgrMod =
   maskMod (hyperMask .|. altgrMask)
 
-hyperMod :: f -> BindingBuilder f ()
+hyperMod :: (Binding k b) => k -> BindingBuilder b ()
 hyperMod = maskMod hyperMask
 
-altgrMod :: f -> BindingBuilder f ()
+altgrMod :: (Binding k b) => k -> BindingBuilder b ()
 altgrMod = maskMod altgrMask
 
 {- Can combine two or more of the functions above to apply the same action to
  - multiple masks. -}
-(-|-) :: (f -> BindingBuilder f ()) ->
-          (f -> BindingBuilder f ()) ->
-          f -> BindingBuilder f ()
+(-|-) :: (Binding k b) => 
+          (k -> BindingBuilder b ()) ->
+          (k -> BindingBuilder b ()) ->
+          k -> BindingBuilder b ()
 (-|-) fn1 fn2 f = fn1 f >> fn2 f
 
 {- Meant for submapping, binds all alphanumeric charactes to (fn c). -}
-- 
cgit 


From 63e5348eb0dbbefb79624c46a37d99c48aaacc1a Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 30 Mar 2022 18:26:54 -0600
Subject: basic ability teo generate config

---
 src/Internal/Keys.hs  | 183 ++++++++++++++++++++++++++++++++++----------------
 src/Internal/KeysM.hs |  51 +++++++++++---
 2 files changed, 167 insertions(+), 67 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 467ed24..88ec8cf 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -101,24 +101,35 @@ button14 = 14
 button15 :: Button
 button15 = 15
 
-resolveSubmaps :: (XConfig l -> KeyBindings) -> KeyMap l
-resolveSubmaps bindings config = (fmap $ \binding ->
-  case binding of
-    Action x -> x
-    Submap _ -> logs "") (bindings config)
-
-keymap :: KeyMap l
-keymap = resolveSubmaps $ runKeys $ do
+keyBindingToKeymap :: (XConfig l -> KeyBindings) -> KeyMap l
+keyBindingToKeymap bindings config = fmap bindingToX (bindings config)
+
+  where
+    bindingToX b =
+      case b of
+        Documented _ (Action x) -> x
+        Documented _ (Submap mapping) ->
+          submap (fmap bindingToX mapping)
+        Documented _ (Repeat mapping) ->
+          fix $ \recur ->
+            submap (fmap (\b -> bindingToX b >> recur) mapping)
+
+keymap :: XConfig l -> KeyBindings
+keymap = runKeys $ do
   config <- getConfig
 
-  let defaultKey key = fromMaybe (return ()) $ Map.lookup key (keymap config)
-      subkeys keysM = submapDefaultWithKey defaultKey $ (resolveSubmaps (runKeys keysM)) config
+  let subkeys keysM = Submap (runKeys keysM config)
+      repeatable keysM = Repeat (runKeys keysM config)
 
   bind xK_apostrophe $ do
-    justMod $ subkeys $ do
-      bind xK_apostrophe $
-        (noMod -|- justMod) jumpToLast
-      mapAlpha 0 jumpToMark
+    justMod $
+      doc "Jumps between marks." $
+      subkeys $ do
+        bind xK_apostrophe $
+          (noMod -|- justMod) $
+            doc "Jumps to the last window." $
+            jumpToLast
+        mapAlpha 0 jumpToMark
 
     shiftMod $ subkeys $ do
       bind xK_apostrophe $
@@ -150,6 +161,12 @@ keymap = resolveSubmaps $ runKeys $ do
     justMod $
       replicateM_ 10 $ withFocused (sendKey (shiftMask, xK_a))
 
+  bind xK_F7 $
+    
+    justMod $
+      doc "Print this documentation." $
+      logs (documentation (keymap config))
+
   bind xK_F10 $ do
     justMod playPause
 
@@ -195,57 +212,105 @@ keymap = resolveSubmaps $ runKeys $ do
     shiftMod $ sendMessage HFlipLayout
 
   bind xK_g $ do
-    justMod $ mapNextString $ \_ str ->
-      case str of
-        [ch] | isAlphaNum ch -> gotoWorkspace ch
-        [' '] -> gotoAccompaningWorkspace
-        _ -> return ()
-    shiftMod $ mapNextString $ \_ str ->
-      case str of
-        [ch] | isAlphaNum ch -> shiftToWorkspace ch
-        _ -> return ()
-    shiftAltMod $ mapNextString $ \_ str ->
-      case str of
-        [ch] | isAlphaNum ch -> swapWorkspace ch
-        _ -> return ()
+    justMod $
+      doc ("Go to a workspace. The next typed character is the workspace " ++
+          "must be alpha-numeric.") $
+      mapNextString $ \_ str ->
+        case str of
+          [ch] | isAlphaNum ch -> gotoWorkspace ch
+          [' '] -> gotoAccompaningWorkspace
+          _ -> return ()
+    shiftMod $
+      doc "Move the currently focused window to another workspace" $
+      mapNextString $ \_ str ->
+        case str of
+          [ch] | isAlphaNum ch -> shiftToWorkspace ch
+          _ -> return ()
+    shiftAltMod $
+      doc "Swap this workspace with another workspace (rename)." $
+      mapNextString $ \_ str ->
+        case str of
+          [ch] | isAlphaNum ch -> swapWorkspace ch
+          _ -> return ()
 
   bind xK_h $ do
-    justMod    $ windows W.focusDown
-    shiftMod   $ windows W.swapDown
-    controlMod rotAllDown
+    justMod $
+      doc "Focus on the next window down in the stack" $
+      windows W.focusDown
+
+    shiftMod $
+      doc "Swap the current window with the next one down in the stack" $
+      windows W.swapDown
+
+    controlMod $
+      doc "Rotate all the windows down the stack"
+      rotAllDown
 
   bind xK_j $ do
-    justMod $ sendMessage ShrinkZoom
+    justMod $
+      doc "Shrink the size of the zoom region" $
+      sendMessage ShrinkZoom
 
   bind xK_k $ do
-    justMod $ sendMessage ExpandZoom
+    justMod $
+      doc "Expand the size of the zoom region" $
+      sendMessage ExpandZoom
 
   bind xK_l $ do
-    justMod    $ windows W.focusUp
-    shiftMod   $ windows W.swapUp
-    controlMod rotAllUp
-    altMod     $ spawnX "xsecurelock"
+    justMod    $
+      doc "Focus the next window in the stack" $
+      windows W.focusUp
+
+    shiftMod   $
+      doc "Swap the currently focused window with the next window in the stack." $
+      windows W.swapUp
+
+    controlMod $
+      doc "Rotate the windows up."
+      rotAllUp
+
+    altMod $
+      doc "Lock the screen" $
+      spawnX "xsecurelock"
 
   bind xK_minus $ do
-    justMod  $ sendMessage (IncMasterN (-1))
-    shiftMod $ withFocused $ sendMessage . shrinkWindowAlt
+    justMod  $
+      doc "Decrease the number of windows in the  master region." $
+      sendMessage (IncMasterN (-1))
+
+    shiftMod $
+      doc "For mosaic layout, shrink the size-share of the current window" $
+      withFocused $ sendMessage . shrinkWindowAlt
 
   bind xK_m $ do
-    justMod $ subkeys $
-      mapAlpha 0 markCurrentWindow
+    justMod $
+      doc "Mark the current window with the next typed character." $
+      subkeys $
+        mapAlpha 0 markCurrentWindow
 
   bind xK_n $ do
-    justMod $ relativeWorkspaceShift next
+    justMod $
+      doc "Shift to the next workspace." $
+      relativeWorkspaceShift next
 
   bind xK_p $ do
-    justMod $ relativeWorkspaceShift prev
+    justMod $
+      doc "Shift to the previous workspace." $
+      relativeWorkspaceShift prev
 
   bind xK_plus $ do
-    justMod  $ sendMessage (IncMasterN 1)
-    shiftMod $ withFocused $ sendMessage . expandWindowAlt
+    justMod $ 
+      doc "Increase the number of windows in the master region." $
+      sendMessage (IncMasterN 1)
+
+    shiftMod $
+      doc "For mosaic layout, increase the size-share of the current window." $
+      withFocused $ sendMessage . expandWindowAlt
 
   bind xK_q $ do
-    shiftMod $ spawnX "xmonad --recompile && xmonad --restart"
+    shiftMod $
+      doc "Recompile and restart XMonad" $
+      spawnX "xmonad --recompile && xmonad --restart"
 
     justMod $ subkeys $ do
 
@@ -279,19 +344,21 @@ keymap = resolveSubmaps $ runKeys $ do
   bind xK_v $
     -- Allows repeated strokes of M-h and M-l to reduce and increase volume
     -- respectively.
-    justMod $ fix $ \recur -> subkeys $ do
-      bind xK_h $ do
-        justMod $ do
-           decreaseVolume
-           recur
+    justMod $
+      doc "Changes the volume." $
+      repeatable $ do
+        bind xK_h $
+          justMod $
+             doc "Decrease volume." $
+             decreaseVolume
 
-      bind xK_l $ do
-        justMod $ do
-           increaseVolume
-           recur
+        bind xK_l $
+          justMod $
+             doc "Increase volume." $
+             increaseVolume
 
-      bind xK_v $ do
-        justMod recur
+        bind xK_v $
+          justMod $ (return () :: X ())
 
   bind xK_w $ do
     justMod windowJump
@@ -505,7 +572,7 @@ windowSpecificBindings config = do
 
   w <- lift ask
 
-  let configureIf b k = tell =<< lift (b --> return (resolveSubmaps (runKeys k) config))
+  let configureIf b k = tell =<< lift (b --> return (keyBindingToKeymap (runKeys k) config))
       emitKey = flip sendKey w
 
   configureIf (flip elem browsers <$> className) $ do
@@ -617,7 +684,7 @@ windowBindings xconfig =
 
 applyKeys :: XConfig l -> IO (XConfig l)
 applyKeys config =
-    return $ windowBindings $ config { keys = keymap, mouseBindings = mouseMap }
+    return $ windowBindings $ config { keys = keyBindingToKeymap keymap, mouseBindings = mouseMap }
 
 click :: X ()
 click = do
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
index b394552..f33d9d0 100644
--- a/src/Internal/KeysM.hs
+++ b/src/Internal/KeysM.hs
@@ -1,7 +1,10 @@
 {-# Language GeneralizedNewtypeDeriving, MultiParamTypeClasses,
-   FunctionalDependencies, FlexibleInstances, TypeFamilies #-}
+   FunctionalDependencies, FlexibleInstances, TypeFamilies, FlexibleContexts #-}
 module Internal.KeysM where
 
+import Data.List
+import Control.Monad.Writer
+import Text.Printf
 import Control.Arrow (second)
 import Control.Monad (void)
 import Control.Monad.State (State(..), modify', get, execState)
@@ -9,8 +12,14 @@ import XMonad
 import Data.Map (Map)
 import qualified Data.Map as Map
 
-data KeyBinding =  Action (X ()) | Submap KeyBindings
-type KeyBindings = Map (KeyMask, KeySym) KeyBinding
+data Documented t = Documented String t
+
+data KeyBinding =
+       Action (X ()) |
+       Submap KeyBindings |
+       Repeat KeyBindings
+
+type KeyBindings = Map (KeyMask, KeySym) (Documented KeyBinding)
 
 type ButtonBinding = Window -> X ()
 type ButtonBindings = Map (KeyMask, Button) ButtonBinding
@@ -35,16 +44,25 @@ class Bindable k where
   bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
 
 class Binding k b where
+  toB :: k -> b
+
   rawMask :: KeyMask -> k -> BindingBuilder b ()
+  rawMask m x = BindingBuilder $ modify' (second ((m, toB x):))
 
-instance Binding (X ()) KeyBinding where
-  rawMask m x = BindingBuilder $ modify' (second ((m, Action x):))
+instance Binding (X ()) (Documented KeyBinding) where
+  toB = Documented "" . Action
 
-instance Binding KeyBindings KeyBinding where
-  rawMask m x = BindingBuilder $ modify' (second ((m, Submap x):))
+instance Binding KeyBindings (Documented KeyBinding) where
+  toB = Documented "" . Submap
+
+instance Binding a (Documented a) where
+  toB = Documented ""
 
 instance Binding a a where
-  rawMask m x = BindingBuilder $ modify' (second ((m, x):))
+  toB = id
+
+doc :: (Binding k (Documented KeyBinding)) => String -> k -> Documented KeyBinding
+doc str k = let (Documented _ t) = toB k in Documented str t
 
 instance Semigroup (KeysM l ()) where
   (<>) = mappend
@@ -92,7 +110,7 @@ justMod :: (Binding k b) => k -> BindingBuilder b ()
 justMod = maskMod 0
 
 instance Bindable KeySym where
-  type BindableValue KeySym = KeyBinding
+  type BindableValue KeySym = Documented KeyBinding
   type BindableMonad KeySym = KeysM
 
   -- bind :: KeySym -> BindingBuilder (X x) a -> KeysM l ()
@@ -436,3 +454,18 @@ mapAlpha km fn =
   , (xK_z, 'z')
   ]
 
+
+documentation :: KeyBindings -> String
+documentation = execWriter . document' "" []
+  where
+    document' pref priorKeys keybindings =
+      forM_ (Map.toList keybindings) $ \(key, Documented doc thing) -> do
+        when (not $ null doc) $
+          tell $ printf "%s%s%s: %s\n" pref (intercalate " " $ map show priorKeys) (show key) doc
+        case thing of
+          Action _ -> return ()
+          Submap submap -> document' (pref ++ "  ") (priorKeys ++ [key]) submap
+          Repeat submap -> do
+            tell pref
+            tell "  (repeatable):\n"
+            document' (pref ++ "    ") (priorKeys ++ [key]) submap
-- 
cgit 


From 346c9b3da170cd51e5fd4e2bb19f7c1990243942 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 31 Mar 2022 17:28:23 -0600
Subject: Add a bunch more documentation and ability to see that documentation

---
 src/Internal/Keys.hs  | 275 +++++++++++++++++++++++++++++++++-----------------
 src/Internal/KeysM.hs |  58 ++++++++---
 2 files changed, 226 insertions(+), 107 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 88ec8cf..fcf233e 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE RankNTypes, FlexibleContexts #-}
+{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-}
 module Internal.Keys (applyKeys) where
 
+import XMonad.Util.Run (safeSpawn)
 import Data.Monoid (Endo(..))
 import Control.Monad.Trans.Class
 import Control.Monad.Reader
@@ -70,6 +71,12 @@ playPause = spawnX "spotify-control play"
 mediaPrev = spawnX "spotify-control prev"
 mediaNext = spawnX "spotify-control next"
 
+decreaseVolumeDoc = doc "Decrease volume" decreaseVolume
+increaseVolumeDoc = doc "Increase volume" increaseVolume
+playPauseDoc = doc "Play/Pause current media" playPause
+mediaPrevDoc = doc "Previous media" mediaPrev
+mediaNextDoc = doc "Next media" mediaNext
+
 
 button6 :: Button
 button6 = 6
@@ -131,19 +138,28 @@ keymap = runKeys $ do
             jumpToLast
         mapAlpha 0 jumpToMark
 
-    shiftMod $ subkeys $ do
+    shiftMod $
+      doc "Swap the current window with a mark." $
+      subkeys $ do
       bind xK_apostrophe $
-        (noMod -|- shiftMod -|- rawMask shiftMask) swapWithLastMark
+        (noMod -|- shiftMod -|- rawMask shiftMask) $
+          doc "Swap the current window with the last mark."
+          swapWithLastMark
+
       mapAlpha shiftMask swapWithMark
 
   bind xK_BackSpace $ do
     -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
     -- something goes wrong with the keyboard layout and for first-time boots
     -- where dmenu/alacritty may not be installed.
-    rawMask mod4Mask $ spawnX "xterm"
+    rawMask mod4Mask $
+      doc "Spawns XTerm as a fallback if xkb is messed up." $
+      spawnX "xterm"
 
     -- Moves xmobar to different monitors.
-    justMod $ spawnX "pkill -SIGUSR1 xmobar"
+    justMod $
+      doc "Move XMobar to another screen." $
+      spawnX "pkill -SIGUSR1 xmobar"
 
   bind xK_F1 $ do
     -- Experimental. Sends 'a' to all windows.
@@ -157,9 +173,11 @@ keymap = runKeys $ do
       logs $ "Try send to " ++ show w
       sendKey (0, xK_a) w
 
-    -- Experimental. Sends 'A' 10 times to the focused window.
     justMod $
-      replicateM_ 10 $ withFocused (sendKey (shiftMask, xK_a))
+      doc "Print this documentation" $
+      (safeSpawn "gxmessage" [
+        "-fn", "Source Code Pro",
+        documentation (keymap config)] :: X ())
 
   bind xK_F7 $
     
@@ -168,13 +186,13 @@ keymap = runKeys $ do
       logs (documentation (keymap config))
 
   bind xK_F10 $ do
-    justMod playPause
+    justMod playPauseDoc
 
   bind xK_F11 $ do
-    justMod mediaPrev
+    justMod mediaPrevDoc
 
   bind xK_F12 $ do
-    justMod mediaNext
+    justMod mediaNextDoc
 
   bind xK_Return $ do
     justMod swapMaster
@@ -188,28 +206,48 @@ keymap = runKeys $ do
   forM_ (zip [xK_a, xK_o, xK_e] [0..]) $ \(key, idx) ->
     bind key $ do
       -- Move focus to that screen.
-      justMod  $ withScreen W.view idx
+      justMod  $
+        doc ("Switch focus to screen " ++ show idx) $
+        withScreen W.view idx
       -- Swap the current screen with the one given
-      altMod   $ withScreen W.greedyView idx
+      altMod   $ 
+        doc ("Swap the current screen with screen " ++ show idx) $
+        withScreen W.greedyView idx
       -- Move the current window to the select screen.
-      shiftMod $ withScreen W.shift idx
+      shiftMod $
+        doc ("Move the current window to screne " ++ show idx) $
+        withScreen W.shift idx
 
-  bind xK_bracketright $ do
-    justMod $ sendMessage $ modifyWindowBorder 5
+      altgrMod $
+        logs "Test altgr"
 
+  bind xK_bracketright $ do
+    justMod $
+      doc "Increase the gaps between windows." $
+      sendMessage $ modifyWindowBorder 5
+ 
   bind xK_bracketleft $ do
-    justMod $ sendMessage $ modifyWindowBorder (-5)
+    justMod $ 
+      doc "Decrease the gaps between windows." $
+      sendMessage $ modifyWindowBorder (-5)
 
   bind xK_b $ do
     justMod $ spawnX "bluetooth-select.sh"
 
   bind xK_c $ do
-    justMod runPassMenu
-    shiftMod CopyWindow.kill1
+    justMod $
+      doc "Run PassMenu" runPassMenu
+
+    shiftMod $
+      doc "Kill the current window" CopyWindow.kill1
 
   bind xK_f $ do
-    justMod  $ sendMessage FlipLayout
-    shiftMod $ sendMessage HFlipLayout
+    justMod  $
+      doc "Flip the current layout vertically" $
+      sendMessage FlipLayout
+    shiftMod $
+      doc "Flip the current layout horizontally" $
+      sendMessage HFlipLayout
 
   bind xK_g $ do
     justMod $
@@ -312,22 +350,46 @@ keymap = runKeys $ do
       doc "Recompile and restart XMonad" $
       spawnX "xmonad --recompile && xmonad --restart"
 
-    justMod $ subkeys $ do
+    justMod $ 
+      doc "Experimental Bindings" $
+      subkeys $ do
 
       bind xK_q $
-        (justMod -|- noMod) $ do
+        (justMod -|- noMod) $
+          let fi = fromIntegral
+              mag (fi -> x₁, fi -> y₁) (fi -> x₂, fi -> y₂) =
+                sqrt ((x₂ - x₁) ^ 2 + (y₂ - y₁) ^ 2) in
+
+          doc "EXPERIMENTAL: Move mouse to control media." $ fix $ \recur -> do
+
+          -- Moving the mouse 100+ pixels to the right will go to the next song
+          -- Moving the mouse 100+ pixel to the left will go to the prior song
+          -- Moving the mouse vertically 100+ pixels will stop the loop
+          --
+          -- May mess up the mouse, requiring an XMonad reboot, which is why
+          -- this is experimental. It's not the most practical bindings in the
+          -- world, but it shows that it's theoretically possible to program
+          -- some neat mouse moptions to do cool things.
           firstMotion@(x, y) <- nextMotion
-          (x', y') <- iterateWhile (==firstMotion) nextMotion
+          (x', y') <- iterateWhile ((<100) . mag firstMotion) nextMotion
 
-          logs $ printf "Motion: (%d, %d) (%d, %d)" x y x' y'
 
-          if (x' - x) < 0
-            then mediaPrev
-            else mediaNext
+          if abs (y' - y) > abs (x' - x)
+            then 
+              if (y' - y) < 0
+                then logs "up"
+                else logs "down"
+            else do
+              if (x' - x) < 0
+                then mediaPrev
+                else mediaNext
+              recur
 
   bind xK_r $ do
-    justMod runDMenu
-    shiftMod $ sendMessage DoRotate
+    justMod $ doc "Run a command via Rofi" runDMenu
+    shiftMod $
+      doc "Rotate the current layout. (flips x, y coordinates)" $
+      sendMessage DoRotate
 
   bind xK_s $ do
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
@@ -350,106 +412,137 @@ keymap = runKeys $ do
         bind xK_h $
           justMod $
              doc "Decrease volume." $
-             decreaseVolume
+             decreaseVolumeDoc
 
         bind xK_l $
           justMod $
              doc "Increase volume." $
-             increaseVolume
+             increaseVolumeDoc
 
         bind xK_v $
           justMod $ (return () :: X ())
 
   bind xK_w $ do
-    justMod windowJump
+    justMod $ doc "Jump to a window (via rofi)" windowJump
 
   bind xK_x $ do
-    justMod $ sendMessage ToggleStruts
+    justMod $
+      doc "Toggles respect for struts." $
+      sendMessage ToggleStruts
 
   bind xK_z $ do
 
-    justMod $ subkeys $ do
-
-      bind xK_g $ do
-        (justMod -|- noMod) $ mapNextString $ \_ s ->
-          case s of
-            [ch] | isAlphaNum ch -> windows (CopyWindow.copy s)
-            _ -> return ()
-
-      bind xK_p $ do
-        (justMod -|- noMod) $ mapNextString $ \_ str ->
-          spawnX $ printf "gxmessage 'typed: \"%s\"\ncodes: \"%s\"\nunicode: á\n'"
-            str
-            (show (map ord str))
-
-      bind xK_t $ do
-        (justMod -|- noMod) $ logs "Test Log"
-
-      bind xK_n $ do
-        (justMod -|- noMod) $ spawnX (terminal config ++ " -t Notes -e notes new")
-
-      bind xK_c $ do
-        shiftMod CopyWindow.killAllOtherCopies
-
-      bind xK_e $ do
-        (justMod -|- noMod) $ spawnX "emoji-select.sh"
-        (shiftMod -|- rawMask shiftMask) $ spawnX "emoticon-select.sh"
-
-      bind xK_a $
-        (justMod -|- noMod) $ spawnX "set-sink.sh"
-
-      bind xK_w $
-        (justMod -|- noMod) $ spawnX "networkmanager_dmenu"
-
-      bind xK_o $
-        (justMod -|- noMod) $ spawnX "library-view.sh"
-
-      bind xK_s $
-        (justMod -|- noMod) toggleSwallowEnabled
-
-      bind xK_v $ do
-        (justMod -|- noMod) $ spawnX "set-volume.sh"
-        (shiftMod -|- rawMask shiftMask) $ spawnX "set-volume.sh -a"
-
-      -- Double-tap Z to toggle zoom.
-      bind xK_z $ do
-        noMod -|- justMod $ sendMessage ToggleZoom
+    justMod $
+      doc "Less often used keybindings." $
+      subkeys $ do
 
-      -- Z is reserved to create sub keybindings to do various things.
-      -- I don't really use these at the moment.
-      bind xK_h $ noMod mediaPrev
-      bind xK_j $ noMod playPause
-      bind xK_l $ noMod mediaNext
+        bind xK_g $ do
+          (justMod -|- noMod) $
+            doc "Copy a window to the given workspace" $
+            mapNextString $ \_ s ->
+              case s of
+                [ch] | isAlphaNum ch -> windows (CopyWindow.copy s)
+                _ -> return ()
+
+        bind xK_p $ do
+          (justMod -|- noMod) $ mapNextString $ \_ str ->
+            spawnX $ printf "gxmessage 'typed: \"%s\"\ncodes: \"%s\"\nunicode: á\n'"
+              str
+              (show (map ord str))
+
+        bind xK_t $ do
+          (justMod -|- noMod) $ logs "Test Log"
+
+        bind xK_n $ do
+          (justMod -|- noMod) $
+            doc "Take a note" $
+            spawnX (terminal config ++ " -t Notes -e notes new")
+
+        bind xK_c $ do
+          shiftMod $
+            doc "Kill all other copies of a window."
+            CopyWindow.killAllOtherCopies
+
+        bind xK_e $ do
+          (justMod -|- noMod) $
+            doc "Select an emoji" $
+            spawnX "emoji-select.sh"
+
+          (shiftMod -|- rawMask shiftMask) $
+            doc "Select an emoticon" $
+            spawnX "emoticon-select.sh"
+
+        bind xK_a $
+          (justMod -|- noMod) $
+            doc "Move the audio sink for an application." $
+            spawnX "set-sink.sh"
+
+        bind xK_w $
+          (justMod -|- noMod) $
+            doc "Select a network to connect to." $
+            spawnX "networkmanager_dmenu"
+
+        bind xK_o $
+          (justMod -|- noMod) $
+            doc "Open a file from the library" $
+            spawnX "library-view.sh"
+
+        bind xK_s $
+          (justMod -|- noMod) $
+            doc "Toggle the ability for terminals to swallow child windows." $
+            toggleSwallowEnabled
+
+        bind xK_v $ do
+          (justMod -|- noMod) $
+            doc "Set the volume via rofi." $
+            spawnX "set-volume.sh"
+          (shiftMod -|- rawMask shiftMask) $
+            doc "Set the volume of an application via rofi." $
+            spawnX "set-volume.sh -a"
+
+        -- Double-tap Z to toggle zoom.
+        bind xK_z $ do
+          noMod -|- justMod $
+            doc "Toggle zoom on the current window." $
+            sendMessage ToggleZoom
+
+        -- Z is reserved to create sub keybindings to do various things.
+        -- I don't really use these at the moment.
+        bind xK_h $ noMod mediaPrevDoc
+        bind xK_j $ noMod playPauseDoc
+        bind xK_l $ noMod mediaNextDoc
 
     -- Centers the current focused window. i.e. toggles the Zoom layout
     -- modifier.
-    shiftMod $ sendMessage ToggleZoom
+    shiftMod $
+      doc "Toggle zoom on the current window." $
+      sendMessage ToggleZoom
 
   bind xF86XK_Calculator $ do
     noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
 
   bind xF86XK_AudioLowerVolume $ do
     noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ -1%"
-    justMod mediaPrev
+    justMod mediaPrevDoc
 
   bind xF86XK_AudioRaiseVolume $ do
     noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ +1%"
-    justMod mediaNext
+    justMod mediaNextDoc
 
   bind xF86XK_AudioMute $ do
     noMod $ spawnX "pactl set-sink-mute @DEFAULT_SINK@ toggle"
 
   bind xF86XK_AudioPlay $ do
-    noMod playPause
+    noMod playPauseDoc
 
   bind xF86XK_AudioNext $ do
-    noMod mediaNext
+    noMod mediaNextDoc
 
   bind xF86XK_AudioPrev $ do
-    noMod mediaPrev
+    noMod mediaPrevDoc
 
   bind xF86XK_AudioPrev $ do
-    noMod mediaPrev
+    noMod mediaPrevDoc
 
   bind xF86XK_MonBrightnessUp $ do
     noMod $ spawnX "set-backlight.sh +0.05"
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
index f33d9d0..fa9b49f 100644
--- a/src/Internal/KeysM.hs
+++ b/src/Internal/KeysM.hs
@@ -3,9 +3,10 @@
 module Internal.KeysM where
 
 import Data.List
+import Data.Bits ((.&.))
 import Control.Monad.Writer
 import Text.Printf
-import Control.Arrow (second)
+import Control.Arrow (second, first)
 import Control.Monad (void)
 import Control.Monad.State (State(..), modify', get, execState)
 import XMonad
@@ -42,6 +43,7 @@ class Bindable k where
   type BindableMonad k :: (* -> *) -> * -> *
 
   bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
+  -- section :: String -> BindableMonad k l () -> BindableMonad k l ()
 
 class Binding k b where
   toB :: k -> b
@@ -64,13 +66,6 @@ instance Binding a a where
 doc :: (Binding k (Documented KeyBinding)) => String -> k -> Documented KeyBinding
 doc str k = let (Documented _ t) = toB k in Documented str t
 
-instance Semigroup (KeysM l ()) where
-  (<>) = mappend
-
-instance Monoid (KeysM l ()) where
-  mempty = return ()
-  mappend = (>>)
-
 runKeys :: KeysM l a -> XConfig l -> KeyBindings
 runKeys (KeysM stateM) config =
   snd $ execState stateM (config, Map.empty)
@@ -101,7 +96,7 @@ hyperMask :: KeyMask
 hyperMask = mod3Mask
 
 altgrMask :: KeyMask
-altgrMask = mod2Mask
+altgrMask = 0x80
 
 superMask :: KeyMask
 superMask = mod4Mask
@@ -121,6 +116,7 @@ instance Bindable KeySym where
     KeysM $ modify' $ second $
       flip (<>) (Map.fromList (map (\(m, v) -> ((m, key), v)) values))
 
+
 instance Bindable Button where
   type BindableValue Button = ButtonBinding
   type BindableMonad Button = ButtonsM
@@ -456,16 +452,46 @@ mapAlpha km fn =
 
 
 documentation :: KeyBindings -> String
-documentation = execWriter . document' "" []
+documentation = execWriter . document' ""
   where
-    document' pref priorKeys keybindings =
-      forM_ (Map.toList keybindings) $ \(key, Documented doc thing) -> do
-        when (not $ null doc) $
-          tell $ printf "%s%s%s: %s\n" pref (intercalate " " $ map show priorKeys) (show key) doc
+    document' pref keybindings =
+      forM_ (sortOn (map (\(a, b) -> (b, a)) . snd . snd) $ Map.toList (keyBindingsToList keybindings)) $ \(doc, (thing, keys)) -> do
+        when ((not $ null doc) || hasSubmap thing) $
+          tell $ printf "%s%s: %s\n" pref (intercalate " or " $ map prettyShow keys) doc
         case thing of
           Action _ -> return ()
-          Submap submap -> document' (pref ++ "  ") (priorKeys ++ [key]) submap
+          Submap submap -> document' (pref ++ "  ") submap
           Repeat submap -> do
             tell pref
             tell "  (repeatable):\n"
-            document' (pref ++ "    ") (priorKeys ++ [key]) submap
+            document' (pref ++ "    ") submap
+
+    keyBindingsToList :: KeyBindings -> Map String (KeyBinding, [(KeyMask, KeySym)])
+    keyBindingsToList b =
+      fmap (\list -> ((\(_, Documented _ t) -> t) (head list), map fst list)) $
+        group (\(_, Documented doc _) -> doc) (sortOn (snd . fst) $ Map.toList b)
+
+    prettyShow :: (KeyMask, KeySym) -> String
+    prettyShow (mask, key) = printf "<%s%s>" (showMask mask) (keysymToString key)
+
+    hasSubmap b = case b of
+      Action _ -> False
+      _ -> True
+
+
+    showMask :: KeyMask -> String
+    showMask mask =
+      let masks = [(shiftMask, "S"),
+                   (altMask, "A"),
+                   (mod3Mask, "H"),
+                   (mod4Mask, "M"),
+                   (altgrMask, "AGr"),
+                   (controlMask, "C")] in
+
+              concatMap ((++"-") . snd) $ filter ((/=0) . (.&.mask) . fst) masks
+
+
+    group :: (Ord b) => (a -> b) -> [a] -> (Map b [a])
+    group fn = Map.fromListWith (++) . map (first fn . (\a -> (a, [a])))
+
+
-- 
cgit 


From c194a9be4e43bc4514070d172024fcf3354fb662 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 1 Apr 2022 16:49:07 -0600
Subject: More experimental MouseMotion

---
 package.yaml                |  1 +
 src/Internal/Keys.hs        | 36 ++++-------------
 src/Internal/MouseMotion.hs | 97 +++++++++++++++++++++++++++++++++++++++++++++
 src/Internal/Submap.hs      | 19 +++++++++
 4 files changed, 124 insertions(+), 29 deletions(-)
 create mode 100644 src/Internal/MouseMotion.hs

diff --git a/package.yaml b/package.yaml
index 7cfb52c..a1f015d 100644
--- a/package.yaml
+++ b/package.yaml
@@ -23,3 +23,4 @@ dependencies:
   - transformers
   - monad-loops
   - data-default
+  - linear
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index fcf233e..6d34c4a 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -46,6 +46,7 @@ import XMonad.Actions.SpawnOn as SpawnOn
 import qualified Data.Map as Map
 import qualified XMonad.StackSet as W
 
+import Internal.MouseMotion
 import Internal.Windows
 import Internal.Lib
 import Internal.DMenu
@@ -356,34 +357,8 @@ keymap = runKeys $ do
 
       bind xK_q $
         (justMod -|- noMod) $
-          let fi = fromIntegral
-              mag (fi -> x₁, fi -> y₁) (fi -> x₂, fi -> y₂) =
-                sqrt ((x₂ - x₁) ^ 2 + (y₂ - y₁) ^ 2) in
-
-          doc "EXPERIMENTAL: Move mouse to control media." $ fix $ \recur -> do
-
-          -- Moving the mouse 100+ pixels to the right will go to the next song
-          -- Moving the mouse 100+ pixel to the left will go to the prior song
-          -- Moving the mouse vertically 100+ pixels will stop the loop
-          --
-          -- May mess up the mouse, requiring an XMonad reboot, which is why
-          -- this is experimental. It's not the most practical bindings in the
-          -- world, but it shows that it's theoretically possible to program
-          -- some neat mouse moptions to do cool things.
-          firstMotion@(x, y) <- nextMotion
-          (x', y') <- iterateWhile ((<100) . mag firstMotion) nextMotion
-
-
-          if abs (y' - y) > abs (x' - x)
-            then 
-              if (y' - y) < 0
-                then logs "up"
-                else logs "down"
-            else do
-              if (x' - x) < 0
-                then mediaPrev
-                else mediaNext
-              recur
+          doc "EXPERIMENTAL: Move mouse to control media." $
+            mouseRotateMotion (logs "CW") (logs "CCW")
 
   bind xK_r $ do
     justMod $ doc "Run a command via Rofi" runDMenu
@@ -625,9 +600,12 @@ mouseMap = runButtons $ do
 
   bind button13 $ noMod $ subMouse $ do
     bind button1 $ noMod mouseMoveWindow
+    bind button2 $ noMod $ windows . W.sink
     bind button3 $ noMod mouseResizeWindow
-    bind button13 $ noMod $ windows . W.sink
 
+    bind button13 $ noMod $ subMouse $ do
+      bind button13 $ noMod $ subMouse $ do
+        bind button13 $ noMod $ noWindow $ spawnX "xsecurelock"
 
   bind button15 $ do
 
diff --git a/src/Internal/MouseMotion.hs b/src/Internal/MouseMotion.hs
new file mode 100644
index 0000000..c72c824
--- /dev/null
+++ b/src/Internal/MouseMotion.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE ViewPatterns, BangPatterns #-}
+module Internal.MouseMotion where
+
+import XMonad
+
+import Control.Monad (void, forever)
+import Text.Printf
+import Internal.Submap
+import Control.Monad.Loops (iterateWhile)
+import Control.Monad.Fix (fix)
+import Internal.Logger
+
+import Linear.V2
+import Linear.Metric
+
+data Quadrant = NE | SE | SW | NW deriving (Enum, Show)
+data Direction = CW | CCW deriving (Enum, Show)
+
+getQuadrant :: (Num a, Ord a) => (a, a) -> Quadrant
+getQuadrant (x, y) | x >= 0 && y >= 0 = NE
+getQuadrant (x, y) | x < 0 && y >= 0 = SE
+getQuadrant (x, y) | x < 0 && y < 0 = SW
+getQuadrant (x, y) = NW
+
+
+getDirection :: Quadrant -> Quadrant -> Maybe Direction
+getDirectory a b | a == b = Nothing
+getDirection SW SE = Just CCW
+getDirection SE NE = Just CCW
+getDirection NE NW = Just CCW
+getDirection NW SW = Just CCW
+getDirection _ _ = Just CW
+
+
+liftMouseMotionM :: X a -> MouseMotionM a
+liftMouseMotionM = MouseMotionM . fmap Just
+
+motion :: MouseMotionM (V2 Int)
+motion = MouseMotionM $ do
+  ev <- nextMotionOrButton
+  case ev of
+    Right button -> do
+      logs ("Button " ++ show button)
+      return Nothing
+
+    Left motion -> return (Just $ uncurry V2 motion)
+
+motionSize :: Int -> MouseMotionM (V2 Int)
+motionSize size = do
+  let fsize = fromIntegral size
+
+  !firstmotion <- fmap fromIntegral <$> motion
+
+  let get = do
+        !next <- motion
+        if distance (fmap fromIntegral next) firstmotion >= fsize
+          then return next
+          else get
+
+  get
+
+runMouseMotionM :: MouseMotionM a -> X (Maybe a)
+runMouseMotionM (MouseMotionM a) = a
+
+execMouseMotionM :: MouseMotionM () -> X ()
+execMouseMotionM = void . runMouseMotionM
+
+-- Monad for capturing mouse motion. Terminates and holds Nothing when a
+-- button is pressed.
+newtype MouseMotionM a = MouseMotionM (X (Maybe a))
+
+instance Functor MouseMotionM where
+  fmap fn (MouseMotionM xma) = MouseMotionM (fmap (fmap fn) xma)
+
+instance Applicative MouseMotionM where
+  mf <*> ma = do
+    !f <- mf
+    !a <- ma
+    return (f a)
+
+  pure = return
+
+instance Monad MouseMotionM where
+  return a = MouseMotionM (return (Just a))
+  (MouseMotionM !xa) >>= fn = MouseMotionM $ do
+    !ma <- xa
+    case ma of
+      Just !a ->
+        let (MouseMotionM !xb) = fn a in xb
+      Nothing -> return Nothing
+
+mouseRotateMotion :: X () -> X () -> X ()
+mouseRotateMotion clockWise counterClockwise = execMouseMotionM doMouse
+  where
+    doMouse = forever $ do
+      v <- motion
+      liftMouseMotionM $ logs $ "Motion: " ++ show v
diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
index c51f9b6..32dda2a 100644
--- a/src/Internal/Submap.hs
+++ b/src/Internal/Submap.hs
@@ -3,6 +3,7 @@ module Internal.Submap (
     submapButtonsWithKey,
     nextButton,
     nextMotion,
+    nextMotionOrButton,
     module X) where
 
 import XMonad hiding (keys)
@@ -62,6 +63,24 @@ nextMotion = do
 
   return ret
 
+nextMotionOrButton :: X (Either (Int, Int) (ButtonMask, Button))
+nextMotionOrButton = do
+  XConf { theRoot = root, display = d } <- ask
+  io $ grabPointer d root False (pointerMotionMask .|. buttonPressMask) grabModeAsync grabModeAsync 0 0 currentTime
+
+  ret <- io $ allocaXEvent $ \xEv -> do
+    maskEvent d (pointerMotionMask .|. buttonPressMask) xEv
+    ev <- getEvent xEv
+    case ev of
+      MotionEvent { ev_x = x, ev_y = y } ->
+        return $ Left (fromIntegral x, fromIntegral y)
+      ButtonEvent { ev_button = button, ev_state = m } ->
+        return $ Right (m, button)
+
+  io $ ungrabPointer d currentTime
+
+  return ret
+
 submapButtonsWithKey ::
     ((ButtonMask, Button) -> Window -> X ()) -> Map (ButtonMask, Button) (Window -> X ()) -> Window -> X ()
 submapButtonsWithKey defaultAction actions window = do
-- 
cgit 


From 9b5a7b99d33891f0bc664316c643337ac638cbae Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 4 Apr 2022 17:21:16 -0600
Subject: Implement a window history system.

This lets the user cycle between past windows. The rules for when a
window gets added to the history is the same as when a window is
considered the last marked.

In fact, now all the last mark does is swap the current window with the
previous one in the history.
---
 src/Internal/Keys.hs    |  23 ++++++----
 src/Internal/Lib.hs     |   9 ++--
 src/Internal/Marking.hs | 112 ++++++++++++++++++++++++++++++++++++++++--------
 3 files changed, 111 insertions(+), 33 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 6d34c4a..2dd7c37 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -290,11 +290,17 @@ keymap = runKeys $ do
       doc "Shrink the size of the zoom region" $
       sendMessage ShrinkZoom
 
+    shiftMod $
+      doc "Go to the previous window in history." historyPrev
+
   bind xK_k $ do
     justMod $
       doc "Expand the size of the zoom region" $
       sendMessage ExpandZoom
 
+    shiftMod $
+      doc "Go to the next window in history." historyNext
+
   bind xK_l $ do
     justMod    $
       doc "Focus the next window in the stack" $
@@ -420,18 +426,19 @@ keymap = runKeys $ do
                 _ -> return ()
 
         bind xK_p $ do
-          (justMod -|- noMod) $ mapNextString $ \_ str ->
-            spawnX $ printf "gxmessage 'typed: \"%s\"\ncodes: \"%s\"\nunicode: á\n'"
-              str
-              (show (map ord str))
+          (justMod -|- noMod) $
+            doc "Go to the prior window in the history" historyPrev
 
         bind xK_t $ do
           (justMod -|- noMod) $ logs "Test Log"
 
+        -- bind xK_n $ do
+        --   (justMod -|- noMod) $
+        --     doc "Take a note" $
+        --     spawnX (terminal config ++ " -t Notes -e notes new")
         bind xK_n $ do
           (justMod -|- noMod) $
-            doc "Take a note" $
-            spawnX (terminal config ++ " -t Notes -e notes new")
+            doc "Go to the next window in the history" historyNext
 
         bind xK_c $ do
           shiftMod $
@@ -589,8 +596,8 @@ mouseMap = runButtons $ do
             (button4, increaseVolume),
             (button5, decreaseVolume),
             (button2, playPause),
-            (button9, mediaNext),
-            (button8, mediaPrev),
+            (button9, historyNext),
+            (button8, historyPrev),
             (button6, mediaPrev),
             (button7, mediaNext)
             ]
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index e608bb0..c29ca31 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -77,8 +77,7 @@ gotoAccompaningWorkspace = do
     else gotoWorkspace (toUpper cur)
 
 gotoWorkspace :: WorkspaceName -> X ()
-gotoWorkspace ch = do
-  saveLastMark
+gotoWorkspace ch = pushHistory $ do
   addHiddenWorkspace [ch]
   windows $ greedyView $ return ch
 
@@ -149,7 +148,7 @@ withScreen fn n = do
       Just screen -> fn (tag $ workspace screen) windowSet
 
 windowJump :: X ()
-windowJump = do
+windowJump = pushHistory $ do
   windowTitlesToWinId <- withWindowSet $ \ss ->
     Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
 
@@ -157,6 +156,4 @@ windowJump = do
 
   case windowId of
     Nothing -> return ()
-    Just wid -> do
-      saveLastMark
-      focus wid
+    Just wid -> focus wid
diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index dcf3c05..89d4a0b 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -1,16 +1,24 @@
 {-# LANGUAGE ScopedTypeVariables #-}
-module Internal.Marking where
+module Internal.Marking (
+  historyNext, historyPrev,
+  markCurrentWindow, pushHistory,
+  jumpToMark, jumpToLast, swapWithLastMark,
+  swapWithMark
+  ) where
 
 import Internal.Windows (mapWindows, findWindow, getLocationWorkspace)
 import XMonad
 import XMonad.StackSet hiding (focus)
 import Data.IORef
 import Data.Map (Map)
+import Control.Monad (when)
 
 import System.FilePath
 import System.IO
 import Control.Exception
 import System.Environment
+import qualified Data.Sequence as Seq
+import Data.Sequence (Seq(..))
 
 import qualified XMonad.Util.ExtensibleState as XS
 
@@ -20,20 +28,68 @@ import qualified Data.Map as Map
 
 type Mark = Char
 
+historySize = 100 -- max number of history elements the tail.
+
+data History a = History [a] (Seq a)
+  deriving (Read, Show)
+
+instance Default (History a) where
+  
+  def = History [] Seq.empty
+
+seqPush :: a -> Seq a -> Seq a
+seqPush elem s@(seq :|> _) | Seq.length s >= historySize = elem :<| seq
+seqPush elem s = elem :<| s
+
+historyForward :: History a -> History a
+historyForward (History (a:as) tail) = History as (seqPush a tail)
+historyForward z = z
+
+historyBackward :: History a -> History a
+historyBackward (History head (a :<| as)) = History (a : head) as
+historyBackward z = z
+
+historyCurrent :: History a -> Maybe a
+historyCurrent (History (a:_) _) = Just a
+historyCurrent _ = Nothing
+
+historyPush :: (Eq a) => a -> History a -> History a
+historyPush a h@(History (w : _) _) | a == w = h
+historyPush a (History (w : _) tail) = History [a] (seqPush w tail)
+historyPush a (History _ tail) = History [a] tail
+
+historySwap :: History a -> History a
+historySwap (History (a:as) (t :<| ts)) = History (t : as) (seqPush a ts)
+historySwap z = z
+
+historyLast :: History a -> Maybe a
+historyLast (History _ (t :<| _)) = Just t
+historyLast _ = Nothing
+
+
 data MarkState =
   MarkState {
     markStateMap :: Map Mark Window
-  , markLast :: Maybe Window
+  , windowHistory :: History Window
   } deriving (Read, Show)
 
 
 instance ExtensionClass MarkState where
-  initialValue = MarkState Map.empty Nothing
+  initialValue = MarkState Map.empty def
+
+changeHistory :: (History Window -> History Window) -> (MarkState -> MarkState)
+changeHistory fn ms = ms { windowHistory = fn (windowHistory ms)}
+
+normalizeWindows :: X ()
+normalizeWindows = do
+  MarkState { windowHistory = h } <- XS.get
+  mapM_ greedyFocus (historyCurrent h)
 
 greedyFocus :: Window -> X ()
 greedyFocus win = do
     ws <- withWindowSet $ \ss ->
             return $ getLocationWorkspace =<< findWindow ss win
+
     mapM_ (windows . greedyView . tag) ws
     focus win
 
@@ -45,16 +101,26 @@ markCurrentWindow mark = do
           markStateMap = Map.insert mark win ms
         }
 
-saveLastMark :: X ()
-saveLastMark =
-  withFocused $ \win ->
-      XS.modify $ \state -> state { markLast = Just win }
+pushHistory :: X () -> X ()
+pushHistory fn = do
+  withFocused $ \windowBefore -> do
+    withHistory $ \hist ->
+      XS.modify $ changeHistory (historyPush windowBefore)
+
+    fn
+
+    withFocused $ \windowAfter ->
+      XS.modify $ changeHistory (historyPush windowAfter)
+
+withHistory :: (History Window -> X ()) -> X ()
+withHistory fn = do
+  MarkState { windowHistory = w } <- XS.get
+  fn w
 
 jumpToLast :: X ()
 jumpToLast = do
-  m <- markLast <$> XS.get
-  saveLastMark
-  mapM_ greedyFocus m
+  XS.modify (changeHistory historySwap)
+  normalizeWindows
 
 jumpToMark :: Mark -> X ()
 jumpToMark mark = do
@@ -62,7 +128,7 @@ jumpToMark mark = do
   case Map.lookup mark m of
     Nothing -> return ()
     Just w -> do
-      saveLastMark
+      XS.modify $ changeHistory (historyPush w)
       greedyFocus w
 
 setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
@@ -85,20 +151,28 @@ swapWithFocused winToSwap stackSet =
             \w -> if w == winToSwap then focused else w) stackSet
 
 swapWithLastMark :: X ()
-swapWithLastMark = do
-  m <- markLast <$> XS.get
-  saveLastMark
+swapWithLastMark = pushHistory $ withHistory $ \hist -> do
 
-  case m of
+  case historyLast hist of
     Nothing -> return ()
-    Just win -> windows $ swapWithFocused win
+    Just win ->
+      windows $ swapWithFocused win
 
 swapWithMark :: Mark -> X ()
-swapWithMark mark = do
+swapWithMark mark = pushHistory $ do
   MarkState {markStateMap = m} <- XS.get
-  saveLastMark
 
   case Map.lookup mark m of
     Nothing -> return ()
-    Just winToSwap ->
+    Just winToSwap -> do
       windows $ swapWithFocused winToSwap
+
+historyPrev :: X ()
+historyPrev = do
+  XS.modify $ changeHistory historyBackward
+  normalizeWindows
+
+historyNext :: X ()
+historyNext = do
+  XS.modify $ changeHistory historyForward
+  normalizeWindows
-- 
cgit 


From 522a993840f5fd8fd414c54a00b871ec2689216f Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 4 Apr 2022 17:27:52 -0600
Subject: change markstate to be persistent

---
 src/Internal/Marking.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index 89d4a0b..9bf58cd 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -76,6 +76,7 @@ data MarkState =
 
 instance ExtensionClass MarkState where
   initialValue = MarkState Map.empty def
+  extensionType = PersistentExtension
 
 changeHistory :: (History Window -> History Window) -> (MarkState -> MarkState)
 changeHistory fn ms = ms { windowHistory = fn (windowHistory ms)}
-- 
cgit 


From 20aaf1e159b6128ad136c0bcf489c0ac0ebc76f5 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 4 Apr 2022 17:49:01 -0600
Subject: Make both Tags and Windows as valid history targets

---
 src/Internal/Marking.hs | 65 ++++++++++++++++++++++++++++++++++---------------
 1 file changed, 45 insertions(+), 20 deletions(-)

diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index 9bf58cd..3ffb411 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -66,11 +66,25 @@ historyLast :: History a -> Maybe a
 historyLast (History _ (t :<| _)) = Just t
 historyLast _ = Nothing
 
+data Spot =
+        WindowSpot Window | -- Focus is on a window.
+        TagSpot String -- Focus is on an (empty) tag
+        deriving (Read, Show, Eq, Ord)
+
+greedyFocus :: Spot -> X ()
+greedyFocus (WindowSpot win) = do
+     ws <- withWindowSet $ \ss ->
+             return $ getLocationWorkspace =<< findWindow ss win
+ 
+     mapM_ (windows . greedyView . tag) ws
+     focus win
+greedyFocus (TagSpot tag) =
+  windows $ greedyView tag
 
 data MarkState =
   MarkState {
     markStateMap :: Map Mark Window
-  , windowHistory :: History Window
+  , windowHistory :: History Spot
   } deriving (Read, Show)
 
 
@@ -78,21 +92,24 @@ instance ExtensionClass MarkState where
   initialValue = MarkState Map.empty def
   extensionType = PersistentExtension
 
-changeHistory :: (History Window -> History Window) -> (MarkState -> MarkState)
+changeHistory :: (History Spot -> History Spot) -> (MarkState -> MarkState)
 changeHistory fn ms = ms { windowHistory = fn (windowHistory ms)}
 
+withMaybeFocused :: (Maybe Window -> X ()) -> X ()
+withMaybeFocused f = withWindowSet $ f . peek
+
 normalizeWindows :: X ()
 normalizeWindows = do
   MarkState { windowHistory = h } <- XS.get
   mapM_ greedyFocus (historyCurrent h)
 
-greedyFocus :: Window -> X ()
-greedyFocus win = do
-    ws <- withWindowSet $ \ss ->
-            return $ getLocationWorkspace =<< findWindow ss win
-
-    mapM_ (windows . greedyView . tag) ws
-    focus win
+-- greedyFocus :: Window -> X ()
+-- greedyFocus win = do
+--     ws <- withWindowSet $ \ss ->
+--             return $ getLocationWorkspace =<< findWindow ss win
+-- 
+--     mapM_ (windows . greedyView . tag) ws
+--     focus win
 
 markCurrentWindow :: Mark -> X ()
 markCurrentWindow mark = do
@@ -104,16 +121,25 @@ markCurrentWindow mark = do
 
 pushHistory :: X () -> X ()
 pushHistory fn = do
-  withFocused $ \windowBefore -> do
-    withHistory $ \hist ->
-      XS.modify $ changeHistory (historyPush windowBefore)
+  withMaybeFocused $ \maybeWindowBefore -> do
+    case maybeWindowBefore of
+      (Just windowBefore) ->
+        XS.modify $ changeHistory (historyPush (WindowSpot windowBefore))
+      Nothing -> 
+        withWindowSet $ \ws ->
+          XS.modify $ changeHistory (historyPush (TagSpot (currentTag ws)))
 
     fn
 
-    withFocused $ \windowAfter ->
-      XS.modify $ changeHistory (historyPush windowAfter)
+    withMaybeFocused $ \maybeWindowAfter ->
+      case maybeWindowAfter of
+        Just windowAfter ->
+          XS.modify $ changeHistory (historyPush $ WindowSpot windowAfter)
+        Nothing ->
+          withWindowSet $ \ws ->
+            XS.modify $ changeHistory (historyPush $ TagSpot $ currentTag ws)
 
-withHistory :: (History Window -> X ()) -> X ()
+withHistory :: (History Spot -> X ()) -> X ()
 withHistory fn = do
   MarkState { windowHistory = w } <- XS.get
   fn w
@@ -128,9 +154,8 @@ jumpToMark mark = do
   MarkState {markStateMap = m} <- XS.get
   case Map.lookup mark m of
     Nothing -> return ()
-    Just w -> do
-      XS.modify $ changeHistory (historyPush w)
-      greedyFocus w
+    Just w -> pushHistory $
+      greedyFocus (WindowSpot w)
 
 setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
 setFocusedWindow
@@ -155,9 +180,9 @@ swapWithLastMark :: X ()
 swapWithLastMark = pushHistory $ withHistory $ \hist -> do
 
   case historyLast hist of
-    Nothing -> return ()
-    Just win ->
+    Just (WindowSpot win) ->
       windows $ swapWithFocused win
+    Nothing -> return ()
 
 swapWithMark :: Mark -> X ()
 swapWithMark mark = pushHistory $ do
-- 
cgit 


From ab90e6f48f5448fa385e1d6f96f95ac723910264 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 4 Apr 2022 19:54:21 -0600
Subject: add suspend buttonstroke

---
 src/Internal/Keys.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 6d34c4a..961bfc5 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -606,6 +606,8 @@ mouseMap = runButtons $ do
     bind button13 $ noMod $ subMouse $ do
       bind button13 $ noMod $ subMouse $ do
         bind button13 $ noMod $ noWindow $ spawnX "xsecurelock"
+        bind button1 $ noMod $ noWindow $
+          spawnX "sudo -A systemctl suspend && xsecurelock"
 
   bind button15 $ do
 
-- 
cgit 


From 5d686c481e8bc1734f822b64792c390aab65f64e Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Wed, 6 Apr 2022 10:19:06 -0600
Subject: Add mousebinding to go to the accompaning workspace.

---
 src/Internal/Keys.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 3f9882b..c8387c6 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -619,6 +619,7 @@ mouseMap = runButtons $ do
   bind button15 $ do
 
     noMod $ subMouse $ do
+      bind button13 $ noMod $ noWindow $ gotoAccompaningWorkspace
 
       bind button15 $ do
         noMod $ noWindow jumpToLast
-- 
cgit 


From 9127725fd496be2db5ab1826d8585a8cf43f7d5a Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 8 Apr 2022 11:42:15 -0600
Subject: Add more bindings to the "g" command.

---
 src/Internal/Keys.hs   | 49 +++++++++++++++++++++++++++++++++++++------------
 src/Internal/Lib.hs    |  6 +++---
 src/Internal/Submap.hs | 27 ++++++++++++++++++++-------
 3 files changed, 60 insertions(+), 22 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index c8387c6..748aae2 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -252,18 +252,43 @@ keymap = runKeys $ do
 
   bind xK_g $ do
     justMod $
-      doc ("Go to a workspace. The next typed character is the workspace " ++
-          "must be alpha-numeric.") $
-      mapNextString $ \_ str ->
-        case str of
-          [ch] | isAlphaNum ch -> gotoWorkspace ch
-          [' '] -> gotoAccompaningWorkspace
+      doc ("Goto a workspace\n\n\t\
+
+      \If the second character typed is alpha-numberic, jump to that\n\t\
+      \workspace. The workspace is created on-the-fly if such a workspace\n\t\
+      \does not exist.\n\n\t\
+
+      \If the second character typed is:\n\t\t\
+         \]: go to the next workspace\n\t\t\
+         \[: go to the previous workspace\n\t\t\
+         \}: cycle the workspaces on the screens to the right\n\t\t\
+         \{: cycle the workspaces on the screens to the left\n\t\t\
+         \<space>: Jump to the accompaning workspace.\n\t\t\
+         \F1: display this help.\n") $
+      mapNextStringWithKeysym $ \_ keysym str ->
+        case (keysym, str) of
+          (_, [ch]) | isAlphaNum ch -> gotoWorkspace ch
+          (_, "]") -> pushHistory $ withRelativeWorkspace next W.greedyView
+          (_, "[") -> pushHistory $ withRelativeWorkspace prev W.greedyView
+          (_, "}") -> windows screenRotateForward
+          (_, "{") -> windows screenRotateBackward
+          (_, " ") -> gotoAccompaningWorkspace
+
+          -- Test binding. Tests that I can still submap keysyms alone (keys
+          -- where XLookupString won't return anything helpful.)
+          (f, _) | f == xK_F1 -> 
+            (safeSpawn "gxmessage" [
+              "-fn", "Source Code Pro",
+              documentation (keymap config)] :: X ())
+
           _ -> return ()
     shiftMod $
       doc "Move the currently focused window to another workspace" $
       mapNextString $ \_ str ->
         case str of
           [ch] | isAlphaNum ch -> shiftToWorkspace ch
+          "]" -> withRelativeWorkspace next W.shift
+          "[" -> withRelativeWorkspace prev W.shift
           _ -> return ()
     shiftAltMod $
       doc "Swap this workspace with another workspace (rename)." $
@@ -336,12 +361,12 @@ keymap = runKeys $ do
   bind xK_n $ do
     justMod $
       doc "Shift to the next workspace." $
-      relativeWorkspaceShift next
+      withRelativeWorkspace next W.greedyView
 
   bind xK_p $ do
     justMod $
       doc "Shift to the previous workspace." $
-      relativeWorkspaceShift prev
+      withRelativeWorkspace prev W.greedyView
 
   bind xK_plus $ do
     justMod $ 
@@ -566,10 +591,10 @@ mouseMap = runButtons $ do
     justMod $ \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster
 
   bind button6 $
-    justMod $ noWindow (relativeWorkspaceShift prev)
+    justMod $ noWindow (withRelativeWorkspace prev W.greedyView)
 
   bind button7 $
-    justMod $ noWindow (relativeWorkspaceShift next)
+    justMod $ noWindow (withRelativeWorkspace next W.greedyView)
 
   bind button8 $
     justMod $ noWindow mediaPrev
@@ -628,8 +653,8 @@ mouseMap = runButtons $ do
       let workspaceButtons = [
             (button2, swapMaster),
 
-            (button9, relativeWorkspaceShift next),
-            (button8, relativeWorkspaceShift prev),
+            (button9, withRelativeWorkspace next W.greedyView),
+            (button8, withRelativeWorkspace prev W.greedyView),
 
             (button4, windows W.focusUp),
             (button5, windows W.focusDown),
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index c29ca31..3ba858f 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -121,13 +121,13 @@ getString = runQuery $ do
       then t
       else printf "%s - %s" t a
 
-relativeWorkspaceShift :: Selector -> X ()
-relativeWorkspaceShift (Selector selector) = do
+withRelativeWorkspace :: Selector -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+withRelativeWorkspace (Selector selector) fn =
   windows $ \ss ->
     let tags = sort (tag . snd  <$> filter (\x -> fst x /= Visible ) (getPopulatedWorkspaces ss))
         from = tag $ workspace $ current ss
         to = selector from tags
-    in greedyView to ss
+    in fn to ss
 
 next :: Selector
 next = Selector $ \a l -> select a l l
diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
index 32dda2a..0e54c43 100644
--- a/src/Internal/Submap.hs
+++ b/src/Internal/Submap.hs
@@ -1,5 +1,6 @@
 module Internal.Submap (
     mapNextString,
+    mapNextStringWithKeysym,
     submapButtonsWithKey,
     nextButton,
     nextMotion,
@@ -13,15 +14,20 @@ import Data.Map (Map)
 
 import XMonad.Actions.Submap as X
 
-{- Like submap fram XMonad.Actions.Submap, but sends the string from
- - XLookupString to the function rather than the KeySym.
+{-
+ - Like submap fram XMonad.Actions.Submap, but sends the string from
+ - XLookupString to the function along side the keysym.
+ -
+ - This function allows mappings where the mapped string might be important,
+ - but also allows submappings for keys that may not have a character associated
+ - with them (for example, the function keys).
  -}
-mapNextString :: (KeyMask -> String -> X a) -> X a
-mapNextString fn = do
+mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X a) -> X a
+mapNextStringWithKeysym fn = do
   XConf { theRoot = root, display = d } <- ask
   io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
 
-  (m, str) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
+  (m, str, keysym) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
     maskEvent d keyPressMask p
     KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
     keysym <- keycodeToKeysym d code 0
@@ -29,12 +35,17 @@ mapNextString fn = do
 
     if isModifierKey keysym
         then nextkey
-        else return (m, str)
+        else return (m, str, keysym)
 
   io $ ungrabKeyboard d currentTime
 
-  fn m str
+  fn m keysym str
 
+{- Like submap, but on the character typed rather than the kysym. -}
+mapNextString :: (KeyMask -> String -> X a) -> X a 
+mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
+
+{- Grabs the mouse and returns the next button press. -}
 nextButton :: X (ButtonMask, Button)
 nextButton = do
   XConf { theRoot = root, display = d } <- ask
@@ -49,6 +60,7 @@ nextButton = do
 
   return ret
 
+{- Grabs the mouse and reports the next mouse motion. -}
 nextMotion :: X (Int, Int)
 nextMotion = do
   XConf { theRoot = root, display = d } <- ask
@@ -63,6 +75,7 @@ nextMotion = do
 
   return ret
 
+{- Grabs the mouse and reports the next mouse motion or button press. -}
 nextMotionOrButton :: X (Either (Int, Int) (ButtonMask, Button))
 nextMotionOrButton = do
   XConf { theRoot = root, display = d } <- ask
-- 
cgit 


From 1c5e867dd7183ffef0611d3bbbd50f06c1022328 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 8 Apr 2022 14:21:24 -0600
Subject: Bidirection navigation for layouts!

---
 src/Internal/LayoutZipper.hs | 166 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 166 insertions(+)
 create mode 100644 src/Internal/LayoutZipper.hs

diff --git a/src/Internal/LayoutZipper.hs b/src/Internal/LayoutZipper.hs
new file mode 100644
index 0000000..d31360b
--- /dev/null
+++ b/src/Internal/LayoutZipper.hs
@@ -0,0 +1,166 @@
+{-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, MultiParamTypeClasses,
+ FlexibleContexts, UndecidableInstances, ViewPatterns, StandaloneDeriving,
+ RankNTypes, TupleSections #-}
+
+{- This module provides a more powerful version of the choose layout, using a
+ - list to store the layouts. -}
+module Internal.LayoutZipper where
+
+import Control.Monad.Identity (runIdentity)
+import Data.Maybe (fromMaybe)
+import Control.Arrow (second)
+import XMonad
+import qualified XMonad.StackSet as W
+import Data.Proxy
+
+data LNil a = LNil deriving (Read, Show)
+data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
+
+data LayoutZipper l a = LayoutZipper Int (l a)
+  deriving (Read, Show)
+
+(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
+(|:) = LCons
+infixr 5 |:
+
+layoutZipper :: (LayoutSelect l a) => l a -> LayoutZipper l a
+layoutZipper = LayoutZipper 0
+
+nil :: LNil a
+nil = LNil
+
+data NavigateLayout = ToNextLayout | ToPreviousLayout deriving (Typeable, Show)
+instance Message NavigateLayout where
+
+class LayoutSelect l a where
+  update :: forall r m. (Monad m) =>
+    Int ->
+    l a ->
+    (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
+    m (Maybe (r, l a))
+
+  nLayouts :: l a -> Int
+
+instance (Read (l a), LayoutClass l a, LayoutSelect t a) =>
+    LayoutSelect (LCons l t) a where
+
+  update 0 (LCons layout t) fn = do
+    (r, layout') <- fn layout
+    return $ Just (r, LCons (fromMaybe layout layout') t)
+
+  update n (LCons l t) fn = do
+    (fmap . fmap) (second $ \t' -> LCons l t') $ update (n - 1) t fn
+  
+  nLayouts (LCons _ t) = 1 + nLayouts t
+
+instance LayoutSelect LNil a where
+  update _ _ _ = return Nothing
+  nLayouts _ = 0
+
+instance (Show (l a), Typeable l, LayoutSelect l a) => LayoutClass (LayoutZipper l) a where
+  runLayout (W.Workspace i (LayoutZipper idx l) ms) r = do
+    r <- update idx l $ \layout ->
+            runLayout (W.Workspace i layout ms) r
+    case r of
+      Nothing -> return ([], Nothing)
+      Just (r, la) -> return (r, Just (LayoutZipper idx la))
+
+  pureLayout (LayoutZipper idx l) r s = runIdentity $ do
+    r <- update idx l $ \layout -> return (pureLayout layout r s, Nothing)
+    case r of
+      Nothing -> return []
+      Just (r, a) -> return r
+
+  emptyLayout (LayoutZipper idx l) r = do
+    r <- update idx l $ \layout -> emptyLayout layout r
+    case r of
+      Nothing -> return ([], Nothing)
+      Just (r, la) -> return (r, Just (LayoutZipper idx la))
+
+  handleMessage (LayoutZipper idx l) (fromMessage -> Just ToNextLayout) =
+    if idx < nLayouts l - 1
+      then return $ Just (LayoutZipper (idx + 1) l)
+      else return $ Just (LayoutZipper 0 l)
+  handleMessage (LayoutZipper idx l) (fromMessage -> Just ToPreviousLayout) =
+    if idx > 0
+      then return $ Just (LayoutZipper (idx - 1) l)
+      else return $ Just (LayoutZipper (nLayouts l - 1) l) 
+  handleMessage (LayoutZipper idx l) m = do
+    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
+    return $ LayoutZipper idx . snd <$> r
+
+  pureMessage (LayoutZipper idx l) m = runIdentity $ do
+    r <- update idx l $ \layout -> return ((), pureMessage layout m)
+    return $ LayoutZipper idx . snd <$> r
+
+  description (LayoutZipper idx l) = runIdentity $ do
+    r <- update idx l $ \l -> return (description l, Nothing)
+    return $
+      case r of
+        Nothing -> "No Layout"
+        Just (descr, _) -> descr
+
+-- data LayoutZipper l a = LayoutZipper [Layout a] [Layout a]
+--   deriving (Read, Show)
+
+
+-- instance LayoutClass Layout a where
+--   runLayout (W.Workspace i (Layout l) ms) r = do
+--     (rects, new) <- runLayout (W.Workspace i l ms) r
+--     return (rects, fmap Layout new)
+--   doLayout (Layout l) r s = do
+--     (rs, l') <- doLayout l r s
+--     return (rs, fmap Layout l')
+--   pureLayout (Layout l) r s = pureLayout l r s
+--   emptyLayout (Layout l) = (fmap . second . fmap) Layout . emptyLayout l
+--   handleMessage (Layout l) = (fmap . fmap) Layout . handleMessage l
+--   pureMessage (Layout l) = fmap Layout . pureMessage l
+--   description (Layout l) = description l
+
+-- replaceHead :: LayoutZipper a -> Layout a ->  LayoutZipper a
+-- replaceHead (LayoutZipper (_:hs) ts) h = LayoutZipper (h:hs) ts
+-- replaceHead z _ = z
+-- 
+-- nil :: LayoutZipper a
+-- nil = LayoutZipper [] []
+-- 
+-- (|:) :: (Read (l a), LayoutClass l a) => l a -> LayoutZipper a -> LayoutZipper a
+-- (|:) l (LayoutZipper h t) = LayoutZipper (Layout l : h) t
+-- 
+-- infixr 5 |:
+-- 
+-- 
+-- 
+-- instance (LayoutClass Layout a) => LayoutClass LayoutZipper a where
+--   runLayout (W.Workspace i z@(LayoutZipper (a:_) _) ms) = do
+--     fmap (second . fmap $ replaceHead z) .
+--       runLayout (W.Workspace i a ms)
+--   runLayout (W.Workspace _ z _) = emptyLayout z
+-- 
+--   doLayout z@(LayoutZipper (h:_) _) r s = do
+--     (rects, mh) <- doLayout h r s
+--     return (rects, fmap (replaceHead z) mh)
+--   doLayout z r s = emptyLayout z r
+-- 
+--   pureLayout (LayoutZipper (h:_) _) = pureLayout h
+--   pureLayout l = \_ _ -> []
+-- 
+--   emptyLayout z@(LayoutZipper (h:_) _) r = do
+--     (rects, mh) <- emptyLayout h r
+--     return (rects, replaceHead z <$> mh)
+--   emptyLayout _ _ = return ([], Nothing)
+-- 
+--   handleMessage (LayoutZipper (hs) (t:ts)) (fromMessage -> Just ToNextLayout) =
+--     return $ return $ LayoutZipper (t:hs) ts
+--   handleMessage (LayoutZipper (h:hs) (ts)) (fromMessage -> Just ToPreviousLayout) =
+--     return $
+--      case hs of
+--        [] -> Nothing
+--        _ -> Just (LayoutZipper hs (h:ts))
+--   handleMessage z@(LayoutZipper (h:_) _) m =
+--     (fmap $ fmap $ replaceHead z) (handleMessage h m)
+--   handleMessage _ _ = return Nothing
+-- 
+--   pureMessage z@(LayoutZipper (h:_) _) = fmap (replaceHead z) . pureMessage h
+-- 
+--   description (LayoutZipper (h:_) _) = description h
-- 
cgit 


From c264ad435597ea6bf68c386195919209c8f2a3e3 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 8 Apr 2022 14:41:34 -0600
Subject: Cleanup and more documentation.

---
 src/Internal/Keys.hs         | 23 ++++++++++++++++++-----
 src/Internal/Layout.hs       | 26 ++++++++++++++++----------
 src/Internal/LayoutZipper.hs |  9 ++++++++-
 3 files changed, 42 insertions(+), 16 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 748aae2..40ad0af 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -46,6 +46,7 @@ import XMonad.Actions.SpawnOn as SpawnOn
 import qualified Data.Map as Map
 import qualified XMonad.StackSet as W
 
+import Internal.LayoutZipper
 import Internal.MouseMotion
 import Internal.Windows
 import Internal.Lib
@@ -401,13 +402,25 @@ keymap = runKeys $ do
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
   bind xK_space $ do
-    justMod  $ sendMessage NextLayout
-    shiftMod $ sendMessage NextLayout
+    justMod  $
+      doc "Use the next layout in the layout list." $ sendMessage ToNextLayout
+
+    altMod   $
+      doc "Reset the layout to the default layout." $ sendMessage (SetLayout 0)
+
+    shiftMod $
+      doc "Use the previous layout in the layout list." $
+        sendMessage ToPreviousLayout
 
   bind xK_t $ do
-    justMod  $ spawnX (terminal config)
-    shiftMod $ withFocused $ windows . W.sink
-    altMod   $ spawnX (terminal config ++ " -t Floating\\ Term")
+    justMod  $
+      doc "Spawn a terminal." $ spawnX (terminal config)
+
+    shiftMod $
+      doc "Sink the current window into the tiling." $ withFocused $ windows . W.sink
+
+    altMod   $
+      doc "Spawn a floating terminal" $ spawnX (terminal config ++ " -t Floating\\ Term")
 
   bind xK_v $
     -- Allows repeated strokes of M-h and M-l to reduce and increase volume
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index 8613284..d883d18 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -1,6 +1,8 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, KindSignatures, DataKinds, GADTs, RankNTypes #-}
 module Internal.Layout where
 
+import GHC.TypeLits
+
 import Internal.CornerLayout (Corner(..))
 import Control.Arrow (second)
 import XMonad.Hooks.ManageDocks
@@ -22,6 +24,8 @@ import XMonad
 import XMonad.Core
 import XMonad.Layout.NoBorders (smartBorders, noBorders)
 
+import Internal.LayoutZipper
+
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
@@ -33,15 +37,17 @@ myLayout =
           ModifiedLayout (Flippable False) $
             ModifiedLayout (HFlippable False) $
               ModifiedLayout (Rotateable False) $
-                spiral (6/7) |||
-                (Corner (3/4) (3/100) :: Corner Window) |||
-                ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |||
-                ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |||
-                Full |||
-                Grid |||
-                Dishes 2 (1/6) |||
-                (MosaicAlt M.empty :: MosaicAlt Window) |||
-                D.Dwindle D.R D.CW 1.5 1.1
+                layoutZipper $
+                  spiral (6/7) |:
+                  (Corner (3/4) (3/100) :: Corner Window) |:
+                  ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |:
+                  ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |:
+                  Full |:
+                  Grid |:
+                  Dishes 2 (1/6) |:
+                  (MosaicAlt M.empty :: MosaicAlt Window) |:
+                  D.Dwindle D.R D.CW 1.5 1.1 |:
+                  nil
 
 data ModifyDescription m l a = ModifyDescription m (l a)
   deriving (Show, Read)
diff --git a/src/Internal/LayoutZipper.hs b/src/Internal/LayoutZipper.hs
index d31360b..787fe4f 100644
--- a/src/Internal/LayoutZipper.hs
+++ b/src/Internal/LayoutZipper.hs
@@ -29,7 +29,11 @@ layoutZipper = LayoutZipper 0
 nil :: LNil a
 nil = LNil
 
-data NavigateLayout = ToNextLayout | ToPreviousLayout deriving (Typeable, Show)
+data NavigateLayout =
+        ToNextLayout |
+        ToPreviousLayout |
+        SetLayout Int
+          deriving (Typeable, Show)
 instance Message NavigateLayout where
 
 class LayoutSelect l a where
@@ -85,6 +89,9 @@ instance (Show (l a), Typeable l, LayoutSelect l a) => LayoutClass (LayoutZipper
     if idx > 0
       then return $ Just (LayoutZipper (idx - 1) l)
       else return $ Just (LayoutZipper (nLayouts l - 1) l) 
+  handleMessage (LayoutZipper _ l) (fromMessage -> Just (SetLayout i)) =
+    return $ Just $ LayoutZipper (max 0 $ min (nLayouts l - 1) $ i) l
+
   handleMessage (LayoutZipper idx l) m = do
     r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
     return $ LayoutZipper idx . snd <$> r
-- 
cgit 


From 45176a8f89bcd1cb1c1d0bce33ed5a5495017c69 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 8 Apr 2022 14:46:07 -0600
Subject: Change the layout modifiers to work on individual layouts.

So, when doing something like a "zoom", it will only affect the current
layout. Before a "zoom" would be persistent across all layouts, now it
will only occur on the current layout.

I'm still trying to decide if I like it this way or not. It looks like
it'll have minimal impact on things. I don't use different layouts that
often anyway.
---
 src/Internal/Layout.hs | 33 ++++++++++++++++++---------------
 1 file changed, 18 insertions(+), 15 deletions(-)

diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index d883d18..d40dd38 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -33,21 +33,24 @@ myLayout =
   fullscreenFull $
     avoidStruts $
       spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
-        ModifiedLayout (Zoomable False 0.05 0.05) $
-          ModifiedLayout (Flippable False) $
-            ModifiedLayout (HFlippable False) $
-              ModifiedLayout (Rotateable False) $
-                layoutZipper $
-                  spiral (6/7) |:
-                  (Corner (3/4) (3/100) :: Corner Window) |:
-                  ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |:
-                  ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |:
-                  Full |:
-                  Grid |:
-                  Dishes 2 (1/6) |:
-                  (MosaicAlt M.empty :: MosaicAlt Window) |:
-                  D.Dwindle D.R D.CW 1.5 1.1 |:
-                  nil
+        layoutZipper $
+          mods (spiral (6/7)) |:
+          mods ((Corner (3/4) (3/100) :: Corner Window)) |:
+          mods (ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2))) |:
+          mods (ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2))) |:
+          mods (Full) |:
+          mods (Grid) |:
+          mods (Dishes 2 (1/6)) |:
+          mods ((MosaicAlt M.empty :: MosaicAlt Window)) |:
+          mods (D.Dwindle D.R D.CW 1.5 1.1) |:
+          nil
+
+
+mods =
+  ModifiedLayout (Zoomable False 0.05 0.05) .
+    ModifiedLayout (Flippable False) .
+    ModifiedLayout (HFlippable False) .
+    ModifiedLayout (Rotateable False)
 
 data ModifyDescription m l a = ModifyDescription m (l a)
   deriving (Show, Read)
-- 
cgit 


From f1f5993a10d57674c635f0cf3b2ffe47f77e9d5c Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 8 Apr 2022 15:07:58 -0600
Subject: More generic navigation and documentation.

---
 src/Internal/Keys.hs         |   6 +--
 src/Internal/Layout.hs       |   6 +--
 src/Internal/LayoutZipper.hs | 105 +++++++++++--------------------------------
 3 files changed, 31 insertions(+), 86 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 40ad0af..5b2e5a8 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -403,14 +403,14 @@ keymap = runKeys $ do
 
   bind xK_space $ do
     justMod  $
-      doc "Use the next layout in the layout list." $ sendMessage ToNextLayout
+      doc "Use the next layout in the layout list." $ sendMessage toNextLayout
 
     altMod   $
-      doc "Reset the layout to the default layout." $ sendMessage (SetLayout 0)
+      doc "Reset the layout to the default layout." $ sendMessage toFirstLayout
 
     shiftMod $
       doc "Use the previous layout in the layout list." $
-        sendMessage ToPreviousLayout
+        sendMessage toPreviousLayout
 
   bind xK_t $ do
     justMod  $
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index d40dd38..a1aeb17 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -35,13 +35,13 @@ myLayout =
       spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
         layoutZipper $
           mods (spiral (6/7)) |:
+          mods (MosaicAlt M.empty :: MosaicAlt Window) |:
           mods ((Corner (3/4) (3/100) :: Corner Window)) |:
+
           mods (ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2))) |:
           mods (ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2))) |:
-          mods (Full) |:
-          mods (Grid) |:
+          mods Grid |:
           mods (Dishes 2 (1/6)) |:
-          mods ((MosaicAlt M.empty :: MosaicAlt Window)) |:
           mods (D.Dwindle D.R D.CW 1.5 1.1) |:
           nil
 
diff --git a/src/Internal/LayoutZipper.hs b/src/Internal/LayoutZipper.hs
index 787fe4f..136b913 100644
--- a/src/Internal/LayoutZipper.hs
+++ b/src/Internal/LayoutZipper.hs
@@ -3,7 +3,7 @@
  RankNTypes, TupleSections #-}
 
 {- This module provides a more powerful version of the choose layout, using a
- - list to store the layouts. -}
+ - list to store the layouts, and thus the list is navigatable. -}
 module Internal.LayoutZipper where
 
 import Control.Monad.Identity (runIdentity)
@@ -19,21 +19,38 @@ data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
 data LayoutZipper l a = LayoutZipper Int (l a)
   deriving (Read, Show)
 
+-- Combinator for combining layouts together into a LayoutList. This amy then be
+-- used with the layoutZipper to create a layout zipper.
 (|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
 (|:) = LCons
 infixr 5 |:
 
+-- Create a layoutZipper that defaults to the first layout in the list.
 layoutZipper :: (LayoutSelect l a) => l a -> LayoutZipper l a
 layoutZipper = LayoutZipper 0
 
+-- The termination of a layout zipper.
 nil :: LNil a
 nil = LNil
 
+-- Message to navigate to a layout.
 data NavigateLayout =
-        ToNextLayout |
-        ToPreviousLayout |
-        SetLayout Int
-          deriving (Typeable, Show)
+          -- Sets the layout based on the given function.
+          SetLayout {
+            changeLayoutFn :: Int -> Int -- Function to use to change the layout.
+          , circularBool :: Bool -- True if the layouts should be treated as circular.
+          }
+          deriving (Typeable)
+
+toNextLayout :: NavigateLayout
+toNextLayout = SetLayout (+1) True
+
+toPreviousLayout :: NavigateLayout
+toPreviousLayout = SetLayout (\x -> x - 1) True
+
+toFirstLayout :: NavigateLayout
+toFirstLayout = SetLayout (const 0) True
+
 instance Message NavigateLayout where
 
 class LayoutSelect l a where
@@ -81,16 +98,9 @@ instance (Show (l a), Typeable l, LayoutSelect l a) => LayoutClass (LayoutZipper
       Nothing -> return ([], Nothing)
       Just (r, la) -> return (r, Just (LayoutZipper idx la))
 
-  handleMessage (LayoutZipper idx l) (fromMessage -> Just ToNextLayout) =
-    if idx < nLayouts l - 1
-      then return $ Just (LayoutZipper (idx + 1) l)
-      else return $ Just (LayoutZipper 0 l)
-  handleMessage (LayoutZipper idx l) (fromMessage -> Just ToPreviousLayout) =
-    if idx > 0
-      then return $ Just (LayoutZipper (idx - 1) l)
-      else return $ Just (LayoutZipper (nLayouts l - 1) l) 
-  handleMessage (LayoutZipper _ l) (fromMessage -> Just (SetLayout i)) =
-    return $ Just $ LayoutZipper (max 0 $ min (nLayouts l - 1) $ i) l
+  handleMessage (LayoutZipper idx l) (fromMessage -> Just (SetLayout fn circ)) =
+    let clip = if circ then mod else \i n -> max 0 $ min (n - 1) i in
+          return $ Just $ LayoutZipper (clip (fn idx) (nLayouts l)) l
 
   handleMessage (LayoutZipper idx l) m = do
     r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
@@ -106,68 +116,3 @@ instance (Show (l a), Typeable l, LayoutSelect l a) => LayoutClass (LayoutZipper
       case r of
         Nothing -> "No Layout"
         Just (descr, _) -> descr
-
--- data LayoutZipper l a = LayoutZipper [Layout a] [Layout a]
---   deriving (Read, Show)
-
-
--- instance LayoutClass Layout a where
---   runLayout (W.Workspace i (Layout l) ms) r = do
---     (rects, new) <- runLayout (W.Workspace i l ms) r
---     return (rects, fmap Layout new)
---   doLayout (Layout l) r s = do
---     (rs, l') <- doLayout l r s
---     return (rs, fmap Layout l')
---   pureLayout (Layout l) r s = pureLayout l r s
---   emptyLayout (Layout l) = (fmap . second . fmap) Layout . emptyLayout l
---   handleMessage (Layout l) = (fmap . fmap) Layout . handleMessage l
---   pureMessage (Layout l) = fmap Layout . pureMessage l
---   description (Layout l) = description l
-
--- replaceHead :: LayoutZipper a -> Layout a ->  LayoutZipper a
--- replaceHead (LayoutZipper (_:hs) ts) h = LayoutZipper (h:hs) ts
--- replaceHead z _ = z
--- 
--- nil :: LayoutZipper a
--- nil = LayoutZipper [] []
--- 
--- (|:) :: (Read (l a), LayoutClass l a) => l a -> LayoutZipper a -> LayoutZipper a
--- (|:) l (LayoutZipper h t) = LayoutZipper (Layout l : h) t
--- 
--- infixr 5 |:
--- 
--- 
--- 
--- instance (LayoutClass Layout a) => LayoutClass LayoutZipper a where
---   runLayout (W.Workspace i z@(LayoutZipper (a:_) _) ms) = do
---     fmap (second . fmap $ replaceHead z) .
---       runLayout (W.Workspace i a ms)
---   runLayout (W.Workspace _ z _) = emptyLayout z
--- 
---   doLayout z@(LayoutZipper (h:_) _) r s = do
---     (rects, mh) <- doLayout h r s
---     return (rects, fmap (replaceHead z) mh)
---   doLayout z r s = emptyLayout z r
--- 
---   pureLayout (LayoutZipper (h:_) _) = pureLayout h
---   pureLayout l = \_ _ -> []
--- 
---   emptyLayout z@(LayoutZipper (h:_) _) r = do
---     (rects, mh) <- emptyLayout h r
---     return (rects, replaceHead z <$> mh)
---   emptyLayout _ _ = return ([], Nothing)
--- 
---   handleMessage (LayoutZipper (hs) (t:ts)) (fromMessage -> Just ToNextLayout) =
---     return $ return $ LayoutZipper (t:hs) ts
---   handleMessage (LayoutZipper (h:hs) (ts)) (fromMessage -> Just ToPreviousLayout) =
---     return $
---      case hs of
---        [] -> Nothing
---        _ -> Just (LayoutZipper hs (h:ts))
---   handleMessage z@(LayoutZipper (h:_) _) m =
---     (fmap $ fmap $ replaceHead z) (handleMessage h m)
---   handleMessage _ _ = return Nothing
--- 
---   pureMessage z@(LayoutZipper (h:_) _) = fmap (replaceHead z) . pureMessage h
--- 
---   description (LayoutZipper (h:_) _) = description h
-- 
cgit 


From b8428f25d0beeb9ee08fdb51d35d6c912d24f72a Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Sat, 9 Apr 2022 15:09:55 -0600
Subject: Change mosaic to respond to multiple different kinds of messages

---
 src/Internal/Layout.hs       | 81 +++++++++++++++++++++++++++++++++++++++++---
 src/Internal/LayoutZipper.hs |  3 ++
 src/Internal/Windows.hs      |  6 +++-
 3 files changed, 85 insertions(+), 5 deletions(-)

diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index a1aeb17..fba1254 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -1,8 +1,9 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, KindSignatures, DataKinds, GADTs, RankNTypes #-}
+{-# LANGUAGE MultiParamTypeClasses, ViewPatterns, FlexibleInstances, KindSignatures, DataKinds, GADTs, RankNTypes, PolyKinds #-}
 module Internal.Layout where
 
 import GHC.TypeLits
 
+import Data.Proxy (Proxy(..))
 import Internal.CornerLayout (Corner(..))
 import Control.Arrow (second)
 import XMonad.Hooks.ManageDocks
@@ -25,19 +26,20 @@ import XMonad.Core
 import XMonad.Layout.NoBorders (smartBorders, noBorders)
 
 import Internal.LayoutZipper
+import Internal.Windows
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
+myLayout :: _
 myLayout =
   fullscreenFull $
     avoidStruts $
       spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
         layoutZipper $
           mods (spiral (6/7)) |:
-          mods (MosaicAlt M.empty :: MosaicAlt Window) |:
-          mods ((Corner (3/4) (3/100) :: Corner Window)) |:
-
+          mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
+          mods (Corner (3/4) (3/100)) |:
           mods (ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2))) |:
           mods (ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2))) |:
           mods Grid |:
@@ -45,6 +47,76 @@ myLayout =
           mods (D.Dwindle D.R D.CW 1.5 1.1) |:
           nil
 
+-- This is a type class that defines how to reinterpret a message. One can think
+-- of this as a kind of type-level function. It lets one associate a function
+-- (reinterpretMessage) with a type construct, which for the case below is a
+-- Symbol.
+--
+-- It would be nice to attach this function to the LayoutModifier directly as a
+-- value, however LayoutModifiers must be Show-able and Read-able and functions
+-- are not. However encoding in the typesystem itsef which function is to be
+-- called is the best alternative I have.
+class DoReinterpret (k :: t) where
+  reinterpretMessage ::
+    Proxy k -> SomeMessage -> X (Maybe SomeMessage)
+
+-- Mosaic doesn't have the concept of a "Master Space", so reinterpret messages
+-- intended to modify the master space and instead have those messages expand
+-- and shrink the current window.
+--
+-- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system
+-- hacking one can do in Haskell.
+instance DoReinterpret "ForMosaic" where
+  
+  -- IncMaster message
+  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
+    (fmap $ SomeMessage .
+      (if n > 0
+        then expandWindowAlt
+        else shrinkWindowAlt)) <$> getFocusedWindow
+  
+  -- ResizeMaster message
+  reinterpretMessage _ (fromMessage -> Just m) = do
+    (fmap $ SomeMessage .
+      (case m of
+        Expand -> expandWindowAlt
+        Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
+
+  -- Messages that don't match the above, just leave it unmodified.
+  reinterpretMessage _ m = return (Just m)
+
+-- Data construct for association a DoReinterpret function with a concrete
+-- construct that can be used in the LayoutModifier instance.
+--
+-- It wolud be nice to have ReinterpretMessage hold the function as a value
+-- rather than delegate to this kind-instance, however, it won't work because
+-- LayoutModifiers have to be Read-able and Show-able, and functions are neither
+-- of those, so a value-level function may not be a member of a LayoutModifier,
+-- thus I have to settle for delegating to a hard-coded instance using
+-- type-classes.
+data ReinterpretMessage k a = ReinterpretMessage
+  deriving (Show, Read)
+
+-- Instance for ReinterpretMessage as a Layout modifier.
+instance (DoReinterpret k) =>
+      LayoutModifier (ReinterpretMessage k) a where 
+
+  handleMessOrMaybeModifyIt self message = do
+
+    -- Delegates to the reinterpretMessage function associatied with the
+    -- type-variable k.
+    newMessage <- reinterpretMessage (ofProxy self) message
+    case newMessage of
+      Just m -> return $ Just $ Right m
+      Nothing -> return $ Just $ Left self
+    where
+      -- ofProxy just provides reifies the phantom type k so the type system can
+      -- figure out what instance to go to.
+      ofProxy :: ReinterpretMessage k a -> Proxy k
+      ofProxy _ = Proxy
+
+modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a
+modifyMosaic = ModifiedLayout ReinterpretMessage
 
 mods =
   ModifiedLayout (Zoomable False 0.05 0.05) .
@@ -52,6 +124,7 @@ mods =
     ModifiedLayout (HFlippable False) .
     ModifiedLayout (Rotateable False)
 
+
 data ModifyDescription m l a = ModifyDescription m (l a)
   deriving (Show, Read)
 
diff --git a/src/Internal/LayoutZipper.hs b/src/Internal/LayoutZipper.hs
index 136b913..e34a078 100644
--- a/src/Internal/LayoutZipper.hs
+++ b/src/Internal/LayoutZipper.hs
@@ -42,12 +42,15 @@ data NavigateLayout =
           }
           deriving (Typeable)
 
+-- NavigateLayout instance to move to the next layout, circularly.
 toNextLayout :: NavigateLayout
 toNextLayout = SetLayout (+1) True
 
+-- NavigateLayout instance to move to the previous layout, circularly.
 toPreviousLayout :: NavigateLayout
 toPreviousLayout = SetLayout (\x -> x - 1) True
 
+-- NavigateLayotu instance to move to the first layout.
 toFirstLayout :: NavigateLayout
 toFirstLayout = SetLayout (const 0) True
 
diff --git a/src/Internal/Windows.hs b/src/Internal/Windows.hs
index 98baa51..45fea95 100644
--- a/src/Internal/Windows.hs
+++ b/src/Internal/Windows.hs
@@ -3,7 +3,7 @@ module Internal.Windows where
 import XMonad (windowset, X, Window, get)
 
 import Control.Applicative ((<|>))
-import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), integrate, integrate', allWindows)
+import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), peek, integrate, integrate', allWindows)
 import Data.Maybe (listToMaybe, catMaybes)
 import qualified Data.Map as Map
 
@@ -52,6 +52,10 @@ forAllWindows fn = do
   stackSet <- windowset <$> get
   mapM_ fn (allWindows stackSet)
 
+getFocusedWindow :: X (Maybe Window)
+getFocusedWindow = do
+  (peek . windowset) <$> get
+
 {- Finds a Window and returns the screen its on and the workspace its on.
  - Returns nothing if the window doesn't exist.
  -
-- 
cgit 


From a1b64c6ca6d31a558c7562e074456e52051aa16c Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Fri, 1 Apr 2022 00:18:41 -0600
Subject: Remove trailing space

---
 src/Internal/Keys.hs  | 24 ++++++++++++------------
 src/Internal/KeysM.hs |  2 +-
 2 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 5b2e5a8..1d3baf4 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -136,7 +136,7 @@ keymap = runKeys $ do
       subkeys $ do
         bind xK_apostrophe $
           (noMod -|- justMod) $
-            doc "Jumps to the last window." $
+            doc "Jumps to the last window."
             jumpToLast
         mapAlpha 0 jumpToMark
 
@@ -176,13 +176,13 @@ keymap = runKeys $ do
       sendKey (0, xK_a) w
 
     justMod $
-      doc "Print this documentation" $
+      doc "Print this documentation"
       (safeSpawn "gxmessage" [
         "-fn", "Source Code Pro",
         documentation (keymap config)] :: X ())
 
   bind xK_F7 $
-    
+
     justMod $
       doc "Print this documentation." $
       logs (documentation (keymap config))
@@ -212,7 +212,7 @@ keymap = runKeys $ do
         doc ("Switch focus to screen " ++ show idx) $
         withScreen W.view idx
       -- Swap the current screen with the one given
-      altMod   $ 
+      altMod   $
         doc ("Swap the current screen with screen " ++ show idx) $
         withScreen W.greedyView idx
       -- Move the current window to the select screen.
@@ -227,9 +227,9 @@ keymap = runKeys $ do
     justMod $
       doc "Increase the gaps between windows." $
       sendMessage $ modifyWindowBorder 5
- 
+
   bind xK_bracketleft $ do
-    justMod $ 
+    justMod $
       doc "Decrease the gaps between windows." $
       sendMessage $ modifyWindowBorder (-5)
 
@@ -370,7 +370,7 @@ keymap = runKeys $ do
       withRelativeWorkspace prev W.greedyView
 
   bind xK_plus $ do
-    justMod $ 
+    justMod $
       doc "Increase the number of windows in the master region." $
       sendMessage (IncMasterN 1)
 
@@ -383,7 +383,7 @@ keymap = runKeys $ do
       doc "Recompile and restart XMonad" $
       spawnX "xmonad --recompile && xmonad --restart"
 
-    justMod $ 
+    justMod $
       doc "Experimental Bindings" $
       subkeys $ do
 
@@ -430,16 +430,16 @@ keymap = runKeys $ do
       repeatable $ do
         bind xK_h $
           justMod $
-             doc "Decrease volume." $
+             doc "Decrease volume."
              decreaseVolumeDoc
 
         bind xK_l $
           justMod $
-             doc "Increase volume." $
+             doc "Increase volume."
              increaseVolumeDoc
 
         bind xK_v $
-          justMod $ (return () :: X ())
+          justMod (return () :: X ())
 
   bind xK_w $ do
     justMod $ doc "Jump to a window (via rofi)" windowJump
@@ -509,7 +509,7 @@ keymap = runKeys $ do
 
         bind xK_s $
           (justMod -|- noMod) $
-            doc "Toggle the ability for terminals to swallow child windows." $
+            doc "Toggle the ability for terminals to swallow child windows."
             toggleSwallowEnabled
 
         bind xK_v $ do
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
index fa9b49f..e490b89 100644
--- a/src/Internal/KeysM.hs
+++ b/src/Internal/KeysM.hs
@@ -377,7 +377,7 @@ altgrMod = maskMod altgrMask
 
 {- Can combine two or more of the functions above to apply the same action to
  - multiple masks. -}
-(-|-) :: (Binding k b) => 
+(-|-) :: (Binding k b) =>
           (k -> BindingBuilder b ()) ->
           (k -> BindingBuilder b ()) ->
           k -> BindingBuilder b ()
-- 
cgit 


From 28494be6925bc341534ad43c3523343e6c95a01a Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Fri, 1 Apr 2022 00:26:28 -0600
Subject: Allow marks to be any alpha-numeric character, including unicode
 characters

---
 src/Internal/Keys.hs | 29 ++++++++++++++---------------
 1 file changed, 14 insertions(+), 15 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 1d3baf4..d340062 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -133,22 +133,19 @@ keymap = runKeys $ do
   bind xK_apostrophe $ do
     justMod $
       doc "Jumps between marks." $
-      subkeys $ do
-        bind xK_apostrophe $
-          (noMod -|- justMod) $
-            doc "Jumps to the last window."
-            jumpToLast
-        mapAlpha 0 jumpToMark
+      mapNextString $ \_ str ->
+        case str of
+          ['\''] -> jumpToLast
+          [ch] | isAlphaNum ch -> jumpToMark ch
+          _ -> return ()
 
     shiftMod $
       doc "Swap the current window with a mark." $
-      subkeys $ do
-      bind xK_apostrophe $
-        (noMod -|- shiftMod -|- rawMask shiftMask) $
-          doc "Swap the current window with the last mark."
-          swapWithLastMark
-
-      mapAlpha shiftMask swapWithMark
+      mapNextString $ \_ str ->
+        case str of
+          ['\''] ->  swapWithLastMark
+          [ch] | isAlphaNum ch -> swapWithMark ch
+          _ -> return ()
 
   bind xK_BackSpace $ do
     -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
@@ -356,8 +353,10 @@ keymap = runKeys $ do
   bind xK_m $ do
     justMod $
       doc "Mark the current window with the next typed character." $
-      subkeys $
-        mapAlpha 0 markCurrentWindow
+      mapNextString $ \_ str ->
+        case str of
+          [ch] | isAlphaNum ch -> markCurrentWindow ch
+          _ -> return ()
 
   bind xK_n $ do
     justMod $
-- 
cgit 


From faaf7cedf1d10c54cc7be27c1d2b125e0b99b7e5 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sat, 9 Apr 2022 15:51:30 -0600
Subject: [Experimental] - Attempting to create typesafy way to navigate
 layouts.

---
 src/Internal/Layout.hs       |  1 -
 src/Internal/LayoutZipper.hs | 94 +++++++++++++++++++++++++++++++++-----------
 src/Internal/Lib.hs          |  1 +
 src/Internal/Windows.hs      |  2 +-
 4 files changed, 74 insertions(+), 24 deletions(-)

diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index fba1254..562f947 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -31,7 +31,6 @@ import Internal.Windows
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
-myLayout :: _
 myLayout =
   fullscreenFull $
     avoidStruts $
diff --git a/src/Internal/LayoutZipper.hs b/src/Internal/LayoutZipper.hs
index e34a078..7af7d7b 100644
--- a/src/Internal/LayoutZipper.hs
+++ b/src/Internal/LayoutZipper.hs
@@ -1,11 +1,12 @@
 {-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, MultiParamTypeClasses,
  FlexibleContexts, UndecidableInstances, ViewPatterns, StandaloneDeriving,
- RankNTypes, TupleSections #-}
+ RankNTypes, TupleSections, TypeFamilies #-}
 
 {- This module provides a more powerful version of the choose layout, using a
  - list to store the layouts, and thus the list is navigatable. -}
 module Internal.LayoutZipper where
 
+import Data.Void
 import Control.Monad.Identity (runIdentity)
 import Data.Maybe (fromMaybe)
 import Control.Arrow (second)
@@ -16,68 +17,118 @@ import Data.Proxy
 data LNil a = LNil deriving (Read, Show)
 data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
 
-data LayoutZipper l a = LayoutZipper Int (l a)
+data IsSelected l = Selected | NotSelected l
   deriving (Read, Show)
 
 -- Combinator for combining layouts together into a LayoutList. This amy then be
 -- used with the layoutZipper to create a layout zipper.
+class SelectionClass c where
+  nextSelection :: c -> c
+  prevSelection :: c -> c
+  firstSelection :: Maybe c
+  isSelected :: c -> Bool
+
+instance (SelectionClass t) => SelectionClass (IsSelected t) where
+  nextSelection (NotSelected l) = NotSelected (nextSelection l)
+  nextSelection Selected = maybe Selected NotSelected firstSelection 
+
+  firstSelection = Just Selected
+
+  prevSelection (NotSelected t) =
+    if isSelected t
+      then Selected
+      else NotSelected (prevSelection t)
+  prevSelection Selected = Selected
+
+  isSelected Selected = True
+  isSelected _ = False
+
+instance SelectionClass Void where
+  nextSelection = absurd
+  prevSelection = absurd
+  firstSelection = Nothing
+  isSelected = const False
+
+data LayoutZipper l a where
+  LayoutZipper :: (LayoutSelect l a) => Selection l -> l a -> LayoutZipper l a
+
+deriving instance (LayoutSelect l a) => Show (LayoutZipper l a)
+deriving instance (LayoutSelect l a) => Read (LayoutZipper l a)
+
 (|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
 (|:) = LCons
-infixr 5 |:
 
--- Create a layoutZipper that defaults to the first layout in the list.
-layoutZipper :: (LayoutSelect l a) => l a -> LayoutZipper l a
-layoutZipper = LayoutZipper 0
+infixr 5 |: 
+
+layoutZipper :: (LayoutSelect l a, Selection l ~ IsSelected n) => l a -> LayoutZipper l a
+layoutZipper = LayoutZipper Selected
 
 -- The termination of a layout zipper.
 nil :: LNil a
 nil = LNil
 
 -- Message to navigate to a layout.
-data NavigateLayout =
+newtype NavigateLayout =
           -- Sets the layout based on the given function.
-          SetLayout {
-            changeLayoutFn :: Int -> Int -- Function to use to change the layout.
-          , circularBool :: Bool -- True if the layouts should be treated as circular.
+          NavigateLayout {
+            changeLayoutFn :: forall c. (SelectionClass c) => c -> c
           }
           deriving (Typeable)
 
 -- NavigateLayout instance to move to the next layout, circularly.
 toNextLayout :: NavigateLayout
-toNextLayout = SetLayout (+1) True
+toNextLayout = NavigateLayout nextSelection
 
 -- NavigateLayout instance to move to the previous layout, circularly.
 toPreviousLayout :: NavigateLayout
-toPreviousLayout = SetLayout (\x -> x - 1) True
+toPreviousLayout = NavigateLayout prevSelection
 
 -- NavigateLayotu instance to move to the first layout.
 toFirstLayout :: NavigateLayout
-toFirstLayout = SetLayout (const 0) True
+toFirstLayout = NavigateLayout (`fromMaybe` firstSelection)
 
 instance Message NavigateLayout where
 
-class LayoutSelect l a where
+class (
+     Show (l a),
+     Read (l a),
+     Read (Selection l),
+     Show (Selection l),
+     SelectionClass (Selection l)) => LayoutSelect l a where
+  type Selection l :: *
+
   update :: forall r m. (Monad m) =>
-    Int ->
+    Selection l ->
     l a ->
     (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
     m (Maybe (r, l a))
 
   nLayouts :: l a -> Int
 
-instance (Read (l a), LayoutClass l a, LayoutSelect t a) =>
+instance (
+        Read (l a),
+        LayoutClass l a,
+        LayoutSelect t a,
+
+        Show (Selection t),
+        Read (Selection t)) =>
     LayoutSelect (LCons l t) a where
 
-  update 0 (LCons layout t) fn = do
+  -- This is something
+  type Selection (LCons l t) = IsSelected (Selection t)
+
+  update Selected (LCons layout t) fn = do
     (r, layout') <- fn layout
     return $ Just (r, LCons (fromMaybe layout layout') t)
 
-  update n (LCons l t) fn = do
-    (fmap . fmap) (second $ \t' -> LCons l t') $ update (n - 1) t fn
+  update (NotSelected s) (LCons l t) fn =
+    fmap (second $ \t' -> LCons l t') <$> update s t fn
   
   nLayouts (LCons _ t) = 1 + nLayouts t
 
 instance LayoutSelect LNil a where
+  type Selection LNil = Void -- Cannot be selected
+
   update _ _ _ = return Nothing
   nLayouts _ = 0
 
@@ -101,9 +152,8 @@ instance (Show (l a), Typeable l, LayoutSelect l a) => LayoutClass (LayoutZipper
       Nothing -> return ([], Nothing)
       Just (r, la) -> return (r, Just (LayoutZipper idx la))
 
-  handleMessage (LayoutZipper idx l) (fromMessage -> Just (SetLayout fn circ)) =
-    let clip = if circ then mod else \i n -> max 0 $ min (n - 1) i in
-          return $ Just $ LayoutZipper (clip (fn idx) (nLayouts l)) l
+  handleMessage (LayoutZipper idx l) (fromMessage -> Just (NavigateLayout fn)) =
+    return $ Just (LayoutZipper (fn idx) l)
 
   handleMessage (LayoutZipper idx l) m = do
     r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index 3ba858f..fdbc9a5 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -24,6 +24,7 @@ import Internal.DMenu
 import Data.Ord (comparing)
 
 import qualified XMonad.StackSet as S
+import Internal.Windows
 
 type WorkspaceName = Char
 newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a)
diff --git a/src/Internal/Windows.hs b/src/Internal/Windows.hs
index 45fea95..35f093c 100644
--- a/src/Internal/Windows.hs
+++ b/src/Internal/Windows.hs
@@ -54,7 +54,7 @@ forAllWindows fn = do
 
 getFocusedWindow :: X (Maybe Window)
 getFocusedWindow = do
-  (peek . windowset) <$> get
+  peek . windowset <$> get
 
 {- Finds a Window and returns the screen its on and the workspace its on.
  - Returns nothing if the window doesn't exist.
-- 
cgit 


From e5a0476248e0f24cd335e88e933ac4affc19aa8d Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sat, 9 Apr 2022 17:35:22 -0600
Subject: Document, and make better LayoutZipper.

Now LayoutZipper can be circular, which means layout switching operates
semantically identically to how it did before making the typesafe
selector.

The selector was very much an acedemic exercise, but since it is working
as expect, I will keep it. I like the type-safety and it can be used as
an example for similar exercises.
---
 src/Internal/LayoutZipper.hs | 246 ++++++++++++++++++++++++++++++-------------
 1 file changed, 175 insertions(+), 71 deletions(-)

diff --git a/src/Internal/LayoutZipper.hs b/src/Internal/LayoutZipper.hs
index 7af7d7b..7fd4a5f 100644
--- a/src/Internal/LayoutZipper.hs
+++ b/src/Internal/LayoutZipper.hs
@@ -2,10 +2,26 @@
  FlexibleContexts, UndecidableInstances, ViewPatterns, StandaloneDeriving,
  RankNTypes, TupleSections, TypeFamilies #-}
 
-{- This module provides a more powerful version of the choose layout, using a
- - list to store the layouts, and thus the list is navigatable. -}
-module Internal.LayoutZipper where
-
+{-
+ - This module provides a more powerful version of the "Choose" layout that can
+ - be bidirectionally navigated.
+ -
+ - The indexing uses a type-safe zipper to keep track of the currently-selected
+ - layout.
+ -}
+module Internal.LayoutZipper (
+  LayoutZipper,
+  layoutZipper,
+  LCons,
+  LNil,
+  toNextLayout,
+  toPreviousLayout,
+  toFirstLayout,
+  (|:),
+  nil
+  )where
+
+import Control.Applicative ((<|>))
 import Data.Void
 import Control.Monad.Identity (runIdentity)
 import Data.Maybe (fromMaybe)
@@ -14,43 +30,108 @@ import XMonad
 import qualified XMonad.StackSet as W
 import Data.Proxy
 
+-- Type-level lists. LNil is the final of the list. LCons contains a layout and a
+-- tail.
 data LNil a = LNil deriving (Read, Show)
 data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
 
-data IsSelected l = Selected | NotSelected l
-  deriving (Read, Show)
-
--- Combinator for combining layouts together into a LayoutList. This amy then be
--- used with the layoutZipper to create a layout zipper.
-class SelectionClass c where
-  nextSelection :: c -> c
-  prevSelection :: c -> c
-  firstSelection :: Maybe c
-  isSelected :: c -> Bool
-
-instance (SelectionClass t) => SelectionClass (IsSelected t) where
-  nextSelection (NotSelected l) = NotSelected (nextSelection l)
-  nextSelection Selected = maybe Selected NotSelected firstSelection 
-
-  firstSelection = Just Selected
-
-  prevSelection (NotSelected t) =
-    if isSelected t
-      then Selected
-      else NotSelected (prevSelection t)
-  prevSelection Selected = Selected
-
-  isSelected Selected = True
-  isSelected _ = False
-
-instance SelectionClass Void where
-  nextSelection = absurd
-  prevSelection = absurd
-  firstSelection = Nothing
-  isSelected = const False
-
+-- Sel - This defines a structure where either this selected, or some
+-- other element is selected.
+--
+-- These types can be composed to create what is effectively a bounded integer.
+-- I.e. there can be a type like
+--
+-- Sel (Sel (Sel (Sel Zero)))
+--
+-- Such a type is equivalent to an integer bounded at 4, because this type can
+-- exist in no more than 4 states:
+--
+-- Sel
+-- Skip Sel
+-- Skip (Skip Sel)
+-- Skip (Skip (Skip Sel))
+--
+-- Note that a type (Sel Zero) can only be in the Sel as Zero may not be
+-- construted (without using undefined).
+data Sel l =
+    Sel |
+    (Selector l) => Skip l
+deriving instance (Read l, Selector l) => Read (Sel l)
+deriving instance (Show l, Selector l) => Show (Sel l)
+
+-- Reimplement Void as Zero, just to keep the two separate, but Zero is for all
+-- intents and purposes Void.
+data Zero
+deriving instance Read Zero
+deriving instance Show Zero
+
+
+-- Types that constitute a selection. Selections can be moved to the next
+-- selection, moved to the previous selection, optionally there could be a
+-- previous selection and they may be currently selected.
+class Selector c where
+  -- Increments the selection to the next state
+  --
+  -- Returns Nothing if the selection class is in the final state and cannot be
+  -- incremented any farther. (This is helpful to facilitate modular
+  -- arithmatic)
+  increment :: c -> Maybe c
+
+  -- Decrements the selection to the previous state. Returns Nothing if the
+  -- state is already in its initial setting.
+  decrement :: c -> Maybe c
+
+  -- The initial state.
+  initial :: Maybe c
+
+  -- The final state.
+  final :: Maybe c
+
+--
+-- Is selelected can be in two states:
+--
+--   1. The current element is selected
+--   2. The current element is not selected and another element deeper in the
+--      structure is selected.
+instance (Selector t) => Selector (Sel t) where
+  -- If the current element is not selected, increment the tail.
+  increment (Skip l) = Skip <$> increment l
+  -- If the current element is selected, the increment is just the initial of
+  -- the tail.
+  increment Sel = Skip <$> initial 
+
+  -- For a selection, the initial is just this in the Sel state.
+  initial = Just Sel
+
+  -- Looks ahead at the tail, sees if it is selected, if so, select this one
+  -- instead, if the one ahead isn't selected, then decrement that one.
+  decrement (Skip t) = Just $ maybe Sel Skip (decrement t)
+  decrement Sel = Nothing
+
+  -- Navigates to the end of the structure to find the final form.
+  final = Just $ maybe Sel Skip final
+
+-- The Zero structure (which is equivalent to Void) is the "null" selector; the
+-- basecase that the Sel selector terminates at.
+instance Selector Zero where
+
+  -- Incrementing the Zero Selector doesn't do anything.
+  increment = const Nothing
+
+  -- Decrementing the Zero Selector doesn't do anythig
+  decrement = const Nothing
+
+  -- There is no initial value for the Zero selector.
+  initial = Nothing
+
+  -- There is not final state for the Zero selector.
+  final = Nothing
+
+-- A LayoutZipper consists of a LayoutSelect type and a corresponding Selector.
 data LayoutZipper l a where
-  LayoutZipper :: (LayoutSelect l a) => Selection l -> l a -> LayoutZipper l a
+  LayoutZipper ::
+    (LayoutSelect l a, Selector (SelectorFor l)) =>
+      SelectorFor l -> l a -> LayoutZipper l a
 
 deriving instance (LayoutSelect l a) => Show (LayoutZipper l a)
 deriving instance (LayoutSelect l a) => Read (LayoutZipper l a)
@@ -60,8 +141,12 @@ deriving instance (LayoutSelect l a) => Read (LayoutZipper l a)
 
 infixr 5 |: 
 
-layoutZipper :: (LayoutSelect l a, Selection l ~ IsSelected n) => l a -> LayoutZipper l a
-layoutZipper = LayoutZipper Selected
+-- Constructs a LayoutZipper. This function enforces that the SelectorFor l
+-- is a 'Sel' type. Essentially this enforces that there must be at least one
+-- underlying layout, otherwise a LayoutZipper cannot be constructed.
+layoutZipper :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
+  l a -> LayoutZipper l a
+layoutZipper = LayoutZipper Sel
 
 -- The termination of a layout zipper.
 nil :: LNil a
@@ -71,68 +156,87 @@ nil = LNil
 newtype NavigateLayout =
           -- Sets the layout based on the given function.
           NavigateLayout {
-            changeLayoutFn :: forall c. (SelectionClass c) => c -> c
+            changeLayoutFn :: forall c. (Selector c) => c -> c
           }
           deriving (Typeable)
 
 -- NavigateLayout instance to move to the next layout, circularly.
 toNextLayout :: NavigateLayout
-toNextLayout = NavigateLayout nextSelection
+toNextLayout = NavigateLayout $ \c -> fromMaybe c (increment c <|> initial)
 
 -- NavigateLayout instance to move to the previous layout, circularly.
 toPreviousLayout :: NavigateLayout
-toPreviousLayout = NavigateLayout prevSelection
+toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
 
 -- NavigateLayotu instance to move to the first layout.
 toFirstLayout :: NavigateLayout
-toFirstLayout = NavigateLayout (`fromMaybe` firstSelection)
+toFirstLayout = NavigateLayout (`fromMaybe` initial)
 
 instance Message NavigateLayout where
 
-class (
-     Show (l a),
-     Read (l a),
-     Read (Selection l),
-     Show (Selection l),
-     SelectionClass (Selection l)) => LayoutSelect l a where
-  type Selection l :: *
-
+-- LayoutSelect class Describes a type that can be used to select a layout using
+-- the associated type SelectorFor.
+--
+-- Instances of this class are LCons and LNil.
+class (Show (l a),
+       Read (l a),
+       Read (SelectorFor l),
+       Show (SelectorFor l),
+       Selector (SelectorFor l)) => LayoutSelect l a where
+
+  -- The selector that is used to update the layout corresponding to the
+  -- selector. This selector must be an instance of the Selector class.
+  type SelectorFor l :: *
+
+  -- Update applies a functor to the selected layout and maybe returns a result
+  -- and an updated layout.
   update :: forall r m. (Monad m) =>
-    Selection l ->
+    -- The selector for this type. Determines which layout the function is
+    -- applied to.
+    SelectorFor l ->
+    -- The LayoutSelect being modified.
     l a ->
+    -- Higher-ordered function to generically apply to the Layout associated
+    -- with the Selector. Works on all LayoutClass's.
     (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
-    m (Maybe (r, l a))
-
-  nLayouts :: l a -> Int
 
-instance (
-        Read (l a),
-        LayoutClass l a,
-        LayoutSelect t a,
+    -- Returns a result r, and an updated LayoutSelect.
+    m (Maybe (r, l a))
 
-        Show (Selection t),
-        Read (Selection t)) =>
+-- Instance for LayoutSelect for cons
+instance (Read (l a),
+          LayoutClass l a,
+          LayoutSelect t a,
+          Show (SelectorFor t),
+          Read (SelectorFor t)) =>
     LayoutSelect (LCons l t) a where
 
-  -- This is something
-  type Selection (LCons l t) = IsSelected (Selection t)
+  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
+  -- Sel (Sel (Sel ( ... (Sel Zero) .. ))) where the number of Sel's match the
+  -- number of Cons in this structure enforcing safe selection.
+  type SelectorFor (LCons l t) = Sel (SelectorFor t)
 
-  update Selected (LCons layout t) fn = do
+  -- The current layout in this Cons-list is selected.
+  update Sel (LCons layout t) fn = do
     (r, layout') <- fn layout
     return $ Just (r, LCons (fromMaybe layout layout') t)
 
-  update (NotSelected s) (LCons l t) fn =
+  -- The current layout is not selected. Move on to another layout.
+  update (Skip s) (LCons l t) fn =
     fmap (second $ \t' -> LCons l t') <$> update s t fn
-  
-  nLayouts (LCons _ t) = 1 + nLayouts t
 
+-- LNil is a layout select. It doesn't do anything. Indeed update really can't
+-- be called on on this because that would require instantiating a Zero type.
 instance LayoutSelect LNil a where
-  type Selection LNil = Void -- Cannot be selected
-
+  type SelectorFor LNil = Zero -- LNil cannot be selected.
   update _ _ _ = return Nothing
-  nLayouts _ = 0
 
-instance (Show (l a), Typeable l, LayoutSelect l a) => LayoutClass (LayoutZipper l) a where
+-- Instance of layout class for LayoutZipper. The implementation for this
+-- just delegates to the underlying LayoutSelect class using the generic
+-- update method.
+instance (Show (l a), Typeable l, LayoutSelect l a) =>
+    LayoutClass (LayoutZipper l) a where
+
   runLayout (W.Workspace i (LayoutZipper idx l) ms) r = do
     r <- update idx l $ \layout ->
             runLayout (W.Workspace i layout ms) r
-- 
cgit 


From 3249935394c85cc9ca25d6bbbd74da002d43dccf Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sat, 9 Apr 2022 22:39:30 -0600
Subject: Rename LayoutZipper to LayoutList. Add more utils for handling a
 selector

---
 src/Internal/Keys.hs         |   2 +-
 src/Internal/Layout.hs       |  22 +++-
 src/Internal/LayoutList.hs   | 297 +++++++++++++++++++++++++++++++++++++++++++
 src/Internal/LayoutZipper.hs | 275 ---------------------------------------
 4 files changed, 315 insertions(+), 281 deletions(-)
 create mode 100644 src/Internal/LayoutList.hs
 delete mode 100644 src/Internal/LayoutZipper.hs

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index d340062..01e438c 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -46,7 +46,7 @@ import XMonad.Actions.SpawnOn as SpawnOn
 import qualified Data.Map as Map
 import qualified XMonad.StackSet as W
 
-import Internal.LayoutZipper
+import Internal.LayoutList
 import Internal.MouseMotion
 import Internal.Windows
 import Internal.Lib
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index 562f947..6c78c70 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -25,7 +25,7 @@ import XMonad
 import XMonad.Core
 import XMonad.Layout.NoBorders (smartBorders, noBorders)
 
-import Internal.LayoutZipper
+import Internal.LayoutList
 import Internal.Windows
 
 import qualified Data.Map as M
@@ -36,9 +36,9 @@ myLayout =
     avoidStruts $
       spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
         layoutZipper $
-          mods (spiral (6/7)) |:
+          mods (reinterpretIncMaster $ spiral (6/7)) |:
           mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
-          mods (Corner (3/4) (3/100)) |:
+          mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
           mods (ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2))) |:
           mods (ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2))) |:
           mods Grid |:
@@ -69,14 +69,14 @@ instance DoReinterpret "ForMosaic" where
   
   -- IncMaster message
   reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
-    (fmap $ SomeMessage .
+    fmap (SomeMessage .
       (if n > 0
         then expandWindowAlt
         else shrinkWindowAlt)) <$> getFocusedWindow
   
   -- ResizeMaster message
   reinterpretMessage _ (fromMessage -> Just m) = do
-    (fmap $ SomeMessage .
+    fmap (SomeMessage .
       (case m of
         Expand -> expandWindowAlt
         Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
@@ -84,6 +84,14 @@ instance DoReinterpret "ForMosaic" where
   -- Messages that don't match the above, just leave it unmodified.
   reinterpretMessage _ m = return (Just m)
 
+instance DoReinterpret "IncMasterToResizeMaster" where
+  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) =
+    return $ Just $
+      if n > 0
+        then SomeMessage Expand
+        else SomeMessage Shrink
+  reinterpretMessage _ m = return (Just m)
+
 -- Data construct for association a DoReinterpret function with a concrete
 -- construct that can be used in the LayoutModifier instance.
 --
@@ -117,6 +125,10 @@ instance (DoReinterpret k) =>
 modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a
 modifyMosaic = ModifiedLayout ReinterpretMessage
 
+reinterpretIncMaster ::
+  l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a
+reinterpretIncMaster = ModifiedLayout ReinterpretMessage
+
 mods =
   ModifiedLayout (Zoomable False 0.05 0.05) .
     ModifiedLayout (Flippable False) .
diff --git a/src/Internal/LayoutList.hs b/src/Internal/LayoutList.hs
new file mode 100644
index 0000000..2405f71
--- /dev/null
+++ b/src/Internal/LayoutList.hs
@@ -0,0 +1,297 @@
+{-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, MultiParamTypeClasses,
+ FlexibleContexts, UndecidableInstances, ViewPatterns, StandaloneDeriving,
+ RankNTypes, TupleSections, TypeFamilies #-}
+
+{-
+ - This module provides a more powerful version of the "Choose" layout that can
+ - be bidirectionally navigated.
+ -
+ - The indexing uses a type-safe zipper to keep track of the currently-selected
+ - layout.
+ -}
+module Internal.LayoutList (
+  LayoutList,
+  layoutZipper,
+  LCons,
+  LNil,
+  toNextLayout,
+  toPreviousLayout,
+  toFirstLayout,
+  (|:),
+  nil
+  )where
+
+import Control.Applicative ((<|>))
+import Data.Void
+import Control.Monad.Identity (runIdentity)
+import Data.Maybe (fromMaybe, fromJust)
+import Control.Arrow (second)
+import XMonad
+import qualified XMonad.StackSet as W
+import Data.Proxy
+
+-- Type-level lists. LNil is the final of the list. LCons contains a layout and a
+-- tail.
+data LNil a = LNil deriving (Read, Show)
+data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
+
+-- Sel - This defines a structure where either this selected, or some
+-- other element is selected.
+--
+-- These types can be composed to create what is effectively a bounded integer.
+-- I.e. there can be a type like
+--
+-- Sel (Sel (Sel (Sel End)))
+--
+-- Such a type is equivalent to an integer bounded at 4, because this type can
+-- exist in no more than 4 states:
+--
+-- Sel
+-- Skip Sel
+-- Skip (Skip Sel)
+-- Skip (Skip (Skip Sel))
+--
+-- Note that a type (Sel End) can only be in the Sel as End may not be
+-- construted (without using undefined).
+data Sel l =
+    Sel |
+    (Selector l) => Skip l
+deriving instance (Read l, Selector l) => Read (Sel l)
+deriving instance (Show l, Selector l) => Show (Sel l)
+deriving instance (Eq l, Selector l) => Eq (Sel l)
+
+-- Reimplement Void as End, just to keep the two separate, but End is for all
+-- intents and purposes Void.
+data End
+deriving instance Read End
+deriving instance Show End
+deriving instance Eq End
+
+
+-- Types that constitute a selection. Selections can be moved to the next
+-- selection, moved to the previous selection, optionally there could be a
+-- previous selection and they may be currently selected.
+class (Eq c) => Selector c where
+  -- Increments the selection to the next state
+  --
+  -- Returns Nothing if the selection class is in the final state and cannot be
+  -- incremented any farther. (This is helpful to facilitate modular
+  -- arithmatic)
+  increment :: c -> Maybe c
+
+  -- Decrements the selection to the previous state. Returns Nothing if the
+  -- state is already in its initial setting.
+  decrement :: c -> Maybe c
+
+  -- The initial state.
+  initial :: Maybe c
+
+  -- The final state.
+  final :: Maybe c
+
+--
+-- Is selelected can be in two states:
+--
+--   1. The current element is selected
+--   2. The current element is not selected and another element deeper in the
+--      structure is selected.
+instance (Selector t) => Selector (Sel t) where
+  -- If the current element is not selected, increment the tail.
+  increment (Skip l) = Skip <$> increment l
+  -- If the current element is selected, the increment is just the initial of
+  -- the tail.
+  increment Sel = Skip <$> initial 
+
+  -- For a selection, the initial is just this in the Sel state.
+  initial = Just Sel
+
+  -- Looks ahead at the tail, sees if it is selected, if so, select this one
+  -- instead, if the one ahead isn't selected, then decrement that one.
+  decrement (Skip t) = Just $ maybe Sel Skip (decrement t)
+  decrement Sel = Nothing
+
+  -- Navigates to the end of the structure to find the final form.
+  final = Just $ maybe Sel Skip final
+
+-- The End structure (which is equivalent to Void) is the "null" selector; the
+-- basecase that the Sel selector terminates at.
+instance Selector End where
+
+  -- Incrementing the End Selector doesn't do anything.
+  increment = const Nothing
+
+  -- Decrementing the End Selector doesn't do anythig
+  decrement = const Nothing
+
+  -- There is no initial value for the End selector.
+  initial = Nothing
+
+  -- There is not final state for the End selector.
+  final = Nothing
+
+-- Increment a selector, but cyclicly
+incrementCycle :: (Selector c) => c -> c
+incrementCycle c =
+  case increment c of
+    Nothing -> fromMaybe c initial
+    Just x -> x
+
+-- Add two selectors together, incrementing the first until the second cannot be
+-- incremented anymore.
+addSelector :: (Selector c) => c -> c -> c
+addSelector c1 c2 = addSel c1 (decrement c2)
+  where
+    addSel c1 Nothing = c1
+    addSel c1 (Just c2) = addSel (incrementCycle c1) (decrement c2)
+
+-- Turn an int into a selector by repeatably incrementing.
+intToSelector :: (Selector c) => Int -> c
+intToSelector 0 = fromJust initial
+intToSelector n = incrementCycle $ intToSelector (n - 1)
+
+-- A LayoutList consists of a LayoutSelect type and a corresponding Selector.
+data LayoutList l a where
+  LayoutList ::
+    (LayoutSelect l a, Selector (SelectorFor l)) =>
+      SelectorFor l -> l a -> LayoutList l a
+
+deriving instance (LayoutSelect l a) => Show (LayoutList l a)
+deriving instance (LayoutSelect l a) => Read (LayoutList l a)
+
+(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
+(|:) = LCons
+
+infixr 5 |: 
+
+-- Constructs a LayoutList. This function enforces that the SelectorFor l
+-- is a 'Sel' type. Essentially this enforces that there must be at least one
+-- underlying layout, otherwise a LayoutList cannot be constructed.
+layoutZipper :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
+  l a -> LayoutList l a
+layoutZipper = LayoutList Sel
+
+-- The termination of a layout zipper.
+nil :: LNil a
+nil = LNil
+
+-- Message to navigate to a layout.
+newtype NavigateLayout =
+          -- Sets the layout based on the given function.
+          NavigateLayout {
+            changeLayoutFn :: forall c. (Selector c) => c -> c
+          }
+          deriving (Typeable)
+
+-- NavigateLayout instance to move to the next layout, circularly.
+toNextLayout :: NavigateLayout
+toNextLayout = NavigateLayout $ addSelector (intToSelector 1)
+
+-- NavigateLayout instance to move to the previous layout, circularly.
+toPreviousLayout :: NavigateLayout
+toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
+
+-- NavigateLayotu instance to move to the first layout.
+toFirstLayout :: NavigateLayout
+toFirstLayout = NavigateLayout (`fromMaybe` initial)
+
+instance Message NavigateLayout where
+
+-- LayoutSelect class Describes a type that can be used to select a layout using
+-- the associated type SelectorFor.
+--
+-- Instances of this class are LCons and LNil.
+class (Show (l a),
+       Read (l a),
+       Read (SelectorFor l),
+       Show (SelectorFor l),
+       Selector (SelectorFor l)) => LayoutSelect l a where
+
+  -- The selector that is used to update the layout corresponding to the
+  -- selector. This selector must be an instance of the Selector class.
+  type SelectorFor l :: *
+
+  -- Update applies a functor to the selected layout and maybe returns a result
+  -- and an updated layout.
+  update :: forall r m. (Monad m) =>
+    -- The selector for this type. Determines which layout the function is
+    -- applied to.
+    SelectorFor l ->
+    -- The LayoutSelect being modified.
+    l a ->
+    -- Higher-ordered function to generically apply to the Layout associated
+    -- with the Selector. Works on all LayoutClass's.
+    (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
+
+    -- Returns a result r, and an updated LayoutSelect.
+    m (Maybe (r, l a))
+
+-- Instance for LayoutSelect for cons
+instance (Read (l a),
+          LayoutClass l a,
+          LayoutSelect t a,
+          Show (SelectorFor t),
+          Read (SelectorFor t)) =>
+    LayoutSelect (LCons l t) a where
+
+  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
+  -- Sel (Sel (Sel ( ... (Sel End) .. ))) where the number of Sel's match the
+  -- number of Cons in this structure enforcing safe selection.
+  type SelectorFor (LCons l t) = Sel (SelectorFor t)
+
+  -- The current layout in this Cons-list is selected.
+  update Sel (LCons layout t) fn = do
+    (r, layout') <- fn layout
+    return $ Just (r, LCons (fromMaybe layout layout') t)
+
+  -- The current layout is not selected. Move on to another layout.
+  update (Skip s) (LCons l t) fn =
+    fmap (second $ \t' -> LCons l t') <$> update s t fn
+
+-- LNil is a layout select. It doesn't do anything. Indeed update really can't
+-- be called on on this because that would require instantiating a End type.
+instance LayoutSelect LNil a where
+  type SelectorFor LNil = End -- LNil cannot be selected.
+  update _ _ _ = return Nothing
+
+-- Instance of layout class for LayoutList. The implementation for this
+-- just delegates to the underlying LayoutSelect class using the generic
+-- update method.
+instance (Show (l a), Typeable l, LayoutSelect l a) =>
+    LayoutClass (LayoutList l) a where
+
+  runLayout (W.Workspace i (LayoutList idx l) ms) r = do
+    r <- update idx l $ \layout ->
+            runLayout (W.Workspace i layout ms) r
+    case r of
+      Nothing -> return ([], Nothing)
+      Just (r, la) -> return (r, Just (LayoutList idx la))
+
+  pureLayout (LayoutList idx l) r s = runIdentity $ do
+    r <- update idx l $ \layout -> return (pureLayout layout r s, Nothing)
+    case r of
+      Nothing -> return []
+      Just (r, a) -> return r
+
+  emptyLayout (LayoutList idx l) r = do
+    r <- update idx l $ \layout -> emptyLayout layout r
+    case r of
+      Nothing -> return ([], Nothing)
+      Just (r, la) -> return (r, Just (LayoutList idx la))
+
+  handleMessage (LayoutList idx l) (fromMessage -> Just (NavigateLayout fn)) =
+    return $ Just (LayoutList (fn idx) l)
+
+  handleMessage (LayoutList idx l) m = do
+    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
+    return $ LayoutList idx . snd <$> r
+
+  pureMessage (LayoutList idx l) m = runIdentity $ do
+    r <- update idx l $ \layout -> return ((), pureMessage layout m)
+    return $ LayoutList idx . snd <$> r
+
+  description (LayoutList idx l) = runIdentity $ do
+    r <- update idx l $ \l -> return (description l, Nothing)
+    return $
+      case r of
+        Nothing -> "No Layout"
+        Just (descr, _) -> descr
diff --git a/src/Internal/LayoutZipper.hs b/src/Internal/LayoutZipper.hs
deleted file mode 100644
index 7fd4a5f..0000000
--- a/src/Internal/LayoutZipper.hs
+++ /dev/null
@@ -1,275 +0,0 @@
-{-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, MultiParamTypeClasses,
- FlexibleContexts, UndecidableInstances, ViewPatterns, StandaloneDeriving,
- RankNTypes, TupleSections, TypeFamilies #-}
-
-{-
- - This module provides a more powerful version of the "Choose" layout that can
- - be bidirectionally navigated.
- -
- - The indexing uses a type-safe zipper to keep track of the currently-selected
- - layout.
- -}
-module Internal.LayoutZipper (
-  LayoutZipper,
-  layoutZipper,
-  LCons,
-  LNil,
-  toNextLayout,
-  toPreviousLayout,
-  toFirstLayout,
-  (|:),
-  nil
-  )where
-
-import Control.Applicative ((<|>))
-import Data.Void
-import Control.Monad.Identity (runIdentity)
-import Data.Maybe (fromMaybe)
-import Control.Arrow (second)
-import XMonad
-import qualified XMonad.StackSet as W
-import Data.Proxy
-
--- Type-level lists. LNil is the final of the list. LCons contains a layout and a
--- tail.
-data LNil a = LNil deriving (Read, Show)
-data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
-
--- Sel - This defines a structure where either this selected, or some
--- other element is selected.
---
--- These types can be composed to create what is effectively a bounded integer.
--- I.e. there can be a type like
---
--- Sel (Sel (Sel (Sel Zero)))
---
--- Such a type is equivalent to an integer bounded at 4, because this type can
--- exist in no more than 4 states:
---
--- Sel
--- Skip Sel
--- Skip (Skip Sel)
--- Skip (Skip (Skip Sel))
---
--- Note that a type (Sel Zero) can only be in the Sel as Zero may not be
--- construted (without using undefined).
-data Sel l =
-    Sel |
-    (Selector l) => Skip l
-deriving instance (Read l, Selector l) => Read (Sel l)
-deriving instance (Show l, Selector l) => Show (Sel l)
-
--- Reimplement Void as Zero, just to keep the two separate, but Zero is for all
--- intents and purposes Void.
-data Zero
-deriving instance Read Zero
-deriving instance Show Zero
-
-
--- Types that constitute a selection. Selections can be moved to the next
--- selection, moved to the previous selection, optionally there could be a
--- previous selection and they may be currently selected.
-class Selector c where
-  -- Increments the selection to the next state
-  --
-  -- Returns Nothing if the selection class is in the final state and cannot be
-  -- incremented any farther. (This is helpful to facilitate modular
-  -- arithmatic)
-  increment :: c -> Maybe c
-
-  -- Decrements the selection to the previous state. Returns Nothing if the
-  -- state is already in its initial setting.
-  decrement :: c -> Maybe c
-
-  -- The initial state.
-  initial :: Maybe c
-
-  -- The final state.
-  final :: Maybe c
-
---
--- Is selelected can be in two states:
---
---   1. The current element is selected
---   2. The current element is not selected and another element deeper in the
---      structure is selected.
-instance (Selector t) => Selector (Sel t) where
-  -- If the current element is not selected, increment the tail.
-  increment (Skip l) = Skip <$> increment l
-  -- If the current element is selected, the increment is just the initial of
-  -- the tail.
-  increment Sel = Skip <$> initial 
-
-  -- For a selection, the initial is just this in the Sel state.
-  initial = Just Sel
-
-  -- Looks ahead at the tail, sees if it is selected, if so, select this one
-  -- instead, if the one ahead isn't selected, then decrement that one.
-  decrement (Skip t) = Just $ maybe Sel Skip (decrement t)
-  decrement Sel = Nothing
-
-  -- Navigates to the end of the structure to find the final form.
-  final = Just $ maybe Sel Skip final
-
--- The Zero structure (which is equivalent to Void) is the "null" selector; the
--- basecase that the Sel selector terminates at.
-instance Selector Zero where
-
-  -- Incrementing the Zero Selector doesn't do anything.
-  increment = const Nothing
-
-  -- Decrementing the Zero Selector doesn't do anythig
-  decrement = const Nothing
-
-  -- There is no initial value for the Zero selector.
-  initial = Nothing
-
-  -- There is not final state for the Zero selector.
-  final = Nothing
-
--- A LayoutZipper consists of a LayoutSelect type and a corresponding Selector.
-data LayoutZipper l a where
-  LayoutZipper ::
-    (LayoutSelect l a, Selector (SelectorFor l)) =>
-      SelectorFor l -> l a -> LayoutZipper l a
-
-deriving instance (LayoutSelect l a) => Show (LayoutZipper l a)
-deriving instance (LayoutSelect l a) => Read (LayoutZipper l a)
-
-(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
-(|:) = LCons
-
-infixr 5 |: 
-
--- Constructs a LayoutZipper. This function enforces that the SelectorFor l
--- is a 'Sel' type. Essentially this enforces that there must be at least one
--- underlying layout, otherwise a LayoutZipper cannot be constructed.
-layoutZipper :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
-  l a -> LayoutZipper l a
-layoutZipper = LayoutZipper Sel
-
--- The termination of a layout zipper.
-nil :: LNil a
-nil = LNil
-
--- Message to navigate to a layout.
-newtype NavigateLayout =
-          -- Sets the layout based on the given function.
-          NavigateLayout {
-            changeLayoutFn :: forall c. (Selector c) => c -> c
-          }
-          deriving (Typeable)
-
--- NavigateLayout instance to move to the next layout, circularly.
-toNextLayout :: NavigateLayout
-toNextLayout = NavigateLayout $ \c -> fromMaybe c (increment c <|> initial)
-
--- NavigateLayout instance to move to the previous layout, circularly.
-toPreviousLayout :: NavigateLayout
-toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
-
--- NavigateLayotu instance to move to the first layout.
-toFirstLayout :: NavigateLayout
-toFirstLayout = NavigateLayout (`fromMaybe` initial)
-
-instance Message NavigateLayout where
-
--- LayoutSelect class Describes a type that can be used to select a layout using
--- the associated type SelectorFor.
---
--- Instances of this class are LCons and LNil.
-class (Show (l a),
-       Read (l a),
-       Read (SelectorFor l),
-       Show (SelectorFor l),
-       Selector (SelectorFor l)) => LayoutSelect l a where
-
-  -- The selector that is used to update the layout corresponding to the
-  -- selector. This selector must be an instance of the Selector class.
-  type SelectorFor l :: *
-
-  -- Update applies a functor to the selected layout and maybe returns a result
-  -- and an updated layout.
-  update :: forall r m. (Monad m) =>
-    -- The selector for this type. Determines which layout the function is
-    -- applied to.
-    SelectorFor l ->
-    -- The LayoutSelect being modified.
-    l a ->
-    -- Higher-ordered function to generically apply to the Layout associated
-    -- with the Selector. Works on all LayoutClass's.
-    (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
-
-    -- Returns a result r, and an updated LayoutSelect.
-    m (Maybe (r, l a))
-
--- Instance for LayoutSelect for cons
-instance (Read (l a),
-          LayoutClass l a,
-          LayoutSelect t a,
-          Show (SelectorFor t),
-          Read (SelectorFor t)) =>
-    LayoutSelect (LCons l t) a where
-
-  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
-  -- Sel (Sel (Sel ( ... (Sel Zero) .. ))) where the number of Sel's match the
-  -- number of Cons in this structure enforcing safe selection.
-  type SelectorFor (LCons l t) = Sel (SelectorFor t)
-
-  -- The current layout in this Cons-list is selected.
-  update Sel (LCons layout t) fn = do
-    (r, layout') <- fn layout
-    return $ Just (r, LCons (fromMaybe layout layout') t)
-
-  -- The current layout is not selected. Move on to another layout.
-  update (Skip s) (LCons l t) fn =
-    fmap (second $ \t' -> LCons l t') <$> update s t fn
-
--- LNil is a layout select. It doesn't do anything. Indeed update really can't
--- be called on on this because that would require instantiating a Zero type.
-instance LayoutSelect LNil a where
-  type SelectorFor LNil = Zero -- LNil cannot be selected.
-  update _ _ _ = return Nothing
-
--- Instance of layout class for LayoutZipper. The implementation for this
--- just delegates to the underlying LayoutSelect class using the generic
--- update method.
-instance (Show (l a), Typeable l, LayoutSelect l a) =>
-    LayoutClass (LayoutZipper l) a where
-
-  runLayout (W.Workspace i (LayoutZipper idx l) ms) r = do
-    r <- update idx l $ \layout ->
-            runLayout (W.Workspace i layout ms) r
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutZipper idx la))
-
-  pureLayout (LayoutZipper idx l) r s = runIdentity $ do
-    r <- update idx l $ \layout -> return (pureLayout layout r s, Nothing)
-    case r of
-      Nothing -> return []
-      Just (r, a) -> return r
-
-  emptyLayout (LayoutZipper idx l) r = do
-    r <- update idx l $ \layout -> emptyLayout layout r
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutZipper idx la))
-
-  handleMessage (LayoutZipper idx l) (fromMessage -> Just (NavigateLayout fn)) =
-    return $ Just (LayoutZipper (fn idx) l)
-
-  handleMessage (LayoutZipper idx l) m = do
-    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
-    return $ LayoutZipper idx . snd <$> r
-
-  pureMessage (LayoutZipper idx l) m = runIdentity $ do
-    r <- update idx l $ \layout -> return ((), pureMessage layout m)
-    return $ LayoutZipper idx . snd <$> r
-
-  description (LayoutZipper idx l) = runIdentity $ do
-    r <- update idx l $ \l -> return (description l, Nothing)
-    return $
-      case r of
-        Nothing -> "No Layout"
-        Just (descr, _) -> descr
-- 
cgit 


From bf2e2459f800f953d95681a937051fcf56ac79aa Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 10 Apr 2022 12:14:22 -0600
Subject: Minor changes

---
 src/Internal/Keys.hs   | 8 +++++---
 src/Internal/Layout.hs | 2 +-
 2 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 01e438c..ad9d719 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -137,6 +137,8 @@ keymap = runKeys $ do
         case str of
           ['\''] -> jumpToLast
           [ch] | isAlphaNum ch -> jumpToMark ch
+          "[" -> historyPrev
+          "]" -> historyNext
           _ -> return ()
 
     shiftMod $
@@ -250,7 +252,7 @@ keymap = runKeys $ do
 
   bind xK_g $ do
     justMod $
-      doc ("Goto a workspace\n\n\t\
+      doc "Goto a workspace\n\n\t\
 
       \If the second character typed is alpha-numberic, jump to that\n\t\
       \workspace. The workspace is created on-the-fly if such a workspace\n\t\
@@ -262,7 +264,7 @@ keymap = runKeys $ do
          \}: cycle the workspaces on the screens to the right\n\t\t\
          \{: cycle the workspaces on the screens to the left\n\t\t\
          \<space>: Jump to the accompaning workspace.\n\t\t\
-         \F1: display this help.\n") $
+         \F1: display this help.\n" $
       mapNextStringWithKeysym $ \_ keysym str ->
         case (keysym, str) of
           (_, [ch]) | isAlphaNum ch -> gotoWorkspace ch
@@ -656,7 +658,7 @@ mouseMap = runButtons $ do
   bind button15 $ do
 
     noMod $ subMouse $ do
-      bind button13 $ noMod $ noWindow $ gotoAccompaningWorkspace
+      bind button13 $ noMod $ noWindow gotoAccompaningWorkspace
 
       bind button15 $ do
         noMod $ noWindow jumpToLast
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index 6c78c70..229e958 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -43,7 +43,7 @@ myLayout =
           mods (ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2))) |:
           mods Grid |:
           mods (Dishes 2 (1/6)) |:
-          mods (D.Dwindle D.R D.CW 1.5 1.1) |:
+          mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1) |:
           nil
 
 -- This is a type class that defines how to reinterpret a message. One can think
-- 
cgit 


From fada61902291aeb29914fff288301a8c487c4ecd Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 10 Apr 2022 13:26:16 -0600
Subject: Rename Internal to Rahm.Desktop

---
 src/Internal/CornerLayout.hs     |  58 ---
 src/Internal/DMenu.hs            |  45 ---
 src/Internal/Hash.hs             |  11 -
 src/Internal/Keys.hs             | 820 ---------------------------------------
 src/Internal/KeysM.hs            | 497 ------------------------
 src/Internal/Layout.hs           | 326 ----------------
 src/Internal/LayoutDraw.hs       | 155 --------
 src/Internal/LayoutList.hs       | 297 --------------
 src/Internal/Lib.hs              | 160 --------
 src/Internal/Logger.hs           |  32 --
 src/Internal/Marking.hs          | 204 ----------
 src/Internal/MouseMotion.hs      |  97 -----
 src/Internal/NoPersist.hs        |  23 --
 src/Internal/PassMenu.hs         |  13 -
 src/Internal/PromptConfig.hs     |  12 -
 src/Internal/RebindKeys.hs       | 119 ------
 src/Internal/ScreenRotate.hs     |  19 -
 src/Internal/Submap.hs           | 104 -----
 src/Internal/Swallow.hs          |  29 --
 src/Internal/SwapMaster.hs       |  41 --
 src/Internal/Windows.hs          |  86 ----
 src/Internal/XMobarLog.hs        |  78 ----
 src/Main.hs                      |  18 +-
 src/Rahm/Desktop/CornerLayout.hs |  58 +++
 src/Rahm/Desktop/DMenu.hs        |  45 +++
 src/Rahm/Desktop/Hash.hs         |  11 +
 src/Rahm/Desktop/Keys.hs         | 820 +++++++++++++++++++++++++++++++++++++++
 src/Rahm/Desktop/KeysM.hs        | 497 ++++++++++++++++++++++++
 src/Rahm/Desktop/Layout.hs       | 326 ++++++++++++++++
 src/Rahm/Desktop/LayoutDraw.hs   | 155 ++++++++
 src/Rahm/Desktop/LayoutList.hs   | 297 ++++++++++++++
 src/Rahm/Desktop/Lib.hs          | 160 ++++++++
 src/Rahm/Desktop/Logger.hs       |  32 ++
 src/Rahm/Desktop/Marking.hs      | 204 ++++++++++
 src/Rahm/Desktop/MouseMotion.hs  |  97 +++++
 src/Rahm/Desktop/NoPersist.hs    |  23 ++
 src/Rahm/Desktop/PassMenu.hs     |  13 +
 src/Rahm/Desktop/PromptConfig.hs |  12 +
 src/Rahm/Desktop/RebindKeys.hs   | 119 ++++++
 src/Rahm/Desktop/ScreenRotate.hs |  19 +
 src/Rahm/Desktop/Submap.hs       | 104 +++++
 src/Rahm/Desktop/Swallow.hs      |  29 ++
 src/Rahm/Desktop/SwapMaster.hs   |  41 ++
 src/Rahm/Desktop/Windows.hs      |  86 ++++
 src/Rahm/Desktop/XMobarLog.hs    |  78 ++++
 45 files changed, 3235 insertions(+), 3235 deletions(-)
 delete mode 100644 src/Internal/CornerLayout.hs
 delete mode 100644 src/Internal/DMenu.hs
 delete mode 100644 src/Internal/Hash.hs
 delete mode 100644 src/Internal/Keys.hs
 delete mode 100644 src/Internal/KeysM.hs
 delete mode 100644 src/Internal/Layout.hs
 delete mode 100644 src/Internal/LayoutDraw.hs
 delete mode 100644 src/Internal/LayoutList.hs
 delete mode 100644 src/Internal/Lib.hs
 delete mode 100644 src/Internal/Logger.hs
 delete mode 100644 src/Internal/Marking.hs
 delete mode 100644 src/Internal/MouseMotion.hs
 delete mode 100644 src/Internal/NoPersist.hs
 delete mode 100644 src/Internal/PassMenu.hs
 delete mode 100644 src/Internal/PromptConfig.hs
 delete mode 100644 src/Internal/RebindKeys.hs
 delete mode 100644 src/Internal/ScreenRotate.hs
 delete mode 100644 src/Internal/Submap.hs
 delete mode 100644 src/Internal/Swallow.hs
 delete mode 100644 src/Internal/SwapMaster.hs
 delete mode 100644 src/Internal/Windows.hs
 delete mode 100644 src/Internal/XMobarLog.hs
 create mode 100644 src/Rahm/Desktop/CornerLayout.hs
 create mode 100644 src/Rahm/Desktop/DMenu.hs
 create mode 100644 src/Rahm/Desktop/Hash.hs
 create mode 100644 src/Rahm/Desktop/Keys.hs
 create mode 100644 src/Rahm/Desktop/KeysM.hs
 create mode 100644 src/Rahm/Desktop/Layout.hs
 create mode 100644 src/Rahm/Desktop/LayoutDraw.hs
 create mode 100644 src/Rahm/Desktop/LayoutList.hs
 create mode 100644 src/Rahm/Desktop/Lib.hs
 create mode 100644 src/Rahm/Desktop/Logger.hs
 create mode 100644 src/Rahm/Desktop/Marking.hs
 create mode 100644 src/Rahm/Desktop/MouseMotion.hs
 create mode 100644 src/Rahm/Desktop/NoPersist.hs
 create mode 100644 src/Rahm/Desktop/PassMenu.hs
 create mode 100644 src/Rahm/Desktop/PromptConfig.hs
 create mode 100644 src/Rahm/Desktop/RebindKeys.hs
 create mode 100644 src/Rahm/Desktop/ScreenRotate.hs
 create mode 100644 src/Rahm/Desktop/Submap.hs
 create mode 100644 src/Rahm/Desktop/Swallow.hs
 create mode 100644 src/Rahm/Desktop/SwapMaster.hs
 create mode 100644 src/Rahm/Desktop/Windows.hs
 create mode 100644 src/Rahm/Desktop/XMobarLog.hs

diff --git a/src/Internal/CornerLayout.hs b/src/Internal/CornerLayout.hs
deleted file mode 100644
index 5545aef..0000000
--- a/src/Internal/CornerLayout.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
--- Creates a layout, the "corner layout" that keeps the master window in the
--- corner and the other windows go around it.
-module Internal.CornerLayout where
-
-import Data.Typeable (Typeable)
-import XMonad (LayoutClass(..), Rectangle(..), Resize(..), fromMessage)
-import qualified XMonad.StackSet as S
-
-data Corner a = Corner Rational Rational
-  deriving (Show, Typeable, Read)
-
-instance LayoutClass Corner a where
-  pureLayout (Corner frac _) screen@(Rectangle x y w h) ss =
-    let w' = floor $ fromIntegral w * frac
-        h' = floor $ fromIntegral h * frac
-        corner = Rectangle 0 0 w' h'
-        vertRect = Rectangle (fromIntegral w') 0 (w - w') h
-        horizRect = Rectangle 0 (fromIntegral h') w' (h - h')
-        ws = S.integrate ss
-
-        vn = (length ws - 1) `div` 2
-        hn = (length ws - 1) - vn
-      in
-        case ws of
-          [a] -> [(a, screen)]
-          [a, b] -> [
-            (a, Rectangle x y w' h),
-            (b, Rectangle (x + fromIntegral w') y (w - w') h)]
-          _ ->
-            zip ws $ map (
-                \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h) $
-              corner :
-                splitVert vertRect vn ++
-                splitHoriz horizRect hn
-
-  pureMessage (Corner frac delta) m = fmap resize (fromMessage m)
-    where
-      resize Shrink = Corner (frac - delta) delta
-      resize Expand = Corner (frac + delta) delta
-
-splitVert :: Rectangle -> Int -> [Rectangle]
-splitVert (Rectangle x y w h) i' =
-  map
-    (\i -> Rectangle x (y + fromIntegral (step * i)) w step)
-    [0 .. i - 1]
-  where
-    i = fromIntegral i'
-    step = h `div` i
-
-splitHoriz :: Rectangle -> Int -> [Rectangle]
-splitHoriz (Rectangle x y w h) i' =
-  map
-    (\i -> Rectangle (x + fromIntegral (step * i)) y step h)
-    [0 .. i - 1]
-  where
-    step = w `div` i
-    i = fromIntegral i'
diff --git a/src/Internal/DMenu.hs b/src/Internal/DMenu.hs
deleted file mode 100644
index 0d22b55..0000000
--- a/src/Internal/DMenu.hs
+++ /dev/null
@@ -1,45 +0,0 @@
-module Internal.DMenu where
-
-import XMonad.Util.Dmenu
-import XMonad
-import Control.Monad
-import Data.Map (Map)
-import qualified Data.Map as Map
-import XMonad.Util.Run
-import Data.List (intercalate)
-import Text.Printf (printf)
-
-data Colors =
-  Colors {
-    fg :: String,
-    bg :: String
-  }  | DefaultColors
-
-menuCommand :: [String]
-menuCommand = ["rofi", "-monitor", "-4", "-dmenu", "-sort", "-levenshtein-sort"]
-
-menuCommandString :: String
-menuCommandString = unwords menuCommand
-
-runDMenu :: X ()
-runDMenu = void $
-  safeSpawn
-    "rofi"
-    ["-monitor", "-4", "-display-run", "Execute", "-show", "run"]
-
-runDMenuPrompt :: String -> Maybe String -> [String] -> X String
-runDMenuPrompt prompt color select =
-  let realColor = maybe [] (\c -> ["-sb", c, "-nf", c]) color
-       in
-    runProcessWithInput "/home/rahm/.local/bin/dmenu_debug.sh" ([
-      "-p", prompt,
-      "-l", "12",
-      "-dim", "0.4" ]  ++ realColor) (intercalate "\n" select)
-
-
-runDMenuPromptWithMap :: String -> Maybe String -> Map String a -> X (Maybe a)
-runDMenuPromptWithMap prompt color map = do
-  let realColor = maybe [] (
-          \c -> ["-theme-str", printf "* {theme-color: %s;}" c]) color
-  menuMapArgs (head menuCommand)
-    (tail menuCommand ++ ["-p", prompt] ++ realColor) map
diff --git a/src/Internal/Hash.hs b/src/Internal/Hash.hs
deleted file mode 100644
index 272808b..0000000
--- a/src/Internal/Hash.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Internal.Hash where
-
-import Numeric (showHex)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BC
-import qualified Crypto.Hash.SHA1 as SHA1
-
-quickHash :: String -> String
-quickHash str =
-    concatMap (`showHex` "") $ BS.unpack (SHA1.hash $ BC.pack str)
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
deleted file mode 100644
index ad9d719..0000000
--- a/src/Internal/Keys.hs
+++ /dev/null
@@ -1,820 +0,0 @@
-{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-}
-module Internal.Keys (applyKeys) where
-
-import XMonad.Util.Run (safeSpawn)
-import Data.Monoid (Endo(..))
-import Control.Monad.Trans.Class
-import Control.Monad.Reader
-import Control.Monad.Writer
-import Control.Monad.Loops (iterateWhile)
-import Control.Monad.Fix (fix)
-import Graphics.X11.ExtraTypes.XF86;
-import Internal.KeysM
-import Internal.SwapMaster (swapMaster)
-import XMonad.Hooks.ManageDocks
-import XMonad.Layout.MosaicAlt
-import Graphics.X11.ExtraTypes.XorgDefault
-import System.Process
-import XMonad.Util.Ungrab
-import XMonad.Layout.Spacing
-import Data.Maybe (isJust, fromMaybe)
-import Debug.Trace
-import Control.Applicative
-import Prelude hiding ((!!))
-import Control.Monad
-import Data.Char
-import Data.List hiding ((!!))
-import Data.List.Safe ((!!))
-import Data.Map (Map)
-import Internal.Layout
-import Internal.Marking
-import Internal.PromptConfig
-import System.IO
-import Text.Printf
-import XMonad
-import Internal.Submap
-import XMonad.Actions.WindowNavigation
-import XMonad.Prompt
-import XMonad.Prompt.Input
-import XMonad.Prompt.Shell
-import XMonad.Util.CustomKeys
-import XMonad.Util.Scratchpad
-import XMonad.Actions.RotSlaves
-import XMonad.Actions.CopyWindow as CopyWindow
-import XMonad.Actions.SpawnOn as SpawnOn
-
-import qualified Data.Map as Map
-import qualified XMonad.StackSet as W
-
-import Internal.LayoutList
-import Internal.MouseMotion
-import Internal.Windows
-import Internal.Lib
-import Internal.DMenu
-import Internal.PassMenu
-import Internal.Logger
-import Internal.RebindKeys
-import Internal.Swallow
-import Internal.ScreenRotate (screenRotateForward, screenRotateBackward)
-
-type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
-type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
-
-
-spawnX :: String -> X ()
-spawnX = spawn
-
-noWindow :: b -> Window -> b
-noWindow = const
-
-decreaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ -5%"
-increaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ +5%"
-playPause = spawnX "spotify-control play"
-mediaPrev = spawnX "spotify-control prev"
-mediaNext = spawnX "spotify-control next"
-
-decreaseVolumeDoc = doc "Decrease volume" decreaseVolume
-increaseVolumeDoc = doc "Increase volume" increaseVolume
-playPauseDoc = doc "Play/Pause current media" playPause
-mediaPrevDoc = doc "Previous media" mediaPrev
-mediaNextDoc = doc "Next media" mediaNext
-
-
-button6 :: Button
-button6 = 6
-
-button7 :: Button
-button7 = 7
-
-button8 :: Button
-button8 = 8
-
-button9 :: Button
-button9 = 9
-
-button10 :: Button
-button10 = 10
-
-button11 :: Button
-button11 = 11
-
-button12 :: Button
-button12 = 12
-
-button13 :: Button
-button13 = 13
-
-button14 :: Button
-button14 = 14
-
-button15 :: Button
-button15 = 15
-
-keyBindingToKeymap :: (XConfig l -> KeyBindings) -> KeyMap l
-keyBindingToKeymap bindings config = fmap bindingToX (bindings config)
-
-  where
-    bindingToX b =
-      case b of
-        Documented _ (Action x) -> x
-        Documented _ (Submap mapping) ->
-          submap (fmap bindingToX mapping)
-        Documented _ (Repeat mapping) ->
-          fix $ \recur ->
-            submap (fmap (\b -> bindingToX b >> recur) mapping)
-
-keymap :: XConfig l -> KeyBindings
-keymap = runKeys $ do
-  config <- getConfig
-
-  let subkeys keysM = Submap (runKeys keysM config)
-      repeatable keysM = Repeat (runKeys keysM config)
-
-  bind xK_apostrophe $ do
-    justMod $
-      doc "Jumps between marks." $
-      mapNextString $ \_ str ->
-        case str of
-          ['\''] -> jumpToLast
-          [ch] | isAlphaNum ch -> jumpToMark ch
-          "[" -> historyPrev
-          "]" -> historyNext
-          _ -> return ()
-
-    shiftMod $
-      doc "Swap the current window with a mark." $
-      mapNextString $ \_ str ->
-        case str of
-          ['\''] ->  swapWithLastMark
-          [ch] | isAlphaNum ch -> swapWithMark ch
-          _ -> return ()
-
-  bind xK_BackSpace $ do
-    -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
-    -- something goes wrong with the keyboard layout and for first-time boots
-    -- where dmenu/alacritty may not be installed.
-    rawMask mod4Mask $
-      doc "Spawns XTerm as a fallback if xkb is messed up." $
-      spawnX "xterm"
-
-    -- Moves xmobar to different monitors.
-    justMod $
-      doc "Move XMobar to another screen." $
-      spawnX "pkill -SIGUSR1 xmobar"
-
-  bind xK_F1 $ do
-    -- Experimental. Sends 'a' to all windows.
-    --
-    -- I've discovered that many clients ignore such synthetic events, including
-    -- Spotify, Chrome and Gedit. Some, like Chrome, seem to honor them if it's
-    -- focused. It's pretty annoying because it keeps me from doing some cool
-    -- things all for BS security theater, but I guess there might be some way
-    -- to do this via XTest?
-    shiftMod $ forAllWindows  $ \w -> do
-      logs $ "Try send to " ++ show w
-      sendKey (0, xK_a) w
-
-    justMod $
-      doc "Print this documentation"
-      (safeSpawn "gxmessage" [
-        "-fn", "Source Code Pro",
-        documentation (keymap config)] :: X ())
-
-  bind xK_F7 $
-
-    justMod $
-      doc "Print this documentation." $
-      logs (documentation (keymap config))
-
-  bind xK_F10 $ do
-    justMod playPauseDoc
-
-  bind xK_F11 $ do
-    justMod mediaPrevDoc
-
-  bind xK_F12 $ do
-    justMod mediaNextDoc
-
-  bind xK_Return $ do
-    justMod swapMaster
-
-  bind xK_Tab $ do
-    justMod  $ windows W.focusDown
-    shiftMod $ windows W.focusUp
-
-  -- Switch between different screens. These are the leftmost keys on the home
-  -- row in a Dvorak layout. One might want to switch these to ASD for QWERTY.
-  forM_ (zip [xK_a, xK_o, xK_e] [0..]) $ \(key, idx) ->
-    bind key $ do
-      -- Move focus to that screen.
-      justMod  $
-        doc ("Switch focus to screen " ++ show idx) $
-        withScreen W.view idx
-      -- Swap the current screen with the one given
-      altMod   $
-        doc ("Swap the current screen with screen " ++ show idx) $
-        withScreen W.greedyView idx
-      -- Move the current window to the select screen.
-      shiftMod $
-        doc ("Move the current window to screne " ++ show idx) $
-        withScreen W.shift idx
-
-      altgrMod $
-        logs "Test altgr"
-
-  bind xK_bracketright $ do
-    justMod $
-      doc "Increase the gaps between windows." $
-      sendMessage $ modifyWindowBorder 5
-
-  bind xK_bracketleft $ do
-    justMod $
-      doc "Decrease the gaps between windows." $
-      sendMessage $ modifyWindowBorder (-5)
-
-  bind xK_b $ do
-    justMod $ spawnX "bluetooth-select.sh"
-
-  bind xK_c $ do
-    justMod $
-      doc "Run PassMenu" runPassMenu
-
-    shiftMod $
-      doc "Kill the current window" CopyWindow.kill1
-
-  bind xK_f $ do
-    justMod  $
-      doc "Flip the current layout vertically" $
-      sendMessage FlipLayout
-    shiftMod $
-      doc "Flip the current layout horizontally" $
-      sendMessage HFlipLayout
-
-  bind xK_g $ do
-    justMod $
-      doc "Goto a workspace\n\n\t\
-
-      \If the second character typed is alpha-numberic, jump to that\n\t\
-      \workspace. The workspace is created on-the-fly if such a workspace\n\t\
-      \does not exist.\n\n\t\
-
-      \If the second character typed is:\n\t\t\
-         \]: go to the next workspace\n\t\t\
-         \[: go to the previous workspace\n\t\t\
-         \}: cycle the workspaces on the screens to the right\n\t\t\
-         \{: cycle the workspaces on the screens to the left\n\t\t\
-         \<space>: Jump to the accompaning workspace.\n\t\t\
-         \F1: display this help.\n" $
-      mapNextStringWithKeysym $ \_ keysym str ->
-        case (keysym, str) of
-          (_, [ch]) | isAlphaNum ch -> gotoWorkspace ch
-          (_, "]") -> pushHistory $ withRelativeWorkspace next W.greedyView
-          (_, "[") -> pushHistory $ withRelativeWorkspace prev W.greedyView
-          (_, "}") -> windows screenRotateForward
-          (_, "{") -> windows screenRotateBackward
-          (_, " ") -> gotoAccompaningWorkspace
-
-          -- Test binding. Tests that I can still submap keysyms alone (keys
-          -- where XLookupString won't return anything helpful.)
-          (f, _) | f == xK_F1 -> 
-            (safeSpawn "gxmessage" [
-              "-fn", "Source Code Pro",
-              documentation (keymap config)] :: X ())
-
-          _ -> return ()
-    shiftMod $
-      doc "Move the currently focused window to another workspace" $
-      mapNextString $ \_ str ->
-        case str of
-          [ch] | isAlphaNum ch -> shiftToWorkspace ch
-          "]" -> withRelativeWorkspace next W.shift
-          "[" -> withRelativeWorkspace prev W.shift
-          _ -> return ()
-    shiftAltMod $
-      doc "Swap this workspace with another workspace (rename)." $
-      mapNextString $ \_ str ->
-        case str of
-          [ch] | isAlphaNum ch -> swapWorkspace ch
-          _ -> return ()
-
-  bind xK_h $ do
-    justMod $
-      doc "Focus on the next window down in the stack" $
-      windows W.focusDown
-
-    shiftMod $
-      doc "Swap the current window with the next one down in the stack" $
-      windows W.swapDown
-
-    controlMod $
-      doc "Rotate all the windows down the stack"
-      rotAllDown
-
-  bind xK_j $ do
-    justMod $
-      doc "Shrink the size of the zoom region" $
-      sendMessage ShrinkZoom
-
-    shiftMod $
-      doc "Go to the previous window in history." historyPrev
-
-  bind xK_k $ do
-    justMod $
-      doc "Expand the size of the zoom region" $
-      sendMessage ExpandZoom
-
-    shiftMod $
-      doc "Go to the next window in history." historyNext
-
-  bind xK_l $ do
-    justMod    $
-      doc "Focus the next window in the stack" $
-      windows W.focusUp
-
-    shiftMod   $
-      doc "Swap the currently focused window with the next window in the stack." $
-      windows W.swapUp
-
-    controlMod $
-      doc "Rotate the windows up."
-      rotAllUp
-
-    altMod $
-      doc "Lock the screen" $
-      spawnX "xsecurelock"
-
-  bind xK_minus $ do
-    justMod  $
-      doc "Decrease the number of windows in the  master region." $
-      sendMessage (IncMasterN (-1))
-
-    shiftMod $
-      doc "For mosaic layout, shrink the size-share of the current window" $
-      withFocused $ sendMessage . shrinkWindowAlt
-
-  bind xK_m $ do
-    justMod $
-      doc "Mark the current window with the next typed character." $
-      mapNextString $ \_ str ->
-        case str of
-          [ch] | isAlphaNum ch -> markCurrentWindow ch
-          _ -> return ()
-
-  bind xK_n $ do
-    justMod $
-      doc "Shift to the next workspace." $
-      withRelativeWorkspace next W.greedyView
-
-  bind xK_p $ do
-    justMod $
-      doc "Shift to the previous workspace." $
-      withRelativeWorkspace prev W.greedyView
-
-  bind xK_plus $ do
-    justMod $
-      doc "Increase the number of windows in the master region." $
-      sendMessage (IncMasterN 1)
-
-    shiftMod $
-      doc "For mosaic layout, increase the size-share of the current window." $
-      withFocused $ sendMessage . expandWindowAlt
-
-  bind xK_q $ do
-    shiftMod $
-      doc "Recompile and restart XMonad" $
-      spawnX "xmonad --recompile && xmonad --restart"
-
-    justMod $
-      doc "Experimental Bindings" $
-      subkeys $ do
-
-      bind xK_q $
-        (justMod -|- noMod) $
-          doc "EXPERIMENTAL: Move mouse to control media." $
-            mouseRotateMotion (logs "CW") (logs "CCW")
-
-  bind xK_r $ do
-    justMod $ doc "Run a command via Rofi" runDMenu
-    shiftMod $
-      doc "Rotate the current layout. (flips x, y coordinates)" $
-      sendMessage DoRotate
-
-  bind xK_s $ do
-    altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
-
-  bind xK_space $ do
-    justMod  $
-      doc "Use the next layout in the layout list." $ sendMessage toNextLayout
-
-    altMod   $
-      doc "Reset the layout to the default layout." $ sendMessage toFirstLayout
-
-    shiftMod $
-      doc "Use the previous layout in the layout list." $
-        sendMessage toPreviousLayout
-
-  bind xK_t $ do
-    justMod  $
-      doc "Spawn a terminal." $ spawnX (terminal config)
-
-    shiftMod $
-      doc "Sink the current window into the tiling." $ withFocused $ windows . W.sink
-
-    altMod   $
-      doc "Spawn a floating terminal" $ spawnX (terminal config ++ " -t Floating\\ Term")
-
-  bind xK_v $
-    -- Allows repeated strokes of M-h and M-l to reduce and increase volume
-    -- respectively.
-    justMod $
-      doc "Changes the volume." $
-      repeatable $ do
-        bind xK_h $
-          justMod $
-             doc "Decrease volume."
-             decreaseVolumeDoc
-
-        bind xK_l $
-          justMod $
-             doc "Increase volume."
-             increaseVolumeDoc
-
-        bind xK_v $
-          justMod (return () :: X ())
-
-  bind xK_w $ do
-    justMod $ doc "Jump to a window (via rofi)" windowJump
-
-  bind xK_x $ do
-    justMod $
-      doc "Toggles respect for struts." $
-      sendMessage ToggleStruts
-
-  bind xK_z $ do
-
-    justMod $
-      doc "Less often used keybindings." $
-      subkeys $ do
-
-        bind xK_g $ do
-          (justMod -|- noMod) $
-            doc "Copy a window to the given workspace" $
-            mapNextString $ \_ s ->
-              case s of
-                [ch] | isAlphaNum ch -> windows (CopyWindow.copy s)
-                _ -> return ()
-
-        bind xK_p $ do
-          (justMod -|- noMod) $
-            doc "Go to the prior window in the history" historyPrev
-
-        bind xK_t $ do
-          (justMod -|- noMod) $ logs "Test Log"
-
-        -- bind xK_n $ do
-        --   (justMod -|- noMod) $
-        --     doc "Take a note" $
-        --     spawnX (terminal config ++ " -t Notes -e notes new")
-        bind xK_n $ do
-          (justMod -|- noMod) $
-            doc "Go to the next window in the history" historyNext
-
-        bind xK_c $ do
-          shiftMod $
-            doc "Kill all other copies of a window."
-            CopyWindow.killAllOtherCopies
-
-        bind xK_e $ do
-          (justMod -|- noMod) $
-            doc "Select an emoji" $
-            spawnX "emoji-select.sh"
-
-          (shiftMod -|- rawMask shiftMask) $
-            doc "Select an emoticon" $
-            spawnX "emoticon-select.sh"
-
-        bind xK_a $
-          (justMod -|- noMod) $
-            doc "Move the audio sink for an application." $
-            spawnX "set-sink.sh"
-
-        bind xK_w $
-          (justMod -|- noMod) $
-            doc "Select a network to connect to." $
-            spawnX "networkmanager_dmenu"
-
-        bind xK_o $
-          (justMod -|- noMod) $
-            doc "Open a file from the library" $
-            spawnX "library-view.sh"
-
-        bind xK_s $
-          (justMod -|- noMod) $
-            doc "Toggle the ability for terminals to swallow child windows."
-            toggleSwallowEnabled
-
-        bind xK_v $ do
-          (justMod -|- noMod) $
-            doc "Set the volume via rofi." $
-            spawnX "set-volume.sh"
-          (shiftMod -|- rawMask shiftMask) $
-            doc "Set the volume of an application via rofi." $
-            spawnX "set-volume.sh -a"
-
-        -- Double-tap Z to toggle zoom.
-        bind xK_z $ do
-          noMod -|- justMod $
-            doc "Toggle zoom on the current window." $
-            sendMessage ToggleZoom
-
-        -- Z is reserved to create sub keybindings to do various things.
-        -- I don't really use these at the moment.
-        bind xK_h $ noMod mediaPrevDoc
-        bind xK_j $ noMod playPauseDoc
-        bind xK_l $ noMod mediaNextDoc
-
-    -- Centers the current focused window. i.e. toggles the Zoom layout
-    -- modifier.
-    shiftMod $
-      doc "Toggle zoom on the current window." $
-      sendMessage ToggleZoom
-
-  bind xF86XK_Calculator $ do
-    noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
-
-  bind xF86XK_AudioLowerVolume $ do
-    noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ -1%"
-    justMod mediaPrevDoc
-
-  bind xF86XK_AudioRaiseVolume $ do
-    noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ +1%"
-    justMod mediaNextDoc
-
-  bind xF86XK_AudioMute $ do
-    noMod $ spawnX "pactl set-sink-mute @DEFAULT_SINK@ toggle"
-
-  bind xF86XK_AudioPlay $ do
-    noMod playPauseDoc
-
-  bind xF86XK_AudioNext $ do
-    noMod mediaNextDoc
-
-  bind xF86XK_AudioPrev $ do
-    noMod mediaPrevDoc
-
-  bind xF86XK_AudioPrev $ do
-    noMod mediaPrevDoc
-
-  bind xF86XK_MonBrightnessUp $ do
-    noMod $ spawnX "set-backlight.sh +0.05"
-    justMod $ spawnX "set-backlight.sh 1"
-
-  bind xF86XK_MonBrightnessDown $ do
-    noMod $ spawnX "set-backlight.sh -0.05"
-    justMod $ spawnX "set-backlight.sh 0.01"
-    rawMask shiftMask $ spawnX "set-backlight.sh 0"
-
-mouseMap :: ButtonsMap l
-mouseMap = runButtons $ do
-  config <- getConfig
-
-  let x button = Map.lookup button (mouseMap config)
-
-  let defaultButtons button = fromMaybe (\w -> return ()) $
-          Map.lookup button (mouseMap config)
-      subMouse = submapButtonsWithKey defaultButtons . flip runButtons config
-
-
-  let continuous :: [(Button, X ())] -> Button -> Window -> X ()
-      continuous actions button w = do
-        case find ((==button) . fst) actions of
-          Just (_, action) -> action
-          Nothing -> return ()
-
-        (subMouse $
-          forM_ (map fst actions) $ \b ->
-            bind b $ noMod $ \w -> continuous actions b w) w
-
-  bind button1 $ do
-    justMod $ \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster
-
-  bind button2 $ do
-    justMod $ windows . (W.shiftMaster .) . W.focusWindow
-
-  bind button3 $ do
-    justMod $ \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster
-
-  bind button6 $
-    justMod $ noWindow (withRelativeWorkspace prev W.greedyView)
-
-  bind button7 $
-    justMod $ noWindow (withRelativeWorkspace next W.greedyView)
-
-  bind button8 $
-    justMod $ noWindow mediaPrev
-
-  bind button9 $
-    justMod $ noWindow mediaNext
-
-  bind button14 $ do
-    noMod $ subMouse $ do
-
-      bind button3 $
-        noMod $ noWindow (gotoWorkspace 's')
-
-      bind button13 $ do
-        noMod $ noWindow $ click >> CopyWindow.kill1
-
-      bind button14 $ do
-        noMod $ noWindow $ click >> sendMessage ToggleZoom
-
-      bind button15 $ do
-        noMod $ noWindow $ spawnX "pavucontrol"
-
-      let mediaButtons = [
-            (button4, increaseVolume),
-            (button5, decreaseVolume),
-            (button2, playPause),
-            (button9, historyNext),
-            (button8, historyPrev),
-            (button6, mediaPrev),
-            (button7, mediaNext)
-            ]
-
-      forM_ (map fst mediaButtons) $ \b ->
-        bind b $ noMod $ continuous mediaButtons b
-
-  bind button13 $ noMod $ subMouse $ do
-    bind button1 $ noMod mouseMoveWindow
-    bind button2 $ noMod $ windows . W.sink
-    bind button3 $ noMod mouseResizeWindow
-
-    bind button13 $ noMod $ subMouse $ do
-      bind button13 $ noMod $ subMouse $ do
-        bind button13 $ noMod $ noWindow $ spawnX "xsecurelock"
-        bind button1 $ noMod $ noWindow $
-          spawnX "sudo -A systemctl suspend && xsecurelock"
-
-  bind button15 $ do
-
-    noMod $ subMouse $ do
-      bind button13 $ noMod $ noWindow gotoAccompaningWorkspace
-
-      bind button15 $ do
-        noMod $ noWindow jumpToLast
-
-
-      let workspaceButtons = [
-            (button2, swapMaster),
-
-            (button9, withRelativeWorkspace next W.greedyView),
-            (button8, withRelativeWorkspace prev W.greedyView),
-
-            (button4, windows W.focusUp),
-            (button5, windows W.focusDown),
-
-            (button7, windows screenRotateForward),
-            (button6, windows screenRotateBackward)
-            ]
-
-      forM_ (map fst workspaceButtons) $ \b ->
-        bind b $ noMod $ continuous workspaceButtons b
-
--- Bindings specific to a window. These are set similarly to th ekeymap above,
--- but uses a Query monad to tell which windows the keys will apply to.
---
--- This is useful to create hotkeys in applications where hot keys are not
--- configurable, or to remove keybindings that are irritating (looking at you,
--- ctrl+w in Chrome!!).
-windowSpecificBindings ::
-  XConfig l -> WriterT (Map (KeyMask, KeySym) (X ())) Query ()
-windowSpecificBindings config = do
-
-  w <- lift ask
-
-  let configureIf b k = tell =<< lift (b --> return (keyBindingToKeymap (runKeys k) config))
-      emitKey = flip sendKey w
-
-  configureIf (flip elem browsers <$> className) $ do
-
-    -- if the window is a browser, configure these bindings. Lots of browsers
-    -- make up their own garbage bindings that are not standard across many
-    -- other applications. This alleviates the issue.
-    --
-    -- Consistency with terminal:
-    --
-    --   Ctrl+h is backspace
-    --   Ctrl+w is ctrl+backspace
-    --   Ctrl+u is ctrl+shift+backspace
-    --
-    -- Consistency with Vim/Emacs-ish:
-    --
-    --   Alt+{Shift,Ctrl,}+{h,j,k,l} -> {Shift,Ctrl,}+{Left,Down,Up,Right}
-    --   Ctrl+b -> Ctrl+Left
-    --   Ctrl+e -> Ctrl+Right
-    --   Ctrl+$ -> End
-    --   Ctrl+^ -> Home
-    --
-    --   Ctrl+d -> Delete current tab.
-
-
-    let mods = permuteMods [shiftMask, controlMask, 0]
-
-    bind xK_h $ do
-      rawMask controlMask $ emitKey (0, xK_BackSpace)
-      forM_ mods $ \mask ->
-        rawMask (altMask .|. mask) $ emitKey (mask, xK_Left)
-
-    bind xK_j $
-      forM_ mods $ \mask ->
-        rawMask (altMask .|. mask) $ emitKey (mask, xK_Down)
-
-    bind xK_k $
-      forM_ mods $ \mask ->
-        rawMask (altMask .|.mask) $ emitKey (mask, xK_Up)
-
-    bind xK_l $
-      forM_ mods $ \mask ->
-        rawMask (altMask .|. mask) $ emitKey (mask, xK_Right)
-
-    bind xK_u $
-      rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_BackSpace)
-
-    bind xK_w $
-      rawMask controlMask $ emitKey (controlMask, xK_BackSpace)
-
-    bind xK_b $ do
-      rawMask controlMask $ emitKey (controlMask, xK_Left)
-      rawMask (controlMask .|. shiftMask) $
-        emitKey (controlMask .|. shiftMask, xK_Left)
-
-    bind xK_e $ do
-      rawMask controlMask $ emitKey (controlMask, xK_Right)
-      rawMask (controlMask .|. shiftMask) $
-        emitKey (controlMask .|. shiftMask, xK_Right)
-
-    bind xK_dollar $
-      rawMask controlMask $ emitKey (0, xK_End)
-
-    bind xK_at $
-      rawMask (controlMask .|. shiftMask) $ emitKey (0, xK_Home)
-
-    bind xK_d $
-      rawMask controlMask $ emitKey (controlMask, xK_w)
-
-    bind xK_F2 $
-      -- Experimental.
-      noMod $ logs "This is a test"
-
-  -- Add a binding to xev as a test.
-  configureIf (title =? "Event Tester") $
-    bind xK_F2 $
-      noMod $ emitKey (controlMask, xK_F2)
-
-  where
-    browsers = ["Google-chrome", "Brave-browser", "firefox-default"]
-
-    -- Create a permutation from a list of modifiers.
-    --
-    -- i.e. permuteMods [C, S, M] will return
-    --
-    -- [C, S, M, C + M, C + S, M + S, C + S + M, 0]
-    permuteMods = map (foldl' (.|.) 0) . filterM (const [True, False])
-
-windowBindings :: XConfig l -> XConfig l
-windowBindings xconfig =
-  xconfig {
-    startupHook = do
-      forAllWindows (runQuery doQuery)
-      startupHook xconfig,
-
-    manageHook = (doQuery >> return (Endo id)) <> manageHook xconfig
-  }
-
-  where
-    doQuery :: Query ()
-    doQuery = do
-      map <- execWriterT $ windowSpecificBindings xconfig
-      w <- ask
-
-      liftX $ logs $ printf "For Window: %s" (show w)
-      forM_ (Map.toList map) $ \(key, action) -> do
-        liftX $ logs $ printf "   -- remap: %s" (show key)
-        remapKey key action
-
-applyKeys :: XConfig l -> IO (XConfig l)
-applyKeys config =
-    return $ windowBindings $ config { keys = keyBindingToKeymap keymap, mouseBindings = mouseMap }
-
-click :: X ()
-click = do
-  (dpy, root) <- asks $ (,) <$> display <*> theRoot
-  (_, _, window, _, _, _, _, _) <- io $ queryPointer dpy root
-  focus window
-
-modifyWindowBorder :: Integer -> SpacingModifier
-modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
-  Border (clip $ a + i) (clip $ b + i) (clip $ c + i) (clip $ d + i)
-
-  where clip i | i < 0 = 0
-        clip i = i
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
deleted file mode 100644
index e490b89..0000000
--- a/src/Internal/KeysM.hs
+++ /dev/null
@@ -1,497 +0,0 @@
-{-# Language GeneralizedNewtypeDeriving, MultiParamTypeClasses,
-   FunctionalDependencies, FlexibleInstances, TypeFamilies, FlexibleContexts #-}
-module Internal.KeysM where
-
-import Data.List
-import Data.Bits ((.&.))
-import Control.Monad.Writer
-import Text.Printf
-import Control.Arrow (second, first)
-import Control.Monad (void)
-import Control.Monad.State (State(..), modify', get, execState)
-import XMonad
-import Data.Map (Map)
-import qualified Data.Map as Map
-
-data Documented t = Documented String t
-
-data KeyBinding =
-       Action (X ()) |
-       Submap KeyBindings |
-       Repeat KeyBindings
-
-type KeyBindings = Map (KeyMask, KeySym) (Documented KeyBinding)
-
-type ButtonBinding = Window -> X ()
-type ButtonBindings = Map (KeyMask, Button) ButtonBinding
-
-{- Module that defines a DSL for binding keys. -}
-newtype KeysM l a = KeysM (State (XConfig l, KeyBindings) a)
-  deriving (Functor, Applicative, Monad)
-
-newtype ButtonsM l a = ButtonsM (State (XConfig l, ButtonBindings) a)
-  deriving (Functor, Applicative, Monad)
-
-newtype BindingBuilder b a = BindingBuilder (State (KeyMask, [(KeyMask, b)]) a)
-  deriving (Functor, Applicative, Monad)
-
-class HasConfig m where
-  getConfig :: m l (XConfig l)
-
-class Bindable k where
-  type BindableValue k :: *
-  type BindableMonad k :: (* -> *) -> * -> *
-
-  bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
-  -- section :: String -> BindableMonad k l () -> BindableMonad k l ()
-
-class Binding k b where
-  toB :: k -> b
-
-  rawMask :: KeyMask -> k -> BindingBuilder b ()
-  rawMask m x = BindingBuilder $ modify' (second ((m, toB x):))
-
-instance Binding (X ()) (Documented KeyBinding) where
-  toB = Documented "" . Action
-
-instance Binding KeyBindings (Documented KeyBinding) where
-  toB = Documented "" . Submap
-
-instance Binding a (Documented a) where
-  toB = Documented ""
-
-instance Binding a a where
-  toB = id
-
-doc :: (Binding k (Documented KeyBinding)) => String -> k -> Documented KeyBinding
-doc str k = let (Documented _ t) = toB k in Documented str t
-
-runKeys :: KeysM l a -> XConfig l -> KeyBindings
-runKeys (KeysM stateM) config =
-  snd $ execState stateM (config, Map.empty)
-
-runButtons :: ButtonsM l a -> XConfig l -> ButtonBindings
-runButtons (ButtonsM stateM) config =
-  snd $ execState stateM (config, Map.empty)
-
-instance HasConfig KeysM where
-  getConfig = fst <$> KeysM get
-
-instance HasConfig ButtonsM where
-  getConfig = fst <$> ButtonsM get
-
-{- Generally it is assumed that the mod key shoud be pressed, but not always. -}
-noMod :: (Binding k b) => k -> BindingBuilder b ()
-noMod = rawMask 0
-
-maskMod :: (Binding k b) => KeyMask -> k -> BindingBuilder b ()
-maskMod mask action = do
-  modMask <- fst <$> BindingBuilder get
-  rawMask (modMask .|. mask) action
-
-altMask :: KeyMask
-altMask = mod1Mask
-
-hyperMask :: KeyMask
-hyperMask = mod3Mask
-
-altgrMask :: KeyMask
-altgrMask = 0x80
-
-superMask :: KeyMask
-superMask = mod4Mask
-
-justMod :: (Binding k b) => k -> BindingBuilder b ()
-justMod = maskMod 0
-
-instance Bindable KeySym where
-  type BindableValue KeySym = Documented KeyBinding
-  type BindableMonad KeySym = KeysM
-
-  -- bind :: KeySym -> BindingBuilder (X x) a -> KeysM l ()
-  bind key (BindingBuilder stM) = do
-    m <- modMask <$> getConfig
-    let (_, values) = execState stM (m, [])
-
-    KeysM $ modify' $ second $
-      flip (<>) (Map.fromList (map (\(m, v) -> ((m, key), v)) values))
-
-
-instance Bindable Button where
-  type BindableValue Button = ButtonBinding
-  type BindableMonad Button = ButtonsM
-
-  -- bind :: KeySym -> BindingBuilder (Window -> X ()) a -> ButtonsM l ()
-  bind button (BindingBuilder stM) = do
-    m <- modMask <$> getConfig
-    let (_, values) = execState stM (m, [])
-
-    ButtonsM $ modify' $ second $
-      flip (<>) (Map.fromList (map (\(m, v) -> ((m, button), v)) values))
-
-shiftControlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltSuperHyperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
-
-shiftControlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltSuperHyperMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask)
-
-shiftControlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltSuperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. altgrMask)
-
-shiftControlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltSuperMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask)
-
-shiftControlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltHyperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask .|. altgrMask)
-
-shiftControlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltHyperMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask)
-
-shiftControlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. altgrMask)
-
-shiftControlAltMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltMod =
-  maskMod (shiftMask .|. controlMask .|. altMask)
-
-shiftControlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlSuperHyperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask .|. altgrMask)
-
-shiftControlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlSuperHyperMod =
-  maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask)
-
-shiftControlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlSuperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. superMask .|. altgrMask)
-
-shiftControlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlSuperMod =
-  maskMod (shiftMask .|. controlMask .|. superMask)
-
-shiftControlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlHyperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. hyperMask .|. altgrMask)
-
-shiftControlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlHyperMod =
-  maskMod (shiftMask .|. controlMask .|. hyperMask)
-
-shiftControlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. altgrMask)
-
-shiftControlMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlMod =
-  maskMod (shiftMask .|. controlMask)
-
-shiftAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltSuperHyperAltgrMod =
-  maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
-
-shiftAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltSuperHyperMod =
-  maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask)
-
-shiftAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltSuperAltgrMod =
-  maskMod (shiftMask .|. altMask .|. superMask .|. altgrMask)
-
-shiftAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltSuperMod =
-  maskMod (shiftMask .|. altMask .|. superMask)
-
-shiftAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltHyperAltgrMod =
-  maskMod (shiftMask .|. altMask .|. hyperMask .|. altgrMask)
-
-shiftAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltHyperMod =
-  maskMod (shiftMask .|. altMask .|. hyperMask)
-
-shiftAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltAltgrMod =
-  maskMod (shiftMask .|. altMask .|. altgrMask)
-
-shiftAltMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltMod =
-  maskMod (shiftMask .|. altMask)
-
-shiftSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftSuperHyperAltgrMod =
-  maskMod (shiftMask .|. superMask .|. hyperMask .|. altgrMask)
-
-shiftSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftSuperHyperMod =
-  maskMod (shiftMask .|. superMask .|. hyperMask)
-
-shiftSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftSuperAltgrMod =
-  maskMod (shiftMask .|. superMask .|. altgrMask)
-
-shiftSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftSuperMod =
-  maskMod (shiftMask .|. superMask)
-
-shiftHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftHyperAltgrMod =
-  maskMod (shiftMask .|. hyperMask .|. altgrMask)
-
-shiftHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftHyperMod =
-  maskMod (shiftMask .|. hyperMask)
-
-shiftAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltgrMod =
-  maskMod (shiftMask .|. altgrMask)
-
-shiftMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftMod = maskMod shiftMask
-
-controlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltSuperHyperAltgrMod =
-  maskMod (controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
-
-controlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltSuperHyperMod =
-  maskMod (controlMask .|. altMask .|. superMask .|. hyperMask)
-
-controlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltSuperAltgrMod =
-  maskMod (controlMask .|. altMask .|. superMask .|. altgrMask)
-
-controlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltSuperMod =
-  maskMod (controlMask .|. altMask .|. superMask)
-
-controlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltHyperAltgrMod =
-  maskMod (controlMask .|. altMask .|. hyperMask .|. altgrMask)
-
-controlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltHyperMod =
-  maskMod (controlMask .|. altMask .|. hyperMask)
-
-controlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltAltgrMod =
-  maskMod (controlMask .|. altMask .|. altgrMask)
-
-controlAltMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltMod =
-  maskMod (controlMask .|. altMask)
-
-controlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlSuperHyperAltgrMod =
-  maskMod (controlMask .|. superMask .|. hyperMask .|. altgrMask)
-
-controlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlSuperHyperMod =
-  maskMod (controlMask .|. superMask .|. hyperMask)
-
-controlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlSuperAltgrMod =
-  maskMod (controlMask .|. superMask .|. altgrMask)
-
-controlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlSuperMod =
-  maskMod (controlMask .|. superMask)
-
-controlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlHyperAltgrMod =
-  maskMod (controlMask .|. hyperMask .|. altgrMask)
-
-controlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlHyperMod =
-  maskMod (controlMask .|. hyperMask)
-
-controlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltgrMod =
-  maskMod (controlMask .|. altgrMask)
-
-controlMod :: (Binding k b) => k -> BindingBuilder b ()
-controlMod = maskMod controlMask
-
-altSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-altSuperHyperAltgrMod =
-  maskMod (altMask .|. superMask .|. hyperMask .|. altgrMask)
-
-altSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-altSuperHyperMod =
-  maskMod (altMask .|. superMask .|. hyperMask)
-
-altSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-altSuperAltgrMod =
-  maskMod (altMask .|. superMask .|. altgrMask)
-
-altSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-altSuperMod =
-  maskMod (altMask .|. superMask)
-
-altHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-altHyperAltgrMod =
-  maskMod (altMask .|. hyperMask .|. altgrMask)
-
-altHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-altHyperMod =
-  maskMod (altMask .|. hyperMask)
-
-altAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-altAltgrMod =
-  maskMod (altMask .|. altgrMask)
-
-altMod :: (Binding k b) => k -> BindingBuilder b ()
-altMod = maskMod altMask
-
-superHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-superHyperAltgrMod =
-  maskMod (superMask .|. hyperMask .|. altgrMask)
-
-superHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-superHyperMod =
-  maskMod (superMask .|. hyperMask)
-
-superAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-superAltgrMod =
-  maskMod (superMask .|. altgrMask)
-
-superMod :: (Binding k b) => k -> BindingBuilder b ()
-superMod = maskMod superMask
-
-hyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-hyperAltgrMod =
-  maskMod (hyperMask .|. altgrMask)
-
-hyperMod :: (Binding k b) => k -> BindingBuilder b ()
-hyperMod = maskMod hyperMask
-
-altgrMod :: (Binding k b) => k -> BindingBuilder b ()
-altgrMod = maskMod altgrMask
-
-{- Can combine two or more of the functions above to apply the same action to
- - multiple masks. -}
-(-|-) :: (Binding k b) =>
-          (k -> BindingBuilder b ()) ->
-          (k -> BindingBuilder b ()) ->
-          k -> BindingBuilder b ()
-(-|-) fn1 fn2 f = fn1 f >> fn2 f
-
-{- Meant for submapping, binds all alphanumeric charactes to (fn c). -}
-mapNumbersAndAlpha :: KeyMask -> (Char -> X ()) -> KeysM l ()
-mapNumbersAndAlpha km fn = do
-  mapNumbers km fn
-  mapAlpha km fn
-
-{- Meant for submapping. This binds all numbers to (fn x) where x is the number
- - pressed and fn is the function provided. -}
-mapNumbers :: KeyMask -> (Char -> X ()) -> KeysM l ()
-mapNumbers km fn = do
-  mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch))
-    [ (xK_0, '0')
-    , (xK_1, '1')
-    , (xK_2, '2')
-    , (xK_3, '3')
-    , (xK_4, '4')
-    , (xK_5, '5')
-    , (xK_6, '6')
-    , (xK_7, '7')
-    , (xK_8, '8')
-    , (xK_9, '9')
-    -- Programmer Dvorak shifts the numbers so I have to map to their unshifted
-    -- form.
-    , (xK_bracketright, '6')
-    , (xK_exclam, '8')
-    , (xK_bracketleft, '7')
-    , (xK_braceleft, '5')
-    , (xK_braceright, '3')
-    , (xK_parenleft, '1')
-    , (xK_equal, '9')
-    , (xK_asterisk, '0')
-    , (xK_parenright, '2')
-    , (xK_plus, '4') ]
-
-{- Meant for submapping. This binds all alpha charactes to (fn c) where c is the
- - character pressed and fn is the function provided. -}
-mapAlpha :: KeyMask -> (Char -> X ()) -> KeysM l ()
-mapAlpha km fn =
-  mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch)) [
-    (xK_a, 'a')
-  , (xK_b, 'b')
-  , (xK_c, 'c')
-  , (xK_d, 'd')
-  , (xK_e, 'e')
-  , (xK_f, 'f')
-  , (xK_g, 'g')
-  , (xK_h, 'h')
-  , (xK_i, 'i')
-  , (xK_j, 'j')
-  , (xK_k, 'k')
-  , (xK_l, 'l')
-  , (xK_m, 'm')
-  , (xK_n, 'n')
-  , (xK_o, 'o')
-  , (xK_p, 'p')
-  , (xK_q, 'q')
-  , (xK_r, 'r')
-  , (xK_s, 's')
-  , (xK_t, 't')
-  , (xK_u, 'u')
-  , (xK_v, 'v')
-  , (xK_w, 'w')
-  , (xK_x, 'x')
-  , (xK_y, 'y')
-  , (xK_z, 'z')
-  ]
-
-
-documentation :: KeyBindings -> String
-documentation = execWriter . document' ""
-  where
-    document' pref keybindings =
-      forM_ (sortOn (map (\(a, b) -> (b, a)) . snd . snd) $ Map.toList (keyBindingsToList keybindings)) $ \(doc, (thing, keys)) -> do
-        when ((not $ null doc) || hasSubmap thing) $
-          tell $ printf "%s%s: %s\n" pref (intercalate " or " $ map prettyShow keys) doc
-        case thing of
-          Action _ -> return ()
-          Submap submap -> document' (pref ++ "  ") submap
-          Repeat submap -> do
-            tell pref
-            tell "  (repeatable):\n"
-            document' (pref ++ "    ") submap
-
-    keyBindingsToList :: KeyBindings -> Map String (KeyBinding, [(KeyMask, KeySym)])
-    keyBindingsToList b =
-      fmap (\list -> ((\(_, Documented _ t) -> t) (head list), map fst list)) $
-        group (\(_, Documented doc _) -> doc) (sortOn (snd . fst) $ Map.toList b)
-
-    prettyShow :: (KeyMask, KeySym) -> String
-    prettyShow (mask, key) = printf "<%s%s>" (showMask mask) (keysymToString key)
-
-    hasSubmap b = case b of
-      Action _ -> False
-      _ -> True
-
-
-    showMask :: KeyMask -> String
-    showMask mask =
-      let masks = [(shiftMask, "S"),
-                   (altMask, "A"),
-                   (mod3Mask, "H"),
-                   (mod4Mask, "M"),
-                   (altgrMask, "AGr"),
-                   (controlMask, "C")] in
-
-              concatMap ((++"-") . snd) $ filter ((/=0) . (.&.mask) . fst) masks
-
-
-    group :: (Ord b) => (a -> b) -> [a] -> (Map b [a])
-    group fn = Map.fromListWith (++) . map (first fn . (\a -> (a, [a])))
-
-
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
deleted file mode 100644
index 229e958..0000000
--- a/src/Internal/Layout.hs
+++ /dev/null
@@ -1,326 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, ViewPatterns, FlexibleInstances, KindSignatures, DataKinds, GADTs, RankNTypes, PolyKinds #-}
-module Internal.Layout where
-
-import GHC.TypeLits
-
-import Data.Proxy (Proxy(..))
-import Internal.CornerLayout (Corner(..))
-import Control.Arrow (second)
-import XMonad.Hooks.ManageDocks
-import XMonad.Layout.Circle
-import XMonad.Layout.Accordion
-import Control.Applicative
-import XMonad.Layout.Spacing
-import Data.List
-import XMonad.Layout.Spiral
-import XMonad.Layout.ThreeColumns
-import XMonad.Layout.Grid
-import XMonad.Layout.Dishes
-import XMonad.Layout.MosaicAlt
-import XMonad.Layout.Fullscreen
-import qualified XMonad.Layout.Dwindle as D
-import XMonad.Layout
-import XMonad.Layout.LayoutModifier
-import XMonad
-import XMonad.Core
-import XMonad.Layout.NoBorders (smartBorders, noBorders)
-
-import Internal.LayoutList
-import Internal.Windows
-
-import qualified Data.Map as M
-import qualified XMonad.StackSet as W
-
-myLayout =
-  fullscreenFull $
-    avoidStruts $
-      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
-        layoutZipper $
-          mods (reinterpretIncMaster $ spiral (6/7)) |:
-          mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
-          mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
-          mods (ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2))) |:
-          mods (ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2))) |:
-          mods Grid |:
-          mods (Dishes 2 (1/6)) |:
-          mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1) |:
-          nil
-
--- This is a type class that defines how to reinterpret a message. One can think
--- of this as a kind of type-level function. It lets one associate a function
--- (reinterpretMessage) with a type construct, which for the case below is a
--- Symbol.
---
--- It would be nice to attach this function to the LayoutModifier directly as a
--- value, however LayoutModifiers must be Show-able and Read-able and functions
--- are not. However encoding in the typesystem itsef which function is to be
--- called is the best alternative I have.
-class DoReinterpret (k :: t) where
-  reinterpretMessage ::
-    Proxy k -> SomeMessage -> X (Maybe SomeMessage)
-
--- Mosaic doesn't have the concept of a "Master Space", so reinterpret messages
--- intended to modify the master space and instead have those messages expand
--- and shrink the current window.
---
--- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system
--- hacking one can do in Haskell.
-instance DoReinterpret "ForMosaic" where
-  
-  -- IncMaster message
-  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
-    fmap (SomeMessage .
-      (if n > 0
-        then expandWindowAlt
-        else shrinkWindowAlt)) <$> getFocusedWindow
-  
-  -- ResizeMaster message
-  reinterpretMessage _ (fromMessage -> Just m) = do
-    fmap (SomeMessage .
-      (case m of
-        Expand -> expandWindowAlt
-        Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
-
-  -- Messages that don't match the above, just leave it unmodified.
-  reinterpretMessage _ m = return (Just m)
-
-instance DoReinterpret "IncMasterToResizeMaster" where
-  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) =
-    return $ Just $
-      if n > 0
-        then SomeMessage Expand
-        else SomeMessage Shrink
-  reinterpretMessage _ m = return (Just m)
-
--- Data construct for association a DoReinterpret function with a concrete
--- construct that can be used in the LayoutModifier instance.
---
--- It wolud be nice to have ReinterpretMessage hold the function as a value
--- rather than delegate to this kind-instance, however, it won't work because
--- LayoutModifiers have to be Read-able and Show-able, and functions are neither
--- of those, so a value-level function may not be a member of a LayoutModifier,
--- thus I have to settle for delegating to a hard-coded instance using
--- type-classes.
-data ReinterpretMessage k a = ReinterpretMessage
-  deriving (Show, Read)
-
--- Instance for ReinterpretMessage as a Layout modifier.
-instance (DoReinterpret k) =>
-      LayoutModifier (ReinterpretMessage k) a where 
-
-  handleMessOrMaybeModifyIt self message = do
-
-    -- Delegates to the reinterpretMessage function associatied with the
-    -- type-variable k.
-    newMessage <- reinterpretMessage (ofProxy self) message
-    case newMessage of
-      Just m -> return $ Just $ Right m
-      Nothing -> return $ Just $ Left self
-    where
-      -- ofProxy just provides reifies the phantom type k so the type system can
-      -- figure out what instance to go to.
-      ofProxy :: ReinterpretMessage k a -> Proxy k
-      ofProxy _ = Proxy
-
-modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a
-modifyMosaic = ModifiedLayout ReinterpretMessage
-
-reinterpretIncMaster ::
-  l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a
-reinterpretIncMaster = ModifiedLayout ReinterpretMessage
-
-mods =
-  ModifiedLayout (Zoomable False 0.05 0.05) .
-    ModifiedLayout (Flippable False) .
-    ModifiedLayout (HFlippable False) .
-    ModifiedLayout (Rotateable False)
-
-
-data ModifyDescription m l a = ModifyDescription m (l a)
-  deriving (Show, Read)
-
-data TallDescriptionModifier = TallDescriptionModifier
-  deriving (Show, Read)
-
-data ThreeColDescMod = ThreeColDescMod
-  deriving (Show, Read)
-
-class DescriptionModifier m l where
-  newDescription :: m -> l a -> String -> String
-
-instance (Typeable m, Show m, DescriptionModifier m l, LayoutClass l a) => LayoutClass (ModifyDescription m l) a where
-  runLayout (W.Workspace t (ModifyDescription m l) a) rect = do
-    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  doLayout (ModifyDescription m l) a s = do
-    (rects, maybeNewLayout) <- doLayout l a s
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  pureLayout (ModifyDescription m l) a s = pureLayout l a s
-
-  emptyLayout (ModifyDescription m l) a = do
-    (rects, maybeNewLayout) <- emptyLayout l a
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  handleMessage (ModifyDescription m l) a = do
-    maybeNewLayout <- handleMessage l a
-    return (ModifyDescription m <$> maybeNewLayout)
-
-  pureMessage (ModifyDescription m l) a =
-    let maybeNewLayout = pureMessage l a in
-      ModifyDescription m <$> maybeNewLayout
-
-  description (ModifyDescription m l) = newDescription m l (description l)
-
-instance DescriptionModifier TallDescriptionModifier Tall where
-  newDescription _ (Tall mast _ _) _ = "Tall(" ++ show mast ++ ")"
-
-instance DescriptionModifier ThreeColDescMod ThreeCol where
-  newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
-  newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
-
-data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
-
-instance Message ResizeZoom where
-
-newtype Flippable a = Flippable Bool -- True if flipped
-  deriving (Show, Read)
-
-newtype HFlippable a = HFlippable Bool -- True if flipped
-  deriving (Show, Read)
-
-newtype Rotateable a = Rotateable Bool -- True if rotated
-  deriving (Show, Read)
-
-data FlipLayout = FlipLayout deriving (Typeable)
-
-data HFlipLayout = HFlipLayout deriving (Typeable)
-
-data DoRotate = DoRotate deriving (Typeable)
-
-data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
-  deriving (Show, Read)
-
--- Toggles if the current window should be zoomed or not. Set the boolean
--- to set the zoom.mhar
-data ZoomModifier =
-       ToggleZoom |
-       Zoom |
-       Unzoom
-  deriving (Typeable)
-
-instance Message FlipLayout where
-
-instance Message HFlipLayout where
-
-instance Message ZoomModifier where
-
-instance Message DoRotate where
-
-instance (Eq a) => LayoutModifier Rotateable a where
-  pureModifier (Rotateable rotate) (Rectangle x' y' sw sh) _ returned =
-    if rotate
-      then (map (second (unzero . scaleRect . mirrorRect . zero)) returned, Nothing)
-      else (returned, Nothing)
-    where
-      zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
-      unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h
-
-      scaleRect (Rectangle x y w h) =
-        Rectangle (x * fi sw `div` fi sh)
-                  (y * fi sh `div` fi sw)
-                  (w * sw `div` sh)
-                  (h * sh `div` sw)
-
-      fi = fromIntegral
-
-
-  pureMess (Rotateable rot) mess =
-    fmap (\DoRotate -> Rotateable (not rot)) (fromMessage mess)
-
-  modifyDescription (Rotateable rot) underlying =
-    let descr = description underlying in
-      if rot
-        then descr ++ " Rotated"
-        else descr
-
-instance (Eq a) => LayoutModifier Flippable a where
-  pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
-    if flip
-      then (map (second doFlip) returned, Nothing)
-      else (returned, Nothing)
-    where
-      doFlip (Rectangle x y w h) =
-        Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
-
-  pureMess (Flippable flip) message =
-    case fromMessage message of
-      Just FlipLayout -> Just (Flippable (not flip))
-      Nothing -> Nothing
-
-  modifyDescription (Flippable flipped) underlying =
-    let descr = description underlying in
-      if flipped
-        then descr ++ " Flipped"
-        else descr
-
-instance (Eq a) => LayoutModifier HFlippable a where
-  pureModifier (HFlippable flip) (Rectangle _ sy _ sh) stack returned =
-    if flip
-      then (map (second doFlip) returned, Nothing)
-      else (returned, Nothing)
-    where
-      doFlip (Rectangle x y w h) =
-        Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
-
-  pureMess (HFlippable flip) message =
-    case fromMessage message of
-      Just HFlipLayout -> Just (HFlippable (not flip))
-      Nothing -> Nothing
-
-  modifyDescription (HFlippable flipped) underlying =
-    let descr = description underlying in
-      if flipped
-        then descr ++ " HFlipped"
-        else descr
-
-
-instance (Eq a) => LayoutModifier Zoomable a where
-  redoLayout (Zoomable doit ws hs) (Rectangle x y w h) stack returned =
-    if doit
-      then
-        let focused = W.focus <$> stack
-            (zoomed, rest) = partition ((==focused) . Just . fst) returned
-         in case zoomed of
-              [] -> return (rest, Nothing)
-              ((fwin, _):_) ->  return ((fwin, Rectangle (x + wp) (y + hp) (w - fromIntegral (wp * 2)) (h - fromIntegral (hp * 2))) : rest, Nothing)
-
-      else return (returned, Nothing)
-    where
-      wp = floor $ fromIntegral w * ws
-      hp = floor $ fromIntegral h * hs
-
-  handleMessOrMaybeModifyIt self@(Zoomable showing sw sh) mess =
-    return $
-      (handleResize <$> fromMessage mess)
-        <|> (Left . handleZoom <$> fromMessage mess)
-      where
-        handleResize r =
-          if showing
-            then Left $ Zoomable showing (guard $ sw + d) (guard $ sh + d)
-            else Right $ case r of
-                   ShrinkZoom -> SomeMessage Shrink
-                   ExpandZoom -> SomeMessage Expand
-
-          where d = (case r of
-                      ShrinkZoom -> -1
-                      ExpandZoom -> 1) * 0.02
-
-        handleZoom ToggleZoom = Zoomable (not showing) sw sh
-        handleZoom Zoom = Zoomable True sw sh
-        handleZoom Unzoom = Zoomable False sw sh
-
-        guard f | f > 1 = 1
-                | f < 0 = 0
-                | otherwise = f
diff --git a/src/Internal/LayoutDraw.hs b/src/Internal/LayoutDraw.hs
deleted file mode 100644
index a105c98..0000000
--- a/src/Internal/LayoutDraw.hs
+++ /dev/null
@@ -1,155 +0,0 @@
-{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
-ScopedTypeVariables, BangPatterns #-}
-module Internal.LayoutDraw (drawLayout) where
-
-import Control.Monad
-
-import Control.Arrow (second)
-import Control.Concurrent (threadDelay)
-import Control.Exception (handle)
-import Control.Monad.Writer (execWriter, tell)
-import Data.Foldable (find)
-import Data.Maybe (fromMaybe)
-import Internal.Hash (quickHash)
-import Internal.Layout (ZoomModifier(..))
-import System.Directory (createDirectoryIfMissing, doesFileExist)
-import System.FilePath ((</>))
-import Text.Printf (printf)
-import XMonad.Layout.Spacing (SpacingModifier(..), Border(..))
-
-import XMonad (X,
-               Rectangle(..),
-               Dimension,
-               LayoutClass,
-               Message,
-               Window,
-               SomeMessage(..))
-
-import qualified XMonad as X
-import qualified XMonad.StackSet as S
-
--- Draws and returns an XPM for the current layout.
---
--- Returns
---  - Bool   - true if the xpm has already been written, and is thus cached.
---  - String - description of the current layout
---  - String - the text to send to XMobar
---
--- This function actually runs the current layout's doLayout function to
--- generate the XPM, so it's completely portable to all layouts.
---
--- Note this function is impure and running the layout to create the XPM is also
--- impure. While in-practice most layouts are pure, it should be kept in mind.
-drawLayout :: X (Bool, String, String)
-drawLayout = do
-    winset <- X.gets X.windowset
-    let layout = S.layout $ S.workspace $ S.current winset
-
-    -- Gotta reset the layout to a consistent state.
-    layout' <- foldM (flip ($)) layout [
-         handleMessage' $ ModifyWindowBorder $ const $ Border 0 0 0 0,
-         handleMessage' Unzoom
-       ]
-
-    (cached, xpm) <- drawXpmIO layout'
-
-    return (cached , X.description layout, printf "<icon=%s/>" xpm)
-
--- Returns true if a point is inside a rectangle (inclusive).
-pointInRect :: (Dimension, Dimension) -> Rectangle -> Bool
-pointInRect (x, y) (Rectangle x' y' w h) =
-  x <= (fi x' + fi w) && x >= fi x' && y <= (fi y' + fi h) && y >= fi y'
-  where
-    fi :: (Integral a, Num b) => a -> b
-    fi = fromIntegral
-
--- Scale factory. Scaling the rectangles before writing the XPM helps to reduce
--- noise from things like AvoidStruts, as there is unfortunately no way to force
--- avoid struts to be off, one can only toggle it.
-sf :: (Integral a) => a
-sf = 1024
-
-handleMessage' ::
-    (LayoutClass layout a, Message m) => m -> layout a -> X (layout a)
-handleMessage' message layout  = do
-  fromMaybe layout <$> X.handleMessage layout (SomeMessage message)
-
--- Creates the XPM for the given layout and returns the path to it.
---
--- This function does run doLayout on the given layout, and that should be
--- accounted for.
-drawXpmIO :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
-drawXpmIO l = do
-  dir <- X.getXMonadDir
-
-  let shrinkAmt = 5 -- amount to shrink the windows by to make pretty gaps.
-
-  let (w, h) = (56, 24)
-  let descr = X.description l
-  let iconCacheDir = dir </> "icons" </> "cache"
-  let iconPath = iconCacheDir </> (quickHash descr ++ ".xpm")
-
-  let colors = [
-        "#cc9a9a", "#cc9999", "#cc8080", "#cc6666",
-        "#cc4c4c", "#cc3232", "#cc1818", "#cc0000" ]
-
-  (rects', _) <-
-    X.runLayout
-      (S.Workspace "0" l (S.differentiate [1 .. 5]))
-      (Rectangle 0 0 ((w + shrinkAmt) * sf) ((h + shrinkAmt) * sf))
-
-  let rects = flip map rects' $ \(_, Rectangle x y w h) ->
-                Rectangle (x `div` sf) (y `div` sf) (w `div` sf) (h `div` sf)
-
-  X.liftIO $ do
-    exists <- doesFileExist iconPath
-    createDirectoryIfMissing True iconCacheDir
-
-    unless exists $ do
-      let xpmText = drawXpm (w, h) (zip (cycle colors) rects) 4
-      writeFile iconPath xpmText
-
-    return (exists, iconPath)
-
---
--- Create's an XPM, purely. Returns a string with the XPM contents.
--- Takes as arguments
---
---   - dimensions of the icon.
---   - list of (color, rectangle) pairs.
---   - The amount to shrink the windows by for those pretty gaps.
---
-drawXpm ::
-    (Dimension, Dimension) -> [(String, Rectangle)] -> Dimension -> String
-drawXpm (w, h) rects' shrinkAmt = execWriter $ do
-    tell "/* XPM */\n"
-    tell "static char *out[] = {\n"
-    tell $ printf "\"%d %d %d 1 \",\n" w h (length rects + 1)
-
-    let zipRects = zip ['A' .. 'Z'] rects
-
-    forM_ zipRects $ \(char, (color, _)) -> do
-      tell $ printf "\"%c c %s\",\n" char color
-    tell "\"% c None\"a,\n"
-
-    forM_ [0 .. h - 1] $ \y -> do
-      tell "\""
-      forM_ [0 .. w - 1] $ \x ->
-        (case find (matches x y) zipRects of
-          Nothing -> tell "%"
-          Just (chr, _) -> tell [chr])
-      tell "\""
-      when (y /= h - 1 - shrinkAmt) (tell ",")
-      tell "\n"
-    tell "};\n"
-
-  where
-    matches x y (_, (_, r)) = pointInRect (x, y) r
-    rects = map (second (shrink shrinkAmt)) rects'
-    guard a b = if a <= shrinkAmt then 1 else b
-    shrink amt (Rectangle x y w h) =
-      Rectangle
-        x
-        y
-        (guard w $ w - fromIntegral amt)
-        (guard h $ h - fromIntegral amt)
diff --git a/src/Internal/LayoutList.hs b/src/Internal/LayoutList.hs
deleted file mode 100644
index 2405f71..0000000
--- a/src/Internal/LayoutList.hs
+++ /dev/null
@@ -1,297 +0,0 @@
-{-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, MultiParamTypeClasses,
- FlexibleContexts, UndecidableInstances, ViewPatterns, StandaloneDeriving,
- RankNTypes, TupleSections, TypeFamilies #-}
-
-{-
- - This module provides a more powerful version of the "Choose" layout that can
- - be bidirectionally navigated.
- -
- - The indexing uses a type-safe zipper to keep track of the currently-selected
- - layout.
- -}
-module Internal.LayoutList (
-  LayoutList,
-  layoutZipper,
-  LCons,
-  LNil,
-  toNextLayout,
-  toPreviousLayout,
-  toFirstLayout,
-  (|:),
-  nil
-  )where
-
-import Control.Applicative ((<|>))
-import Data.Void
-import Control.Monad.Identity (runIdentity)
-import Data.Maybe (fromMaybe, fromJust)
-import Control.Arrow (second)
-import XMonad
-import qualified XMonad.StackSet as W
-import Data.Proxy
-
--- Type-level lists. LNil is the final of the list. LCons contains a layout and a
--- tail.
-data LNil a = LNil deriving (Read, Show)
-data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
-
--- Sel - This defines a structure where either this selected, or some
--- other element is selected.
---
--- These types can be composed to create what is effectively a bounded integer.
--- I.e. there can be a type like
---
--- Sel (Sel (Sel (Sel End)))
---
--- Such a type is equivalent to an integer bounded at 4, because this type can
--- exist in no more than 4 states:
---
--- Sel
--- Skip Sel
--- Skip (Skip Sel)
--- Skip (Skip (Skip Sel))
---
--- Note that a type (Sel End) can only be in the Sel as End may not be
--- construted (without using undefined).
-data Sel l =
-    Sel |
-    (Selector l) => Skip l
-deriving instance (Read l, Selector l) => Read (Sel l)
-deriving instance (Show l, Selector l) => Show (Sel l)
-deriving instance (Eq l, Selector l) => Eq (Sel l)
-
--- Reimplement Void as End, just to keep the two separate, but End is for all
--- intents and purposes Void.
-data End
-deriving instance Read End
-deriving instance Show End
-deriving instance Eq End
-
-
--- Types that constitute a selection. Selections can be moved to the next
--- selection, moved to the previous selection, optionally there could be a
--- previous selection and they may be currently selected.
-class (Eq c) => Selector c where
-  -- Increments the selection to the next state
-  --
-  -- Returns Nothing if the selection class is in the final state and cannot be
-  -- incremented any farther. (This is helpful to facilitate modular
-  -- arithmatic)
-  increment :: c -> Maybe c
-
-  -- Decrements the selection to the previous state. Returns Nothing if the
-  -- state is already in its initial setting.
-  decrement :: c -> Maybe c
-
-  -- The initial state.
-  initial :: Maybe c
-
-  -- The final state.
-  final :: Maybe c
-
---
--- Is selelected can be in two states:
---
---   1. The current element is selected
---   2. The current element is not selected and another element deeper in the
---      structure is selected.
-instance (Selector t) => Selector (Sel t) where
-  -- If the current element is not selected, increment the tail.
-  increment (Skip l) = Skip <$> increment l
-  -- If the current element is selected, the increment is just the initial of
-  -- the tail.
-  increment Sel = Skip <$> initial 
-
-  -- For a selection, the initial is just this in the Sel state.
-  initial = Just Sel
-
-  -- Looks ahead at the tail, sees if it is selected, if so, select this one
-  -- instead, if the one ahead isn't selected, then decrement that one.
-  decrement (Skip t) = Just $ maybe Sel Skip (decrement t)
-  decrement Sel = Nothing
-
-  -- Navigates to the end of the structure to find the final form.
-  final = Just $ maybe Sel Skip final
-
--- The End structure (which is equivalent to Void) is the "null" selector; the
--- basecase that the Sel selector terminates at.
-instance Selector End where
-
-  -- Incrementing the End Selector doesn't do anything.
-  increment = const Nothing
-
-  -- Decrementing the End Selector doesn't do anythig
-  decrement = const Nothing
-
-  -- There is no initial value for the End selector.
-  initial = Nothing
-
-  -- There is not final state for the End selector.
-  final = Nothing
-
--- Increment a selector, but cyclicly
-incrementCycle :: (Selector c) => c -> c
-incrementCycle c =
-  case increment c of
-    Nothing -> fromMaybe c initial
-    Just x -> x
-
--- Add two selectors together, incrementing the first until the second cannot be
--- incremented anymore.
-addSelector :: (Selector c) => c -> c -> c
-addSelector c1 c2 = addSel c1 (decrement c2)
-  where
-    addSel c1 Nothing = c1
-    addSel c1 (Just c2) = addSel (incrementCycle c1) (decrement c2)
-
--- Turn an int into a selector by repeatably incrementing.
-intToSelector :: (Selector c) => Int -> c
-intToSelector 0 = fromJust initial
-intToSelector n = incrementCycle $ intToSelector (n - 1)
-
--- A LayoutList consists of a LayoutSelect type and a corresponding Selector.
-data LayoutList l a where
-  LayoutList ::
-    (LayoutSelect l a, Selector (SelectorFor l)) =>
-      SelectorFor l -> l a -> LayoutList l a
-
-deriving instance (LayoutSelect l a) => Show (LayoutList l a)
-deriving instance (LayoutSelect l a) => Read (LayoutList l a)
-
-(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
-(|:) = LCons
-
-infixr 5 |: 
-
--- Constructs a LayoutList. This function enforces that the SelectorFor l
--- is a 'Sel' type. Essentially this enforces that there must be at least one
--- underlying layout, otherwise a LayoutList cannot be constructed.
-layoutZipper :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
-  l a -> LayoutList l a
-layoutZipper = LayoutList Sel
-
--- The termination of a layout zipper.
-nil :: LNil a
-nil = LNil
-
--- Message to navigate to a layout.
-newtype NavigateLayout =
-          -- Sets the layout based on the given function.
-          NavigateLayout {
-            changeLayoutFn :: forall c. (Selector c) => c -> c
-          }
-          deriving (Typeable)
-
--- NavigateLayout instance to move to the next layout, circularly.
-toNextLayout :: NavigateLayout
-toNextLayout = NavigateLayout $ addSelector (intToSelector 1)
-
--- NavigateLayout instance to move to the previous layout, circularly.
-toPreviousLayout :: NavigateLayout
-toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
-
--- NavigateLayotu instance to move to the first layout.
-toFirstLayout :: NavigateLayout
-toFirstLayout = NavigateLayout (`fromMaybe` initial)
-
-instance Message NavigateLayout where
-
--- LayoutSelect class Describes a type that can be used to select a layout using
--- the associated type SelectorFor.
---
--- Instances of this class are LCons and LNil.
-class (Show (l a),
-       Read (l a),
-       Read (SelectorFor l),
-       Show (SelectorFor l),
-       Selector (SelectorFor l)) => LayoutSelect l a where
-
-  -- The selector that is used to update the layout corresponding to the
-  -- selector. This selector must be an instance of the Selector class.
-  type SelectorFor l :: *
-
-  -- Update applies a functor to the selected layout and maybe returns a result
-  -- and an updated layout.
-  update :: forall r m. (Monad m) =>
-    -- The selector for this type. Determines which layout the function is
-    -- applied to.
-    SelectorFor l ->
-    -- The LayoutSelect being modified.
-    l a ->
-    -- Higher-ordered function to generically apply to the Layout associated
-    -- with the Selector. Works on all LayoutClass's.
-    (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
-
-    -- Returns a result r, and an updated LayoutSelect.
-    m (Maybe (r, l a))
-
--- Instance for LayoutSelect for cons
-instance (Read (l a),
-          LayoutClass l a,
-          LayoutSelect t a,
-          Show (SelectorFor t),
-          Read (SelectorFor t)) =>
-    LayoutSelect (LCons l t) a where
-
-  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
-  -- Sel (Sel (Sel ( ... (Sel End) .. ))) where the number of Sel's match the
-  -- number of Cons in this structure enforcing safe selection.
-  type SelectorFor (LCons l t) = Sel (SelectorFor t)
-
-  -- The current layout in this Cons-list is selected.
-  update Sel (LCons layout t) fn = do
-    (r, layout') <- fn layout
-    return $ Just (r, LCons (fromMaybe layout layout') t)
-
-  -- The current layout is not selected. Move on to another layout.
-  update (Skip s) (LCons l t) fn =
-    fmap (second $ \t' -> LCons l t') <$> update s t fn
-
--- LNil is a layout select. It doesn't do anything. Indeed update really can't
--- be called on on this because that would require instantiating a End type.
-instance LayoutSelect LNil a where
-  type SelectorFor LNil = End -- LNil cannot be selected.
-  update _ _ _ = return Nothing
-
--- Instance of layout class for LayoutList. The implementation for this
--- just delegates to the underlying LayoutSelect class using the generic
--- update method.
-instance (Show (l a), Typeable l, LayoutSelect l a) =>
-    LayoutClass (LayoutList l) a where
-
-  runLayout (W.Workspace i (LayoutList idx l) ms) r = do
-    r <- update idx l $ \layout ->
-            runLayout (W.Workspace i layout ms) r
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutList idx la))
-
-  pureLayout (LayoutList idx l) r s = runIdentity $ do
-    r <- update idx l $ \layout -> return (pureLayout layout r s, Nothing)
-    case r of
-      Nothing -> return []
-      Just (r, a) -> return r
-
-  emptyLayout (LayoutList idx l) r = do
-    r <- update idx l $ \layout -> emptyLayout layout r
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutList idx la))
-
-  handleMessage (LayoutList idx l) (fromMessage -> Just (NavigateLayout fn)) =
-    return $ Just (LayoutList (fn idx) l)
-
-  handleMessage (LayoutList idx l) m = do
-    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
-    return $ LayoutList idx . snd <$> r
-
-  pureMessage (LayoutList idx l) m = runIdentity $ do
-    r <- update idx l $ \layout -> return ((), pureMessage layout m)
-    return $ LayoutList idx . snd <$> r
-
-  description (LayoutList idx l) = runIdentity $ do
-    r <- update idx l $ \l -> return (description l, Nothing)
-    return $
-      case r of
-        Nothing -> "No Layout"
-        Just (descr, _) -> descr
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
deleted file mode 100644
index fdbc9a5..0000000
--- a/src/Internal/Lib.hs
+++ /dev/null
@@ -1,160 +0,0 @@
-{-# LANGUAGE RankNTypes #-}
-module Internal.Lib where
-
-import Prelude hiding ((!!))
-
-import XMonad.Actions.DynamicWorkspaces
-import XMonad.Util.Run
-import XMonad.Prompt
-import XMonad.Prompt.Input
-import XMonad.Prompt.Shell
-
-import Internal.PromptConfig
-
-import Data.Char
-import Data.List hiding ((!!))
-import Data.List.Safe ((!!))
-import Data.Maybe
-import Internal.Marking
-import Text.Printf
-import XMonad hiding (workspaces, Screen)
-import XMonad.StackSet hiding (filter, focus)
-import qualified Data.Map as Map
-import Internal.DMenu
-import Data.Ord (comparing)
-
-import qualified XMonad.StackSet as S
-import Internal.Windows
-
-type WorkspaceName = Char
-newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a)
-
-data WinPrompt = WinPrompt
-
-instance XPrompt WinPrompt where
-    showXPrompt _ = "[Window] "
-    commandToComplete _ = id
-
-data WorkspaceState = Current | Hidden | Visible
-  deriving (Ord, Eq, Enum)
-
--- Returns all the workspaces that are either visible, current or Hidden but
--- have windows and that workspace's state.
---
--- In other words, filters out workspaces that have no windows and are not
--- visible.
---
--- This function will sort the result by the workspace tag.
-getPopulatedWorkspaces ::
-  (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, S.Workspace i l a)]
-getPopulatedWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
-  sortOn (tag . snd) $
-    mapMaybe (\w@(S.Workspace _ _ s) -> fmap (const (Hidden, w)) s) hi ++
-      map (\(S.Screen w _ _) -> (Visible, w)) vis ++
-        [(Current, cur)]
-
-getHorizontallyOrderedScreens ::
-  StackSet wid l a ScreenId ScreenDetail ->
-    [Screen wid l a ScreenId ScreenDetail]
--- ^ Returns a list of screens ordered from leftmost to rightmost.
-getHorizontallyOrderedScreens windowSet =
-    flip sortBy screens $ \sc1 sc2 ->
-      let (SD (Rectangle x1 _ _ _)) = screenDetail sc1
-          (SD (Rectangle x2 _ _ _)) = screenDetail sc2
-          in x1 `compare` x2
-    where
-      screens = current windowSet : visible windowSet
-
-getCurrentWorkspace :: X WorkspaceName
-getCurrentWorkspace = withWindowSet $
-  \(StackSet (Screen (Workspace t _ _) _ _) _ _ _) -> do
-    return (head t)
-
-gotoAccompaningWorkspace :: X ()
-gotoAccompaningWorkspace = do
-  cur <- getCurrentWorkspace
-  if isUpper cur
-    then gotoWorkspace (toLower cur)
-    else gotoWorkspace (toUpper cur)
-
-gotoWorkspace :: WorkspaceName -> X ()
-gotoWorkspace ch = pushHistory $ do
-  addHiddenWorkspace [ch]
-  windows $ greedyView $ return ch
-
-shiftToWorkspace :: WorkspaceName -> X ()
-shiftToWorkspace ch = do
-  addHiddenWorkspace [ch]
-  (windows . shift . return) ch
-
-swapWorkspace :: WorkspaceName -> X ()
-swapWorkspace toWorkspaceName = do
-  addHiddenWorkspace [toWorkspaceName]
-  windows $ \ss -> do
-    let fromWorkspace = tag $ workspace $ current ss
-        toWorkspace = [toWorkspaceName] in
-      StackSet (swapSc fromWorkspace toWorkspace $ current ss)
-                (map (swapSc fromWorkspace toWorkspace) $ visible ss)
-                (map (swapWs fromWorkspace toWorkspace) $ hidden ss)
-                (floating ss)
-  where
-    swapSc fromWorkspace toWorkspace (Screen ws a b) =
-        Screen (swapWs fromWorkspace toWorkspace ws) a b
-
-    swapWs fromWorkspace toWorkspace ws@(Workspace t' l s)
-        | t' == fromWorkspace = Workspace toWorkspace l s
-        | t' == toWorkspace = Workspace fromWorkspace l s
-        | otherwise = ws
-
-fuzzyCompletion :: String -> String -> Bool
-fuzzyCompletion str0 str1 =
-  all (`isInfixOf`l0) ws
-  where
-    ws = filter (not . all isSpace) $ words (map toLower str0)
-    l0 = map toLower str1
-
-getString :: Window -> X String
-getString = runQuery $ do
-  t <- title
-  a <- appName
-  return $
-    if map toLower a `isInfixOf` map toLower t
-      then t
-      else printf "%s - %s" t a
-
-withRelativeWorkspace :: Selector -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
-withRelativeWorkspace (Selector selector) fn =
-  windows $ \ss ->
-    let tags = sort (tag . snd  <$> filter (\x -> fst x /= Visible ) (getPopulatedWorkspaces ss))
-        from = tag $ workspace $ current ss
-        to = selector from tags
-    in fn to ss
-
-next :: Selector
-next = Selector $ \a l -> select a l l
-  where select n (x:y:xs) _ | n == x = y
-        select n [x] (y:_) | n == x = y
-        select n (x:xs) orig = select n xs orig
-        select n _ _ = n
-
-prev :: Selector
-prev = Selector $ \a l ->
-  let (Selector fn) = next in fn a (reverse l)
-
-withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
-withScreen fn n = do
-  windows $ \windowSet ->
-    case getHorizontallyOrderedScreens windowSet !! n of
-      Nothing -> windowSet
-      Just screen -> fn (tag $ workspace screen) windowSet
-
-windowJump :: X ()
-windowJump = pushHistory $ do
-  windowTitlesToWinId <- withWindowSet $ \ss ->
-    Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
-
-  windowId <- runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
-
-  case windowId of
-    Nothing -> return ()
-    Just wid -> focus wid
diff --git a/src/Internal/Logger.hs b/src/Internal/Logger.hs
deleted file mode 100644
index e5824a4..0000000
--- a/src/Internal/Logger.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-module Internal.Logger where
-
-import XMonad
-import qualified XMonad.Util.ExtensibleState as XS
-import System.IO
-
-import Internal.NoPersist
-
-newtype LoggerState =
-  LoggerState {
-    logHandle :: Maybe (NoPersist Handle)
-  }
-
-instance ExtensionClass LoggerState where
-  initialValue = LoggerState Nothing
-
-logs :: String -> X ()
-logs s = do
-  LoggerState handle' <- XS.get
-
-  handle <-
-    case handle' of
-      Nothing -> do
-        handle <- io $ openFile "/tmp/xmonad.log" AppendMode
-        XS.put $ LoggerState $ Just $ NoPersist handle
-        return handle
-
-      Just (NoPersist h) -> return h
-
-  io $ do
-    hPutStrLn handle s
-    hFlush handle
diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
deleted file mode 100644
index 3ffb411..0000000
--- a/src/Internal/Marking.hs
+++ /dev/null
@@ -1,204 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-module Internal.Marking (
-  historyNext, historyPrev,
-  markCurrentWindow, pushHistory,
-  jumpToMark, jumpToLast, swapWithLastMark,
-  swapWithMark
-  ) where
-
-import Internal.Windows (mapWindows, findWindow, getLocationWorkspace)
-import XMonad
-import XMonad.StackSet hiding (focus)
-import Data.IORef
-import Data.Map (Map)
-import Control.Monad (when)
-
-import System.FilePath
-import System.IO
-import Control.Exception
-import System.Environment
-import qualified Data.Sequence as Seq
-import Data.Sequence (Seq(..))
-
-import qualified XMonad.Util.ExtensibleState as XS
-
-import qualified Data.Map as Map
-
-{- Submodule that handles marking windows so they can be jumped back to. -}
-
-type Mark = Char
-
-historySize = 100 -- max number of history elements the tail.
-
-data History a = History [a] (Seq a)
-  deriving (Read, Show)
-
-instance Default (History a) where
-  
-  def = History [] Seq.empty
-
-seqPush :: a -> Seq a -> Seq a
-seqPush elem s@(seq :|> _) | Seq.length s >= historySize = elem :<| seq
-seqPush elem s = elem :<| s
-
-historyForward :: History a -> History a
-historyForward (History (a:as) tail) = History as (seqPush a tail)
-historyForward z = z
-
-historyBackward :: History a -> History a
-historyBackward (History head (a :<| as)) = History (a : head) as
-historyBackward z = z
-
-historyCurrent :: History a -> Maybe a
-historyCurrent (History (a:_) _) = Just a
-historyCurrent _ = Nothing
-
-historyPush :: (Eq a) => a -> History a -> History a
-historyPush a h@(History (w : _) _) | a == w = h
-historyPush a (History (w : _) tail) = History [a] (seqPush w tail)
-historyPush a (History _ tail) = History [a] tail
-
-historySwap :: History a -> History a
-historySwap (History (a:as) (t :<| ts)) = History (t : as) (seqPush a ts)
-historySwap z = z
-
-historyLast :: History a -> Maybe a
-historyLast (History _ (t :<| _)) = Just t
-historyLast _ = Nothing
-
-data Spot =
-        WindowSpot Window | -- Focus is on a window.
-        TagSpot String -- Focus is on an (empty) tag
-        deriving (Read, Show, Eq, Ord)
-
-greedyFocus :: Spot -> X ()
-greedyFocus (WindowSpot win) = do
-     ws <- withWindowSet $ \ss ->
-             return $ getLocationWorkspace =<< findWindow ss win
- 
-     mapM_ (windows . greedyView . tag) ws
-     focus win
-greedyFocus (TagSpot tag) =
-  windows $ greedyView tag
-
-data MarkState =
-  MarkState {
-    markStateMap :: Map Mark Window
-  , windowHistory :: History Spot
-  } deriving (Read, Show)
-
-
-instance ExtensionClass MarkState where
-  initialValue = MarkState Map.empty def
-  extensionType = PersistentExtension
-
-changeHistory :: (History Spot -> History Spot) -> (MarkState -> MarkState)
-changeHistory fn ms = ms { windowHistory = fn (windowHistory ms)}
-
-withMaybeFocused :: (Maybe Window -> X ()) -> X ()
-withMaybeFocused f = withWindowSet $ f . peek
-
-normalizeWindows :: X ()
-normalizeWindows = do
-  MarkState { windowHistory = h } <- XS.get
-  mapM_ greedyFocus (historyCurrent h)
-
--- greedyFocus :: Window -> X ()
--- greedyFocus win = do
---     ws <- withWindowSet $ \ss ->
---             return $ getLocationWorkspace =<< findWindow ss win
--- 
---     mapM_ (windows . greedyView . tag) ws
---     focus win
-
-markCurrentWindow :: Mark -> X ()
-markCurrentWindow mark = do
-  withFocused $ \win ->
-    XS.modify $ \state@MarkState {markStateMap = ms} ->
-        state {
-          markStateMap = Map.insert mark win ms
-        }
-
-pushHistory :: X () -> X ()
-pushHistory fn = do
-  withMaybeFocused $ \maybeWindowBefore -> do
-    case maybeWindowBefore of
-      (Just windowBefore) ->
-        XS.modify $ changeHistory (historyPush (WindowSpot windowBefore))
-      Nothing -> 
-        withWindowSet $ \ws ->
-          XS.modify $ changeHistory (historyPush (TagSpot (currentTag ws)))
-
-    fn
-
-    withMaybeFocused $ \maybeWindowAfter ->
-      case maybeWindowAfter of
-        Just windowAfter ->
-          XS.modify $ changeHistory (historyPush $ WindowSpot windowAfter)
-        Nothing ->
-          withWindowSet $ \ws ->
-            XS.modify $ changeHistory (historyPush $ TagSpot $ currentTag ws)
-
-withHistory :: (History Spot -> X ()) -> X ()
-withHistory fn = do
-  MarkState { windowHistory = w } <- XS.get
-  fn w
-
-jumpToLast :: X ()
-jumpToLast = do
-  XS.modify (changeHistory historySwap)
-  normalizeWindows
-
-jumpToMark :: Mark -> X ()
-jumpToMark mark = do
-  MarkState {markStateMap = m} <- XS.get
-  case Map.lookup mark m of
-    Nothing -> return ()
-    Just w -> pushHistory $
-      greedyFocus (WindowSpot w)
-
-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 :: X ()
-swapWithLastMark = pushHistory $ withHistory $ \hist -> do
-
-  case historyLast hist of
-    Just (WindowSpot win) ->
-      windows $ swapWithFocused win
-    Nothing -> return ()
-
-swapWithMark :: Mark -> X ()
-swapWithMark mark = pushHistory $ do
-  MarkState {markStateMap = m} <- XS.get
-
-  case Map.lookup mark m of
-    Nothing -> return ()
-    Just winToSwap -> do
-      windows $ swapWithFocused winToSwap
-
-historyPrev :: X ()
-historyPrev = do
-  XS.modify $ changeHistory historyBackward
-  normalizeWindows
-
-historyNext :: X ()
-historyNext = do
-  XS.modify $ changeHistory historyForward
-  normalizeWindows
diff --git a/src/Internal/MouseMotion.hs b/src/Internal/MouseMotion.hs
deleted file mode 100644
index c72c824..0000000
--- a/src/Internal/MouseMotion.hs
+++ /dev/null
@@ -1,97 +0,0 @@
-{-# LANGUAGE ViewPatterns, BangPatterns #-}
-module Internal.MouseMotion where
-
-import XMonad
-
-import Control.Monad (void, forever)
-import Text.Printf
-import Internal.Submap
-import Control.Monad.Loops (iterateWhile)
-import Control.Monad.Fix (fix)
-import Internal.Logger
-
-import Linear.V2
-import Linear.Metric
-
-data Quadrant = NE | SE | SW | NW deriving (Enum, Show)
-data Direction = CW | CCW deriving (Enum, Show)
-
-getQuadrant :: (Num a, Ord a) => (a, a) -> Quadrant
-getQuadrant (x, y) | x >= 0 && y >= 0 = NE
-getQuadrant (x, y) | x < 0 && y >= 0 = SE
-getQuadrant (x, y) | x < 0 && y < 0 = SW
-getQuadrant (x, y) = NW
-
-
-getDirection :: Quadrant -> Quadrant -> Maybe Direction
-getDirectory a b | a == b = Nothing
-getDirection SW SE = Just CCW
-getDirection SE NE = Just CCW
-getDirection NE NW = Just CCW
-getDirection NW SW = Just CCW
-getDirection _ _ = Just CW
-
-
-liftMouseMotionM :: X a -> MouseMotionM a
-liftMouseMotionM = MouseMotionM . fmap Just
-
-motion :: MouseMotionM (V2 Int)
-motion = MouseMotionM $ do
-  ev <- nextMotionOrButton
-  case ev of
-    Right button -> do
-      logs ("Button " ++ show button)
-      return Nothing
-
-    Left motion -> return (Just $ uncurry V2 motion)
-
-motionSize :: Int -> MouseMotionM (V2 Int)
-motionSize size = do
-  let fsize = fromIntegral size
-
-  !firstmotion <- fmap fromIntegral <$> motion
-
-  let get = do
-        !next <- motion
-        if distance (fmap fromIntegral next) firstmotion >= fsize
-          then return next
-          else get
-
-  get
-
-runMouseMotionM :: MouseMotionM a -> X (Maybe a)
-runMouseMotionM (MouseMotionM a) = a
-
-execMouseMotionM :: MouseMotionM () -> X ()
-execMouseMotionM = void . runMouseMotionM
-
--- Monad for capturing mouse motion. Terminates and holds Nothing when a
--- button is pressed.
-newtype MouseMotionM a = MouseMotionM (X (Maybe a))
-
-instance Functor MouseMotionM where
-  fmap fn (MouseMotionM xma) = MouseMotionM (fmap (fmap fn) xma)
-
-instance Applicative MouseMotionM where
-  mf <*> ma = do
-    !f <- mf
-    !a <- ma
-    return (f a)
-
-  pure = return
-
-instance Monad MouseMotionM where
-  return a = MouseMotionM (return (Just a))
-  (MouseMotionM !xa) >>= fn = MouseMotionM $ do
-    !ma <- xa
-    case ma of
-      Just !a ->
-        let (MouseMotionM !xb) = fn a in xb
-      Nothing -> return Nothing
-
-mouseRotateMotion :: X () -> X () -> X ()
-mouseRotateMotion clockWise counterClockwise = execMouseMotionM doMouse
-  where
-    doMouse = forever $ do
-      v <- motion
-      liftMouseMotionM $ logs $ "Motion: " ++ show v
diff --git a/src/Internal/NoPersist.hs b/src/Internal/NoPersist.hs
deleted file mode 100644
index a67e649..0000000
--- a/src/Internal/NoPersist.hs
+++ /dev/null
@@ -1,23 +0,0 @@
--- Module for not persisting XMonad state. To be used with ExtensibleState
--- for data types that cannot be persisted.
-module Internal.NoPersist where
-
-import Data.Default (Default, def)
-import Data.Typeable
-
-import XMonad (ExtensionClass(..))
-
-newtype NoPersist a = NoPersist a
-  deriving (Typeable)
-
-instance Show (NoPersist a) where
-  show (NoPersist _) = show ()
-
-instance (Default a) => Read (NoPersist a) where
-  readsPrec i s = map (\(_, s) -> (NoPersist def, s)) (readsPrec i s :: [((), String)])
-
-instance (Default a) => Default (NoPersist a) where
-  def = NoPersist def
-
-instance (Default a, Typeable a) => ExtensionClass (NoPersist a) where
-  initialValue = NoPersist def
diff --git a/src/Internal/PassMenu.hs b/src/Internal/PassMenu.hs
deleted file mode 100644
index 5b031c0..0000000
--- a/src/Internal/PassMenu.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Internal.PassMenu where
-
-import XMonad
-import XMonad.Util.Run
-import Control.Monad
-
-runPassMenu :: X ()
-runPassMenu = void $
-  safeSpawn "rofi-pass" [
-    "-p", "Password ",
-    "-theme-str",
-    "* {theme-color: #f54245;}"]
-
diff --git a/src/Internal/PromptConfig.hs b/src/Internal/PromptConfig.hs
deleted file mode 100644
index 0db3027..0000000
--- a/src/Internal/PromptConfig.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Internal.PromptConfig where
-
-import XMonad.Prompt
-
-xpConfig :: XPConfig
-xpConfig = def {
-               font = "xft:Source Code Pro:size=10"
-             , bgColor = "#404040"
-             , fgColor = "#8888ff"
-             , promptBorderWidth = 0
-             , height = 40
-             }
diff --git a/src/Internal/RebindKeys.hs b/src/Internal/RebindKeys.hs
deleted file mode 100644
index 38af754..0000000
--- a/src/Internal/RebindKeys.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-
--- Module for intercepting key presses not explicity mapped in the key bindings.
--- This uses some deep magic with grabKey and windows and everything else, but
--- it makes window-specific key bindings awesome!
-module Internal.RebindKeys where
-
-import XMonad
-
-import Text.Printf
-import Control.Monad.Trans.Class (lift)
-import Control.Monad (forM, forM_)
-import Data.Default (Default, def)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import qualified XMonad.Util.ExtensibleState as XS
-import Data.Monoid (All(..))
-
-import Internal.Logger
-import Internal.NoPersist
-
-type WindowHook = Query ()
-
-newtype InterceptState =
-  InterceptState (NoPersist (Map (KeyMask, KeySym) (X ())))
-
-newtype RemapState =
-  RemapState (NoPersist (Map (Window, (KeyMask, KeySym)) (X ())))
-
-instance ExtensionClass InterceptState where
-  initialValue = InterceptState def
-
-instance ExtensionClass RemapState where
-  initialValue = RemapState def
-
-remapHook :: Event -> X All
-remapHook event = do
-  RemapState (NoPersist map) <- XS.get
-
-  case event of
-    KeyEvent { ev_window = win, ev_event_type = typ, ev_keycode = code, ev_state = m }
-        | typ == keyPress-> do
-      XConf {display = dpy, theRoot = rootw} <- ask
-      keysym <- io $ keycodeToKeysym dpy code 0
-
-      case Map.lookup (win, (m, keysym)) map of
-
-        Just xdo -> do
-          xdo
-          return (All False)
-
-        Nothing -> return (All True)
-
-    _ -> return (All True)
-
-getKeyCodesForKeysym :: Display -> KeySym -> IO [KeyCode]
-getKeyCodesForKeysym dpy keysym = do
-  let (minCode, maxCode) = displayKeycodes dpy
-      allCodes = [fromIntegral minCode .. fromIntegral maxCode]
-
-  syms <- forM allCodes $ \code -> keycodeToKeysym dpy code 0
-  let keysymMap' = Map.fromListWith (++) (zip syms [[code] | code <- allCodes])
-
-  -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
-  -- want to grab those whenever someone accidentally uses def :: KeySym
-  let keysymMap = Map.delete noSymbol keysymMap'
-  let keysymToKeycodes sym = Map.findWithDefault [] keysym keysymMap
-
-  return $ keysymToKeycodes keysym
-
-
-doGrab :: Display -> Window -> (KeyMask, KeySym) -> X ()
-doGrab dpy win (keyMask, keysym) = do
-  let grab kc m = io $ grabKey dpy kc m win True grabModeAsync grabModeAsync
-
-  codes <- io $ getKeyCodesForKeysym dpy keysym
-
-  forM_ codes $ \kc ->
-    mapM_ (grab kc . (keyMask .|.)) =<< extraModifiers
-
-disableKey :: (KeyMask, KeySym) -> WindowHook
-disableKey key = remapKey key (return ())
-
-remapKey :: (KeyMask, KeySym) -> X () -> WindowHook
-remapKey keyFrom action = do
-  window <- ask
-  Query $ lift $ do
-    XConf { display = disp, theRoot = rootw } <- ask
-    doGrab disp window keyFrom
-
-    XS.modify $ \(RemapState (NoPersist keyMap)) -> RemapState $ NoPersist $
-      Map.insert (window, keyFrom) action keyMap
-
--- sendKey, but as a query.
-sendKeyQ :: (KeyMask, KeySym) -> Query ()
-sendKeyQ key = do
-  win <- ask
-  liftX (sendKey key win)
-
-sendKey :: (KeyMask, KeySym) -> Window -> X ()
-sendKey (keymask, keysym) w = do
-  XConf { display = disp, theRoot = rootw } <- ask
-
-  codes <- io $ getKeyCodesForKeysym disp keysym
-
-  case codes of
-    (keycode:_) ->
-      io $ allocaXEvent $ \xEv -> do
-        setEventType xEv keyPress
-        setKeyEvent xEv w rootw none keymask keycode True
-        sendEvent disp w True keyPressMask xEv
-
-        setEventType xEv keyRelease
-        sendEvent disp w True keyReleaseMask xEv
-
-    _ -> return ()
-
-rebindKey :: (KeyMask, KeySym) -> (KeyMask, KeySym) -> WindowHook
-rebindKey keyFrom keyTo =
-  (remapKey keyFrom . sendKey keyTo) =<< ask
diff --git a/src/Internal/ScreenRotate.hs b/src/Internal/ScreenRotate.hs
deleted file mode 100644
index 8108381..0000000
--- a/src/Internal/ScreenRotate.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module Internal.ScreenRotate where
-
-import XMonad.StackSet as W
-
-screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
-screenRotateBackward (W.StackSet current visible others floating) = do
-  let screens = current : visible
-      workspaces = tail $ cycle $ map W.workspace screens
-      (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
-      in W.StackSet current' visible' others floating
-
-screenRotateForward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
-screenRotateForward (W.StackSet current visible others floating) = do
-  let screens = current : visible
-      workspaces = rcycle $ map W.workspace screens
-      (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
-      in W.StackSet current' visible' others floating
-
-  where rcycle l = last l : l
diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
deleted file mode 100644
index 0e54c43..0000000
--- a/src/Internal/Submap.hs
+++ /dev/null
@@ -1,104 +0,0 @@
-module Internal.Submap (
-    mapNextString,
-    mapNextStringWithKeysym,
-    submapButtonsWithKey,
-    nextButton,
-    nextMotion,
-    nextMotionOrButton,
-    module X) where
-
-import XMonad hiding (keys)
-import Control.Monad.Fix (fix)
-import qualified Data.Map as Map
-import Data.Map (Map)
-
-import XMonad.Actions.Submap as X
-
-{-
- - Like submap fram XMonad.Actions.Submap, but sends the string from
- - XLookupString to the function along side the keysym.
- -
- - This function allows mappings where the mapped string might be important,
- - but also allows submappings for keys that may not have a character associated
- - with them (for example, the function keys).
- -}
-mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X a) -> X a
-mapNextStringWithKeysym fn = do
-  XConf { theRoot = root, display = d } <- ask
-  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
-
-  (m, str, keysym) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
-    maskEvent d keyPressMask p
-    KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
-    keysym <- keycodeToKeysym d code 0
-    (_, str) <- lookupString (asKeyEvent p)
-
-    if isModifierKey keysym
-        then nextkey
-        else return (m, str, keysym)
-
-  io $ ungrabKeyboard d currentTime
-
-  fn m keysym str
-
-{- Like submap, but on the character typed rather than the kysym. -}
-mapNextString :: (KeyMask -> String -> X a) -> X a 
-mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
-
-{- Grabs the mouse and returns the next button press. -}
-nextButton :: X (ButtonMask, Button)
-nextButton = do
-  XConf { theRoot = root, display = d } <- ask
-  io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime
-
-  ret <- io $ allocaXEvent $ \xEv -> do
-    maskEvent d buttonPressMask xEv
-    ButtonEvent { ev_button = button, ev_state = m } <- getEvent xEv
-    return (m, button)
-
-  io $ ungrabPointer d currentTime
-
-  return ret
-
-{- Grabs the mouse and reports the next mouse motion. -}
-nextMotion :: X (Int, Int)
-nextMotion = do
-  XConf { theRoot = root, display = d } <- ask
-  io $ grabPointer d root False pointerMotionMask grabModeAsync grabModeAsync 0 0 currentTime
-
-  ret <- io $ allocaXEvent $ \xEv -> do
-    maskEvent d pointerMotionMask xEv
-    MotionEvent { ev_x = x, ev_y = y } <- getEvent xEv
-    return (fromIntegral x, fromIntegral y)
-
-  io $ ungrabPointer d currentTime
-
-  return ret
-
-{- Grabs the mouse and reports the next mouse motion or button press. -}
-nextMotionOrButton :: X (Either (Int, Int) (ButtonMask, Button))
-nextMotionOrButton = do
-  XConf { theRoot = root, display = d } <- ask
-  io $ grabPointer d root False (pointerMotionMask .|. buttonPressMask) grabModeAsync grabModeAsync 0 0 currentTime
-
-  ret <- io $ allocaXEvent $ \xEv -> do
-    maskEvent d (pointerMotionMask .|. buttonPressMask) xEv
-    ev <- getEvent xEv
-    case ev of
-      MotionEvent { ev_x = x, ev_y = y } ->
-        return $ Left (fromIntegral x, fromIntegral y)
-      ButtonEvent { ev_button = button, ev_state = m } ->
-        return $ Right (m, button)
-
-  io $ ungrabPointer d currentTime
-
-  return ret
-
-submapButtonsWithKey ::
-    ((ButtonMask, Button) -> Window -> X ()) -> Map (ButtonMask, Button) (Window -> X ()) -> Window -> X ()
-submapButtonsWithKey defaultAction actions window = do
-  arg <- nextButton
-
-  case Map.lookup arg actions of
-    Nothing -> defaultAction arg window
-    Just fn -> fn window
diff --git a/src/Internal/Swallow.hs b/src/Internal/Swallow.hs
deleted file mode 100644
index 3e4112f..0000000
--- a/src/Internal/Swallow.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-module Internal.Swallow (
-  swallowHook, setSwallowEnabled, isSwallowEnabled, toggleSwallowEnabled) where
-
-import XMonad
-import Data.Monoid (All)
-import XMonad.Hooks.WindowSwallowing
-import XMonad.Util.ExtensibleState as XS
-
-data DisableSwallow = DisableSwallow Bool deriving (Show)
-
-swallowHook :: Event -> X All
-swallowHook = swallowEventHook (className =? "Alacritty") $
-  liftX $ do
-    (DisableSwallow disable) <- XS.get
-    return (not disable)
-
-isSwallowEnabled :: X Bool
-isSwallowEnabled = do
-  (DisableSwallow b) <- XS.get
-  return (not b)
-
-setSwallowEnabled :: Bool -> X ()
-setSwallowEnabled enable = XS.modify $ const $ DisableSwallow $ not enable
-
-toggleSwallowEnabled :: X ()
-toggleSwallowEnabled = (setSwallowEnabled . not) =<< isSwallowEnabled
-
-instance ExtensionClass DisableSwallow where
-  initialValue = DisableSwallow False
diff --git a/src/Internal/SwapMaster.hs b/src/Internal/SwapMaster.hs
deleted file mode 100644
index e7ade19..0000000
--- a/src/Internal/SwapMaster.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-{- Swap window with the master, but save it. -}
-module Internal.SwapMaster (swapMaster) where
-
-import qualified XMonad.StackSet as W
-
-import Internal.Windows (mapWindows, getMaster, swapWindows)
-import Control.Monad.Trans.Maybe
-import XMonad (Window, ExtensionClass(..), X(..), windows, windowset)
-import Control.Monad (void)
-import Control.Monad.Trans (lift)
-import Data.Maybe (fromMaybe)
-import Control.Monad.State (gets)
-
-import qualified XMonad.Util.ExtensibleState as XS
-
-newtype LastWindow = LastWindow {
-    lastWindow :: Maybe Window
-  } deriving (Show, Read)
-
-instance ExtensionClass LastWindow where
-  initialValue = LastWindow Nothing
-
-hoist :: (Monad m) => Maybe a -> MaybeT m a
-hoist = MaybeT . return
-
-swapMaster :: X ()
-swapMaster = void $ runMaybeT $ do
-    ss <- gets windowset
-
-    focused <- hoist $ W.peek ss
-    master <- hoist $ getMaster ss
-
-    if focused == master
-        then do
-          lw <- MaybeT $ lastWindow <$> XS.get
-          lift $ windows (swapWindows focused lw)
-        else lift $ windows (swapWindows focused master)
-
-    lift $ do
-      XS.put (LastWindow $ Just master)
-      windows W.focusMaster
diff --git a/src/Internal/Windows.hs b/src/Internal/Windows.hs
deleted file mode 100644
index 35f093c..0000000
--- a/src/Internal/Windows.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-module Internal.Windows where
-
-import XMonad (windowset, X, Window, get)
-
-import Control.Applicative ((<|>))
-import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), peek, integrate, integrate', allWindows)
-import Data.Maybe (listToMaybe, catMaybes)
-import qualified Data.Map as Map
-
-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)
-
-getMaster :: StackSet i l a s sd -> Maybe a
-getMaster (StackSet (Screen (Workspace _ _ ss) _ _) _ _ _) =
-  head . integrate <$> ss
-
-swapWindows :: (Ord a) => a -> a -> StackSet i l a s d -> StackSet i l a s d
-swapWindows wa wb = mapWindows $ \w ->
-  case w of
-    _ | w == wa -> wb
-    _ | w == wb -> wa
-    _ -> w
-
-data WindowLocation i l a s sd =
-  OnScreen (Screen i l a s sd) |
-  OnHiddenWorkspace (Workspace i l a) |
-  Floating
-
-getLocationWorkspace :: WindowLocation i l a s sd -> Maybe (Workspace i l a)
-getLocationWorkspace (OnScreen (Screen w _ _)) = Just w
-getLocationWorkspace (OnHiddenWorkspace w) = Just w
-getLocationWorkspace _ = Nothing
-
-workspaceMember :: (Eq a) => Workspace i l a -> a -> Bool
-workspaceMember (Workspace _ _ s) w = w `elem` integrate' s
-
-forAllWindows :: (Window -> X ()) -> X ()
-forAllWindows fn = do
-  stackSet <- windowset <$> get
-  mapM_ fn (allWindows stackSet)
-
-getFocusedWindow :: X (Maybe Window)
-getFocusedWindow = do
-  peek . windowset <$> get
-
-{- Finds a Window and returns the screen its on and the workspace its on.
- - Returns nothing if the window doesn't exist.
- -
- - If the window is not a screen Just (Nothing, workspace) is returned.
- - If the window is a floating window Just (Nothing, Nothing) is returned. -}
-findWindow ::
-    (Eq a) => StackSet i l a s sd -> a -> Maybe (WindowLocation i l a s sd)
-findWindow (StackSet cur vis hid float) win =
-    listToMaybe . catMaybes $
-      map findWindowScreen (cur : vis) ++
-        map findWindowWorkspace hid ++
-          [findWindowFloat]
-
-  where
-    findWindowScreen s@(Screen ws _ _) =
-      if workspaceMember ws win
-        then Just (OnScreen s)
-        else Nothing
-
-    findWindowWorkspace w =
-      if workspaceMember w win
-        then Just (OnHiddenWorkspace w)
-        else Nothing
-
-    findWindowFloat =
-      if win `elem` Map.keys float
-        then Just Floating
-        else Nothing
diff --git a/src/Internal/XMobarLog.hs b/src/Internal/XMobarLog.hs
deleted file mode 100644
index c0aa2a7..0000000
--- a/src/Internal/XMobarLog.hs
+++ /dev/null
@@ -1,78 +0,0 @@
-module Internal.XMobarLog ( XMobarLog, spawnXMobar, xMobarLogHook ) where
-
-import Control.Arrow (second)
-import Control.Monad (forM_)
-import Control.Monad.Writer (tell, execWriter)
-import Data.List (sortBy)
-import Data.Maybe (mapMaybe)
-import Data.Ord (comparing)
-import Internal.LayoutDraw (drawLayout)
-import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
-import XMonad.Util.NamedWindows (getName)
-import XMonad.Util.Run (spawnPipe)
-import XMonad (X)
-import Internal.Lib (getPopulatedWorkspaces, WorkspaceState(..))
-
-import qualified XMonad as X
-import qualified XMonad.StackSet as S
-
-data XMobarLog = XMobarLog Handle
-
--- The log hook for XMobar. This is a custom log hook that does not use any
--- of the Xmonad dynamic log libraries.
---
--- This is because the given dynamic log libraries don't handle unicode properly
--- and this has been causing issues. It is also more flexible and frankly easier
--- to just DIY.
-
-spawnXMobar :: IO XMobarLog
-spawnXMobar = do
-  pipe <- spawnPipe "xmobar"
-  hSetEncoding pipe utf8
-  return (XMobarLog pipe)
-
-
--- XMonad Log Hook meant to be used with the XMonad config logHook.
-xMobarLogHook :: XMobarLog -> X ()
-xMobarLogHook (XMobarLog xmproc) = do
-  (_, _, layoutXpm) <- drawLayout
-
-  winset <- X.gets X.windowset
-  title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
-  let wss = getPopulatedWorkspaces winset
-
-  X.liftIO $ do
-    hPutStrLn xmproc $ trunc 80 $ execWriter $ do
-      tell layoutXpm
-      tell $ "<fc=#404040> │ </fc>"
-
-      forM_ wss $ \(t, ws) -> do
-        case t of
-          Current -> tell "<fn=1><fc=#ff8888>"
-          Visible -> tell "<fn=6><fc=#8888ff>"
-          Hidden -> tell "<fn=2><fc=#888888>"
-        tell (S.tag ws)
-        tell " </fc></fn>"
-
-      tell $ "<fc=#404040>│ </fc><fc=#a0a0a0><fn=3>"
-      tell $ title
-      tell $ "</fn></fc>"
-
--- Truncate an XMobar string to the provided number of _visible_ characters.
--- This is to keep long window titles from overrunning the whole bar.
-trunc :: Int -> String -> String
-trunc amt str = reverse $ trunc' False amt str []
-  where
-    trunc' _ _ [] acc = acc
-    trunc' ignore amt (a:as) acc =
-      case a of
-        '<' -> trunc' True amt as (a : acc)
-        '>' -> trunc' False amt as (a : acc)
-        _ ->
-          if ignore
-            then trunc' True amt as (a : acc)
-            else
-              case amt of
-                0 -> trunc' False 0 as acc
-                3 -> trunc' False 0 as ("..." ++ acc)
-                _ -> trunc' False (amt - 1) as (a : acc)
diff --git a/src/Main.hs b/src/Main.hs
index 0b4a181..c8cdd19 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -12,15 +12,15 @@ import System.Environment (setEnv)
 import Data.Monoid
 import qualified Data.Map as Map
 
-import Internal.Swallow
-import Internal.Windows
-import Internal.XMobarLog
-import Internal.Keys
-import Internal.Layout
-import Internal.Logger
-import Internal.DMenu (menuCommandString)
-import Internal.RebindKeys
-import Internal.KeysM
+import Rahm.Desktop.Swallow
+import Rahm.Desktop.Windows
+import Rahm.Desktop.XMobarLog
+import Rahm.Desktop.Keys
+import Rahm.Desktop.Layout
+import Rahm.Desktop.Logger
+import Rahm.Desktop.DMenu (menuCommandString)
+import Rahm.Desktop.RebindKeys
+import Rahm.Desktop.KeysM
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as W
diff --git a/src/Rahm/Desktop/CornerLayout.hs b/src/Rahm/Desktop/CornerLayout.hs
new file mode 100644
index 0000000..33f439e
--- /dev/null
+++ b/src/Rahm/Desktop/CornerLayout.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+-- Creates a layout, the "corner layout" that keeps the master window in the
+-- corner and the other windows go around it.
+module Rahm.Desktop.CornerLayout where
+
+import Data.Typeable (Typeable)
+import XMonad (LayoutClass(..), Rectangle(..), Resize(..), fromMessage)
+import qualified XMonad.StackSet as S
+
+data Corner a = Corner Rational Rational
+  deriving (Show, Typeable, Read)
+
+instance LayoutClass Corner a where
+  pureLayout (Corner frac _) screen@(Rectangle x y w h) ss =
+    let w' = floor $ fromIntegral w * frac
+        h' = floor $ fromIntegral h * frac
+        corner = Rectangle 0 0 w' h'
+        vertRect = Rectangle (fromIntegral w') 0 (w - w') h
+        horizRect = Rectangle 0 (fromIntegral h') w' (h - h')
+        ws = S.integrate ss
+
+        vn = (length ws - 1) `div` 2
+        hn = (length ws - 1) - vn
+      in
+        case ws of
+          [a] -> [(a, screen)]
+          [a, b] -> [
+            (a, Rectangle x y w' h),
+            (b, Rectangle (x + fromIntegral w') y (w - w') h)]
+          _ ->
+            zip ws $ map (
+                \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h) $
+              corner :
+                splitVert vertRect vn ++
+                splitHoriz horizRect hn
+
+  pureMessage (Corner frac delta) m = fmap resize (fromMessage m)
+    where
+      resize Shrink = Corner (frac - delta) delta
+      resize Expand = Corner (frac + delta) delta
+
+splitVert :: Rectangle -> Int -> [Rectangle]
+splitVert (Rectangle x y w h) i' =
+  map
+    (\i -> Rectangle x (y + fromIntegral (step * i)) w step)
+    [0 .. i - 1]
+  where
+    i = fromIntegral i'
+    step = h `div` i
+
+splitHoriz :: Rectangle -> Int -> [Rectangle]
+splitHoriz (Rectangle x y w h) i' =
+  map
+    (\i -> Rectangle (x + fromIntegral (step * i)) y step h)
+    [0 .. i - 1]
+  where
+    step = w `div` i
+    i = fromIntegral i'
diff --git a/src/Rahm/Desktop/DMenu.hs b/src/Rahm/Desktop/DMenu.hs
new file mode 100644
index 0000000..62ecdd3
--- /dev/null
+++ b/src/Rahm/Desktop/DMenu.hs
@@ -0,0 +1,45 @@
+module Rahm.Desktop.DMenu where
+
+import XMonad.Util.Dmenu
+import XMonad
+import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
+import XMonad.Util.Run
+import Data.List (intercalate)
+import Text.Printf (printf)
+
+data Colors =
+  Colors {
+    fg :: String,
+    bg :: String
+  }  | DefaultColors
+
+menuCommand :: [String]
+menuCommand = ["rofi", "-monitor", "-4", "-dmenu", "-sort", "-levenshtein-sort"]
+
+menuCommandString :: String
+menuCommandString = unwords menuCommand
+
+runDMenu :: X ()
+runDMenu = void $
+  safeSpawn
+    "rofi"
+    ["-monitor", "-4", "-display-run", "Execute", "-show", "run"]
+
+runDMenuPrompt :: String -> Maybe String -> [String] -> X String
+runDMenuPrompt prompt color select =
+  let realColor = maybe [] (\c -> ["-sb", c, "-nf", c]) color
+       in
+    runProcessWithInput "/home/rahm/.local/bin/dmenu_debug.sh" ([
+      "-p", prompt,
+      "-l", "12",
+      "-dim", "0.4" ]  ++ realColor) (intercalate "\n" select)
+
+
+runDMenuPromptWithMap :: String -> Maybe String -> Map String a -> X (Maybe a)
+runDMenuPromptWithMap prompt color map = do
+  let realColor = maybe [] (
+          \c -> ["-theme-str", printf "* {theme-color: %s;}" c]) color
+  menuMapArgs (head menuCommand)
+    (tail menuCommand ++ ["-p", prompt] ++ realColor) map
diff --git a/src/Rahm/Desktop/Hash.hs b/src/Rahm/Desktop/Hash.hs
new file mode 100644
index 0000000..dc58d96
--- /dev/null
+++ b/src/Rahm/Desktop/Hash.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Rahm.Desktop.Hash where
+
+import Numeric (showHex)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BC
+import qualified Crypto.Hash.SHA1 as SHA1
+
+quickHash :: String -> String
+quickHash str =
+    concatMap (`showHex` "") $ BS.unpack (SHA1.hash $ BC.pack str)
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
new file mode 100644
index 0000000..9712f84
--- /dev/null
+++ b/src/Rahm/Desktop/Keys.hs
@@ -0,0 +1,820 @@
+{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-}
+module Rahm.Desktop.Keys (applyKeys) where
+
+import XMonad.Util.Run (safeSpawn)
+import Data.Monoid (Endo(..))
+import Control.Monad.Trans.Class
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Control.Monad.Loops (iterateWhile)
+import Control.Monad.Fix (fix)
+import Graphics.X11.ExtraTypes.XF86;
+import Rahm.Desktop.KeysM
+import Rahm.Desktop.SwapMaster (swapMaster)
+import XMonad.Hooks.ManageDocks
+import XMonad.Layout.MosaicAlt
+import Graphics.X11.ExtraTypes.XorgDefault
+import System.Process
+import XMonad.Util.Ungrab
+import XMonad.Layout.Spacing
+import Data.Maybe (isJust, fromMaybe)
+import Debug.Trace
+import Control.Applicative
+import Prelude hiding ((!!))
+import Control.Monad
+import Data.Char
+import Data.List hiding ((!!))
+import Data.List.Safe ((!!))
+import Data.Map (Map)
+import Rahm.Desktop.Layout
+import Rahm.Desktop.Marking
+import Rahm.Desktop.PromptConfig
+import System.IO
+import Text.Printf
+import XMonad
+import Rahm.Desktop.Submap
+import XMonad.Actions.WindowNavigation
+import XMonad.Prompt
+import XMonad.Prompt.Input
+import XMonad.Prompt.Shell
+import XMonad.Util.CustomKeys
+import XMonad.Util.Scratchpad
+import XMonad.Actions.RotSlaves
+import XMonad.Actions.CopyWindow as CopyWindow
+import XMonad.Actions.SpawnOn as SpawnOn
+
+import qualified Data.Map as Map
+import qualified XMonad.StackSet as W
+
+import Rahm.Desktop.LayoutList
+import Rahm.Desktop.MouseMotion
+import Rahm.Desktop.Windows
+import Rahm.Desktop.Lib
+import Rahm.Desktop.DMenu
+import Rahm.Desktop.PassMenu
+import Rahm.Desktop.Logger
+import Rahm.Desktop.RebindKeys
+import Rahm.Desktop.Swallow
+import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
+
+type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
+type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
+
+
+spawnX :: String -> X ()
+spawnX = spawn
+
+noWindow :: b -> Window -> b
+noWindow = const
+
+decreaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ -5%"
+increaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ +5%"
+playPause = spawnX "spotify-control play"
+mediaPrev = spawnX "spotify-control prev"
+mediaNext = spawnX "spotify-control next"
+
+decreaseVolumeDoc = doc "Decrease volume" decreaseVolume
+increaseVolumeDoc = doc "Increase volume" increaseVolume
+playPauseDoc = doc "Play/Pause current media" playPause
+mediaPrevDoc = doc "Previous media" mediaPrev
+mediaNextDoc = doc "Next media" mediaNext
+
+
+button6 :: Button
+button6 = 6
+
+button7 :: Button
+button7 = 7
+
+button8 :: Button
+button8 = 8
+
+button9 :: Button
+button9 = 9
+
+button10 :: Button
+button10 = 10
+
+button11 :: Button
+button11 = 11
+
+button12 :: Button
+button12 = 12
+
+button13 :: Button
+button13 = 13
+
+button14 :: Button
+button14 = 14
+
+button15 :: Button
+button15 = 15
+
+keyBindingToKeymap :: (XConfig l -> KeyBindings) -> KeyMap l
+keyBindingToKeymap bindings config = fmap bindingToX (bindings config)
+
+  where
+    bindingToX b =
+      case b of
+        Documented _ (Action x) -> x
+        Documented _ (Submap mapping) ->
+          submap (fmap bindingToX mapping)
+        Documented _ (Repeat mapping) ->
+          fix $ \recur ->
+            submap (fmap (\b -> bindingToX b >> recur) mapping)
+
+keymap :: XConfig l -> KeyBindings
+keymap = runKeys $ do
+  config <- getConfig
+
+  let subkeys keysM = Submap (runKeys keysM config)
+      repeatable keysM = Repeat (runKeys keysM config)
+
+  bind xK_apostrophe $ do
+    justMod $
+      doc "Jumps between marks." $
+      mapNextString $ \_ str ->
+        case str of
+          ['\''] -> jumpToLast
+          [ch] | isAlphaNum ch -> jumpToMark ch
+          "[" -> historyPrev
+          "]" -> historyNext
+          _ -> return ()
+
+    shiftMod $
+      doc "Swap the current window with a mark." $
+      mapNextString $ \_ str ->
+        case str of
+          ['\''] ->  swapWithLastMark
+          [ch] | isAlphaNum ch -> swapWithMark ch
+          _ -> return ()
+
+  bind xK_BackSpace $ do
+    -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
+    -- something goes wrong with the keyboard layout and for first-time boots
+    -- where dmenu/alacritty may not be installed.
+    rawMask mod4Mask $
+      doc "Spawns XTerm as a fallback if xkb is messed up." $
+      spawnX "xterm"
+
+    -- Moves xmobar to different monitors.
+    justMod $
+      doc "Move XMobar to another screen." $
+      spawnX "pkill -SIGUSR1 xmobar"
+
+  bind xK_F1 $ do
+    -- Experimental. Sends 'a' to all windows.
+    --
+    -- I've discovered that many clients ignore such synthetic events, including
+    -- Spotify, Chrome and Gedit. Some, like Chrome, seem to honor them if it's
+    -- focused. It's pretty annoying because it keeps me from doing some cool
+    -- things all for BS security theater, but I guess there might be some way
+    -- to do this via XTest?
+    shiftMod $ forAllWindows  $ \w -> do
+      logs $ "Try send to " ++ show w
+      sendKey (0, xK_a) w
+
+    justMod $
+      doc "Print this documentation"
+      (safeSpawn "gxmessage" [
+        "-fn", "Source Code Pro",
+        documentation (keymap config)] :: X ())
+
+  bind xK_F7 $
+
+    justMod $
+      doc "Print this documentation." $
+      logs (documentation (keymap config))
+
+  bind xK_F10 $ do
+    justMod playPauseDoc
+
+  bind xK_F11 $ do
+    justMod mediaPrevDoc
+
+  bind xK_F12 $ do
+    justMod mediaNextDoc
+
+  bind xK_Return $ do
+    justMod swapMaster
+
+  bind xK_Tab $ do
+    justMod  $ windows W.focusDown
+    shiftMod $ windows W.focusUp
+
+  -- Switch between different screens. These are the leftmost keys on the home
+  -- row in a Dvorak layout. One might want to switch these to ASD for QWERTY.
+  forM_ (zip [xK_a, xK_o, xK_e] [0..]) $ \(key, idx) ->
+    bind key $ do
+      -- Move focus to that screen.
+      justMod  $
+        doc ("Switch focus to screen " ++ show idx) $
+        withScreen W.view idx
+      -- Swap the current screen with the one given
+      altMod   $
+        doc ("Swap the current screen with screen " ++ show idx) $
+        withScreen W.greedyView idx
+      -- Move the current window to the select screen.
+      shiftMod $
+        doc ("Move the current window to screne " ++ show idx) $
+        withScreen W.shift idx
+
+      altgrMod $
+        logs "Test altgr"
+
+  bind xK_bracketright $ do
+    justMod $
+      doc "Increase the gaps between windows." $
+      sendMessage $ modifyWindowBorder 5
+
+  bind xK_bracketleft $ do
+    justMod $
+      doc "Decrease the gaps between windows." $
+      sendMessage $ modifyWindowBorder (-5)
+
+  bind xK_b $ do
+    justMod $ spawnX "bluetooth-select.sh"
+
+  bind xK_c $ do
+    justMod $
+      doc "Run PassMenu" runPassMenu
+
+    shiftMod $
+      doc "Kill the current window" CopyWindow.kill1
+
+  bind xK_f $ do
+    justMod  $
+      doc "Flip the current layout vertically" $
+      sendMessage FlipLayout
+    shiftMod $
+      doc "Flip the current layout horizontally" $
+      sendMessage HFlipLayout
+
+  bind xK_g $ do
+    justMod $
+      doc "Goto a workspace\n\n\t\
+
+      \If the second character typed is alpha-numberic, jump to that\n\t\
+      \workspace. The workspace is created on-the-fly if such a workspace\n\t\
+      \does not exist.\n\n\t\
+
+      \If the second character typed is:\n\t\t\
+         \]: go to the next workspace\n\t\t\
+         \[: go to the previous workspace\n\t\t\
+         \}: cycle the workspaces on the screens to the right\n\t\t\
+         \{: cycle the workspaces on the screens to the left\n\t\t\
+         \<space>: Jump to the accompaning workspace.\n\t\t\
+         \F1: display this help.\n" $
+      mapNextStringWithKeysym $ \_ keysym str ->
+        case (keysym, str) of
+          (_, [ch]) | isAlphaNum ch -> gotoWorkspace ch
+          (_, "]") -> pushHistory $ withRelativeWorkspace next W.greedyView
+          (_, "[") -> pushHistory $ withRelativeWorkspace prev W.greedyView
+          (_, "}") -> windows screenRotateForward
+          (_, "{") -> windows screenRotateBackward
+          (_, " ") -> gotoAccompaningWorkspace
+
+          -- Test binding. Tests that I can still submap keysyms alone (keys
+          -- where XLookupString won't return anything helpful.)
+          (f, _) | f == xK_F1 -> 
+            (safeSpawn "gxmessage" [
+              "-fn", "Source Code Pro",
+              documentation (keymap config)] :: X ())
+
+          _ -> return ()
+    shiftMod $
+      doc "Move the currently focused window to another workspace" $
+      mapNextString $ \_ str ->
+        case str of
+          [ch] | isAlphaNum ch -> shiftToWorkspace ch
+          "]" -> withRelativeWorkspace next W.shift
+          "[" -> withRelativeWorkspace prev W.shift
+          _ -> return ()
+    shiftAltMod $
+      doc "Swap this workspace with another workspace (rename)." $
+      mapNextString $ \_ str ->
+        case str of
+          [ch] | isAlphaNum ch -> swapWorkspace ch
+          _ -> return ()
+
+  bind xK_h $ do
+    justMod $
+      doc "Focus on the next window down in the stack" $
+      windows W.focusDown
+
+    shiftMod $
+      doc "Swap the current window with the next one down in the stack" $
+      windows W.swapDown
+
+    controlMod $
+      doc "Rotate all the windows down the stack"
+      rotAllDown
+
+  bind xK_j $ do
+    justMod $
+      doc "Shrink the size of the zoom region" $
+      sendMessage ShrinkZoom
+
+    shiftMod $
+      doc "Go to the previous window in history." historyPrev
+
+  bind xK_k $ do
+    justMod $
+      doc "Expand the size of the zoom region" $
+      sendMessage ExpandZoom
+
+    shiftMod $
+      doc "Go to the next window in history." historyNext
+
+  bind xK_l $ do
+    justMod    $
+      doc "Focus the next window in the stack" $
+      windows W.focusUp
+
+    shiftMod   $
+      doc "Swap the currently focused window with the next window in the stack." $
+      windows W.swapUp
+
+    controlMod $
+      doc "Rotate the windows up."
+      rotAllUp
+
+    altMod $
+      doc "Lock the screen" $
+      spawnX "xsecurelock"
+
+  bind xK_minus $ do
+    justMod  $
+      doc "Decrease the number of windows in the  master region." $
+      sendMessage (IncMasterN (-1))
+
+    shiftMod $
+      doc "For mosaic layout, shrink the size-share of the current window" $
+      withFocused $ sendMessage . shrinkWindowAlt
+
+  bind xK_m $ do
+    justMod $
+      doc "Mark the current window with the next typed character." $
+      mapNextString $ \_ str ->
+        case str of
+          [ch] | isAlphaNum ch -> markCurrentWindow ch
+          _ -> return ()
+
+  bind xK_n $ do
+    justMod $
+      doc "Shift to the next workspace." $
+      withRelativeWorkspace next W.greedyView
+
+  bind xK_p $ do
+    justMod $
+      doc "Shift to the previous workspace." $
+      withRelativeWorkspace prev W.greedyView
+
+  bind xK_plus $ do
+    justMod $
+      doc "Increase the number of windows in the master region." $
+      sendMessage (IncMasterN 1)
+
+    shiftMod $
+      doc "For mosaic layout, increase the size-share of the current window." $
+      withFocused $ sendMessage . expandWindowAlt
+
+  bind xK_q $ do
+    shiftMod $
+      doc "Recompile and restart XMonad" $
+      spawnX "xmonad --recompile && xmonad --restart"
+
+    justMod $
+      doc "Experimental Bindings" $
+      subkeys $ do
+
+      bind xK_q $
+        (justMod -|- noMod) $
+          doc "EXPERIMENTAL: Move mouse to control media." $
+            mouseRotateMotion (logs "CW") (logs "CCW")
+
+  bind xK_r $ do
+    justMod $ doc "Run a command via Rofi" runDMenu
+    shiftMod $
+      doc "Rotate the current layout. (flips x, y coordinates)" $
+      sendMessage DoRotate
+
+  bind xK_s $ do
+    altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
+
+  bind xK_space $ do
+    justMod  $
+      doc "Use the next layout in the layout list." $ sendMessage toNextLayout
+
+    altMod   $
+      doc "Reset the layout to the default layout." $ sendMessage toFirstLayout
+
+    shiftMod $
+      doc "Use the previous layout in the layout list." $
+        sendMessage toPreviousLayout
+
+  bind xK_t $ do
+    justMod  $
+      doc "Spawn a terminal." $ spawnX (terminal config)
+
+    shiftMod $
+      doc "Sink the current window into the tiling." $ withFocused $ windows . W.sink
+
+    altMod   $
+      doc "Spawn a floating terminal" $ spawnX (terminal config ++ " -t Floating\\ Term")
+
+  bind xK_v $
+    -- Allows repeated strokes of M-h and M-l to reduce and increase volume
+    -- respectively.
+    justMod $
+      doc "Changes the volume." $
+      repeatable $ do
+        bind xK_h $
+          justMod $
+             doc "Decrease volume."
+             decreaseVolumeDoc
+
+        bind xK_l $
+          justMod $
+             doc "Increase volume."
+             increaseVolumeDoc
+
+        bind xK_v $
+          justMod (return () :: X ())
+
+  bind xK_w $ do
+    justMod $ doc "Jump to a window (via rofi)" windowJump
+
+  bind xK_x $ do
+    justMod $
+      doc "Toggles respect for struts." $
+      sendMessage ToggleStruts
+
+  bind xK_z $ do
+
+    justMod $
+      doc "Less often used keybindings." $
+      subkeys $ do
+
+        bind xK_g $ do
+          (justMod -|- noMod) $
+            doc "Copy a window to the given workspace" $
+            mapNextString $ \_ s ->
+              case s of
+                [ch] | isAlphaNum ch -> windows (CopyWindow.copy s)
+                _ -> return ()
+
+        bind xK_p $ do
+          (justMod -|- noMod) $
+            doc "Go to the prior window in the history" historyPrev
+
+        bind xK_t $ do
+          (justMod -|- noMod) $ logs "Test Log"
+
+        -- bind xK_n $ do
+        --   (justMod -|- noMod) $
+        --     doc "Take a note" $
+        --     spawnX (terminal config ++ " -t Notes -e notes new")
+        bind xK_n $ do
+          (justMod -|- noMod) $
+            doc "Go to the next window in the history" historyNext
+
+        bind xK_c $ do
+          shiftMod $
+            doc "Kill all other copies of a window."
+            CopyWindow.killAllOtherCopies
+
+        bind xK_e $ do
+          (justMod -|- noMod) $
+            doc "Select an emoji" $
+            spawnX "emoji-select.sh"
+
+          (shiftMod -|- rawMask shiftMask) $
+            doc "Select an emoticon" $
+            spawnX "emoticon-select.sh"
+
+        bind xK_a $
+          (justMod -|- noMod) $
+            doc "Move the audio sink for an application." $
+            spawnX "set-sink.sh"
+
+        bind xK_w $
+          (justMod -|- noMod) $
+            doc "Select a network to connect to." $
+            spawnX "networkmanager_dmenu"
+
+        bind xK_o $
+          (justMod -|- noMod) $
+            doc "Open a file from the library" $
+            spawnX "library-view.sh"
+
+        bind xK_s $
+          (justMod -|- noMod) $
+            doc "Toggle the ability for terminals to swallow child windows."
+            toggleSwallowEnabled
+
+        bind xK_v $ do
+          (justMod -|- noMod) $
+            doc "Set the volume via rofi." $
+            spawnX "set-volume.sh"
+          (shiftMod -|- rawMask shiftMask) $
+            doc "Set the volume of an application via rofi." $
+            spawnX "set-volume.sh -a"
+
+        -- Double-tap Z to toggle zoom.
+        bind xK_z $ do
+          noMod -|- justMod $
+            doc "Toggle zoom on the current window." $
+            sendMessage ToggleZoom
+
+        -- Z is reserved to create sub keybindings to do various things.
+        -- I don't really use these at the moment.
+        bind xK_h $ noMod mediaPrevDoc
+        bind xK_j $ noMod playPauseDoc
+        bind xK_l $ noMod mediaNextDoc
+
+    -- Centers the current focused window. i.e. toggles the Zoom layout
+    -- modifier.
+    shiftMod $
+      doc "Toggle zoom on the current window." $
+      sendMessage ToggleZoom
+
+  bind xF86XK_Calculator $ do
+    noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
+
+  bind xF86XK_AudioLowerVolume $ do
+    noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ -1%"
+    justMod mediaPrevDoc
+
+  bind xF86XK_AudioRaiseVolume $ do
+    noMod $ spawnX "pactl set-sink-volume @DEFAULT_SINK@ +1%"
+    justMod mediaNextDoc
+
+  bind xF86XK_AudioMute $ do
+    noMod $ spawnX "pactl set-sink-mute @DEFAULT_SINK@ toggle"
+
+  bind xF86XK_AudioPlay $ do
+    noMod playPauseDoc
+
+  bind xF86XK_AudioNext $ do
+    noMod mediaNextDoc
+
+  bind xF86XK_AudioPrev $ do
+    noMod mediaPrevDoc
+
+  bind xF86XK_AudioPrev $ do
+    noMod mediaPrevDoc
+
+  bind xF86XK_MonBrightnessUp $ do
+    noMod $ spawnX "set-backlight.sh +0.05"
+    justMod $ spawnX "set-backlight.sh 1"
+
+  bind xF86XK_MonBrightnessDown $ do
+    noMod $ spawnX "set-backlight.sh -0.05"
+    justMod $ spawnX "set-backlight.sh 0.01"
+    rawMask shiftMask $ spawnX "set-backlight.sh 0"
+
+mouseMap :: ButtonsMap l
+mouseMap = runButtons $ do
+  config <- getConfig
+
+  let x button = Map.lookup button (mouseMap config)
+
+  let defaultButtons button = fromMaybe (\w -> return ()) $
+          Map.lookup button (mouseMap config)
+      subMouse = submapButtonsWithKey defaultButtons . flip runButtons config
+
+
+  let continuous :: [(Button, X ())] -> Button -> Window -> X ()
+      continuous actions button w = do
+        case find ((==button) . fst) actions of
+          Just (_, action) -> action
+          Nothing -> return ()
+
+        (subMouse $
+          forM_ (map fst actions) $ \b ->
+            bind b $ noMod $ \w -> continuous actions b w) w
+
+  bind button1 $ do
+    justMod $ \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster
+
+  bind button2 $ do
+    justMod $ windows . (W.shiftMaster .) . W.focusWindow
+
+  bind button3 $ do
+    justMod $ \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster
+
+  bind button6 $
+    justMod $ noWindow (withRelativeWorkspace prev W.greedyView)
+
+  bind button7 $
+    justMod $ noWindow (withRelativeWorkspace next W.greedyView)
+
+  bind button8 $
+    justMod $ noWindow mediaPrev
+
+  bind button9 $
+    justMod $ noWindow mediaNext
+
+  bind button14 $ do
+    noMod $ subMouse $ do
+
+      bind button3 $
+        noMod $ noWindow (gotoWorkspace 's')
+
+      bind button13 $ do
+        noMod $ noWindow $ click >> CopyWindow.kill1
+
+      bind button14 $ do
+        noMod $ noWindow $ click >> sendMessage ToggleZoom
+
+      bind button15 $ do
+        noMod $ noWindow $ spawnX "pavucontrol"
+
+      let mediaButtons = [
+            (button4, increaseVolume),
+            (button5, decreaseVolume),
+            (button2, playPause),
+            (button9, historyNext),
+            (button8, historyPrev),
+            (button6, mediaPrev),
+            (button7, mediaNext)
+            ]
+
+      forM_ (map fst mediaButtons) $ \b ->
+        bind b $ noMod $ continuous mediaButtons b
+
+  bind button13 $ noMod $ subMouse $ do
+    bind button1 $ noMod mouseMoveWindow
+    bind button2 $ noMod $ windows . W.sink
+    bind button3 $ noMod mouseResizeWindow
+
+    bind button13 $ noMod $ subMouse $ do
+      bind button13 $ noMod $ subMouse $ do
+        bind button13 $ noMod $ noWindow $ spawnX "xsecurelock"
+        bind button1 $ noMod $ noWindow $
+          spawnX "sudo -A systemctl suspend && xsecurelock"
+
+  bind button15 $ do
+
+    noMod $ subMouse $ do
+      bind button13 $ noMod $ noWindow gotoAccompaningWorkspace
+
+      bind button15 $ do
+        noMod $ noWindow jumpToLast
+
+
+      let workspaceButtons = [
+            (button2, swapMaster),
+
+            (button9, withRelativeWorkspace next W.greedyView),
+            (button8, withRelativeWorkspace prev W.greedyView),
+
+            (button4, windows W.focusUp),
+            (button5, windows W.focusDown),
+
+            (button7, windows screenRotateForward),
+            (button6, windows screenRotateBackward)
+            ]
+
+      forM_ (map fst workspaceButtons) $ \b ->
+        bind b $ noMod $ continuous workspaceButtons b
+
+-- Bindings specific to a window. These are set similarly to th ekeymap above,
+-- but uses a Query monad to tell which windows the keys will apply to.
+--
+-- This is useful to create hotkeys in applications where hot keys are not
+-- configurable, or to remove keybindings that are irritating (looking at you,
+-- ctrl+w in Chrome!!).
+windowSpecificBindings ::
+  XConfig l -> WriterT (Map (KeyMask, KeySym) (X ())) Query ()
+windowSpecificBindings config = do
+
+  w <- lift ask
+
+  let configureIf b k = tell =<< lift (b --> return (keyBindingToKeymap (runKeys k) config))
+      emitKey = flip sendKey w
+
+  configureIf (flip elem browsers <$> className) $ do
+
+    -- if the window is a browser, configure these bindings. Lots of browsers
+    -- make up their own garbage bindings that are not standard across many
+    -- other applications. This alleviates the issue.
+    --
+    -- Consistency with terminal:
+    --
+    --   Ctrl+h is backspace
+    --   Ctrl+w is ctrl+backspace
+    --   Ctrl+u is ctrl+shift+backspace
+    --
+    -- Consistency with Vim/Emacs-ish:
+    --
+    --   Alt+{Shift,Ctrl,}+{h,j,k,l} -> {Shift,Ctrl,}+{Left,Down,Up,Right}
+    --   Ctrl+b -> Ctrl+Left
+    --   Ctrl+e -> Ctrl+Right
+    --   Ctrl+$ -> End
+    --   Ctrl+^ -> Home
+    --
+    --   Ctrl+d -> Delete current tab.
+
+
+    let mods = permuteMods [shiftMask, controlMask, 0]
+
+    bind xK_h $ do
+      rawMask controlMask $ emitKey (0, xK_BackSpace)
+      forM_ mods $ \mask ->
+        rawMask (altMask .|. mask) $ emitKey (mask, xK_Left)
+
+    bind xK_j $
+      forM_ mods $ \mask ->
+        rawMask (altMask .|. mask) $ emitKey (mask, xK_Down)
+
+    bind xK_k $
+      forM_ mods $ \mask ->
+        rawMask (altMask .|.mask) $ emitKey (mask, xK_Up)
+
+    bind xK_l $
+      forM_ mods $ \mask ->
+        rawMask (altMask .|. mask) $ emitKey (mask, xK_Right)
+
+    bind xK_u $
+      rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_BackSpace)
+
+    bind xK_w $
+      rawMask controlMask $ emitKey (controlMask, xK_BackSpace)
+
+    bind xK_b $ do
+      rawMask controlMask $ emitKey (controlMask, xK_Left)
+      rawMask (controlMask .|. shiftMask) $
+        emitKey (controlMask .|. shiftMask, xK_Left)
+
+    bind xK_e $ do
+      rawMask controlMask $ emitKey (controlMask, xK_Right)
+      rawMask (controlMask .|. shiftMask) $
+        emitKey (controlMask .|. shiftMask, xK_Right)
+
+    bind xK_dollar $
+      rawMask controlMask $ emitKey (0, xK_End)
+
+    bind xK_at $
+      rawMask (controlMask .|. shiftMask) $ emitKey (0, xK_Home)
+
+    bind xK_d $
+      rawMask controlMask $ emitKey (controlMask, xK_w)
+
+    bind xK_F2 $
+      -- Experimental.
+      noMod $ logs "This is a test"
+
+  -- Add a binding to xev as a test.
+  configureIf (title =? "Event Tester") $
+    bind xK_F2 $
+      noMod $ emitKey (controlMask, xK_F2)
+
+  where
+    browsers = ["Google-chrome", "Brave-browser", "firefox-default"]
+
+    -- Create a permutation from a list of modifiers.
+    --
+    -- i.e. permuteMods [C, S, M] will return
+    --
+    -- [C, S, M, C + M, C + S, M + S, C + S + M, 0]
+    permuteMods = map (foldl' (.|.) 0) . filterM (const [True, False])
+
+windowBindings :: XConfig l -> XConfig l
+windowBindings xconfig =
+  xconfig {
+    startupHook = do
+      forAllWindows (runQuery doQuery)
+      startupHook xconfig,
+
+    manageHook = (doQuery >> return (Endo id)) <> manageHook xconfig
+  }
+
+  where
+    doQuery :: Query ()
+    doQuery = do
+      map <- execWriterT $ windowSpecificBindings xconfig
+      w <- ask
+
+      liftX $ logs $ printf "For Window: %s" (show w)
+      forM_ (Map.toList map) $ \(key, action) -> do
+        liftX $ logs $ printf "   -- remap: %s" (show key)
+        remapKey key action
+
+applyKeys :: XConfig l -> IO (XConfig l)
+applyKeys config =
+    return $ windowBindings $ config { keys = keyBindingToKeymap keymap, mouseBindings = mouseMap }
+
+click :: X ()
+click = do
+  (dpy, root) <- asks $ (,) <$> display <*> theRoot
+  (_, _, window, _, _, _, _, _) <- io $ queryPointer dpy root
+  focus window
+
+modifyWindowBorder :: Integer -> SpacingModifier
+modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
+  Border (clip $ a + i) (clip $ b + i) (clip $ c + i) (clip $ d + i)
+
+  where clip i | i < 0 = 0
+        clip i = i
diff --git a/src/Rahm/Desktop/KeysM.hs b/src/Rahm/Desktop/KeysM.hs
new file mode 100644
index 0000000..ef52c24
--- /dev/null
+++ b/src/Rahm/Desktop/KeysM.hs
@@ -0,0 +1,497 @@
+{-# Language GeneralizedNewtypeDeriving, MultiParamTypeClasses,
+   FunctionalDependencies, FlexibleInstances, TypeFamilies, FlexibleContexts #-}
+module Rahm.Desktop.KeysM where
+
+import Data.List
+import Data.Bits ((.&.))
+import Control.Monad.Writer
+import Text.Printf
+import Control.Arrow (second, first)
+import Control.Monad (void)
+import Control.Monad.State (State(..), modify', get, execState)
+import XMonad
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+data Documented t = Documented String t
+
+data KeyBinding =
+       Action (X ()) |
+       Submap KeyBindings |
+       Repeat KeyBindings
+
+type KeyBindings = Map (KeyMask, KeySym) (Documented KeyBinding)
+
+type ButtonBinding = Window -> X ()
+type ButtonBindings = Map (KeyMask, Button) ButtonBinding
+
+{- Module that defines a DSL for binding keys. -}
+newtype KeysM l a = KeysM (State (XConfig l, KeyBindings) a)
+  deriving (Functor, Applicative, Monad)
+
+newtype ButtonsM l a = ButtonsM (State (XConfig l, ButtonBindings) a)
+  deriving (Functor, Applicative, Monad)
+
+newtype BindingBuilder b a = BindingBuilder (State (KeyMask, [(KeyMask, b)]) a)
+  deriving (Functor, Applicative, Monad)
+
+class HasConfig m where
+  getConfig :: m l (XConfig l)
+
+class Bindable k where
+  type BindableValue k :: *
+  type BindableMonad k :: (* -> *) -> * -> *
+
+  bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
+  -- section :: String -> BindableMonad k l () -> BindableMonad k l ()
+
+class Binding k b where
+  toB :: k -> b
+
+  rawMask :: KeyMask -> k -> BindingBuilder b ()
+  rawMask m x = BindingBuilder $ modify' (second ((m, toB x):))
+
+instance Binding (X ()) (Documented KeyBinding) where
+  toB = Documented "" . Action
+
+instance Binding KeyBindings (Documented KeyBinding) where
+  toB = Documented "" . Submap
+
+instance Binding a (Documented a) where
+  toB = Documented ""
+
+instance Binding a a where
+  toB = id
+
+doc :: (Binding k (Documented KeyBinding)) => String -> k -> Documented KeyBinding
+doc str k = let (Documented _ t) = toB k in Documented str t
+
+runKeys :: KeysM l a -> XConfig l -> KeyBindings
+runKeys (KeysM stateM) config =
+  snd $ execState stateM (config, Map.empty)
+
+runButtons :: ButtonsM l a -> XConfig l -> ButtonBindings
+runButtons (ButtonsM stateM) config =
+  snd $ execState stateM (config, Map.empty)
+
+instance HasConfig KeysM where
+  getConfig = fst <$> KeysM get
+
+instance HasConfig ButtonsM where
+  getConfig = fst <$> ButtonsM get
+
+{- Generally it is assumed that the mod key shoud be pressed, but not always. -}
+noMod :: (Binding k b) => k -> BindingBuilder b ()
+noMod = rawMask 0
+
+maskMod :: (Binding k b) => KeyMask -> k -> BindingBuilder b ()
+maskMod mask action = do
+  modMask <- fst <$> BindingBuilder get
+  rawMask (modMask .|. mask) action
+
+altMask :: KeyMask
+altMask = mod1Mask
+
+hyperMask :: KeyMask
+hyperMask = mod3Mask
+
+altgrMask :: KeyMask
+altgrMask = 0x80
+
+superMask :: KeyMask
+superMask = mod4Mask
+
+justMod :: (Binding k b) => k -> BindingBuilder b ()
+justMod = maskMod 0
+
+instance Bindable KeySym where
+  type BindableValue KeySym = Documented KeyBinding
+  type BindableMonad KeySym = KeysM
+
+  -- bind :: KeySym -> BindingBuilder (X x) a -> KeysM l ()
+  bind key (BindingBuilder stM) = do
+    m <- modMask <$> getConfig
+    let (_, values) = execState stM (m, [])
+
+    KeysM $ modify' $ second $
+      flip (<>) (Map.fromList (map (\(m, v) -> ((m, key), v)) values))
+
+
+instance Bindable Button where
+  type BindableValue Button = ButtonBinding
+  type BindableMonad Button = ButtonsM
+
+  -- bind :: KeySym -> BindingBuilder (Window -> X ()) a -> ButtonsM l ()
+  bind button (BindingBuilder stM) = do
+    m <- modMask <$> getConfig
+    let (_, values) = execState stM (m, [])
+
+    ButtonsM $ modify' $ second $
+      flip (<>) (Map.fromList (map (\(m, v) -> ((m, button), v)) values))
+
+shiftControlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltSuperHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftControlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltSuperHyperMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask)
+
+shiftControlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltSuperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. altgrMask)
+
+shiftControlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltSuperMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask)
+
+shiftControlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask .|. altgrMask)
+
+shiftControlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltHyperMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask)
+
+shiftControlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. altgrMask)
+
+shiftControlAltMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltMod =
+  maskMod (shiftMask .|. controlMask .|. altMask)
+
+shiftControlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlSuperHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftControlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlSuperHyperMod =
+  maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask)
+
+shiftControlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlSuperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. superMask .|. altgrMask)
+
+shiftControlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlSuperMod =
+  maskMod (shiftMask .|. controlMask .|. superMask)
+
+shiftControlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. hyperMask .|. altgrMask)
+
+shiftControlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlHyperMod =
+  maskMod (shiftMask .|. controlMask .|. hyperMask)
+
+shiftControlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altgrMask)
+
+shiftControlMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlMod =
+  maskMod (shiftMask .|. controlMask)
+
+shiftAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltSuperHyperAltgrMod =
+  maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltSuperHyperMod =
+  maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask)
+
+shiftAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltSuperAltgrMod =
+  maskMod (shiftMask .|. altMask .|. superMask .|. altgrMask)
+
+shiftAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltSuperMod =
+  maskMod (shiftMask .|. altMask .|. superMask)
+
+shiftAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltHyperAltgrMod =
+  maskMod (shiftMask .|. altMask .|. hyperMask .|. altgrMask)
+
+shiftAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltHyperMod =
+  maskMod (shiftMask .|. altMask .|. hyperMask)
+
+shiftAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltAltgrMod =
+  maskMod (shiftMask .|. altMask .|. altgrMask)
+
+shiftAltMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltMod =
+  maskMod (shiftMask .|. altMask)
+
+shiftSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftSuperHyperAltgrMod =
+  maskMod (shiftMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftSuperHyperMod =
+  maskMod (shiftMask .|. superMask .|. hyperMask)
+
+shiftSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftSuperAltgrMod =
+  maskMod (shiftMask .|. superMask .|. altgrMask)
+
+shiftSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftSuperMod =
+  maskMod (shiftMask .|. superMask)
+
+shiftHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftHyperAltgrMod =
+  maskMod (shiftMask .|. hyperMask .|. altgrMask)
+
+shiftHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftHyperMod =
+  maskMod (shiftMask .|. hyperMask)
+
+shiftAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltgrMod =
+  maskMod (shiftMask .|. altgrMask)
+
+shiftMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftMod = maskMod shiftMask
+
+controlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltSuperHyperAltgrMod =
+  maskMod (controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+controlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltSuperHyperMod =
+  maskMod (controlMask .|. altMask .|. superMask .|. hyperMask)
+
+controlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltSuperAltgrMod =
+  maskMod (controlMask .|. altMask .|. superMask .|. altgrMask)
+
+controlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltSuperMod =
+  maskMod (controlMask .|. altMask .|. superMask)
+
+controlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltHyperAltgrMod =
+  maskMod (controlMask .|. altMask .|. hyperMask .|. altgrMask)
+
+controlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltHyperMod =
+  maskMod (controlMask .|. altMask .|. hyperMask)
+
+controlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltAltgrMod =
+  maskMod (controlMask .|. altMask .|. altgrMask)
+
+controlAltMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltMod =
+  maskMod (controlMask .|. altMask)
+
+controlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlSuperHyperAltgrMod =
+  maskMod (controlMask .|. superMask .|. hyperMask .|. altgrMask)
+
+controlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlSuperHyperMod =
+  maskMod (controlMask .|. superMask .|. hyperMask)
+
+controlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlSuperAltgrMod =
+  maskMod (controlMask .|. superMask .|. altgrMask)
+
+controlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlSuperMod =
+  maskMod (controlMask .|. superMask)
+
+controlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlHyperAltgrMod =
+  maskMod (controlMask .|. hyperMask .|. altgrMask)
+
+controlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlHyperMod =
+  maskMod (controlMask .|. hyperMask)
+
+controlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltgrMod =
+  maskMod (controlMask .|. altgrMask)
+
+controlMod :: (Binding k b) => k -> BindingBuilder b ()
+controlMod = maskMod controlMask
+
+altSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+altSuperHyperAltgrMod =
+  maskMod (altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+altSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+altSuperHyperMod =
+  maskMod (altMask .|. superMask .|. hyperMask)
+
+altSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+altSuperAltgrMod =
+  maskMod (altMask .|. superMask .|. altgrMask)
+
+altSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+altSuperMod =
+  maskMod (altMask .|. superMask)
+
+altHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+altHyperAltgrMod =
+  maskMod (altMask .|. hyperMask .|. altgrMask)
+
+altHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+altHyperMod =
+  maskMod (altMask .|. hyperMask)
+
+altAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+altAltgrMod =
+  maskMod (altMask .|. altgrMask)
+
+altMod :: (Binding k b) => k -> BindingBuilder b ()
+altMod = maskMod altMask
+
+superHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+superHyperAltgrMod =
+  maskMod (superMask .|. hyperMask .|. altgrMask)
+
+superHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+superHyperMod =
+  maskMod (superMask .|. hyperMask)
+
+superAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+superAltgrMod =
+  maskMod (superMask .|. altgrMask)
+
+superMod :: (Binding k b) => k -> BindingBuilder b ()
+superMod = maskMod superMask
+
+hyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+hyperAltgrMod =
+  maskMod (hyperMask .|. altgrMask)
+
+hyperMod :: (Binding k b) => k -> BindingBuilder b ()
+hyperMod = maskMod hyperMask
+
+altgrMod :: (Binding k b) => k -> BindingBuilder b ()
+altgrMod = maskMod altgrMask
+
+{- Can combine two or more of the functions above to apply the same action to
+ - multiple masks. -}
+(-|-) :: (Binding k b) =>
+          (k -> BindingBuilder b ()) ->
+          (k -> BindingBuilder b ()) ->
+          k -> BindingBuilder b ()
+(-|-) fn1 fn2 f = fn1 f >> fn2 f
+
+{- Meant for submapping, binds all alphanumeric charactes to (fn c). -}
+mapNumbersAndAlpha :: KeyMask -> (Char -> X ()) -> KeysM l ()
+mapNumbersAndAlpha km fn = do
+  mapNumbers km fn
+  mapAlpha km fn
+
+{- Meant for submapping. This binds all numbers to (fn x) where x is the number
+ - pressed and fn is the function provided. -}
+mapNumbers :: KeyMask -> (Char -> X ()) -> KeysM l ()
+mapNumbers km fn = do
+  mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch))
+    [ (xK_0, '0')
+    , (xK_1, '1')
+    , (xK_2, '2')
+    , (xK_3, '3')
+    , (xK_4, '4')
+    , (xK_5, '5')
+    , (xK_6, '6')
+    , (xK_7, '7')
+    , (xK_8, '8')
+    , (xK_9, '9')
+    -- Programmer Dvorak shifts the numbers so I have to map to their unshifted
+    -- form.
+    , (xK_bracketright, '6')
+    , (xK_exclam, '8')
+    , (xK_bracketleft, '7')
+    , (xK_braceleft, '5')
+    , (xK_braceright, '3')
+    , (xK_parenleft, '1')
+    , (xK_equal, '9')
+    , (xK_asterisk, '0')
+    , (xK_parenright, '2')
+    , (xK_plus, '4') ]
+
+{- Meant for submapping. This binds all alpha charactes to (fn c) where c is the
+ - character pressed and fn is the function provided. -}
+mapAlpha :: KeyMask -> (Char -> X ()) -> KeysM l ()
+mapAlpha km fn =
+  mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch)) [
+    (xK_a, 'a')
+  , (xK_b, 'b')
+  , (xK_c, 'c')
+  , (xK_d, 'd')
+  , (xK_e, 'e')
+  , (xK_f, 'f')
+  , (xK_g, 'g')
+  , (xK_h, 'h')
+  , (xK_i, 'i')
+  , (xK_j, 'j')
+  , (xK_k, 'k')
+  , (xK_l, 'l')
+  , (xK_m, 'm')
+  , (xK_n, 'n')
+  , (xK_o, 'o')
+  , (xK_p, 'p')
+  , (xK_q, 'q')
+  , (xK_r, 'r')
+  , (xK_s, 's')
+  , (xK_t, 't')
+  , (xK_u, 'u')
+  , (xK_v, 'v')
+  , (xK_w, 'w')
+  , (xK_x, 'x')
+  , (xK_y, 'y')
+  , (xK_z, 'z')
+  ]
+
+
+documentation :: KeyBindings -> String
+documentation = execWriter . document' ""
+  where
+    document' pref keybindings =
+      forM_ (sortOn (map (\(a, b) -> (b, a)) . snd . snd) $ Map.toList (keyBindingsToList keybindings)) $ \(doc, (thing, keys)) -> do
+        when ((not $ null doc) || hasSubmap thing) $
+          tell $ printf "%s%s: %s\n" pref (intercalate " or " $ map prettyShow keys) doc
+        case thing of
+          Action _ -> return ()
+          Submap submap -> document' (pref ++ "  ") submap
+          Repeat submap -> do
+            tell pref
+            tell "  (repeatable):\n"
+            document' (pref ++ "    ") submap
+
+    keyBindingsToList :: KeyBindings -> Map String (KeyBinding, [(KeyMask, KeySym)])
+    keyBindingsToList b =
+      fmap (\list -> ((\(_, Documented _ t) -> t) (head list), map fst list)) $
+        group (\(_, Documented doc _) -> doc) (sortOn (snd . fst) $ Map.toList b)
+
+    prettyShow :: (KeyMask, KeySym) -> String
+    prettyShow (mask, key) = printf "<%s%s>" (showMask mask) (keysymToString key)
+
+    hasSubmap b = case b of
+      Action _ -> False
+      _ -> True
+
+
+    showMask :: KeyMask -> String
+    showMask mask =
+      let masks = [(shiftMask, "S"),
+                   (altMask, "A"),
+                   (mod3Mask, "H"),
+                   (mod4Mask, "M"),
+                   (altgrMask, "AGr"),
+                   (controlMask, "C")] in
+
+              concatMap ((++"-") . snd) $ filter ((/=0) . (.&.mask) . fst) masks
+
+
+    group :: (Ord b) => (a -> b) -> [a] -> (Map b [a])
+    group fn = Map.fromListWith (++) . map (first fn . (\a -> (a, [a])))
+
+
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
new file mode 100644
index 0000000..95854b8
--- /dev/null
+++ b/src/Rahm/Desktop/Layout.hs
@@ -0,0 +1,326 @@
+{-# LANGUAGE MultiParamTypeClasses, ViewPatterns, FlexibleInstances, KindSignatures, DataKinds, GADTs, RankNTypes, PolyKinds #-}
+module Rahm.Desktop.Layout where
+
+import GHC.TypeLits
+
+import Data.Proxy (Proxy(..))
+import Rahm.Desktop.CornerLayout (Corner(..))
+import Control.Arrow (second)
+import XMonad.Hooks.ManageDocks
+import XMonad.Layout.Circle
+import XMonad.Layout.Accordion
+import Control.Applicative
+import XMonad.Layout.Spacing
+import Data.List
+import XMonad.Layout.Spiral
+import XMonad.Layout.ThreeColumns
+import XMonad.Layout.Grid
+import XMonad.Layout.Dishes
+import XMonad.Layout.MosaicAlt
+import XMonad.Layout.Fullscreen
+import qualified XMonad.Layout.Dwindle as D
+import XMonad.Layout
+import XMonad.Layout.LayoutModifier
+import XMonad
+import XMonad.Core
+import XMonad.Layout.NoBorders (smartBorders, noBorders)
+
+import Rahm.Desktop.LayoutList
+import Rahm.Desktop.Windows
+
+import qualified Data.Map as M
+import qualified XMonad.StackSet as W
+
+myLayout =
+  fullscreenFull $
+    avoidStruts $
+      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
+        layoutZipper $
+          mods (reinterpretIncMaster $ spiral (6/7)) |:
+          mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
+          mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
+          mods (ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2))) |:
+          mods (ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2))) |:
+          mods Grid |:
+          mods (Dishes 2 (1/6)) |:
+          mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1) |:
+          nil
+
+-- This is a type class that defines how to reinterpret a message. One can think
+-- of this as a kind of type-level function. It lets one associate a function
+-- (reinterpretMessage) with a type construct, which for the case below is a
+-- Symbol.
+--
+-- It would be nice to attach this function to the LayoutModifier directly as a
+-- value, however LayoutModifiers must be Show-able and Read-able and functions
+-- are not. However encoding in the typesystem itsef which function is to be
+-- called is the best alternative I have.
+class DoReinterpret (k :: t) where
+  reinterpretMessage ::
+    Proxy k -> SomeMessage -> X (Maybe SomeMessage)
+
+-- Mosaic doesn't have the concept of a "Master Space", so reinterpret messages
+-- intended to modify the master space and instead have those messages expand
+-- and shrink the current window.
+--
+-- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system
+-- hacking one can do in Haskell.
+instance DoReinterpret "ForMosaic" where
+  
+  -- IncMaster message
+  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
+    fmap (SomeMessage .
+      (if n > 0
+        then expandWindowAlt
+        else shrinkWindowAlt)) <$> getFocusedWindow
+  
+  -- ResizeMaster message
+  reinterpretMessage _ (fromMessage -> Just m) = do
+    fmap (SomeMessage .
+      (case m of
+        Expand -> expandWindowAlt
+        Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
+
+  -- Messages that don't match the above, just leave it unmodified.
+  reinterpretMessage _ m = return (Just m)
+
+instance DoReinterpret "IncMasterToResizeMaster" where
+  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) =
+    return $ Just $
+      if n > 0
+        then SomeMessage Expand
+        else SomeMessage Shrink
+  reinterpretMessage _ m = return (Just m)
+
+-- Data construct for association a DoReinterpret function with a concrete
+-- construct that can be used in the LayoutModifier instance.
+--
+-- It wolud be nice to have ReinterpretMessage hold the function as a value
+-- rather than delegate to this kind-instance, however, it won't work because
+-- LayoutModifiers have to be Read-able and Show-able, and functions are neither
+-- of those, so a value-level function may not be a member of a LayoutModifier,
+-- thus I have to settle for delegating to a hard-coded instance using
+-- type-classes.
+data ReinterpretMessage k a = ReinterpretMessage
+  deriving (Show, Read)
+
+-- Instance for ReinterpretMessage as a Layout modifier.
+instance (DoReinterpret k) =>
+      LayoutModifier (ReinterpretMessage k) a where 
+
+  handleMessOrMaybeModifyIt self message = do
+
+    -- Delegates to the reinterpretMessage function associatied with the
+    -- type-variable k.
+    newMessage <- reinterpretMessage (ofProxy self) message
+    case newMessage of
+      Just m -> return $ Just $ Right m
+      Nothing -> return $ Just $ Left self
+    where
+      -- ofProxy just provides reifies the phantom type k so the type system can
+      -- figure out what instance to go to.
+      ofProxy :: ReinterpretMessage k a -> Proxy k
+      ofProxy _ = Proxy
+
+modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a
+modifyMosaic = ModifiedLayout ReinterpretMessage
+
+reinterpretIncMaster ::
+  l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a
+reinterpretIncMaster = ModifiedLayout ReinterpretMessage
+
+mods =
+  ModifiedLayout (Zoomable False 0.05 0.05) .
+    ModifiedLayout (Flippable False) .
+    ModifiedLayout (HFlippable False) .
+    ModifiedLayout (Rotateable False)
+
+
+data ModifyDescription m l a = ModifyDescription m (l a)
+  deriving (Show, Read)
+
+data TallDescriptionModifier = TallDescriptionModifier
+  deriving (Show, Read)
+
+data ThreeColDescMod = ThreeColDescMod
+  deriving (Show, Read)
+
+class DescriptionModifier m l where
+  newDescription :: m -> l a -> String -> String
+
+instance (Typeable m, Show m, DescriptionModifier m l, LayoutClass l a) => LayoutClass (ModifyDescription m l) a where
+  runLayout (W.Workspace t (ModifyDescription m l) a) rect = do
+    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
+    return (rects, fmap (ModifyDescription m) maybeNewLayout)
+
+  doLayout (ModifyDescription m l) a s = do
+    (rects, maybeNewLayout) <- doLayout l a s
+    return (rects, fmap (ModifyDescription m) maybeNewLayout)
+
+  pureLayout (ModifyDescription m l) a s = pureLayout l a s
+
+  emptyLayout (ModifyDescription m l) a = do
+    (rects, maybeNewLayout) <- emptyLayout l a
+    return (rects, fmap (ModifyDescription m) maybeNewLayout)
+
+  handleMessage (ModifyDescription m l) a = do
+    maybeNewLayout <- handleMessage l a
+    return (ModifyDescription m <$> maybeNewLayout)
+
+  pureMessage (ModifyDescription m l) a =
+    let maybeNewLayout = pureMessage l a in
+      ModifyDescription m <$> maybeNewLayout
+
+  description (ModifyDescription m l) = newDescription m l (description l)
+
+instance DescriptionModifier TallDescriptionModifier Tall where
+  newDescription _ (Tall mast _ _) _ = "Tall(" ++ show mast ++ ")"
+
+instance DescriptionModifier ThreeColDescMod ThreeCol where
+  newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
+  newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
+
+data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
+
+instance Message ResizeZoom where
+
+newtype Flippable a = Flippable Bool -- True if flipped
+  deriving (Show, Read)
+
+newtype HFlippable a = HFlippable Bool -- True if flipped
+  deriving (Show, Read)
+
+newtype Rotateable a = Rotateable Bool -- True if rotated
+  deriving (Show, Read)
+
+data FlipLayout = FlipLayout deriving (Typeable)
+
+data HFlipLayout = HFlipLayout deriving (Typeable)
+
+data DoRotate = DoRotate deriving (Typeable)
+
+data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
+  deriving (Show, Read)
+
+-- Toggles if the current window should be zoomed or not. Set the boolean
+-- to set the zoom.mhar
+data ZoomModifier =
+       ToggleZoom |
+       Zoom |
+       Unzoom
+  deriving (Typeable)
+
+instance Message FlipLayout where
+
+instance Message HFlipLayout where
+
+instance Message ZoomModifier where
+
+instance Message DoRotate where
+
+instance (Eq a) => LayoutModifier Rotateable a where
+  pureModifier (Rotateable rotate) (Rectangle x' y' sw sh) _ returned =
+    if rotate
+      then (map (second (unzero . scaleRect . mirrorRect . zero)) returned, Nothing)
+      else (returned, Nothing)
+    where
+      zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
+      unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h
+
+      scaleRect (Rectangle x y w h) =
+        Rectangle (x * fi sw `div` fi sh)
+                  (y * fi sh `div` fi sw)
+                  (w * sw `div` sh)
+                  (h * sh `div` sw)
+
+      fi = fromIntegral
+
+
+  pureMess (Rotateable rot) mess =
+    fmap (\DoRotate -> Rotateable (not rot)) (fromMessage mess)
+
+  modifyDescription (Rotateable rot) underlying =
+    let descr = description underlying in
+      if rot
+        then descr ++ " Rotated"
+        else descr
+
+instance (Eq a) => LayoutModifier Flippable a where
+  pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
+    if flip
+      then (map (second doFlip) returned, Nothing)
+      else (returned, Nothing)
+    where
+      doFlip (Rectangle x y w h) =
+        Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
+
+  pureMess (Flippable flip) message =
+    case fromMessage message of
+      Just FlipLayout -> Just (Flippable (not flip))
+      Nothing -> Nothing
+
+  modifyDescription (Flippable flipped) underlying =
+    let descr = description underlying in
+      if flipped
+        then descr ++ " Flipped"
+        else descr
+
+instance (Eq a) => LayoutModifier HFlippable a where
+  pureModifier (HFlippable flip) (Rectangle _ sy _ sh) stack returned =
+    if flip
+      then (map (second doFlip) returned, Nothing)
+      else (returned, Nothing)
+    where
+      doFlip (Rectangle x y w h) =
+        Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
+
+  pureMess (HFlippable flip) message =
+    case fromMessage message of
+      Just HFlipLayout -> Just (HFlippable (not flip))
+      Nothing -> Nothing
+
+  modifyDescription (HFlippable flipped) underlying =
+    let descr = description underlying in
+      if flipped
+        then descr ++ " HFlipped"
+        else descr
+
+
+instance (Eq a) => LayoutModifier Zoomable a where
+  redoLayout (Zoomable doit ws hs) (Rectangle x y w h) stack returned =
+    if doit
+      then
+        let focused = W.focus <$> stack
+            (zoomed, rest) = partition ((==focused) . Just . fst) returned
+         in case zoomed of
+              [] -> return (rest, Nothing)
+              ((fwin, _):_) ->  return ((fwin, Rectangle (x + wp) (y + hp) (w - fromIntegral (wp * 2)) (h - fromIntegral (hp * 2))) : rest, Nothing)
+
+      else return (returned, Nothing)
+    where
+      wp = floor $ fromIntegral w * ws
+      hp = floor $ fromIntegral h * hs
+
+  handleMessOrMaybeModifyIt self@(Zoomable showing sw sh) mess =
+    return $
+      (handleResize <$> fromMessage mess)
+        <|> (Left . handleZoom <$> fromMessage mess)
+      where
+        handleResize r =
+          if showing
+            then Left $ Zoomable showing (guard $ sw + d) (guard $ sh + d)
+            else Right $ case r of
+                   ShrinkZoom -> SomeMessage Shrink
+                   ExpandZoom -> SomeMessage Expand
+
+          where d = (case r of
+                      ShrinkZoom -> -1
+                      ExpandZoom -> 1) * 0.02
+
+        handleZoom ToggleZoom = Zoomable (not showing) sw sh
+        handleZoom Zoom = Zoomable True sw sh
+        handleZoom Unzoom = Zoomable False sw sh
+
+        guard f | f > 1 = 1
+                | f < 0 = 0
+                | otherwise = f
diff --git a/src/Rahm/Desktop/LayoutDraw.hs b/src/Rahm/Desktop/LayoutDraw.hs
new file mode 100644
index 0000000..c3d8c9e
--- /dev/null
+++ b/src/Rahm/Desktop/LayoutDraw.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
+ScopedTypeVariables, BangPatterns #-}
+module Rahm.Desktop.LayoutDraw (drawLayout) where
+
+import Control.Monad
+
+import Control.Arrow (second)
+import Control.Concurrent (threadDelay)
+import Control.Exception (handle)
+import Control.Monad.Writer (execWriter, tell)
+import Data.Foldable (find)
+import Data.Maybe (fromMaybe)
+import Rahm.Desktop.Hash (quickHash)
+import Rahm.Desktop.Layout (ZoomModifier(..))
+import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+import XMonad.Layout.Spacing (SpacingModifier(..), Border(..))
+
+import XMonad (X,
+               Rectangle(..),
+               Dimension,
+               LayoutClass,
+               Message,
+               Window,
+               SomeMessage(..))
+
+import qualified XMonad as X
+import qualified XMonad.StackSet as S
+
+-- Draws and returns an XPM for the current layout.
+--
+-- Returns
+--  - Bool   - true if the xpm has already been written, and is thus cached.
+--  - String - description of the current layout
+--  - String - the text to send to XMobar
+--
+-- This function actually runs the current layout's doLayout function to
+-- generate the XPM, so it's completely portable to all layouts.
+--
+-- Note this function is impure and running the layout to create the XPM is also
+-- impure. While in-practice most layouts are pure, it should be kept in mind.
+drawLayout :: X (Bool, String, String)
+drawLayout = do
+    winset <- X.gets X.windowset
+    let layout = S.layout $ S.workspace $ S.current winset
+
+    -- Gotta reset the layout to a consistent state.
+    layout' <- foldM (flip ($)) layout [
+         handleMessage' $ ModifyWindowBorder $ const $ Border 0 0 0 0,
+         handleMessage' Unzoom
+       ]
+
+    (cached, xpm) <- drawXpmIO layout'
+
+    return (cached , X.description layout, printf "<icon=%s/>" xpm)
+
+-- Returns true if a point is inside a rectangle (inclusive).
+pointInRect :: (Dimension, Dimension) -> Rectangle -> Bool
+pointInRect (x, y) (Rectangle x' y' w h) =
+  x <= (fi x' + fi w) && x >= fi x' && y <= (fi y' + fi h) && y >= fi y'
+  where
+    fi :: (Integral a, Num b) => a -> b
+    fi = fromIntegral
+
+-- Scale factory. Scaling the rectangles before writing the XPM helps to reduce
+-- noise from things like AvoidStruts, as there is unfortunately no way to force
+-- avoid struts to be off, one can only toggle it.
+sf :: (Integral a) => a
+sf = 1024
+
+handleMessage' ::
+    (LayoutClass layout a, Message m) => m -> layout a -> X (layout a)
+handleMessage' message layout  = do
+  fromMaybe layout <$> X.handleMessage layout (SomeMessage message)
+
+-- Creates the XPM for the given layout and returns the path to it.
+--
+-- This function does run doLayout on the given layout, and that should be
+-- accounted for.
+drawXpmIO :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
+drawXpmIO l = do
+  dir <- X.getXMonadDir
+
+  let shrinkAmt = 5 -- amount to shrink the windows by to make pretty gaps.
+
+  let (w, h) = (56, 24)
+  let descr = X.description l
+  let iconCacheDir = dir </> "icons" </> "cache"
+  let iconPath = iconCacheDir </> (quickHash descr ++ ".xpm")
+
+  let colors = [
+        "#cc9a9a", "#cc9999", "#cc8080", "#cc6666",
+        "#cc4c4c", "#cc3232", "#cc1818", "#cc0000" ]
+
+  (rects', _) <-
+    X.runLayout
+      (S.Workspace "0" l (S.differentiate [1 .. 5]))
+      (Rectangle 0 0 ((w + shrinkAmt) * sf) ((h + shrinkAmt) * sf))
+
+  let rects = flip map rects' $ \(_, Rectangle x y w h) ->
+                Rectangle (x `div` sf) (y `div` sf) (w `div` sf) (h `div` sf)
+
+  X.liftIO $ do
+    exists <- doesFileExist iconPath
+    createDirectoryIfMissing True iconCacheDir
+
+    unless exists $ do
+      let xpmText = drawXpm (w, h) (zip (cycle colors) rects) 4
+      writeFile iconPath xpmText
+
+    return (exists, iconPath)
+
+--
+-- Create's an XPM, purely. Returns a string with the XPM contents.
+-- Takes as arguments
+--
+--   - dimensions of the icon.
+--   - list of (color, rectangle) pairs.
+--   - The amount to shrink the windows by for those pretty gaps.
+--
+drawXpm ::
+    (Dimension, Dimension) -> [(String, Rectangle)] -> Dimension -> String
+drawXpm (w, h) rects' shrinkAmt = execWriter $ do
+    tell "/* XPM */\n"
+    tell "static char *out[] = {\n"
+    tell $ printf "\"%d %d %d 1 \",\n" w h (length rects + 1)
+
+    let zipRects = zip ['A' .. 'Z'] rects
+
+    forM_ zipRects $ \(char, (color, _)) -> do
+      tell $ printf "\"%c c %s\",\n" char color
+    tell "\"% c None\"a,\n"
+
+    forM_ [0 .. h - 1] $ \y -> do
+      tell "\""
+      forM_ [0 .. w - 1] $ \x ->
+        (case find (matches x y) zipRects of
+          Nothing -> tell "%"
+          Just (chr, _) -> tell [chr])
+      tell "\""
+      when (y /= h - 1 - shrinkAmt) (tell ",")
+      tell "\n"
+    tell "};\n"
+
+  where
+    matches x y (_, (_, r)) = pointInRect (x, y) r
+    rects = map (second (shrink shrinkAmt)) rects'
+    guard a b = if a <= shrinkAmt then 1 else b
+    shrink amt (Rectangle x y w h) =
+      Rectangle
+        x
+        y
+        (guard w $ w - fromIntegral amt)
+        (guard h $ h - fromIntegral amt)
diff --git a/src/Rahm/Desktop/LayoutList.hs b/src/Rahm/Desktop/LayoutList.hs
new file mode 100644
index 0000000..3bc09d3
--- /dev/null
+++ b/src/Rahm/Desktop/LayoutList.hs
@@ -0,0 +1,297 @@
+{-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, MultiParamTypeClasses,
+ FlexibleContexts, UndecidableInstances, ViewPatterns, StandaloneDeriving,
+ RankNTypes, TupleSections, TypeFamilies #-}
+
+{-
+ - This module provides a more powerful version of the "Choose" layout that can
+ - be bidirectionally navigated.
+ -
+ - The indexing uses a type-safe zipper to keep track of the currently-selected
+ - layout.
+ -}
+module Rahm.Desktop.LayoutList (
+  LayoutList,
+  layoutZipper,
+  LCons,
+  LNil,
+  toNextLayout,
+  toPreviousLayout,
+  toFirstLayout,
+  (|:),
+  nil
+  )where
+
+import Control.Applicative ((<|>))
+import Data.Void
+import Control.Monad.Identity (runIdentity)
+import Data.Maybe (fromMaybe, fromJust)
+import Control.Arrow (second)
+import XMonad
+import qualified XMonad.StackSet as W
+import Data.Proxy
+
+-- Type-level lists. LNil is the final of the list. LCons contains a layout and a
+-- tail.
+data LNil a = LNil deriving (Read, Show)
+data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
+
+-- Sel - This defines a structure where either this selected, or some
+-- other element is selected.
+--
+-- These types can be composed to create what is effectively a bounded integer.
+-- I.e. there can be a type like
+--
+-- Sel (Sel (Sel (Sel End)))
+--
+-- Such a type is equivalent to an integer bounded at 4, because this type can
+-- exist in no more than 4 states:
+--
+-- Sel
+-- Skip Sel
+-- Skip (Skip Sel)
+-- Skip (Skip (Skip Sel))
+--
+-- Note that a type (Sel End) can only be in the Sel as End may not be
+-- construted (without using undefined).
+data Sel l =
+    Sel |
+    (Selector l) => Skip l
+deriving instance (Read l, Selector l) => Read (Sel l)
+deriving instance (Show l, Selector l) => Show (Sel l)
+deriving instance (Eq l, Selector l) => Eq (Sel l)
+
+-- Reimplement Void as End, just to keep the two separate, but End is for all
+-- intents and purposes Void.
+data End
+deriving instance Read End
+deriving instance Show End
+deriving instance Eq End
+
+
+-- Types that constitute a selection. Selections can be moved to the next
+-- selection, moved to the previous selection, optionally there could be a
+-- previous selection and they may be currently selected.
+class (Eq c) => Selector c where
+  -- Increments the selection to the next state
+  --
+  -- Returns Nothing if the selection class is in the final state and cannot be
+  -- incremented any farther. (This is helpful to facilitate modular
+  -- arithmatic)
+  increment :: c -> Maybe c
+
+  -- Decrements the selection to the previous state. Returns Nothing if the
+  -- state is already in its initial setting.
+  decrement :: c -> Maybe c
+
+  -- The initial state.
+  initial :: Maybe c
+
+  -- The final state.
+  final :: Maybe c
+
+--
+-- Is selelected can be in two states:
+--
+--   1. The current element is selected
+--   2. The current element is not selected and another element deeper in the
+--      structure is selected.
+instance (Selector t) => Selector (Sel t) where
+  -- If the current element is not selected, increment the tail.
+  increment (Skip l) = Skip <$> increment l
+  -- If the current element is selected, the increment is just the initial of
+  -- the tail.
+  increment Sel = Skip <$> initial 
+
+  -- For a selection, the initial is just this in the Sel state.
+  initial = Just Sel
+
+  -- Looks ahead at the tail, sees if it is selected, if so, select this one
+  -- instead, if the one ahead isn't selected, then decrement that one.
+  decrement (Skip t) = Just $ maybe Sel Skip (decrement t)
+  decrement Sel = Nothing
+
+  -- Navigates to the end of the structure to find the final form.
+  final = Just $ maybe Sel Skip final
+
+-- The End structure (which is equivalent to Void) is the "null" selector; the
+-- basecase that the Sel selector terminates at.
+instance Selector End where
+
+  -- Incrementing the End Selector doesn't do anything.
+  increment = const Nothing
+
+  -- Decrementing the End Selector doesn't do anythig
+  decrement = const Nothing
+
+  -- There is no initial value for the End selector.
+  initial = Nothing
+
+  -- There is not final state for the End selector.
+  final = Nothing
+
+-- Increment a selector, but cyclicly
+incrementCycle :: (Selector c) => c -> c
+incrementCycle c =
+  case increment c of
+    Nothing -> fromMaybe c initial
+    Just x -> x
+
+-- Add two selectors together, incrementing the first until the second cannot be
+-- incremented anymore.
+addSelector :: (Selector c) => c -> c -> c
+addSelector c1 c2 = addSel c1 (decrement c2)
+  where
+    addSel c1 Nothing = c1
+    addSel c1 (Just c2) = addSel (incrementCycle c1) (decrement c2)
+
+-- Turn an int into a selector by repeatably incrementing.
+intToSelector :: (Selector c) => Int -> c
+intToSelector 0 = fromJust initial
+intToSelector n = incrementCycle $ intToSelector (n - 1)
+
+-- A LayoutList consists of a LayoutSelect type and a corresponding Selector.
+data LayoutList l a where
+  LayoutList ::
+    (LayoutSelect l a, Selector (SelectorFor l)) =>
+      SelectorFor l -> l a -> LayoutList l a
+
+deriving instance (LayoutSelect l a) => Show (LayoutList l a)
+deriving instance (LayoutSelect l a) => Read (LayoutList l a)
+
+(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
+(|:) = LCons
+
+infixr 5 |: 
+
+-- Constructs a LayoutList. This function enforces that the SelectorFor l
+-- is a 'Sel' type. Essentially this enforces that there must be at least one
+-- underlying layout, otherwise a LayoutList cannot be constructed.
+layoutZipper :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
+  l a -> LayoutList l a
+layoutZipper = LayoutList Sel
+
+-- The termination of a layout zipper.
+nil :: LNil a
+nil = LNil
+
+-- Message to navigate to a layout.
+newtype NavigateLayout =
+          -- Sets the layout based on the given function.
+          NavigateLayout {
+            changeLayoutFn :: forall c. (Selector c) => c -> c
+          }
+          deriving (Typeable)
+
+-- NavigateLayout instance to move to the next layout, circularly.
+toNextLayout :: NavigateLayout
+toNextLayout = NavigateLayout $ addSelector (intToSelector 1)
+
+-- NavigateLayout instance to move to the previous layout, circularly.
+toPreviousLayout :: NavigateLayout
+toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
+
+-- NavigateLayotu instance to move to the first layout.
+toFirstLayout :: NavigateLayout
+toFirstLayout = NavigateLayout (`fromMaybe` initial)
+
+instance Message NavigateLayout where
+
+-- LayoutSelect class Describes a type that can be used to select a layout using
+-- the associated type SelectorFor.
+--
+-- Instances of this class are LCons and LNil.
+class (Show (l a),
+       Read (l a),
+       Read (SelectorFor l),
+       Show (SelectorFor l),
+       Selector (SelectorFor l)) => LayoutSelect l a where
+
+  -- The selector that is used to update the layout corresponding to the
+  -- selector. This selector must be an instance of the Selector class.
+  type SelectorFor l :: *
+
+  -- Update applies a functor to the selected layout and maybe returns a result
+  -- and an updated layout.
+  update :: forall r m. (Monad m) =>
+    -- The selector for this type. Determines which layout the function is
+    -- applied to.
+    SelectorFor l ->
+    -- The LayoutSelect being modified.
+    l a ->
+    -- Higher-ordered function to generically apply to the Layout associated
+    -- with the Selector. Works on all LayoutClass's.
+    (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
+
+    -- Returns a result r, and an updated LayoutSelect.
+    m (Maybe (r, l a))
+
+-- Instance for LayoutSelect for cons
+instance (Read (l a),
+          LayoutClass l a,
+          LayoutSelect t a,
+          Show (SelectorFor t),
+          Read (SelectorFor t)) =>
+    LayoutSelect (LCons l t) a where
+
+  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
+  -- Sel (Sel (Sel ( ... (Sel End) .. ))) where the number of Sel's match the
+  -- number of Cons in this structure enforcing safe selection.
+  type SelectorFor (LCons l t) = Sel (SelectorFor t)
+
+  -- The current layout in this Cons-list is selected.
+  update Sel (LCons layout t) fn = do
+    (r, layout') <- fn layout
+    return $ Just (r, LCons (fromMaybe layout layout') t)
+
+  -- The current layout is not selected. Move on to another layout.
+  update (Skip s) (LCons l t) fn =
+    fmap (second $ \t' -> LCons l t') <$> update s t fn
+
+-- LNil is a layout select. It doesn't do anything. Indeed update really can't
+-- be called on on this because that would require instantiating a End type.
+instance LayoutSelect LNil a where
+  type SelectorFor LNil = End -- LNil cannot be selected.
+  update _ _ _ = return Nothing
+
+-- Instance of layout class for LayoutList. The implementation for this
+-- just delegates to the underlying LayoutSelect class using the generic
+-- update method.
+instance (Show (l a), Typeable l, LayoutSelect l a) =>
+    LayoutClass (LayoutList l) a where
+
+  runLayout (W.Workspace i (LayoutList idx l) ms) r = do
+    r <- update idx l $ \layout ->
+            runLayout (W.Workspace i layout ms) r
+    case r of
+      Nothing -> return ([], Nothing)
+      Just (r, la) -> return (r, Just (LayoutList idx la))
+
+  pureLayout (LayoutList idx l) r s = runIdentity $ do
+    r <- update idx l $ \layout -> return (pureLayout layout r s, Nothing)
+    case r of
+      Nothing -> return []
+      Just (r, a) -> return r
+
+  emptyLayout (LayoutList idx l) r = do
+    r <- update idx l $ \layout -> emptyLayout layout r
+    case r of
+      Nothing -> return ([], Nothing)
+      Just (r, la) -> return (r, Just (LayoutList idx la))
+
+  handleMessage (LayoutList idx l) (fromMessage -> Just (NavigateLayout fn)) =
+    return $ Just (LayoutList (fn idx) l)
+
+  handleMessage (LayoutList idx l) m = do
+    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
+    return $ LayoutList idx . snd <$> r
+
+  pureMessage (LayoutList idx l) m = runIdentity $ do
+    r <- update idx l $ \layout -> return ((), pureMessage layout m)
+    return $ LayoutList idx . snd <$> r
+
+  description (LayoutList idx l) = runIdentity $ do
+    r <- update idx l $ \l -> return (description l, Nothing)
+    return $
+      case r of
+        Nothing -> "No Layout"
+        Just (descr, _) -> descr
diff --git a/src/Rahm/Desktop/Lib.hs b/src/Rahm/Desktop/Lib.hs
new file mode 100644
index 0000000..c90a5d7
--- /dev/null
+++ b/src/Rahm/Desktop/Lib.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE RankNTypes #-}
+module Rahm.Desktop.Lib where
+
+import Prelude hiding ((!!))
+
+import XMonad.Actions.DynamicWorkspaces
+import XMonad.Util.Run
+import XMonad.Prompt
+import XMonad.Prompt.Input
+import XMonad.Prompt.Shell
+
+import Rahm.Desktop.PromptConfig
+
+import Data.Char
+import Data.List hiding ((!!))
+import Data.List.Safe ((!!))
+import Data.Maybe
+import Rahm.Desktop.Marking
+import Text.Printf
+import XMonad hiding (workspaces, Screen)
+import XMonad.StackSet hiding (filter, focus)
+import qualified Data.Map as Map
+import Rahm.Desktop.DMenu
+import Data.Ord (comparing)
+
+import qualified XMonad.StackSet as S
+import Rahm.Desktop.Windows
+
+type WorkspaceName = Char
+newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a)
+
+data WinPrompt = WinPrompt
+
+instance XPrompt WinPrompt where
+    showXPrompt _ = "[Window] "
+    commandToComplete _ = id
+
+data WorkspaceState = Current | Hidden | Visible
+  deriving (Ord, Eq, Enum)
+
+-- Returns all the workspaces that are either visible, current or Hidden but
+-- have windows and that workspace's state.
+--
+-- In other words, filters out workspaces that have no windows and are not
+-- visible.
+--
+-- This function will sort the result by the workspace tag.
+getPopulatedWorkspaces ::
+  (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, S.Workspace i l a)]
+getPopulatedWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
+  sortOn (tag . snd) $
+    mapMaybe (\w@(S.Workspace _ _ s) -> fmap (const (Hidden, w)) s) hi ++
+      map (\(S.Screen w _ _) -> (Visible, w)) vis ++
+        [(Current, cur)]
+
+getHorizontallyOrderedScreens ::
+  StackSet wid l a ScreenId ScreenDetail ->
+    [Screen wid l a ScreenId ScreenDetail]
+-- ^ Returns a list of screens ordered from leftmost to rightmost.
+getHorizontallyOrderedScreens windowSet =
+    flip sortBy screens $ \sc1 sc2 ->
+      let (SD (Rectangle x1 _ _ _)) = screenDetail sc1
+          (SD (Rectangle x2 _ _ _)) = screenDetail sc2
+          in x1 `compare` x2
+    where
+      screens = current windowSet : visible windowSet
+
+getCurrentWorkspace :: X WorkspaceName
+getCurrentWorkspace = withWindowSet $
+  \(StackSet (Screen (Workspace t _ _) _ _) _ _ _) -> do
+    return (head t)
+
+gotoAccompaningWorkspace :: X ()
+gotoAccompaningWorkspace = do
+  cur <- getCurrentWorkspace
+  if isUpper cur
+    then gotoWorkspace (toLower cur)
+    else gotoWorkspace (toUpper cur)
+
+gotoWorkspace :: WorkspaceName -> X ()
+gotoWorkspace ch = pushHistory $ do
+  addHiddenWorkspace [ch]
+  windows $ greedyView $ return ch
+
+shiftToWorkspace :: WorkspaceName -> X ()
+shiftToWorkspace ch = do
+  addHiddenWorkspace [ch]
+  (windows . shift . return) ch
+
+swapWorkspace :: WorkspaceName -> X ()
+swapWorkspace toWorkspaceName = do
+  addHiddenWorkspace [toWorkspaceName]
+  windows $ \ss -> do
+    let fromWorkspace = tag $ workspace $ current ss
+        toWorkspace = [toWorkspaceName] in
+      StackSet (swapSc fromWorkspace toWorkspace $ current ss)
+                (map (swapSc fromWorkspace toWorkspace) $ visible ss)
+                (map (swapWs fromWorkspace toWorkspace) $ hidden ss)
+                (floating ss)
+  where
+    swapSc fromWorkspace toWorkspace (Screen ws a b) =
+        Screen (swapWs fromWorkspace toWorkspace ws) a b
+
+    swapWs fromWorkspace toWorkspace ws@(Workspace t' l s)
+        | t' == fromWorkspace = Workspace toWorkspace l s
+        | t' == toWorkspace = Workspace fromWorkspace l s
+        | otherwise = ws
+
+fuzzyCompletion :: String -> String -> Bool
+fuzzyCompletion str0 str1 =
+  all (`isInfixOf`l0) ws
+  where
+    ws = filter (not . all isSpace) $ words (map toLower str0)
+    l0 = map toLower str1
+
+getString :: Window -> X String
+getString = runQuery $ do
+  t <- title
+  a <- appName
+  return $
+    if map toLower a `isInfixOf` map toLower t
+      then t
+      else printf "%s - %s" t a
+
+withRelativeWorkspace :: Selector -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+withRelativeWorkspace (Selector selector) fn =
+  windows $ \ss ->
+    let tags = sort (tag . snd  <$> filter (\x -> fst x /= Visible ) (getPopulatedWorkspaces ss))
+        from = tag $ workspace $ current ss
+        to = selector from tags
+    in fn to ss
+
+next :: Selector
+next = Selector $ \a l -> select a l l
+  where select n (x:y:xs) _ | n == x = y
+        select n [x] (y:_) | n == x = y
+        select n (x:xs) orig = select n xs orig
+        select n _ _ = n
+
+prev :: Selector
+prev = Selector $ \a l ->
+  let (Selector fn) = next in fn a (reverse l)
+
+withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
+withScreen fn n = do
+  windows $ \windowSet ->
+    case getHorizontallyOrderedScreens windowSet !! n of
+      Nothing -> windowSet
+      Just screen -> fn (tag $ workspace screen) windowSet
+
+windowJump :: X ()
+windowJump = pushHistory $ do
+  windowTitlesToWinId <- withWindowSet $ \ss ->
+    Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
+
+  windowId <- runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
+
+  case windowId of
+    Nothing -> return ()
+    Just wid -> focus wid
diff --git a/src/Rahm/Desktop/Logger.hs b/src/Rahm/Desktop/Logger.hs
new file mode 100644
index 0000000..c73942f
--- /dev/null
+++ b/src/Rahm/Desktop/Logger.hs
@@ -0,0 +1,32 @@
+module Rahm.Desktop.Logger where
+
+import XMonad
+import qualified XMonad.Util.ExtensibleState as XS
+import System.IO
+
+import Rahm.Desktop.NoPersist
+
+newtype LoggerState =
+  LoggerState {
+    logHandle :: Maybe (NoPersist Handle)
+  }
+
+instance ExtensionClass LoggerState where
+  initialValue = LoggerState Nothing
+
+logs :: String -> X ()
+logs s = do
+  LoggerState handle' <- XS.get
+
+  handle <-
+    case handle' of
+      Nothing -> do
+        handle <- io $ openFile "/tmp/xmonad.log" AppendMode
+        XS.put $ LoggerState $ Just $ NoPersist handle
+        return handle
+
+      Just (NoPersist h) -> return h
+
+  io $ do
+    hPutStrLn handle s
+    hFlush handle
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
new file mode 100644
index 0000000..8e9867d
--- /dev/null
+++ b/src/Rahm/Desktop/Marking.hs
@@ -0,0 +1,204 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Rahm.Desktop.Marking (
+  historyNext, historyPrev,
+  markCurrentWindow, pushHistory,
+  jumpToMark, jumpToLast, swapWithLastMark,
+  swapWithMark
+  ) where
+
+import Rahm.Desktop.Windows (mapWindows, findWindow, getLocationWorkspace)
+import XMonad
+import XMonad.StackSet hiding (focus)
+import Data.IORef
+import Data.Map (Map)
+import Control.Monad (when)
+
+import System.FilePath
+import System.IO
+import Control.Exception
+import System.Environment
+import qualified Data.Sequence as Seq
+import Data.Sequence (Seq(..))
+
+import qualified XMonad.Util.ExtensibleState as XS
+
+import qualified Data.Map as Map
+
+{- Submodule that handles marking windows so they can be jumped back to. -}
+
+type Mark = Char
+
+historySize = 100 -- max number of history elements the tail.
+
+data History a = History [a] (Seq a)
+  deriving (Read, Show)
+
+instance Default (History a) where
+  
+  def = History [] Seq.empty
+
+seqPush :: a -> Seq a -> Seq a
+seqPush elem s@(seq :|> _) | Seq.length s >= historySize = elem :<| seq
+seqPush elem s = elem :<| s
+
+historyForward :: History a -> History a
+historyForward (History (a:as) tail) = History as (seqPush a tail)
+historyForward z = z
+
+historyBackward :: History a -> History a
+historyBackward (History head (a :<| as)) = History (a : head) as
+historyBackward z = z
+
+historyCurrent :: History a -> Maybe a
+historyCurrent (History (a:_) _) = Just a
+historyCurrent _ = Nothing
+
+historyPush :: (Eq a) => a -> History a -> History a
+historyPush a h@(History (w : _) _) | a == w = h
+historyPush a (History (w : _) tail) = History [a] (seqPush w tail)
+historyPush a (History _ tail) = History [a] tail
+
+historySwap :: History a -> History a
+historySwap (History (a:as) (t :<| ts)) = History (t : as) (seqPush a ts)
+historySwap z = z
+
+historyLast :: History a -> Maybe a
+historyLast (History _ (t :<| _)) = Just t
+historyLast _ = Nothing
+
+data Spot =
+        WindowSpot Window | -- Focus is on a window.
+        TagSpot String -- Focus is on an (empty) tag
+        deriving (Read, Show, Eq, Ord)
+
+greedyFocus :: Spot -> X ()
+greedyFocus (WindowSpot win) = do
+     ws <- withWindowSet $ \ss ->
+             return $ getLocationWorkspace =<< findWindow ss win
+ 
+     mapM_ (windows . greedyView . tag) ws
+     focus win
+greedyFocus (TagSpot tag) =
+  windows $ greedyView tag
+
+data MarkState =
+  MarkState {
+    markStateMap :: Map Mark Window
+  , windowHistory :: History Spot
+  } deriving (Read, Show)
+
+
+instance ExtensionClass MarkState where
+  initialValue = MarkState Map.empty def
+  extensionType = PersistentExtension
+
+changeHistory :: (History Spot -> History Spot) -> (MarkState -> MarkState)
+changeHistory fn ms = ms { windowHistory = fn (windowHistory ms)}
+
+withMaybeFocused :: (Maybe Window -> X ()) -> X ()
+withMaybeFocused f = withWindowSet $ f . peek
+
+normalizeWindows :: X ()
+normalizeWindows = do
+  MarkState { windowHistory = h } <- XS.get
+  mapM_ greedyFocus (historyCurrent h)
+
+-- greedyFocus :: Window -> X ()
+-- greedyFocus win = do
+--     ws <- withWindowSet $ \ss ->
+--             return $ getLocationWorkspace =<< findWindow ss win
+-- 
+--     mapM_ (windows . greedyView . tag) ws
+--     focus win
+
+markCurrentWindow :: Mark -> X ()
+markCurrentWindow mark = do
+  withFocused $ \win ->
+    XS.modify $ \state@MarkState {markStateMap = ms} ->
+        state {
+          markStateMap = Map.insert mark win ms
+        }
+
+pushHistory :: X () -> X ()
+pushHistory fn = do
+  withMaybeFocused $ \maybeWindowBefore -> do
+    case maybeWindowBefore of
+      (Just windowBefore) ->
+        XS.modify $ changeHistory (historyPush (WindowSpot windowBefore))
+      Nothing -> 
+        withWindowSet $ \ws ->
+          XS.modify $ changeHistory (historyPush (TagSpot (currentTag ws)))
+
+    fn
+
+    withMaybeFocused $ \maybeWindowAfter ->
+      case maybeWindowAfter of
+        Just windowAfter ->
+          XS.modify $ changeHistory (historyPush $ WindowSpot windowAfter)
+        Nothing ->
+          withWindowSet $ \ws ->
+            XS.modify $ changeHistory (historyPush $ TagSpot $ currentTag ws)
+
+withHistory :: (History Spot -> X ()) -> X ()
+withHistory fn = do
+  MarkState { windowHistory = w } <- XS.get
+  fn w
+
+jumpToLast :: X ()
+jumpToLast = do
+  XS.modify (changeHistory historySwap)
+  normalizeWindows
+
+jumpToMark :: Mark -> X ()
+jumpToMark mark = do
+  MarkState {markStateMap = m} <- XS.get
+  case Map.lookup mark m of
+    Nothing -> return ()
+    Just w -> pushHistory $
+      greedyFocus (WindowSpot w)
+
+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 :: X ()
+swapWithLastMark = pushHistory $ withHistory $ \hist -> do
+
+  case historyLast hist of
+    Just (WindowSpot win) ->
+      windows $ swapWithFocused win
+    Nothing -> return ()
+
+swapWithMark :: Mark -> X ()
+swapWithMark mark = pushHistory $ do
+  MarkState {markStateMap = m} <- XS.get
+
+  case Map.lookup mark m of
+    Nothing -> return ()
+    Just winToSwap -> do
+      windows $ swapWithFocused winToSwap
+
+historyPrev :: X ()
+historyPrev = do
+  XS.modify $ changeHistory historyBackward
+  normalizeWindows
+
+historyNext :: X ()
+historyNext = do
+  XS.modify $ changeHistory historyForward
+  normalizeWindows
diff --git a/src/Rahm/Desktop/MouseMotion.hs b/src/Rahm/Desktop/MouseMotion.hs
new file mode 100644
index 0000000..488f06a
--- /dev/null
+++ b/src/Rahm/Desktop/MouseMotion.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE ViewPatterns, BangPatterns #-}
+module Rahm.Desktop.MouseMotion where
+
+import XMonad
+
+import Control.Monad (void, forever)
+import Text.Printf
+import Rahm.Desktop.Submap
+import Control.Monad.Loops (iterateWhile)
+import Control.Monad.Fix (fix)
+import Rahm.Desktop.Logger
+
+import Linear.V2
+import Linear.Metric
+
+data Quadrant = NE | SE | SW | NW deriving (Enum, Show)
+data Direction = CW | CCW deriving (Enum, Show)
+
+getQuadrant :: (Num a, Ord a) => (a, a) -> Quadrant
+getQuadrant (x, y) | x >= 0 && y >= 0 = NE
+getQuadrant (x, y) | x < 0 && y >= 0 = SE
+getQuadrant (x, y) | x < 0 && y < 0 = SW
+getQuadrant (x, y) = NW
+
+
+getDirection :: Quadrant -> Quadrant -> Maybe Direction
+getDirectory a b | a == b = Nothing
+getDirection SW SE = Just CCW
+getDirection SE NE = Just CCW
+getDirection NE NW = Just CCW
+getDirection NW SW = Just CCW
+getDirection _ _ = Just CW
+
+
+liftMouseMotionM :: X a -> MouseMotionM a
+liftMouseMotionM = MouseMotionM . fmap Just
+
+motion :: MouseMotionM (V2 Int)
+motion = MouseMotionM $ do
+  ev <- nextMotionOrButton
+  case ev of
+    Right button -> do
+      logs ("Button " ++ show button)
+      return Nothing
+
+    Left motion -> return (Just $ uncurry V2 motion)
+
+motionSize :: Int -> MouseMotionM (V2 Int)
+motionSize size = do
+  let fsize = fromIntegral size
+
+  !firstmotion <- fmap fromIntegral <$> motion
+
+  let get = do
+        !next <- motion
+        if distance (fmap fromIntegral next) firstmotion >= fsize
+          then return next
+          else get
+
+  get
+
+runMouseMotionM :: MouseMotionM a -> X (Maybe a)
+runMouseMotionM (MouseMotionM a) = a
+
+execMouseMotionM :: MouseMotionM () -> X ()
+execMouseMotionM = void . runMouseMotionM
+
+-- Monad for capturing mouse motion. Terminates and holds Nothing when a
+-- button is pressed.
+newtype MouseMotionM a = MouseMotionM (X (Maybe a))
+
+instance Functor MouseMotionM where
+  fmap fn (MouseMotionM xma) = MouseMotionM (fmap (fmap fn) xma)
+
+instance Applicative MouseMotionM where
+  mf <*> ma = do
+    !f <- mf
+    !a <- ma
+    return (f a)
+
+  pure = return
+
+instance Monad MouseMotionM where
+  return a = MouseMotionM (return (Just a))
+  (MouseMotionM !xa) >>= fn = MouseMotionM $ do
+    !ma <- xa
+    case ma of
+      Just !a ->
+        let (MouseMotionM !xb) = fn a in xb
+      Nothing -> return Nothing
+
+mouseRotateMotion :: X () -> X () -> X ()
+mouseRotateMotion clockWise counterClockwise = execMouseMotionM doMouse
+  where
+    doMouse = forever $ do
+      v <- motion
+      liftMouseMotionM $ logs $ "Motion: " ++ show v
diff --git a/src/Rahm/Desktop/NoPersist.hs b/src/Rahm/Desktop/NoPersist.hs
new file mode 100644
index 0000000..66e52da
--- /dev/null
+++ b/src/Rahm/Desktop/NoPersist.hs
@@ -0,0 +1,23 @@
+-- Module for not persisting XMonad state. To be used with ExtensibleState
+-- for data types that cannot be persisted.
+module Rahm.Desktop.NoPersist where
+
+import Data.Default (Default, def)
+import Data.Typeable
+
+import XMonad (ExtensionClass(..))
+
+newtype NoPersist a = NoPersist a
+  deriving (Typeable)
+
+instance Show (NoPersist a) where
+  show (NoPersist _) = show ()
+
+instance (Default a) => Read (NoPersist a) where
+  readsPrec i s = map (\(_, s) -> (NoPersist def, s)) (readsPrec i s :: [((), String)])
+
+instance (Default a) => Default (NoPersist a) where
+  def = NoPersist def
+
+instance (Default a, Typeable a) => ExtensionClass (NoPersist a) where
+  initialValue = NoPersist def
diff --git a/src/Rahm/Desktop/PassMenu.hs b/src/Rahm/Desktop/PassMenu.hs
new file mode 100644
index 0000000..4c0b4c5
--- /dev/null
+++ b/src/Rahm/Desktop/PassMenu.hs
@@ -0,0 +1,13 @@
+module Rahm.Desktop.PassMenu where
+
+import XMonad
+import XMonad.Util.Run
+import Control.Monad
+
+runPassMenu :: X ()
+runPassMenu = void $
+  safeSpawn "rofi-pass" [
+    "-p", "Password ",
+    "-theme-str",
+    "* {theme-color: #f54245;}"]
+
diff --git a/src/Rahm/Desktop/PromptConfig.hs b/src/Rahm/Desktop/PromptConfig.hs
new file mode 100644
index 0000000..ce45cb2
--- /dev/null
+++ b/src/Rahm/Desktop/PromptConfig.hs
@@ -0,0 +1,12 @@
+module Rahm.Desktop.PromptConfig where
+
+import XMonad.Prompt
+
+xpConfig :: XPConfig
+xpConfig = def {
+               font = "xft:Source Code Pro:size=10"
+             , bgColor = "#404040"
+             , fgColor = "#8888ff"
+             , promptBorderWidth = 0
+             , height = 40
+             }
diff --git a/src/Rahm/Desktop/RebindKeys.hs b/src/Rahm/Desktop/RebindKeys.hs
new file mode 100644
index 0000000..0b4d768
--- /dev/null
+++ b/src/Rahm/Desktop/RebindKeys.hs
@@ -0,0 +1,119 @@
+
+-- Module for intercepting key presses not explicity mapped in the key bindings.
+-- This uses some deep magic with grabKey and windows and everything else, but
+-- it makes window-specific key bindings awesome!
+module Rahm.Desktop.RebindKeys where
+
+import XMonad
+
+import Text.Printf
+import Control.Monad.Trans.Class (lift)
+import Control.Monad (forM, forM_)
+import Data.Default (Default, def)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified XMonad.Util.ExtensibleState as XS
+import Data.Monoid (All(..))
+
+import Rahm.Desktop.Logger
+import Rahm.Desktop.NoPersist
+
+type WindowHook = Query ()
+
+newtype InterceptState =
+  InterceptState (NoPersist (Map (KeyMask, KeySym) (X ())))
+
+newtype RemapState =
+  RemapState (NoPersist (Map (Window, (KeyMask, KeySym)) (X ())))
+
+instance ExtensionClass InterceptState where
+  initialValue = InterceptState def
+
+instance ExtensionClass RemapState where
+  initialValue = RemapState def
+
+remapHook :: Event -> X All
+remapHook event = do
+  RemapState (NoPersist map) <- XS.get
+
+  case event of
+    KeyEvent { ev_window = win, ev_event_type = typ, ev_keycode = code, ev_state = m }
+        | typ == keyPress-> do
+      XConf {display = dpy, theRoot = rootw} <- ask
+      keysym <- io $ keycodeToKeysym dpy code 0
+
+      case Map.lookup (win, (m, keysym)) map of
+
+        Just xdo -> do
+          xdo
+          return (All False)
+
+        Nothing -> return (All True)
+
+    _ -> return (All True)
+
+getKeyCodesForKeysym :: Display -> KeySym -> IO [KeyCode]
+getKeyCodesForKeysym dpy keysym = do
+  let (minCode, maxCode) = displayKeycodes dpy
+      allCodes = [fromIntegral minCode .. fromIntegral maxCode]
+
+  syms <- forM allCodes $ \code -> keycodeToKeysym dpy code 0
+  let keysymMap' = Map.fromListWith (++) (zip syms [[code] | code <- allCodes])
+
+  -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
+  -- want to grab those whenever someone accidentally uses def :: KeySym
+  let keysymMap = Map.delete noSymbol keysymMap'
+  let keysymToKeycodes sym = Map.findWithDefault [] keysym keysymMap
+
+  return $ keysymToKeycodes keysym
+
+
+doGrab :: Display -> Window -> (KeyMask, KeySym) -> X ()
+doGrab dpy win (keyMask, keysym) = do
+  let grab kc m = io $ grabKey dpy kc m win True grabModeAsync grabModeAsync
+
+  codes <- io $ getKeyCodesForKeysym dpy keysym
+
+  forM_ codes $ \kc ->
+    mapM_ (grab kc . (keyMask .|.)) =<< extraModifiers
+
+disableKey :: (KeyMask, KeySym) -> WindowHook
+disableKey key = remapKey key (return ())
+
+remapKey :: (KeyMask, KeySym) -> X () -> WindowHook
+remapKey keyFrom action = do
+  window <- ask
+  Query $ lift $ do
+    XConf { display = disp, theRoot = rootw } <- ask
+    doGrab disp window keyFrom
+
+    XS.modify $ \(RemapState (NoPersist keyMap)) -> RemapState $ NoPersist $
+      Map.insert (window, keyFrom) action keyMap
+
+-- sendKey, but as a query.
+sendKeyQ :: (KeyMask, KeySym) -> Query ()
+sendKeyQ key = do
+  win <- ask
+  liftX (sendKey key win)
+
+sendKey :: (KeyMask, KeySym) -> Window -> X ()
+sendKey (keymask, keysym) w = do
+  XConf { display = disp, theRoot = rootw } <- ask
+
+  codes <- io $ getKeyCodesForKeysym disp keysym
+
+  case codes of
+    (keycode:_) ->
+      io $ allocaXEvent $ \xEv -> do
+        setEventType xEv keyPress
+        setKeyEvent xEv w rootw none keymask keycode True
+        sendEvent disp w True keyPressMask xEv
+
+        setEventType xEv keyRelease
+        sendEvent disp w True keyReleaseMask xEv
+
+    _ -> return ()
+
+rebindKey :: (KeyMask, KeySym) -> (KeyMask, KeySym) -> WindowHook
+rebindKey keyFrom keyTo =
+  (remapKey keyFrom . sendKey keyTo) =<< ask
diff --git a/src/Rahm/Desktop/ScreenRotate.hs b/src/Rahm/Desktop/ScreenRotate.hs
new file mode 100644
index 0000000..1f238b1
--- /dev/null
+++ b/src/Rahm/Desktop/ScreenRotate.hs
@@ -0,0 +1,19 @@
+module Rahm.Desktop.ScreenRotate where
+
+import XMonad.StackSet as W
+
+screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
+screenRotateBackward (W.StackSet current visible others floating) = do
+  let screens = current : visible
+      workspaces = tail $ cycle $ map W.workspace screens
+      (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
+      in W.StackSet current' visible' others floating
+
+screenRotateForward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
+screenRotateForward (W.StackSet current visible others floating) = do
+  let screens = current : visible
+      workspaces = rcycle $ map W.workspace screens
+      (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
+      in W.StackSet current' visible' others floating
+
+  where rcycle l = last l : l
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
new file mode 100644
index 0000000..f3b9e23
--- /dev/null
+++ b/src/Rahm/Desktop/Submap.hs
@@ -0,0 +1,104 @@
+module Rahm.Desktop.Submap (
+    mapNextString,
+    mapNextStringWithKeysym,
+    submapButtonsWithKey,
+    nextButton,
+    nextMotion,
+    nextMotionOrButton,
+    module X) where
+
+import XMonad hiding (keys)
+import Control.Monad.Fix (fix)
+import qualified Data.Map as Map
+import Data.Map (Map)
+
+import XMonad.Actions.Submap as X
+
+{-
+ - Like submap fram XMonad.Actions.Submap, but sends the string from
+ - XLookupString to the function along side the keysym.
+ -
+ - This function allows mappings where the mapped string might be important,
+ - but also allows submappings for keys that may not have a character associated
+ - with them (for example, the function keys).
+ -}
+mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X a) -> X a
+mapNextStringWithKeysym fn = do
+  XConf { theRoot = root, display = d } <- ask
+  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+
+  (m, str, keysym) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
+    maskEvent d keyPressMask p
+    KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
+    keysym <- keycodeToKeysym d code 0
+    (_, str) <- lookupString (asKeyEvent p)
+
+    if isModifierKey keysym
+        then nextkey
+        else return (m, str, keysym)
+
+  io $ ungrabKeyboard d currentTime
+
+  fn m keysym str
+
+{- Like submap, but on the character typed rather than the kysym. -}
+mapNextString :: (KeyMask -> String -> X a) -> X a 
+mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
+
+{- Grabs the mouse and returns the next button press. -}
+nextButton :: X (ButtonMask, Button)
+nextButton = do
+  XConf { theRoot = root, display = d } <- ask
+  io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime
+
+  ret <- io $ allocaXEvent $ \xEv -> do
+    maskEvent d buttonPressMask xEv
+    ButtonEvent { ev_button = button, ev_state = m } <- getEvent xEv
+    return (m, button)
+
+  io $ ungrabPointer d currentTime
+
+  return ret
+
+{- Grabs the mouse and reports the next mouse motion. -}
+nextMotion :: X (Int, Int)
+nextMotion = do
+  XConf { theRoot = root, display = d } <- ask
+  io $ grabPointer d root False pointerMotionMask grabModeAsync grabModeAsync 0 0 currentTime
+
+  ret <- io $ allocaXEvent $ \xEv -> do
+    maskEvent d pointerMotionMask xEv
+    MotionEvent { ev_x = x, ev_y = y } <- getEvent xEv
+    return (fromIntegral x, fromIntegral y)
+
+  io $ ungrabPointer d currentTime
+
+  return ret
+
+{- Grabs the mouse and reports the next mouse motion or button press. -}
+nextMotionOrButton :: X (Either (Int, Int) (ButtonMask, Button))
+nextMotionOrButton = do
+  XConf { theRoot = root, display = d } <- ask
+  io $ grabPointer d root False (pointerMotionMask .|. buttonPressMask) grabModeAsync grabModeAsync 0 0 currentTime
+
+  ret <- io $ allocaXEvent $ \xEv -> do
+    maskEvent d (pointerMotionMask .|. buttonPressMask) xEv
+    ev <- getEvent xEv
+    case ev of
+      MotionEvent { ev_x = x, ev_y = y } ->
+        return $ Left (fromIntegral x, fromIntegral y)
+      ButtonEvent { ev_button = button, ev_state = m } ->
+        return $ Right (m, button)
+
+  io $ ungrabPointer d currentTime
+
+  return ret
+
+submapButtonsWithKey ::
+    ((ButtonMask, Button) -> Window -> X ()) -> Map (ButtonMask, Button) (Window -> X ()) -> Window -> X ()
+submapButtonsWithKey defaultAction actions window = do
+  arg <- nextButton
+
+  case Map.lookup arg actions of
+    Nothing -> defaultAction arg window
+    Just fn -> fn window
diff --git a/src/Rahm/Desktop/Swallow.hs b/src/Rahm/Desktop/Swallow.hs
new file mode 100644
index 0000000..1939c58
--- /dev/null
+++ b/src/Rahm/Desktop/Swallow.hs
@@ -0,0 +1,29 @@
+module Rahm.Desktop.Swallow (
+  swallowHook, setSwallowEnabled, isSwallowEnabled, toggleSwallowEnabled) where
+
+import XMonad
+import Data.Monoid (All)
+import XMonad.Hooks.WindowSwallowing
+import XMonad.Util.ExtensibleState as XS
+
+data DisableSwallow = DisableSwallow Bool deriving (Show)
+
+swallowHook :: Event -> X All
+swallowHook = swallowEventHook (className =? "Alacritty") $
+  liftX $ do
+    (DisableSwallow disable) <- XS.get
+    return (not disable)
+
+isSwallowEnabled :: X Bool
+isSwallowEnabled = do
+  (DisableSwallow b) <- XS.get
+  return (not b)
+
+setSwallowEnabled :: Bool -> X ()
+setSwallowEnabled enable = XS.modify $ const $ DisableSwallow $ not enable
+
+toggleSwallowEnabled :: X ()
+toggleSwallowEnabled = (setSwallowEnabled . not) =<< isSwallowEnabled
+
+instance ExtensionClass DisableSwallow where
+  initialValue = DisableSwallow False
diff --git a/src/Rahm/Desktop/SwapMaster.hs b/src/Rahm/Desktop/SwapMaster.hs
new file mode 100644
index 0000000..b039fdb
--- /dev/null
+++ b/src/Rahm/Desktop/SwapMaster.hs
@@ -0,0 +1,41 @@
+{- Swap window with the master, but save it. -}
+module Rahm.Desktop.SwapMaster (swapMaster) where
+
+import qualified XMonad.StackSet as W
+
+import Rahm.Desktop.Windows (mapWindows, getMaster, swapWindows)
+import Control.Monad.Trans.Maybe
+import XMonad (Window, ExtensionClass(..), X(..), windows, windowset)
+import Control.Monad (void)
+import Control.Monad.Trans (lift)
+import Data.Maybe (fromMaybe)
+import Control.Monad.State (gets)
+
+import qualified XMonad.Util.ExtensibleState as XS
+
+newtype LastWindow = LastWindow {
+    lastWindow :: Maybe Window
+  } deriving (Show, Read)
+
+instance ExtensionClass LastWindow where
+  initialValue = LastWindow Nothing
+
+hoist :: (Monad m) => Maybe a -> MaybeT m a
+hoist = MaybeT . return
+
+swapMaster :: X ()
+swapMaster = void $ runMaybeT $ do
+    ss <- gets windowset
+
+    focused <- hoist $ W.peek ss
+    master <- hoist $ getMaster ss
+
+    if focused == master
+        then do
+          lw <- MaybeT $ lastWindow <$> XS.get
+          lift $ windows (swapWindows focused lw)
+        else lift $ windows (swapWindows focused master)
+
+    lift $ do
+      XS.put (LastWindow $ Just master)
+      windows W.focusMaster
diff --git a/src/Rahm/Desktop/Windows.hs b/src/Rahm/Desktop/Windows.hs
new file mode 100644
index 0000000..d525aac
--- /dev/null
+++ b/src/Rahm/Desktop/Windows.hs
@@ -0,0 +1,86 @@
+module Rahm.Desktop.Windows where
+
+import XMonad (windowset, X, Window, get)
+
+import Control.Applicative ((<|>))
+import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), peek, integrate, integrate', allWindows)
+import Data.Maybe (listToMaybe, catMaybes)
+import qualified Data.Map as Map
+
+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)
+
+getMaster :: StackSet i l a s sd -> Maybe a
+getMaster (StackSet (Screen (Workspace _ _ ss) _ _) _ _ _) =
+  head . integrate <$> ss
+
+swapWindows :: (Ord a) => a -> a -> StackSet i l a s d -> StackSet i l a s d
+swapWindows wa wb = mapWindows $ \w ->
+  case w of
+    _ | w == wa -> wb
+    _ | w == wb -> wa
+    _ -> w
+
+data WindowLocation i l a s sd =
+  OnScreen (Screen i l a s sd) |
+  OnHiddenWorkspace (Workspace i l a) |
+  Floating
+
+getLocationWorkspace :: WindowLocation i l a s sd -> Maybe (Workspace i l a)
+getLocationWorkspace (OnScreen (Screen w _ _)) = Just w
+getLocationWorkspace (OnHiddenWorkspace w) = Just w
+getLocationWorkspace _ = Nothing
+
+workspaceMember :: (Eq a) => Workspace i l a -> a -> Bool
+workspaceMember (Workspace _ _ s) w = w `elem` integrate' s
+
+forAllWindows :: (Window -> X ()) -> X ()
+forAllWindows fn = do
+  stackSet <- windowset <$> get
+  mapM_ fn (allWindows stackSet)
+
+getFocusedWindow :: X (Maybe Window)
+getFocusedWindow = do
+  peek . windowset <$> get
+
+{- Finds a Window and returns the screen its on and the workspace its on.
+ - Returns nothing if the window doesn't exist.
+ -
+ - If the window is not a screen Just (Nothing, workspace) is returned.
+ - If the window is a floating window Just (Nothing, Nothing) is returned. -}
+findWindow ::
+    (Eq a) => StackSet i l a s sd -> a -> Maybe (WindowLocation i l a s sd)
+findWindow (StackSet cur vis hid float) win =
+    listToMaybe . catMaybes $
+      map findWindowScreen (cur : vis) ++
+        map findWindowWorkspace hid ++
+          [findWindowFloat]
+
+  where
+    findWindowScreen s@(Screen ws _ _) =
+      if workspaceMember ws win
+        then Just (OnScreen s)
+        else Nothing
+
+    findWindowWorkspace w =
+      if workspaceMember w win
+        then Just (OnHiddenWorkspace w)
+        else Nothing
+
+    findWindowFloat =
+      if win `elem` Map.keys float
+        then Just Floating
+        else Nothing
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
new file mode 100644
index 0000000..f3beb86
--- /dev/null
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -0,0 +1,78 @@
+module Rahm.Desktop.XMobarLog ( XMobarLog, spawnXMobar, xMobarLogHook ) where
+
+import Control.Arrow (second)
+import Control.Monad (forM_)
+import Control.Monad.Writer (tell, execWriter)
+import Data.List (sortBy)
+import Data.Maybe (mapMaybe)
+import Data.Ord (comparing)
+import Rahm.Desktop.LayoutDraw (drawLayout)
+import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
+import XMonad.Util.NamedWindows (getName)
+import XMonad.Util.Run (spawnPipe)
+import XMonad (X)
+import Rahm.Desktop.Lib (getPopulatedWorkspaces, WorkspaceState(..))
+
+import qualified XMonad as X
+import qualified XMonad.StackSet as S
+
+data XMobarLog = XMobarLog Handle
+
+-- The log hook for XMobar. This is a custom log hook that does not use any
+-- of the Xmonad dynamic log libraries.
+--
+-- This is because the given dynamic log libraries don't handle unicode properly
+-- and this has been causing issues. It is also more flexible and frankly easier
+-- to just DIY.
+
+spawnXMobar :: IO XMobarLog
+spawnXMobar = do
+  pipe <- spawnPipe "xmobar"
+  hSetEncoding pipe utf8
+  return (XMobarLog pipe)
+
+
+-- XMonad Log Hook meant to be used with the XMonad config logHook.
+xMobarLogHook :: XMobarLog -> X ()
+xMobarLogHook (XMobarLog xmproc) = do
+  (_, _, layoutXpm) <- drawLayout
+
+  winset <- X.gets X.windowset
+  title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
+  let wss = getPopulatedWorkspaces winset
+
+  X.liftIO $ do
+    hPutStrLn xmproc $ trunc 80 $ execWriter $ do
+      tell layoutXpm
+      tell $ "<fc=#404040> │ </fc>"
+
+      forM_ wss $ \(t, ws) -> do
+        case t of
+          Current -> tell "<fn=1><fc=#ff8888>"
+          Visible -> tell "<fn=6><fc=#8888ff>"
+          Hidden -> tell "<fn=2><fc=#888888>"
+        tell (S.tag ws)
+        tell " </fc></fn>"
+
+      tell $ "<fc=#404040>│ </fc><fc=#a0a0a0><fn=3>"
+      tell $ title
+      tell $ "</fn></fc>"
+
+-- Truncate an XMobar string to the provided number of _visible_ characters.
+-- This is to keep long window titles from overrunning the whole bar.
+trunc :: Int -> String -> String
+trunc amt str = reverse $ trunc' False amt str []
+  where
+    trunc' _ _ [] acc = acc
+    trunc' ignore amt (a:as) acc =
+      case a of
+        '<' -> trunc' True amt as (a : acc)
+        '>' -> trunc' False amt as (a : acc)
+        _ ->
+          if ignore
+            then trunc' True amt as (a : acc)
+            else
+              case amt of
+                0 -> trunc' False 0 as acc
+                3 -> trunc' False 0 as ("..." ++ acc)
+                _ -> trunc' False (amt - 1) as (a : acc)
-- 
cgit 


From 49f20ca3391ca713c021fdf15bf9db3fe54f18f6 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 10 Apr 2022 13:51:43 -0600
Subject: More refactoring. Started breaking up Layout. Moved Language
 extensions into stack file.

---
 package.yaml                                  |  22 +-
 src/Main.hs                                   |   2 +-
 src/Rahm/Desktop/CornerLayout.hs              |  58 -----
 src/Rahm/Desktop/Keys.hs                      |   5 +-
 src/Rahm/Desktop/KeysM.hs                     |   2 -
 src/Rahm/Desktop/Layout.hs                    | 326 --------------------------
 src/Rahm/Desktop/Layout/CornerLayout.hs       |  57 +++++
 src/Rahm/Desktop/Layout/Layout.hs             | 283 ++++++++++++++++++++++
 src/Rahm/Desktop/Layout/LayoutDraw.hs         | 155 ++++++++++++
 src/Rahm/Desktop/Layout/LayoutList.hs         | 295 +++++++++++++++++++++++
 src/Rahm/Desktop/Layout/ReinterpretMessage.hs |  48 ++++
 src/Rahm/Desktop/LayoutDraw.hs                | 155 ------------
 src/Rahm/Desktop/LayoutList.hs                | 297 -----------------------
 src/Rahm/Desktop/Lib.hs                       |   1 -
 src/Rahm/Desktop/Marking.hs                   |   1 -
 src/Rahm/Desktop/MouseMotion.hs               |   1 -
 src/Rahm/Desktop/XMobarLog.hs                 |   2 +-
 17 files changed, 861 insertions(+), 849 deletions(-)
 delete mode 100644 src/Rahm/Desktop/CornerLayout.hs
 delete mode 100644 src/Rahm/Desktop/Layout.hs
 create mode 100644 src/Rahm/Desktop/Layout/CornerLayout.hs
 create mode 100644 src/Rahm/Desktop/Layout/Layout.hs
 create mode 100644 src/Rahm/Desktop/Layout/LayoutDraw.hs
 create mode 100644 src/Rahm/Desktop/Layout/LayoutList.hs
 create mode 100644 src/Rahm/Desktop/Layout/ReinterpretMessage.hs
 delete mode 100644 src/Rahm/Desktop/LayoutDraw.hs
 delete mode 100644 src/Rahm/Desktop/LayoutList.hs

diff --git a/package.yaml b/package.yaml
index a1f015d..7e7244c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,11 +1,27 @@
-name: jrahm-xmonad
-version: 0.0.1
+name: rde
+version: 0.5
 
 executables:
-  jrahm-xmonad:
+  rde:
     main: Main.hs
     source-dirs: src
 
+ghc-options:
+  - -XBangPatterns
+  - -XDataKinds
+  - -XFlexibleContexts
+  - -XFlexibleInstances
+  - -XGADTs
+  - -XKindSignatures
+  - -XMultiParamTypeClasses
+  - -XPolyKinds
+  - -XRankNTypes
+  - -XGeneralizedNewtypeDeriving
+  - -XStandaloneDeriving
+  - -XTupleSections
+  - -XTypeFamilies
+  - -XViewPatterns
+
 dependencies:
   - base >= 4.0.0
   - xmonad >= 0.17
diff --git a/src/Main.hs b/src/Main.hs
index c8cdd19..86b6fc8 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -16,7 +16,7 @@ import Rahm.Desktop.Swallow
 import Rahm.Desktop.Windows
 import Rahm.Desktop.XMobarLog
 import Rahm.Desktop.Keys
-import Rahm.Desktop.Layout
+import Rahm.Desktop.Layout.Layout
 import Rahm.Desktop.Logger
 import Rahm.Desktop.DMenu (menuCommandString)
 import Rahm.Desktop.RebindKeys
diff --git a/src/Rahm/Desktop/CornerLayout.hs b/src/Rahm/Desktop/CornerLayout.hs
deleted file mode 100644
index 33f439e..0000000
--- a/src/Rahm/Desktop/CornerLayout.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
--- Creates a layout, the "corner layout" that keeps the master window in the
--- corner and the other windows go around it.
-module Rahm.Desktop.CornerLayout where
-
-import Data.Typeable (Typeable)
-import XMonad (LayoutClass(..), Rectangle(..), Resize(..), fromMessage)
-import qualified XMonad.StackSet as S
-
-data Corner a = Corner Rational Rational
-  deriving (Show, Typeable, Read)
-
-instance LayoutClass Corner a where
-  pureLayout (Corner frac _) screen@(Rectangle x y w h) ss =
-    let w' = floor $ fromIntegral w * frac
-        h' = floor $ fromIntegral h * frac
-        corner = Rectangle 0 0 w' h'
-        vertRect = Rectangle (fromIntegral w') 0 (w - w') h
-        horizRect = Rectangle 0 (fromIntegral h') w' (h - h')
-        ws = S.integrate ss
-
-        vn = (length ws - 1) `div` 2
-        hn = (length ws - 1) - vn
-      in
-        case ws of
-          [a] -> [(a, screen)]
-          [a, b] -> [
-            (a, Rectangle x y w' h),
-            (b, Rectangle (x + fromIntegral w') y (w - w') h)]
-          _ ->
-            zip ws $ map (
-                \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h) $
-              corner :
-                splitVert vertRect vn ++
-                splitHoriz horizRect hn
-
-  pureMessage (Corner frac delta) m = fmap resize (fromMessage m)
-    where
-      resize Shrink = Corner (frac - delta) delta
-      resize Expand = Corner (frac + delta) delta
-
-splitVert :: Rectangle -> Int -> [Rectangle]
-splitVert (Rectangle x y w h) i' =
-  map
-    (\i -> Rectangle x (y + fromIntegral (step * i)) w step)
-    [0 .. i - 1]
-  where
-    i = fromIntegral i'
-    step = h `div` i
-
-splitHoriz :: Rectangle -> Int -> [Rectangle]
-splitHoriz (Rectangle x y w h) i' =
-  map
-    (\i -> Rectangle (x + fromIntegral (step * i)) y step h)
-    [0 .. i - 1]
-  where
-    step = w `div` i
-    i = fromIntegral i'
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 9712f84..0bebd6f 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-}
 module Rahm.Desktop.Keys (applyKeys) where
 
 import XMonad.Util.Run (safeSpawn)
@@ -26,7 +25,7 @@ import Data.Char
 import Data.List hiding ((!!))
 import Data.List.Safe ((!!))
 import Data.Map (Map)
-import Rahm.Desktop.Layout
+import Rahm.Desktop.Layout.Layout
 import Rahm.Desktop.Marking
 import Rahm.Desktop.PromptConfig
 import System.IO
@@ -46,7 +45,7 @@ import XMonad.Actions.SpawnOn as SpawnOn
 import qualified Data.Map as Map
 import qualified XMonad.StackSet as W
 
-import Rahm.Desktop.LayoutList
+import Rahm.Desktop.Layout.LayoutList
 import Rahm.Desktop.MouseMotion
 import Rahm.Desktop.Windows
 import Rahm.Desktop.Lib
diff --git a/src/Rahm/Desktop/KeysM.hs b/src/Rahm/Desktop/KeysM.hs
index ef52c24..dcbce2a 100644
--- a/src/Rahm/Desktop/KeysM.hs
+++ b/src/Rahm/Desktop/KeysM.hs
@@ -1,5 +1,3 @@
-{-# Language GeneralizedNewtypeDeriving, MultiParamTypeClasses,
-   FunctionalDependencies, FlexibleInstances, TypeFamilies, FlexibleContexts #-}
 module Rahm.Desktop.KeysM where
 
 import Data.List
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
deleted file mode 100644
index 95854b8..0000000
--- a/src/Rahm/Desktop/Layout.hs
+++ /dev/null
@@ -1,326 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, ViewPatterns, FlexibleInstances, KindSignatures, DataKinds, GADTs, RankNTypes, PolyKinds #-}
-module Rahm.Desktop.Layout where
-
-import GHC.TypeLits
-
-import Data.Proxy (Proxy(..))
-import Rahm.Desktop.CornerLayout (Corner(..))
-import Control.Arrow (second)
-import XMonad.Hooks.ManageDocks
-import XMonad.Layout.Circle
-import XMonad.Layout.Accordion
-import Control.Applicative
-import XMonad.Layout.Spacing
-import Data.List
-import XMonad.Layout.Spiral
-import XMonad.Layout.ThreeColumns
-import XMonad.Layout.Grid
-import XMonad.Layout.Dishes
-import XMonad.Layout.MosaicAlt
-import XMonad.Layout.Fullscreen
-import qualified XMonad.Layout.Dwindle as D
-import XMonad.Layout
-import XMonad.Layout.LayoutModifier
-import XMonad
-import XMonad.Core
-import XMonad.Layout.NoBorders (smartBorders, noBorders)
-
-import Rahm.Desktop.LayoutList
-import Rahm.Desktop.Windows
-
-import qualified Data.Map as M
-import qualified XMonad.StackSet as W
-
-myLayout =
-  fullscreenFull $
-    avoidStruts $
-      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
-        layoutZipper $
-          mods (reinterpretIncMaster $ spiral (6/7)) |:
-          mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
-          mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
-          mods (ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2))) |:
-          mods (ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2))) |:
-          mods Grid |:
-          mods (Dishes 2 (1/6)) |:
-          mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1) |:
-          nil
-
--- This is a type class that defines how to reinterpret a message. One can think
--- of this as a kind of type-level function. It lets one associate a function
--- (reinterpretMessage) with a type construct, which for the case below is a
--- Symbol.
---
--- It would be nice to attach this function to the LayoutModifier directly as a
--- value, however LayoutModifiers must be Show-able and Read-able and functions
--- are not. However encoding in the typesystem itsef which function is to be
--- called is the best alternative I have.
-class DoReinterpret (k :: t) where
-  reinterpretMessage ::
-    Proxy k -> SomeMessage -> X (Maybe SomeMessage)
-
--- Mosaic doesn't have the concept of a "Master Space", so reinterpret messages
--- intended to modify the master space and instead have those messages expand
--- and shrink the current window.
---
--- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system
--- hacking one can do in Haskell.
-instance DoReinterpret "ForMosaic" where
-  
-  -- IncMaster message
-  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
-    fmap (SomeMessage .
-      (if n > 0
-        then expandWindowAlt
-        else shrinkWindowAlt)) <$> getFocusedWindow
-  
-  -- ResizeMaster message
-  reinterpretMessage _ (fromMessage -> Just m) = do
-    fmap (SomeMessage .
-      (case m of
-        Expand -> expandWindowAlt
-        Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
-
-  -- Messages that don't match the above, just leave it unmodified.
-  reinterpretMessage _ m = return (Just m)
-
-instance DoReinterpret "IncMasterToResizeMaster" where
-  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) =
-    return $ Just $
-      if n > 0
-        then SomeMessage Expand
-        else SomeMessage Shrink
-  reinterpretMessage _ m = return (Just m)
-
--- Data construct for association a DoReinterpret function with a concrete
--- construct that can be used in the LayoutModifier instance.
---
--- It wolud be nice to have ReinterpretMessage hold the function as a value
--- rather than delegate to this kind-instance, however, it won't work because
--- LayoutModifiers have to be Read-able and Show-able, and functions are neither
--- of those, so a value-level function may not be a member of a LayoutModifier,
--- thus I have to settle for delegating to a hard-coded instance using
--- type-classes.
-data ReinterpretMessage k a = ReinterpretMessage
-  deriving (Show, Read)
-
--- Instance for ReinterpretMessage as a Layout modifier.
-instance (DoReinterpret k) =>
-      LayoutModifier (ReinterpretMessage k) a where 
-
-  handleMessOrMaybeModifyIt self message = do
-
-    -- Delegates to the reinterpretMessage function associatied with the
-    -- type-variable k.
-    newMessage <- reinterpretMessage (ofProxy self) message
-    case newMessage of
-      Just m -> return $ Just $ Right m
-      Nothing -> return $ Just $ Left self
-    where
-      -- ofProxy just provides reifies the phantom type k so the type system can
-      -- figure out what instance to go to.
-      ofProxy :: ReinterpretMessage k a -> Proxy k
-      ofProxy _ = Proxy
-
-modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a
-modifyMosaic = ModifiedLayout ReinterpretMessage
-
-reinterpretIncMaster ::
-  l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a
-reinterpretIncMaster = ModifiedLayout ReinterpretMessage
-
-mods =
-  ModifiedLayout (Zoomable False 0.05 0.05) .
-    ModifiedLayout (Flippable False) .
-    ModifiedLayout (HFlippable False) .
-    ModifiedLayout (Rotateable False)
-
-
-data ModifyDescription m l a = ModifyDescription m (l a)
-  deriving (Show, Read)
-
-data TallDescriptionModifier = TallDescriptionModifier
-  deriving (Show, Read)
-
-data ThreeColDescMod = ThreeColDescMod
-  deriving (Show, Read)
-
-class DescriptionModifier m l where
-  newDescription :: m -> l a -> String -> String
-
-instance (Typeable m, Show m, DescriptionModifier m l, LayoutClass l a) => LayoutClass (ModifyDescription m l) a where
-  runLayout (W.Workspace t (ModifyDescription m l) a) rect = do
-    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  doLayout (ModifyDescription m l) a s = do
-    (rects, maybeNewLayout) <- doLayout l a s
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  pureLayout (ModifyDescription m l) a s = pureLayout l a s
-
-  emptyLayout (ModifyDescription m l) a = do
-    (rects, maybeNewLayout) <- emptyLayout l a
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  handleMessage (ModifyDescription m l) a = do
-    maybeNewLayout <- handleMessage l a
-    return (ModifyDescription m <$> maybeNewLayout)
-
-  pureMessage (ModifyDescription m l) a =
-    let maybeNewLayout = pureMessage l a in
-      ModifyDescription m <$> maybeNewLayout
-
-  description (ModifyDescription m l) = newDescription m l (description l)
-
-instance DescriptionModifier TallDescriptionModifier Tall where
-  newDescription _ (Tall mast _ _) _ = "Tall(" ++ show mast ++ ")"
-
-instance DescriptionModifier ThreeColDescMod ThreeCol where
-  newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
-  newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
-
-data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
-
-instance Message ResizeZoom where
-
-newtype Flippable a = Flippable Bool -- True if flipped
-  deriving (Show, Read)
-
-newtype HFlippable a = HFlippable Bool -- True if flipped
-  deriving (Show, Read)
-
-newtype Rotateable a = Rotateable Bool -- True if rotated
-  deriving (Show, Read)
-
-data FlipLayout = FlipLayout deriving (Typeable)
-
-data HFlipLayout = HFlipLayout deriving (Typeable)
-
-data DoRotate = DoRotate deriving (Typeable)
-
-data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
-  deriving (Show, Read)
-
--- Toggles if the current window should be zoomed or not. Set the boolean
--- to set the zoom.mhar
-data ZoomModifier =
-       ToggleZoom |
-       Zoom |
-       Unzoom
-  deriving (Typeable)
-
-instance Message FlipLayout where
-
-instance Message HFlipLayout where
-
-instance Message ZoomModifier where
-
-instance Message DoRotate where
-
-instance (Eq a) => LayoutModifier Rotateable a where
-  pureModifier (Rotateable rotate) (Rectangle x' y' sw sh) _ returned =
-    if rotate
-      then (map (second (unzero . scaleRect . mirrorRect . zero)) returned, Nothing)
-      else (returned, Nothing)
-    where
-      zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
-      unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h
-
-      scaleRect (Rectangle x y w h) =
-        Rectangle (x * fi sw `div` fi sh)
-                  (y * fi sh `div` fi sw)
-                  (w * sw `div` sh)
-                  (h * sh `div` sw)
-
-      fi = fromIntegral
-
-
-  pureMess (Rotateable rot) mess =
-    fmap (\DoRotate -> Rotateable (not rot)) (fromMessage mess)
-
-  modifyDescription (Rotateable rot) underlying =
-    let descr = description underlying in
-      if rot
-        then descr ++ " Rotated"
-        else descr
-
-instance (Eq a) => LayoutModifier Flippable a where
-  pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
-    if flip
-      then (map (second doFlip) returned, Nothing)
-      else (returned, Nothing)
-    where
-      doFlip (Rectangle x y w h) =
-        Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
-
-  pureMess (Flippable flip) message =
-    case fromMessage message of
-      Just FlipLayout -> Just (Flippable (not flip))
-      Nothing -> Nothing
-
-  modifyDescription (Flippable flipped) underlying =
-    let descr = description underlying in
-      if flipped
-        then descr ++ " Flipped"
-        else descr
-
-instance (Eq a) => LayoutModifier HFlippable a where
-  pureModifier (HFlippable flip) (Rectangle _ sy _ sh) stack returned =
-    if flip
-      then (map (second doFlip) returned, Nothing)
-      else (returned, Nothing)
-    where
-      doFlip (Rectangle x y w h) =
-        Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
-
-  pureMess (HFlippable flip) message =
-    case fromMessage message of
-      Just HFlipLayout -> Just (HFlippable (not flip))
-      Nothing -> Nothing
-
-  modifyDescription (HFlippable flipped) underlying =
-    let descr = description underlying in
-      if flipped
-        then descr ++ " HFlipped"
-        else descr
-
-
-instance (Eq a) => LayoutModifier Zoomable a where
-  redoLayout (Zoomable doit ws hs) (Rectangle x y w h) stack returned =
-    if doit
-      then
-        let focused = W.focus <$> stack
-            (zoomed, rest) = partition ((==focused) . Just . fst) returned
-         in case zoomed of
-              [] -> return (rest, Nothing)
-              ((fwin, _):_) ->  return ((fwin, Rectangle (x + wp) (y + hp) (w - fromIntegral (wp * 2)) (h - fromIntegral (hp * 2))) : rest, Nothing)
-
-      else return (returned, Nothing)
-    where
-      wp = floor $ fromIntegral w * ws
-      hp = floor $ fromIntegral h * hs
-
-  handleMessOrMaybeModifyIt self@(Zoomable showing sw sh) mess =
-    return $
-      (handleResize <$> fromMessage mess)
-        <|> (Left . handleZoom <$> fromMessage mess)
-      where
-        handleResize r =
-          if showing
-            then Left $ Zoomable showing (guard $ sw + d) (guard $ sh + d)
-            else Right $ case r of
-                   ShrinkZoom -> SomeMessage Shrink
-                   ExpandZoom -> SomeMessage Expand
-
-          where d = (case r of
-                      ShrinkZoom -> -1
-                      ExpandZoom -> 1) * 0.02
-
-        handleZoom ToggleZoom = Zoomable (not showing) sw sh
-        handleZoom Zoom = Zoomable True sw sh
-        handleZoom Unzoom = Zoomable False sw sh
-
-        guard f | f > 1 = 1
-                | f < 0 = 0
-                | otherwise = f
diff --git a/src/Rahm/Desktop/Layout/CornerLayout.hs b/src/Rahm/Desktop/Layout/CornerLayout.hs
new file mode 100644
index 0000000..f0952c7
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/CornerLayout.hs
@@ -0,0 +1,57 @@
+-- Creates a layout, the "corner layout" that keeps the master window in the
+-- corner and the other windows go around it.
+module Rahm.Desktop.Layout.CornerLayout where
+
+import Data.Typeable (Typeable)
+import XMonad (LayoutClass(..), Rectangle(..), Resize(..), fromMessage)
+import qualified XMonad.StackSet as S
+
+data Corner a = Corner Rational Rational
+  deriving (Show, Typeable, Read)
+
+instance LayoutClass Corner a where
+  pureLayout (Corner frac _) screen@(Rectangle x y w h) ss =
+    let w' = floor $ fromIntegral w * frac
+        h' = floor $ fromIntegral h * frac
+        corner = Rectangle 0 0 w' h'
+        vertRect = Rectangle (fromIntegral w') 0 (w - w') h
+        horizRect = Rectangle 0 (fromIntegral h') w' (h - h')
+        ws = S.integrate ss
+
+        vn = (length ws - 1) `div` 2
+        hn = (length ws - 1) - vn
+      in
+        case ws of
+          [a] -> [(a, screen)]
+          [a, b] -> [
+            (a, Rectangle x y w' h),
+            (b, Rectangle (x + fromIntegral w') y (w - w') h)]
+          _ ->
+            zip ws $ map (
+                \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h) $
+              corner :
+                splitVert vertRect vn ++
+                splitHoriz horizRect hn
+
+  pureMessage (Corner frac delta) m = fmap resize (fromMessage m)
+    where
+      resize Shrink = Corner (frac - delta) delta
+      resize Expand = Corner (frac + delta) delta
+
+splitVert :: Rectangle -> Int -> [Rectangle]
+splitVert (Rectangle x y w h) i' =
+  map
+    (\i -> Rectangle x (y + fromIntegral (step * i)) w step)
+    [0 .. i - 1]
+  where
+    i = fromIntegral i'
+    step = h `div` i
+
+splitHoriz :: Rectangle -> Int -> [Rectangle]
+splitHoriz (Rectangle x y w h) i' =
+  map
+    (\i -> Rectangle (x + fromIntegral (step * i)) y step h)
+    [0 .. i - 1]
+  where
+    step = w `div` i
+    i = fromIntegral i'
diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs
new file mode 100644
index 0000000..93228e7
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Layout.hs
@@ -0,0 +1,283 @@
+module Rahm.Desktop.Layout.Layout where
+
+import GHC.TypeLits
+
+import Data.Proxy (Proxy(..))
+import Control.Arrow (second)
+import XMonad.Hooks.ManageDocks
+import XMonad.Layout.Circle
+import XMonad.Layout.Accordion
+import Control.Applicative
+import XMonad.Layout.Spacing
+import Data.List
+import XMonad.Layout.Spiral
+import XMonad.Layout.ThreeColumns
+import XMonad.Layout.Grid
+import XMonad.Layout.Dishes
+import XMonad.Layout.MosaicAlt
+import XMonad.Layout.Fullscreen
+import qualified XMonad.Layout.Dwindle as D
+import XMonad.Layout
+import XMonad.Layout.LayoutModifier
+import XMonad
+import XMonad.Core
+import XMonad.Layout.NoBorders (smartBorders, noBorders)
+
+import Rahm.Desktop.Layout.CornerLayout (Corner(..))
+import Rahm.Desktop.Layout.LayoutList
+import Rahm.Desktop.Windows
+import Rahm.Desktop.Layout.ReinterpretMessage
+
+import qualified Data.Map as M
+import qualified XMonad.StackSet as W
+
+myLayout =
+  fullscreenFull $
+    avoidStruts $
+      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
+        layoutZipper $
+          mods (reinterpretIncMaster $ spiral (6/7)) |:
+          mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
+          mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
+          mods (ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2))) |:
+          mods (ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2))) |:
+          mods Grid |:
+          mods (Dishes 2 (1/6)) |:
+          mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1) |:
+          nil
+
+-- Mosaic doesn't have the concept of a "Master Space", so reinterpret messages
+-- intended to modify the master space and instead have those messages expand
+-- and shrink the current window.
+--
+-- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system
+-- hacking one can do in Haskell.
+instance DoReinterpret "ForMosaic" where
+  
+  -- IncMaster message
+  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
+    fmap (SomeMessage .
+      (if n > 0
+        then expandWindowAlt
+        else shrinkWindowAlt)) <$> getFocusedWindow
+  
+  -- ResizeMaster message
+  reinterpretMessage _ (fromMessage -> Just m) = do
+    fmap (SomeMessage .
+      (case m of
+        Expand -> expandWindowAlt
+        Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
+
+  -- Messages that don't match the above, just leave it unmodified.
+  reinterpretMessage _ m = return (Just m)
+
+instance DoReinterpret "IncMasterToResizeMaster" where
+  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) =
+    return $ Just $
+      if n > 0
+        then SomeMessage Expand
+        else SomeMessage Shrink
+  reinterpretMessage _ m = return (Just m)
+
+modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a
+modifyMosaic = ModifiedLayout ReinterpretMessage
+
+reinterpretIncMaster ::
+  l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a
+reinterpretIncMaster = ModifiedLayout ReinterpretMessage
+
+mods =
+  ModifiedLayout (Zoomable False 0.05 0.05) .
+    ModifiedLayout (Flippable False) .
+    ModifiedLayout (HFlippable False) .
+    ModifiedLayout (Rotateable False)
+
+
+data ModifyDescription m l a = ModifyDescription m (l a)
+  deriving (Show, Read)
+
+data TallDescriptionModifier = TallDescriptionModifier
+  deriving (Show, Read)
+
+data ThreeColDescMod = ThreeColDescMod
+  deriving (Show, Read)
+
+class DescriptionModifier m l where
+  newDescription :: m -> l a -> String -> String
+
+instance (Typeable m, Show m, DescriptionModifier m l, LayoutClass l a) => LayoutClass (ModifyDescription m l) a where
+  runLayout (W.Workspace t (ModifyDescription m l) a) rect = do
+    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
+    return (rects, fmap (ModifyDescription m) maybeNewLayout)
+
+  doLayout (ModifyDescription m l) a s = do
+    (rects, maybeNewLayout) <- doLayout l a s
+    return (rects, fmap (ModifyDescription m) maybeNewLayout)
+
+  pureLayout (ModifyDescription m l) a s = pureLayout l a s
+
+  emptyLayout (ModifyDescription m l) a = do
+    (rects, maybeNewLayout) <- emptyLayout l a
+    return (rects, fmap (ModifyDescription m) maybeNewLayout)
+
+  handleMessage (ModifyDescription m l) a = do
+    maybeNewLayout <- handleMessage l a
+    return (ModifyDescription m <$> maybeNewLayout)
+
+  pureMessage (ModifyDescription m l) a =
+    let maybeNewLayout = pureMessage l a in
+      ModifyDescription m <$> maybeNewLayout
+
+  description (ModifyDescription m l) = newDescription m l (description l)
+
+instance DescriptionModifier TallDescriptionModifier Tall where
+  newDescription _ (Tall mast _ _) _ = "Tall(" ++ show mast ++ ")"
+
+instance DescriptionModifier ThreeColDescMod ThreeCol where
+  newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
+  newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
+
+data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
+
+instance Message ResizeZoom where
+
+newtype Flippable a = Flippable Bool -- True if flipped
+  deriving (Show, Read)
+
+newtype HFlippable a = HFlippable Bool -- True if flipped
+  deriving (Show, Read)
+
+newtype Rotateable a = Rotateable Bool -- True if rotated
+  deriving (Show, Read)
+
+data FlipLayout = FlipLayout deriving (Typeable)
+
+data HFlipLayout = HFlipLayout deriving (Typeable)
+
+data DoRotate = DoRotate deriving (Typeable)
+
+data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
+  deriving (Show, Read)
+
+-- Toggles if the current window should be zoomed or not. Set the boolean
+-- to set the zoom.mhar
+data ZoomModifier =
+       ToggleZoom |
+       Zoom |
+       Unzoom
+  deriving (Typeable)
+
+instance Message FlipLayout where
+
+instance Message HFlipLayout where
+
+instance Message ZoomModifier where
+
+instance Message DoRotate where
+
+instance (Eq a) => LayoutModifier Rotateable a where
+  pureModifier (Rotateable rotate) (Rectangle x' y' sw sh) _ returned =
+    if rotate
+      then (map (second (unzero . scaleRect . mirrorRect . zero)) returned, Nothing)
+      else (returned, Nothing)
+    where
+      zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
+      unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h
+
+      scaleRect (Rectangle x y w h) =
+        Rectangle (x * fi sw `div` fi sh)
+                  (y * fi sh `div` fi sw)
+                  (w * sw `div` sh)
+                  (h * sh `div` sw)
+
+      fi = fromIntegral
+
+
+  pureMess (Rotateable rot) mess =
+    fmap (\DoRotate -> Rotateable (not rot)) (fromMessage mess)
+
+  modifyDescription (Rotateable rot) underlying =
+    let descr = description underlying in
+      if rot
+        then descr ++ " Rotated"
+        else descr
+
+instance (Eq a) => LayoutModifier Flippable a where
+  pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
+    if flip
+      then (map (second doFlip) returned, Nothing)
+      else (returned, Nothing)
+    where
+      doFlip (Rectangle x y w h) =
+        Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
+
+  pureMess (Flippable flip) message =
+    case fromMessage message of
+      Just FlipLayout -> Just (Flippable (not flip))
+      Nothing -> Nothing
+
+  modifyDescription (Flippable flipped) underlying =
+    let descr = description underlying in
+      if flipped
+        then descr ++ " Flipped"
+        else descr
+
+instance (Eq a) => LayoutModifier HFlippable a where
+  pureModifier (HFlippable flip) (Rectangle _ sy _ sh) stack returned =
+    if flip
+      then (map (second doFlip) returned, Nothing)
+      else (returned, Nothing)
+    where
+      doFlip (Rectangle x y w h) =
+        Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
+
+  pureMess (HFlippable flip) message =
+    case fromMessage message of
+      Just HFlipLayout -> Just (HFlippable (not flip))
+      Nothing -> Nothing
+
+  modifyDescription (HFlippable flipped) underlying =
+    let descr = description underlying in
+      if flipped
+        then descr ++ " HFlipped"
+        else descr
+
+
+instance (Eq a) => LayoutModifier Zoomable a where
+  redoLayout (Zoomable doit ws hs) (Rectangle x y w h) stack returned =
+    if doit
+      then
+        let focused = W.focus <$> stack
+            (zoomed, rest) = partition ((==focused) . Just . fst) returned
+         in case zoomed of
+              [] -> return (rest, Nothing)
+              ((fwin, _):_) ->  return ((fwin, Rectangle (x + wp) (y + hp) (w - fromIntegral (wp * 2)) (h - fromIntegral (hp * 2))) : rest, Nothing)
+
+      else return (returned, Nothing)
+    where
+      wp = floor $ fromIntegral w * ws
+      hp = floor $ fromIntegral h * hs
+
+  handleMessOrMaybeModifyIt self@(Zoomable showing sw sh) mess =
+    return $
+      (handleResize <$> fromMessage mess)
+        <|> (Left . handleZoom <$> fromMessage mess)
+      where
+        handleResize r =
+          if showing
+            then Left $ Zoomable showing (guard $ sw + d) (guard $ sh + d)
+            else Right $ case r of
+                   ShrinkZoom -> SomeMessage Shrink
+                   ExpandZoom -> SomeMessage Expand
+
+          where d = (case r of
+                      ShrinkZoom -> -1
+                      ExpandZoom -> 1) * 0.02
+
+        handleZoom ToggleZoom = Zoomable (not showing) sw sh
+        handleZoom Zoom = Zoomable True sw sh
+        handleZoom Unzoom = Zoomable False sw sh
+
+        guard f | f > 1 = 1
+                | f < 0 = 0
+                | otherwise = f
diff --git a/src/Rahm/Desktop/Layout/LayoutDraw.hs b/src/Rahm/Desktop/Layout/LayoutDraw.hs
new file mode 100644
index 0000000..7e59284
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/LayoutDraw.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
+ScopedTypeVariables, BangPatterns #-}
+module Rahm.Desktop.Layout.LayoutDraw (drawLayout) where
+
+import Control.Monad
+
+import Control.Arrow (second)
+import Control.Concurrent (threadDelay)
+import Control.Exception (handle)
+import Control.Monad.Writer (execWriter, tell)
+import Data.Foldable (find)
+import Data.Maybe (fromMaybe)
+import Rahm.Desktop.Hash (quickHash)
+import Rahm.Desktop.Layout.Layout (ZoomModifier(..))
+import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+import XMonad.Layout.Spacing (SpacingModifier(..), Border(..))
+
+import XMonad (X,
+               Rectangle(..),
+               Dimension,
+               LayoutClass,
+               Message,
+               Window,
+               SomeMessage(..))
+
+import qualified XMonad as X
+import qualified XMonad.StackSet as S
+
+-- Draws and returns an XPM for the current layout.
+--
+-- Returns
+--  - Bool   - true if the xpm has already been written, and is thus cached.
+--  - String - description of the current layout
+--  - String - the text to send to XMobar
+--
+-- This function actually runs the current layout's doLayout function to
+-- generate the XPM, so it's completely portable to all layouts.
+--
+-- Note this function is impure and running the layout to create the XPM is also
+-- impure. While in-practice most layouts are pure, it should be kept in mind.
+drawLayout :: X (Bool, String, String)
+drawLayout = do
+    winset <- X.gets X.windowset
+    let layout = S.layout $ S.workspace $ S.current winset
+
+    -- Gotta reset the layout to a consistent state.
+    layout' <- foldM (flip ($)) layout [
+         handleMessage' $ ModifyWindowBorder $ const $ Border 0 0 0 0,
+         handleMessage' Unzoom
+       ]
+
+    (cached, xpm) <- drawXpmIO layout'
+
+    return (cached , X.description layout, printf "<icon=%s/>" xpm)
+
+-- Returns true if a point is inside a rectangle (inclusive).
+pointInRect :: (Dimension, Dimension) -> Rectangle -> Bool
+pointInRect (x, y) (Rectangle x' y' w h) =
+  x <= (fi x' + fi w) && x >= fi x' && y <= (fi y' + fi h) && y >= fi y'
+  where
+    fi :: (Integral a, Num b) => a -> b
+    fi = fromIntegral
+
+-- Scale factory. Scaling the rectangles before writing the XPM helps to reduce
+-- noise from things like AvoidStruts, as there is unfortunately no way to force
+-- avoid struts to be off, one can only toggle it.
+sf :: (Integral a) => a
+sf = 1024
+
+handleMessage' ::
+    (LayoutClass layout a, Message m) => m -> layout a -> X (layout a)
+handleMessage' message layout  = do
+  fromMaybe layout <$> X.handleMessage layout (SomeMessage message)
+
+-- Creates the XPM for the given layout and returns the path to it.
+--
+-- This function does run doLayout on the given layout, and that should be
+-- accounted for.
+drawXpmIO :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
+drawXpmIO l = do
+  dir <- X.getXMonadDir
+
+  let shrinkAmt = 5 -- amount to shrink the windows by to make pretty gaps.
+
+  let (w, h) = (56, 24)
+  let descr = X.description l
+  let iconCacheDir = dir </> "icons" </> "cache"
+  let iconPath = iconCacheDir </> (quickHash descr ++ ".xpm")
+
+  let colors = [
+        "#cc9a9a", "#cc9999", "#cc8080", "#cc6666",
+        "#cc4c4c", "#cc3232", "#cc1818", "#cc0000" ]
+
+  (rects', _) <-
+    X.runLayout
+      (S.Workspace "0" l (S.differentiate [1 .. 5]))
+      (Rectangle 0 0 ((w + shrinkAmt) * sf) ((h + shrinkAmt) * sf))
+
+  let rects = flip map rects' $ \(_, Rectangle x y w h) ->
+                Rectangle (x `div` sf) (y `div` sf) (w `div` sf) (h `div` sf)
+
+  X.liftIO $ do
+    exists <- doesFileExist iconPath
+    createDirectoryIfMissing True iconCacheDir
+
+    unless exists $ do
+      let xpmText = drawXpm (w, h) (zip (cycle colors) rects) 4
+      writeFile iconPath xpmText
+
+    return (exists, iconPath)
+
+--
+-- Create's an XPM, purely. Returns a string with the XPM contents.
+-- Takes as arguments
+--
+--   - dimensions of the icon.
+--   - list of (color, rectangle) pairs.
+--   - The amount to shrink the windows by for those pretty gaps.
+--
+drawXpm ::
+    (Dimension, Dimension) -> [(String, Rectangle)] -> Dimension -> String
+drawXpm (w, h) rects' shrinkAmt = execWriter $ do
+    tell "/* XPM */\n"
+    tell "static char *out[] = {\n"
+    tell $ printf "\"%d %d %d 1 \",\n" w h (length rects + 1)
+
+    let zipRects = zip ['A' .. 'Z'] rects
+
+    forM_ zipRects $ \(char, (color, _)) -> do
+      tell $ printf "\"%c c %s\",\n" char color
+    tell "\"% c None\"a,\n"
+
+    forM_ [0 .. h - 1] $ \y -> do
+      tell "\""
+      forM_ [0 .. w - 1] $ \x ->
+        (case find (matches x y) zipRects of
+          Nothing -> tell "%"
+          Just (chr, _) -> tell [chr])
+      tell "\""
+      when (y /= h - 1 - shrinkAmt) (tell ",")
+      tell "\n"
+    tell "};\n"
+
+  where
+    matches x y (_, (_, r)) = pointInRect (x, y) r
+    rects = map (second (shrink shrinkAmt)) rects'
+    guard a b = if a <= shrinkAmt then 1 else b
+    shrink amt (Rectangle x y w h) =
+      Rectangle
+        x
+        y
+        (guard w $ w - fromIntegral amt)
+        (guard h $ h - fromIntegral amt)
diff --git a/src/Rahm/Desktop/Layout/LayoutList.hs b/src/Rahm/Desktop/Layout/LayoutList.hs
new file mode 100644
index 0000000..3e72e99
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/LayoutList.hs
@@ -0,0 +1,295 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+{-
+ - This module provides a more powerful version of the "Choose" layout that can
+ - be bidirectionally navigated.
+ -
+ - The indexing uses a type-safe zipper to keep track of the currently-selected
+ - layout.
+ -}
+module Rahm.Desktop.Layout.LayoutList (
+  LayoutList,
+  layoutZipper,
+  LCons,
+  LNil,
+  toNextLayout,
+  toPreviousLayout,
+  toFirstLayout,
+  (|:),
+  nil
+  )where
+
+import Control.Applicative ((<|>))
+import Data.Void
+import Control.Monad.Identity (runIdentity)
+import Data.Maybe (fromMaybe, fromJust)
+import Control.Arrow (second)
+import XMonad
+import qualified XMonad.StackSet as W
+import Data.Proxy
+
+-- Type-level lists. LNil is the final of the list. LCons contains a layout and a
+-- tail.
+data LNil a = LNil deriving (Read, Show)
+data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
+
+-- Sel - This defines a structure where either this selected, or some
+-- other element is selected.
+--
+-- These types can be composed to create what is effectively a bounded integer.
+-- I.e. there can be a type like
+--
+-- Sel (Sel (Sel (Sel End)))
+--
+-- Such a type is equivalent to an integer bounded at 4, because this type can
+-- exist in no more than 4 states:
+--
+-- Sel
+-- Skip Sel
+-- Skip (Skip Sel)
+-- Skip (Skip (Skip Sel))
+--
+-- Note that a type (Sel End) can only be in the Sel as End may not be
+-- construted (without using undefined).
+data Sel l =
+    Sel |
+    (Selector l) => Skip l
+deriving instance (Read l, Selector l) => Read (Sel l)
+deriving instance (Show l, Selector l) => Show (Sel l)
+deriving instance (Eq l, Selector l) => Eq (Sel l)
+
+-- Reimplement Void as End, just to keep the two separate, but End is for all
+-- intents and purposes Void.
+data End
+deriving instance Read End
+deriving instance Show End
+deriving instance Eq End
+
+
+-- Types that constitute a selection. Selections can be moved to the next
+-- selection, moved to the previous selection, optionally there could be a
+-- previous selection and they may be currently selected.
+class (Eq c) => Selector c where
+  -- Increments the selection to the next state
+  --
+  -- Returns Nothing if the selection class is in the final state and cannot be
+  -- incremented any farther. (This is helpful to facilitate modular
+  -- arithmatic)
+  increment :: c -> Maybe c
+
+  -- Decrements the selection to the previous state. Returns Nothing if the
+  -- state is already in its initial setting.
+  decrement :: c -> Maybe c
+
+  -- The initial state.
+  initial :: Maybe c
+
+  -- The final state.
+  final :: Maybe c
+
+--
+-- Is selelected can be in two states:
+--
+--   1. The current element is selected
+--   2. The current element is not selected and another element deeper in the
+--      structure is selected.
+instance (Selector t) => Selector (Sel t) where
+  -- If the current element is not selected, increment the tail.
+  increment (Skip l) = Skip <$> increment l
+  -- If the current element is selected, the increment is just the initial of
+  -- the tail.
+  increment Sel = Skip <$> initial 
+
+  -- For a selection, the initial is just this in the Sel state.
+  initial = Just Sel
+
+  -- Looks ahead at the tail, sees if it is selected, if so, select this one
+  -- instead, if the one ahead isn't selected, then decrement that one.
+  decrement (Skip t) = Just $ maybe Sel Skip (decrement t)
+  decrement Sel = Nothing
+
+  -- Navigates to the end of the structure to find the final form.
+  final = Just $ maybe Sel Skip final
+
+-- The End structure (which is equivalent to Void) is the "null" selector; the
+-- basecase that the Sel selector terminates at.
+instance Selector End where
+
+  -- Incrementing the End Selector doesn't do anything.
+  increment = const Nothing
+
+  -- Decrementing the End Selector doesn't do anythig
+  decrement = const Nothing
+
+  -- There is no initial value for the End selector.
+  initial = Nothing
+
+  -- There is not final state for the End selector.
+  final = Nothing
+
+-- Increment a selector, but cyclicly
+incrementCycle :: (Selector c) => c -> c
+incrementCycle c =
+  case increment c of
+    Nothing -> fromMaybe c initial
+    Just x -> x
+
+-- Add two selectors together, incrementing the first until the second cannot be
+-- incremented anymore.
+addSelector :: (Selector c) => c -> c -> c
+addSelector c1 c2 = addSel c1 (decrement c2)
+  where
+    addSel c1 Nothing = c1
+    addSel c1 (Just c2) = addSel (incrementCycle c1) (decrement c2)
+
+-- Turn an int into a selector by repeatably incrementing.
+intToSelector :: (Selector c) => Int -> c
+intToSelector 0 = fromJust initial
+intToSelector n = incrementCycle $ intToSelector (n - 1)
+
+-- A LayoutList consists of a LayoutSelect type and a corresponding Selector.
+data LayoutList l a where
+  LayoutList ::
+    (LayoutSelect l a, Selector (SelectorFor l)) =>
+      SelectorFor l -> l a -> LayoutList l a
+
+deriving instance (LayoutSelect l a) => Show (LayoutList l a)
+deriving instance (LayoutSelect l a) => Read (LayoutList l a)
+
+(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
+(|:) = LCons
+
+infixr 5 |: 
+
+-- Constructs a LayoutList. This function enforces that the SelectorFor l
+-- is a 'Sel' type. Essentially this enforces that there must be at least one
+-- underlying layout, otherwise a LayoutList cannot be constructed.
+layoutZipper :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
+  l a -> LayoutList l a
+layoutZipper = LayoutList Sel
+
+-- The termination of a layout zipper.
+nil :: LNil a
+nil = LNil
+
+-- Message to navigate to a layout.
+newtype NavigateLayout =
+          -- Sets the layout based on the given function.
+          NavigateLayout {
+            changeLayoutFn :: forall c. (Selector c) => c -> c
+          }
+          deriving (Typeable)
+
+-- NavigateLayout instance to move to the next layout, circularly.
+toNextLayout :: NavigateLayout
+toNextLayout = NavigateLayout $ addSelector (intToSelector 1)
+
+-- NavigateLayout instance to move to the previous layout, circularly.
+toPreviousLayout :: NavigateLayout
+toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
+
+-- NavigateLayotu instance to move to the first layout.
+toFirstLayout :: NavigateLayout
+toFirstLayout = NavigateLayout (`fromMaybe` initial)
+
+instance Message NavigateLayout where
+
+-- LayoutSelect class Describes a type that can be used to select a layout using
+-- the associated type SelectorFor.
+--
+-- Instances of this class are LCons and LNil.
+class (Show (l a),
+       Read (l a),
+       Read (SelectorFor l),
+       Show (SelectorFor l),
+       Selector (SelectorFor l)) => LayoutSelect l a where
+
+  -- The selector that is used to update the layout corresponding to the
+  -- selector. This selector must be an instance of the Selector class.
+  type SelectorFor l :: *
+
+  -- Update applies a functor to the selected layout and maybe returns a result
+  -- and an updated layout.
+  update :: forall r m. (Monad m) =>
+    -- The selector for this type. Determines which layout the function is
+    -- applied to.
+    SelectorFor l ->
+    -- The LayoutSelect being modified.
+    l a ->
+    -- Higher-ordered function to generically apply to the Layout associated
+    -- with the Selector. Works on all LayoutClass's.
+    (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
+
+    -- Returns a result r, and an updated LayoutSelect.
+    m (Maybe (r, l a))
+
+-- Instance for LayoutSelect for cons
+instance (Read (l a),
+          LayoutClass l a,
+          LayoutSelect t a,
+          Show (SelectorFor t),
+          Read (SelectorFor t)) =>
+    LayoutSelect (LCons l t) a where
+
+  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
+  -- Sel (Sel (Sel ( ... (Sel End) .. ))) where the number of Sel's match the
+  -- number of Cons in this structure enforcing safe selection.
+  type SelectorFor (LCons l t) = Sel (SelectorFor t)
+
+  -- The current layout in this Cons-list is selected.
+  update Sel (LCons layout t) fn = do
+    (r, layout') <- fn layout
+    return $ Just (r, LCons (fromMaybe layout layout') t)
+
+  -- The current layout is not selected. Move on to another layout.
+  update (Skip s) (LCons l t) fn =
+    fmap (second $ \t' -> LCons l t') <$> update s t fn
+
+-- LNil is a layout select. It doesn't do anything. Indeed update really can't
+-- be called on on this because that would require instantiating a End type.
+instance LayoutSelect LNil a where
+  type SelectorFor LNil = End -- LNil cannot be selected.
+  update _ _ _ = return Nothing
+
+-- Instance of layout class for LayoutList. The implementation for this
+-- just delegates to the underlying LayoutSelect class using the generic
+-- update method.
+instance (Show (l a), Typeable l, LayoutSelect l a) =>
+    LayoutClass (LayoutList l) a where
+
+  runLayout (W.Workspace i (LayoutList idx l) ms) r = do
+    r <- update idx l $ \layout ->
+            runLayout (W.Workspace i layout ms) r
+    case r of
+      Nothing -> return ([], Nothing)
+      Just (r, la) -> return (r, Just (LayoutList idx la))
+
+  pureLayout (LayoutList idx l) r s = runIdentity $ do
+    r <- update idx l $ \layout -> return (pureLayout layout r s, Nothing)
+    case r of
+      Nothing -> return []
+      Just (r, a) -> return r
+
+  emptyLayout (LayoutList idx l) r = do
+    r <- update idx l $ \layout -> emptyLayout layout r
+    case r of
+      Nothing -> return ([], Nothing)
+      Just (r, la) -> return (r, Just (LayoutList idx la))
+
+  handleMessage (LayoutList idx l) (fromMessage -> Just (NavigateLayout fn)) =
+    return $ Just (LayoutList (fn idx) l)
+
+  handleMessage (LayoutList idx l) m = do
+    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
+    return $ LayoutList idx . snd <$> r
+
+  pureMessage (LayoutList idx l) m = runIdentity $ do
+    r <- update idx l $ \layout -> return ((), pureMessage layout m)
+    return $ LayoutList idx . snd <$> r
+
+  description (LayoutList idx l) = runIdentity $ do
+    r <- update idx l $ \l -> return (description l, Nothing)
+    return $
+      case r of
+        Nothing -> "No Layout"
+        Just (descr, _) -> descr
diff --git a/src/Rahm/Desktop/Layout/ReinterpretMessage.hs b/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
new file mode 100644
index 0000000..98bf779
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
@@ -0,0 +1,48 @@
+module Rahm.Desktop.Layout.ReinterpretMessage where
+
+import XMonad (SomeMessage, X)
+import XMonad.Layout.LayoutModifier (LayoutModifier(..))
+import Data.Proxy (Proxy (..))
+
+-- This is a type class that defines how to reinterpret a message. One can think
+-- of this as a kind of type-level function. It lets one associate a function
+-- (reinterpretMessage) with a type construct, which for the case below is a
+-- Symbol.
+--
+-- It would be nice to attach this function to the LayoutModifier directly as a
+-- value, however LayoutModifiers must be Show-able and Read-able and functions
+-- are not. However encoding in the typesystem itsef which function is to be
+-- called is the best alternative I have.
+class DoReinterpret (k :: t) where
+  reinterpretMessage ::
+    Proxy k -> SomeMessage -> X (Maybe SomeMessage)
+
+-- Data construct for association a DoReinterpret function with a concrete
+-- construct that can be used in the LayoutModifier instance.
+--
+-- It wolud be nice to have ReinterpretMessage hold the function as a value
+-- rather than delegate to this kind-instance, however, it won't work because
+-- LayoutModifiers have to be Read-able and Show-able, and functions are neither
+-- of those, so a value-level function may not be a member of a LayoutModifier,
+-- thus I have to settle for delegating to a hard-coded instance using
+-- type-classes.
+data ReinterpretMessage k a = ReinterpretMessage
+  deriving (Show, Read)
+
+-- Instance for ReinterpretMessage as a Layout modifier.
+instance (DoReinterpret k) =>
+      LayoutModifier (ReinterpretMessage k) a where 
+
+  handleMessOrMaybeModifyIt self message = do
+
+    -- Delegates to the reinterpretMessage function associatied with the
+    -- type-variable k.
+    newMessage <- reinterpretMessage (ofProxy self) message
+    case newMessage of
+      Just m -> return $ Just $ Right m
+      Nothing -> return $ Just $ Left self
+    where
+      -- ofProxy just provides reifies the phantom type k so the type system can
+      -- figure out what instance to go to.
+      ofProxy :: ReinterpretMessage k a -> Proxy k
+      ofProxy _ = Proxy
diff --git a/src/Rahm/Desktop/LayoutDraw.hs b/src/Rahm/Desktop/LayoutDraw.hs
deleted file mode 100644
index c3d8c9e..0000000
--- a/src/Rahm/Desktop/LayoutDraw.hs
+++ /dev/null
@@ -1,155 +0,0 @@
-{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
-ScopedTypeVariables, BangPatterns #-}
-module Rahm.Desktop.LayoutDraw (drawLayout) where
-
-import Control.Monad
-
-import Control.Arrow (second)
-import Control.Concurrent (threadDelay)
-import Control.Exception (handle)
-import Control.Monad.Writer (execWriter, tell)
-import Data.Foldable (find)
-import Data.Maybe (fromMaybe)
-import Rahm.Desktop.Hash (quickHash)
-import Rahm.Desktop.Layout (ZoomModifier(..))
-import System.Directory (createDirectoryIfMissing, doesFileExist)
-import System.FilePath ((</>))
-import Text.Printf (printf)
-import XMonad.Layout.Spacing (SpacingModifier(..), Border(..))
-
-import XMonad (X,
-               Rectangle(..),
-               Dimension,
-               LayoutClass,
-               Message,
-               Window,
-               SomeMessage(..))
-
-import qualified XMonad as X
-import qualified XMonad.StackSet as S
-
--- Draws and returns an XPM for the current layout.
---
--- Returns
---  - Bool   - true if the xpm has already been written, and is thus cached.
---  - String - description of the current layout
---  - String - the text to send to XMobar
---
--- This function actually runs the current layout's doLayout function to
--- generate the XPM, so it's completely portable to all layouts.
---
--- Note this function is impure and running the layout to create the XPM is also
--- impure. While in-practice most layouts are pure, it should be kept in mind.
-drawLayout :: X (Bool, String, String)
-drawLayout = do
-    winset <- X.gets X.windowset
-    let layout = S.layout $ S.workspace $ S.current winset
-
-    -- Gotta reset the layout to a consistent state.
-    layout' <- foldM (flip ($)) layout [
-         handleMessage' $ ModifyWindowBorder $ const $ Border 0 0 0 0,
-         handleMessage' Unzoom
-       ]
-
-    (cached, xpm) <- drawXpmIO layout'
-
-    return (cached , X.description layout, printf "<icon=%s/>" xpm)
-
--- Returns true if a point is inside a rectangle (inclusive).
-pointInRect :: (Dimension, Dimension) -> Rectangle -> Bool
-pointInRect (x, y) (Rectangle x' y' w h) =
-  x <= (fi x' + fi w) && x >= fi x' && y <= (fi y' + fi h) && y >= fi y'
-  where
-    fi :: (Integral a, Num b) => a -> b
-    fi = fromIntegral
-
--- Scale factory. Scaling the rectangles before writing the XPM helps to reduce
--- noise from things like AvoidStruts, as there is unfortunately no way to force
--- avoid struts to be off, one can only toggle it.
-sf :: (Integral a) => a
-sf = 1024
-
-handleMessage' ::
-    (LayoutClass layout a, Message m) => m -> layout a -> X (layout a)
-handleMessage' message layout  = do
-  fromMaybe layout <$> X.handleMessage layout (SomeMessage message)
-
--- Creates the XPM for the given layout and returns the path to it.
---
--- This function does run doLayout on the given layout, and that should be
--- accounted for.
-drawXpmIO :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
-drawXpmIO l = do
-  dir <- X.getXMonadDir
-
-  let shrinkAmt = 5 -- amount to shrink the windows by to make pretty gaps.
-
-  let (w, h) = (56, 24)
-  let descr = X.description l
-  let iconCacheDir = dir </> "icons" </> "cache"
-  let iconPath = iconCacheDir </> (quickHash descr ++ ".xpm")
-
-  let colors = [
-        "#cc9a9a", "#cc9999", "#cc8080", "#cc6666",
-        "#cc4c4c", "#cc3232", "#cc1818", "#cc0000" ]
-
-  (rects', _) <-
-    X.runLayout
-      (S.Workspace "0" l (S.differentiate [1 .. 5]))
-      (Rectangle 0 0 ((w + shrinkAmt) * sf) ((h + shrinkAmt) * sf))
-
-  let rects = flip map rects' $ \(_, Rectangle x y w h) ->
-                Rectangle (x `div` sf) (y `div` sf) (w `div` sf) (h `div` sf)
-
-  X.liftIO $ do
-    exists <- doesFileExist iconPath
-    createDirectoryIfMissing True iconCacheDir
-
-    unless exists $ do
-      let xpmText = drawXpm (w, h) (zip (cycle colors) rects) 4
-      writeFile iconPath xpmText
-
-    return (exists, iconPath)
-
---
--- Create's an XPM, purely. Returns a string with the XPM contents.
--- Takes as arguments
---
---   - dimensions of the icon.
---   - list of (color, rectangle) pairs.
---   - The amount to shrink the windows by for those pretty gaps.
---
-drawXpm ::
-    (Dimension, Dimension) -> [(String, Rectangle)] -> Dimension -> String
-drawXpm (w, h) rects' shrinkAmt = execWriter $ do
-    tell "/* XPM */\n"
-    tell "static char *out[] = {\n"
-    tell $ printf "\"%d %d %d 1 \",\n" w h (length rects + 1)
-
-    let zipRects = zip ['A' .. 'Z'] rects
-
-    forM_ zipRects $ \(char, (color, _)) -> do
-      tell $ printf "\"%c c %s\",\n" char color
-    tell "\"% c None\"a,\n"
-
-    forM_ [0 .. h - 1] $ \y -> do
-      tell "\""
-      forM_ [0 .. w - 1] $ \x ->
-        (case find (matches x y) zipRects of
-          Nothing -> tell "%"
-          Just (chr, _) -> tell [chr])
-      tell "\""
-      when (y /= h - 1 - shrinkAmt) (tell ",")
-      tell "\n"
-    tell "};\n"
-
-  where
-    matches x y (_, (_, r)) = pointInRect (x, y) r
-    rects = map (second (shrink shrinkAmt)) rects'
-    guard a b = if a <= shrinkAmt then 1 else b
-    shrink amt (Rectangle x y w h) =
-      Rectangle
-        x
-        y
-        (guard w $ w - fromIntegral amt)
-        (guard h $ h - fromIntegral amt)
diff --git a/src/Rahm/Desktop/LayoutList.hs b/src/Rahm/Desktop/LayoutList.hs
deleted file mode 100644
index 3bc09d3..0000000
--- a/src/Rahm/Desktop/LayoutList.hs
+++ /dev/null
@@ -1,297 +0,0 @@
-{-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, MultiParamTypeClasses,
- FlexibleContexts, UndecidableInstances, ViewPatterns, StandaloneDeriving,
- RankNTypes, TupleSections, TypeFamilies #-}
-
-{-
- - This module provides a more powerful version of the "Choose" layout that can
- - be bidirectionally navigated.
- -
- - The indexing uses a type-safe zipper to keep track of the currently-selected
- - layout.
- -}
-module Rahm.Desktop.LayoutList (
-  LayoutList,
-  layoutZipper,
-  LCons,
-  LNil,
-  toNextLayout,
-  toPreviousLayout,
-  toFirstLayout,
-  (|:),
-  nil
-  )where
-
-import Control.Applicative ((<|>))
-import Data.Void
-import Control.Monad.Identity (runIdentity)
-import Data.Maybe (fromMaybe, fromJust)
-import Control.Arrow (second)
-import XMonad
-import qualified XMonad.StackSet as W
-import Data.Proxy
-
--- Type-level lists. LNil is the final of the list. LCons contains a layout and a
--- tail.
-data LNil a = LNil deriving (Read, Show)
-data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
-
--- Sel - This defines a structure where either this selected, or some
--- other element is selected.
---
--- These types can be composed to create what is effectively a bounded integer.
--- I.e. there can be a type like
---
--- Sel (Sel (Sel (Sel End)))
---
--- Such a type is equivalent to an integer bounded at 4, because this type can
--- exist in no more than 4 states:
---
--- Sel
--- Skip Sel
--- Skip (Skip Sel)
--- Skip (Skip (Skip Sel))
---
--- Note that a type (Sel End) can only be in the Sel as End may not be
--- construted (without using undefined).
-data Sel l =
-    Sel |
-    (Selector l) => Skip l
-deriving instance (Read l, Selector l) => Read (Sel l)
-deriving instance (Show l, Selector l) => Show (Sel l)
-deriving instance (Eq l, Selector l) => Eq (Sel l)
-
--- Reimplement Void as End, just to keep the two separate, but End is for all
--- intents and purposes Void.
-data End
-deriving instance Read End
-deriving instance Show End
-deriving instance Eq End
-
-
--- Types that constitute a selection. Selections can be moved to the next
--- selection, moved to the previous selection, optionally there could be a
--- previous selection and they may be currently selected.
-class (Eq c) => Selector c where
-  -- Increments the selection to the next state
-  --
-  -- Returns Nothing if the selection class is in the final state and cannot be
-  -- incremented any farther. (This is helpful to facilitate modular
-  -- arithmatic)
-  increment :: c -> Maybe c
-
-  -- Decrements the selection to the previous state. Returns Nothing if the
-  -- state is already in its initial setting.
-  decrement :: c -> Maybe c
-
-  -- The initial state.
-  initial :: Maybe c
-
-  -- The final state.
-  final :: Maybe c
-
---
--- Is selelected can be in two states:
---
---   1. The current element is selected
---   2. The current element is not selected and another element deeper in the
---      structure is selected.
-instance (Selector t) => Selector (Sel t) where
-  -- If the current element is not selected, increment the tail.
-  increment (Skip l) = Skip <$> increment l
-  -- If the current element is selected, the increment is just the initial of
-  -- the tail.
-  increment Sel = Skip <$> initial 
-
-  -- For a selection, the initial is just this in the Sel state.
-  initial = Just Sel
-
-  -- Looks ahead at the tail, sees if it is selected, if so, select this one
-  -- instead, if the one ahead isn't selected, then decrement that one.
-  decrement (Skip t) = Just $ maybe Sel Skip (decrement t)
-  decrement Sel = Nothing
-
-  -- Navigates to the end of the structure to find the final form.
-  final = Just $ maybe Sel Skip final
-
--- The End structure (which is equivalent to Void) is the "null" selector; the
--- basecase that the Sel selector terminates at.
-instance Selector End where
-
-  -- Incrementing the End Selector doesn't do anything.
-  increment = const Nothing
-
-  -- Decrementing the End Selector doesn't do anythig
-  decrement = const Nothing
-
-  -- There is no initial value for the End selector.
-  initial = Nothing
-
-  -- There is not final state for the End selector.
-  final = Nothing
-
--- Increment a selector, but cyclicly
-incrementCycle :: (Selector c) => c -> c
-incrementCycle c =
-  case increment c of
-    Nothing -> fromMaybe c initial
-    Just x -> x
-
--- Add two selectors together, incrementing the first until the second cannot be
--- incremented anymore.
-addSelector :: (Selector c) => c -> c -> c
-addSelector c1 c2 = addSel c1 (decrement c2)
-  where
-    addSel c1 Nothing = c1
-    addSel c1 (Just c2) = addSel (incrementCycle c1) (decrement c2)
-
--- Turn an int into a selector by repeatably incrementing.
-intToSelector :: (Selector c) => Int -> c
-intToSelector 0 = fromJust initial
-intToSelector n = incrementCycle $ intToSelector (n - 1)
-
--- A LayoutList consists of a LayoutSelect type and a corresponding Selector.
-data LayoutList l a where
-  LayoutList ::
-    (LayoutSelect l a, Selector (SelectorFor l)) =>
-      SelectorFor l -> l a -> LayoutList l a
-
-deriving instance (LayoutSelect l a) => Show (LayoutList l a)
-deriving instance (LayoutSelect l a) => Read (LayoutList l a)
-
-(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
-(|:) = LCons
-
-infixr 5 |: 
-
--- Constructs a LayoutList. This function enforces that the SelectorFor l
--- is a 'Sel' type. Essentially this enforces that there must be at least one
--- underlying layout, otherwise a LayoutList cannot be constructed.
-layoutZipper :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
-  l a -> LayoutList l a
-layoutZipper = LayoutList Sel
-
--- The termination of a layout zipper.
-nil :: LNil a
-nil = LNil
-
--- Message to navigate to a layout.
-newtype NavigateLayout =
-          -- Sets the layout based on the given function.
-          NavigateLayout {
-            changeLayoutFn :: forall c. (Selector c) => c -> c
-          }
-          deriving (Typeable)
-
--- NavigateLayout instance to move to the next layout, circularly.
-toNextLayout :: NavigateLayout
-toNextLayout = NavigateLayout $ addSelector (intToSelector 1)
-
--- NavigateLayout instance to move to the previous layout, circularly.
-toPreviousLayout :: NavigateLayout
-toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
-
--- NavigateLayotu instance to move to the first layout.
-toFirstLayout :: NavigateLayout
-toFirstLayout = NavigateLayout (`fromMaybe` initial)
-
-instance Message NavigateLayout where
-
--- LayoutSelect class Describes a type that can be used to select a layout using
--- the associated type SelectorFor.
---
--- Instances of this class are LCons and LNil.
-class (Show (l a),
-       Read (l a),
-       Read (SelectorFor l),
-       Show (SelectorFor l),
-       Selector (SelectorFor l)) => LayoutSelect l a where
-
-  -- The selector that is used to update the layout corresponding to the
-  -- selector. This selector must be an instance of the Selector class.
-  type SelectorFor l :: *
-
-  -- Update applies a functor to the selected layout and maybe returns a result
-  -- and an updated layout.
-  update :: forall r m. (Monad m) =>
-    -- The selector for this type. Determines which layout the function is
-    -- applied to.
-    SelectorFor l ->
-    -- The LayoutSelect being modified.
-    l a ->
-    -- Higher-ordered function to generically apply to the Layout associated
-    -- with the Selector. Works on all LayoutClass's.
-    (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
-
-    -- Returns a result r, and an updated LayoutSelect.
-    m (Maybe (r, l a))
-
--- Instance for LayoutSelect for cons
-instance (Read (l a),
-          LayoutClass l a,
-          LayoutSelect t a,
-          Show (SelectorFor t),
-          Read (SelectorFor t)) =>
-    LayoutSelect (LCons l t) a where
-
-  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
-  -- Sel (Sel (Sel ( ... (Sel End) .. ))) where the number of Sel's match the
-  -- number of Cons in this structure enforcing safe selection.
-  type SelectorFor (LCons l t) = Sel (SelectorFor t)
-
-  -- The current layout in this Cons-list is selected.
-  update Sel (LCons layout t) fn = do
-    (r, layout') <- fn layout
-    return $ Just (r, LCons (fromMaybe layout layout') t)
-
-  -- The current layout is not selected. Move on to another layout.
-  update (Skip s) (LCons l t) fn =
-    fmap (second $ \t' -> LCons l t') <$> update s t fn
-
--- LNil is a layout select. It doesn't do anything. Indeed update really can't
--- be called on on this because that would require instantiating a End type.
-instance LayoutSelect LNil a where
-  type SelectorFor LNil = End -- LNil cannot be selected.
-  update _ _ _ = return Nothing
-
--- Instance of layout class for LayoutList. The implementation for this
--- just delegates to the underlying LayoutSelect class using the generic
--- update method.
-instance (Show (l a), Typeable l, LayoutSelect l a) =>
-    LayoutClass (LayoutList l) a where
-
-  runLayout (W.Workspace i (LayoutList idx l) ms) r = do
-    r <- update idx l $ \layout ->
-            runLayout (W.Workspace i layout ms) r
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutList idx la))
-
-  pureLayout (LayoutList idx l) r s = runIdentity $ do
-    r <- update idx l $ \layout -> return (pureLayout layout r s, Nothing)
-    case r of
-      Nothing -> return []
-      Just (r, a) -> return r
-
-  emptyLayout (LayoutList idx l) r = do
-    r <- update idx l $ \layout -> emptyLayout layout r
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutList idx la))
-
-  handleMessage (LayoutList idx l) (fromMessage -> Just (NavigateLayout fn)) =
-    return $ Just (LayoutList (fn idx) l)
-
-  handleMessage (LayoutList idx l) m = do
-    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
-    return $ LayoutList idx . snd <$> r
-
-  pureMessage (LayoutList idx l) m = runIdentity $ do
-    r <- update idx l $ \layout -> return ((), pureMessage layout m)
-    return $ LayoutList idx . snd <$> r
-
-  description (LayoutList idx l) = runIdentity $ do
-    r <- update idx l $ \l -> return (description l, Nothing)
-    return $
-      case r of
-        Nothing -> "No Layout"
-        Just (descr, _) -> descr
diff --git a/src/Rahm/Desktop/Lib.hs b/src/Rahm/Desktop/Lib.hs
index c90a5d7..2f90d0a 100644
--- a/src/Rahm/Desktop/Lib.hs
+++ b/src/Rahm/Desktop/Lib.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE RankNTypes #-}
 module Rahm.Desktop.Lib where
 
 import Prelude hiding ((!!))
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 8e9867d..8ca50fd 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE ScopedTypeVariables #-}
 module Rahm.Desktop.Marking (
   historyNext, historyPrev,
   markCurrentWindow, pushHistory,
diff --git a/src/Rahm/Desktop/MouseMotion.hs b/src/Rahm/Desktop/MouseMotion.hs
index 488f06a..b5e8874 100644
--- a/src/Rahm/Desktop/MouseMotion.hs
+++ b/src/Rahm/Desktop/MouseMotion.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE ViewPatterns, BangPatterns #-}
 module Rahm.Desktop.MouseMotion where
 
 import XMonad
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index f3beb86..8b0ad72 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -6,7 +6,7 @@ import Control.Monad.Writer (tell, execWriter)
 import Data.List (sortBy)
 import Data.Maybe (mapMaybe)
 import Data.Ord (comparing)
-import Rahm.Desktop.LayoutDraw (drawLayout)
+import Rahm.Desktop.Layout.LayoutDraw (drawLayout)
 import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
 import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Run (spawnPipe)
-- 
cgit 


From 9230d82c5ee361891144f0f11347e02f54d634f5 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 11 Apr 2022 17:23:42 -0600
Subject: Add clickable workspaces to XMobar.

This is using xdotool to send a keystroke, which is not the best way to
do this. In fact, a proper server protocol would be better, but this is
how it is at the momement unfortunately.

There is a problem where trying to use xdotool to send a key for a
multibyte character will cause all events to freeze on XMonad for some
reason, so these actions are guarded so only 'a-zA-Z0-9' are clickable
and the rest are not, which is /okay/, I don't use unicode workspaces
that often.
---
 extras/HOME/.xmobarrc         |  4 ++--
 src/Rahm/Desktop/XMobarLog.hs | 12 +++++++++++-
 2 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index 7461de8..aa252f7 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -29,13 +29,13 @@ Config
    , alignSep = "}{"
    , template =
       " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc><fc=#404040> │\
-      \</fc>%StdinReader%}\
+      \</fc>%UnsafeStdinReader%}\
       \{ %cpu% %memory% <fc=#404040>\
       \│</fc> %weather% <fc=#404040>│\
       \</fc> <fc=#a0a0a0>%media%</fc> <fc=#404040>│ \
       \</fc>%bluetooth%%bat% <fc=#404040>│</fc> <fn=2><fc=#606060>%time%</fc></fn> "
    , commands = [
-       Run StdinReader,
+       Run UnsafeStdinReader,
        Run Date "%m/%d %H:%M:%S" "time" 10,
        Run Cpu [
            "-t", "<fn=3><fc=#000000><bar></fc></fn>",
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index 8b0ad72..0f67ed4 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -12,6 +12,7 @@ import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Run (spawnPipe)
 import XMonad (X)
 import Rahm.Desktop.Lib (getPopulatedWorkspaces, WorkspaceState(..))
+import Text.Printf
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as S
@@ -43,6 +44,7 @@ xMobarLogHook (XMobarLog xmproc) = do
 
   X.liftIO $ do
     hPutStrLn xmproc $ trunc 80 $ execWriter $ do
+      tell " "
       tell layoutXpm
       tell $ "<fc=#404040> │ </fc>"
 
@@ -51,12 +53,20 @@ xMobarLogHook (XMobarLog xmproc) = do
           Current -> tell "<fn=1><fc=#ff8888>"
           Visible -> tell "<fn=6><fc=#8888ff>"
           Hidden -> tell "<fn=2><fc=#888888>"
-        tell (S.tag ws)
+
+        tell $ toAction $ S.tag ws
         tell " </fc></fn>"
 
       tell $ "<fc=#404040>│ </fc><fc=#a0a0a0><fn=3>"
       tell $ title
       tell $ "</fn></fc>"
+  
+  where
+    toAction [ch] | (ch >= 'A' && ch <= 'Z') ||
+                    (ch >= 'a' && ch <= 'z') ||
+                    (ch >= '0' && ch <= '9') =
+                      printf "<action=`xdotool key 'Hyper_L+g' '%s'`>%s</action>" [ch] [ch]
+    toAction ch = ch
 
 -- Truncate an XMobar string to the provided number of _visible_ characters.
 -- This is to keep long window titles from overrunning the whole bar.
-- 
cgit 


From f999e85bb5be0b7eb42a37566d45b92261e043f0 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 11 Apr 2022 22:40:34 -0600
Subject: Add right click to move current window to a workspace.

---
 extras/HOME/.xmonad/build                     | 2 +-
 src/Rahm/Desktop/Layout/ReinterpretMessage.hs | 4 ++--
 src/Rahm/Desktop/XMobarLog.hs                 | 2 +-
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/extras/HOME/.xmonad/build b/extras/HOME/.xmonad/build
index 72b6310..484d580 100755
--- a/extras/HOME/.xmonad/build
+++ b/extras/HOME/.xmonad/build
@@ -14,4 +14,4 @@ fi
 
 cd "$olddir"
 
-ln -sf "$HOME/.local/bin/jrahm-xmonad" "$1"
+ln -sf "$HOME/.local/bin/rde" "$1"
diff --git a/src/Rahm/Desktop/Layout/ReinterpretMessage.hs b/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
index 98bf779..8f6a78d 100644
--- a/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
+++ b/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
@@ -20,7 +20,7 @@ class DoReinterpret (k :: t) where
 -- Data construct for association a DoReinterpret function with a concrete
 -- construct that can be used in the LayoutModifier instance.
 --
--- It wolud be nice to have ReinterpretMessage hold the function as a value
+-- It would be nice to have ReinterpretMessage hold the function as a value
 -- rather than delegate to this kind-instance, however, it won't work because
 -- LayoutModifiers have to be Read-able and Show-able, and functions are neither
 -- of those, so a value-level function may not be a member of a LayoutModifier,
@@ -35,7 +35,7 @@ instance (DoReinterpret k) =>
 
   handleMessOrMaybeModifyIt self message = do
 
-    -- Delegates to the reinterpretMessage function associatied with the
+    -- Delegates to the reinterpretMessage function associated with the
     -- type-variable k.
     newMessage <- reinterpretMessage (ofProxy self) message
     case newMessage of
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index 0f67ed4..4b266c1 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -65,7 +65,7 @@ xMobarLogHook (XMobarLog xmproc) = do
     toAction [ch] | (ch >= 'A' && ch <= 'Z') ||
                     (ch >= 'a' && ch <= 'z') ||
                     (ch >= '0' && ch <= '9') =
-                      printf "<action=`xdotool key 'Hyper_L+g' '%s'`>%s</action>" [ch] [ch]
+                      printf "<action=`xdotool key 'Hyper_L+g' '%s'` button=1><action=`xdotool key 'Hyper_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
     toAction ch = ch
 
 -- Truncate an XMobar string to the provided number of _visible_ characters.
-- 
cgit 


From 4ec113c501dd0435bce173110ef2f0ba0293c360 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 11 Apr 2022 22:58:45 -0600
Subject: Rename Zoom to Pop and move into its own Module.

Much cleaner.
---
 src/Rahm/Desktop/Keys.hs          | 15 +++----
 src/Rahm/Desktop/Layout/Layout.hs | 60 +---------------------------
 src/Rahm/Desktop/Layout/Pop.hs    | 83 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 93 insertions(+), 65 deletions(-)
 create mode 100644 src/Rahm/Desktop/Layout/Pop.hs

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 0bebd6f..7ca6161 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -54,6 +54,7 @@ import Rahm.Desktop.PassMenu
 import Rahm.Desktop.Logger
 import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.Swallow
+import Rahm.Desktop.Layout.Pop (PopMessage(..))
 import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -311,16 +312,16 @@ keymap = runKeys $ do
 
   bind xK_j $ do
     justMod $
-      doc "Shrink the size of the zoom region" $
-      sendMessage ShrinkZoom
+      doc "Shrink the size of the master region" $
+      sendMessage Shrink
 
     shiftMod $
       doc "Go to the previous window in history." historyPrev
 
   bind xK_k $ do
     justMod $
-      doc "Expand the size of the zoom region" $
-      sendMessage ExpandZoom
+      doc "Expand the size of the master region" $
+      sendMessage Expand
 
     shiftMod $
       doc "Go to the next window in history." historyNext
@@ -524,7 +525,7 @@ keymap = runKeys $ do
         bind xK_z $ do
           noMod -|- justMod $
             doc "Toggle zoom on the current window." $
-            sendMessage ToggleZoom
+            sendMessage TogglePop
 
         -- Z is reserved to create sub keybindings to do various things.
         -- I don't really use these at the moment.
@@ -536,7 +537,7 @@ keymap = runKeys $ do
     -- modifier.
     shiftMod $
       doc "Toggle zoom on the current window." $
-      sendMessage ToggleZoom
+      sendMessage TogglePop
 
   bind xF86XK_Calculator $ do
     noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
@@ -625,7 +626,7 @@ mouseMap = runButtons $ do
         noMod $ noWindow $ click >> CopyWindow.kill1
 
       bind button14 $ do
-        noMod $ noWindow $ click >> sendMessage ToggleZoom
+        noMod $ noWindow $ click >> sendMessage TogglePop
 
       bind button15 $ do
         noMod $ noWindow $ spawnX "pavucontrol"
diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs
index 93228e7..fd34c33 100644
--- a/src/Rahm/Desktop/Layout/Layout.hs
+++ b/src/Rahm/Desktop/Layout/Layout.hs
@@ -27,6 +27,7 @@ import Rahm.Desktop.Layout.CornerLayout (Corner(..))
 import Rahm.Desktop.Layout.LayoutList
 import Rahm.Desktop.Windows
 import Rahm.Desktop.Layout.ReinterpretMessage
+import Rahm.Desktop.Layout.Pop
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
@@ -87,7 +88,7 @@ reinterpretIncMaster ::
 reinterpretIncMaster = ModifiedLayout ReinterpretMessage
 
 mods =
-  ModifiedLayout (Zoomable False 0.05 0.05) .
+  poppable .
     ModifiedLayout (Flippable False) .
     ModifiedLayout (HFlippable False) .
     ModifiedLayout (Rotateable False)
@@ -137,10 +138,6 @@ instance DescriptionModifier ThreeColDescMod ThreeCol where
   newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
   newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
 
-data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
-
-instance Message ResizeZoom where
-
 newtype Flippable a = Flippable Bool -- True if flipped
   deriving (Show, Read)
 
@@ -156,23 +153,10 @@ data HFlipLayout = HFlipLayout deriving (Typeable)
 
 data DoRotate = DoRotate deriving (Typeable)
 
-data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
-  deriving (Show, Read)
-
--- Toggles if the current window should be zoomed or not. Set the boolean
--- to set the zoom.mhar
-data ZoomModifier =
-       ToggleZoom |
-       Zoom |
-       Unzoom
-  deriving (Typeable)
-
 instance Message FlipLayout where
 
 instance Message HFlipLayout where
 
-instance Message ZoomModifier where
-
 instance Message DoRotate where
 
 instance (Eq a) => LayoutModifier Rotateable a where
@@ -241,43 +225,3 @@ instance (Eq a) => LayoutModifier HFlippable a where
       if flipped
         then descr ++ " HFlipped"
         else descr
-
-
-instance (Eq a) => LayoutModifier Zoomable a where
-  redoLayout (Zoomable doit ws hs) (Rectangle x y w h) stack returned =
-    if doit
-      then
-        let focused = W.focus <$> stack
-            (zoomed, rest) = partition ((==focused) . Just . fst) returned
-         in case zoomed of
-              [] -> return (rest, Nothing)
-              ((fwin, _):_) ->  return ((fwin, Rectangle (x + wp) (y + hp) (w - fromIntegral (wp * 2)) (h - fromIntegral (hp * 2))) : rest, Nothing)
-
-      else return (returned, Nothing)
-    where
-      wp = floor $ fromIntegral w * ws
-      hp = floor $ fromIntegral h * hs
-
-  handleMessOrMaybeModifyIt self@(Zoomable showing sw sh) mess =
-    return $
-      (handleResize <$> fromMessage mess)
-        <|> (Left . handleZoom <$> fromMessage mess)
-      where
-        handleResize r =
-          if showing
-            then Left $ Zoomable showing (guard $ sw + d) (guard $ sh + d)
-            else Right $ case r of
-                   ShrinkZoom -> SomeMessage Shrink
-                   ExpandZoom -> SomeMessage Expand
-
-          where d = (case r of
-                      ShrinkZoom -> -1
-                      ExpandZoom -> 1) * 0.02
-
-        handleZoom ToggleZoom = Zoomable (not showing) sw sh
-        handleZoom Zoom = Zoomable True sw sh
-        handleZoom Unzoom = Zoomable False sw sh
-
-        guard f | f > 1 = 1
-                | f < 0 = 0
-                | otherwise = f
diff --git a/src/Rahm/Desktop/Layout/Pop.hs b/src/Rahm/Desktop/Layout/Pop.hs
new file mode 100644
index 0000000..194e645
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Pop.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+-- | The Pap layout modifier allows the user to "pop" the focused window into a
+-- frame in the middle of the screen, sort of like fullscreen, but only taking
+-- up a percentage of the screen rather than the whole screen so other windows
+-- are still visible, alebeit typically not usable.
+module Rahm.Desktop.Layout.Pop (Poppable(..), PopMessage(..), poppable) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
+import Data.Default (Default(..))
+import qualified XMonad.StackSet as W
+
+data Poppable a = Poppable {
+    -- True if the current window is popped out or not.
+    isPopped :: Bool
+
+    -- Fraction of the screen width around the window.
+  , xFrac :: Float
+
+    -- Fraction of the screen height around the window.
+  , yFrac :: Float
+  } deriving (Show, Read, Eq, Ord)
+
+instance Default (Poppable a) where
+  def = Poppable {
+      isPopped = False
+    , xFrac = 0.05
+    , yFrac = 0.05
+    }
+
+poppable :: l a -> ModifiedLayout Poppable l a
+poppable = ModifiedLayout def
+
+-- Message to control the state of the popped layouts modifier.
+data PopMessage = TogglePop | Pop | Unpop | ResizePop Float
+  deriving (Typeable, Show, Eq, Ord, Message)
+
+instance (Eq a) => LayoutModifier Poppable a where
+
+  -- If the current layout is not popped, then just return what the underlying
+  -- layout returned.
+  redoLayout Poppable { isPopped = False } _ _ returned =
+     return (returned, Nothing)
+
+  -- Can't do anything with an empty stack.
+  redoLayout _ _ Nothing returned = return (returned, Nothing)
+  
+  redoLayout self (Rectangle x y w h) (Just (W.focus -> focused)) returned =
+      return ((focused, newRect) : remaining, Nothing)
+    where
+      remaining = filter ((/=focused) . fst) returned
+      wp = floor $ fromIntegral w * xFrac self
+      hp = floor $ fromIntegral h * yFrac self
+      newRect = Rectangle
+        (x + wp)
+        (y + hp)
+        (w - fromIntegral (wp * 2))
+        (h - fromIntegral (hp * 2))
+
+  -- Handle the Pop messages associated with this layout.
+  pureMess self (fromMessage -> Just mess) =
+    Just $ case mess of
+      TogglePop -> self { isPopped = not (isPopped self) }
+      Pop -> self { isPopped = True }
+      Unpop -> self { isPopped = False }
+      ResizePop amt -> self {
+          xFrac = guard (xFrac self + amt),
+          yFrac = guard (yFrac self + amt)
+        }
+    where
+      guard = min 0.45 . max 0
+
+  -- Handle Shrink and Expand if it is currently in the popped state.
+  pureMess
+      self@Poppable { isPopped = True }
+      (fromMessage -> Just mess) =
+    pureMess self $ SomeMessage $
+      case mess of
+        Shrink -> ResizePop (-0.05)
+        Expand -> ResizePop 0.05
+
+  pureMess _ _ = Nothing
-- 
cgit 


From 1521bb8dc5d81e68823802454576901075a5dcca Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 11 Apr 2022 23:28:18 -0600
Subject: Fix bug with Poppable where it was passing the Resize to the
 underlying layout.

Unfortunately it's a little hacky how this ended up working, but I don't
have a great solution yet.
---
 src/Rahm/Desktop/Layout/Layout.hs     |  9 +++---
 src/Rahm/Desktop/Layout/LayoutDraw.hs |  4 +--
 src/Rahm/Desktop/Layout/Pop.hs        | 61 +++++++++++++++++++++++------------
 3 files changed, 48 insertions(+), 26 deletions(-)

diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs
index fd34c33..135b9a0 100644
--- a/src/Rahm/Desktop/Layout/Layout.hs
+++ b/src/Rahm/Desktop/Layout/Layout.hs
@@ -88,10 +88,11 @@ reinterpretIncMaster ::
 reinterpretIncMaster = ModifiedLayout ReinterpretMessage
 
 mods =
-  poppable .
-    ModifiedLayout (Flippable False) .
-    ModifiedLayout (HFlippable False) .
-    ModifiedLayout (Rotateable False)
+  reinterpretResize .
+    poppable .
+      ModifiedLayout (Flippable False) .
+      ModifiedLayout (HFlippable False) .
+      ModifiedLayout (Rotateable False)
 
 
 data ModifyDescription m l a = ModifyDescription m (l a)
diff --git a/src/Rahm/Desktop/Layout/LayoutDraw.hs b/src/Rahm/Desktop/Layout/LayoutDraw.hs
index 7e59284..99828e3 100644
--- a/src/Rahm/Desktop/Layout/LayoutDraw.hs
+++ b/src/Rahm/Desktop/Layout/LayoutDraw.hs
@@ -11,7 +11,7 @@ import Control.Monad.Writer (execWriter, tell)
 import Data.Foldable (find)
 import Data.Maybe (fromMaybe)
 import Rahm.Desktop.Hash (quickHash)
-import Rahm.Desktop.Layout.Layout (ZoomModifier(..))
+import Rahm.Desktop.Layout.Pop (PopMessage(..))
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath ((</>))
 import Text.Printf (printf)
@@ -48,7 +48,7 @@ drawLayout = do
     -- Gotta reset the layout to a consistent state.
     layout' <- foldM (flip ($)) layout [
          handleMessage' $ ModifyWindowBorder $ const $ Border 0 0 0 0,
-         handleMessage' Unzoom
+         handleMessage' Unpop
        ]
 
     (cached, xpm) <- drawXpmIO layout'
diff --git a/src/Rahm/Desktop/Layout/Pop.hs b/src/Rahm/Desktop/Layout/Pop.hs
index 194e645..037e664 100644
--- a/src/Rahm/Desktop/Layout/Pop.hs
+++ b/src/Rahm/Desktop/Layout/Pop.hs
@@ -4,13 +4,19 @@
 -- frame in the middle of the screen, sort of like fullscreen, but only taking
 -- up a percentage of the screen rather than the whole screen so other windows
 -- are still visible, alebeit typically not usable.
-module Rahm.Desktop.Layout.Pop (Poppable(..), PopMessage(..), poppable) where
+module Rahm.Desktop.Layout.Pop (
+  Poppable(..),
+  PopMessage(..),
+  poppable,
+  reinterpretResize) where
 
 import XMonad
 import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
 import Data.Default (Default(..))
 import qualified XMonad.StackSet as W
 
+import Rahm.Desktop.Layout.ReinterpretMessage
+
 data Poppable a = Poppable {
     -- True if the current window is popped out or not.
     isPopped :: Bool
@@ -29,6 +35,18 @@ instance Default (Poppable a) where
     , yFrac = 0.05
     }
 
+-- Returns a modified layout that converts Resize (Shrink/Expand) into ResizePop
+-- messages. Unfortunately this is required because a LayoutModifier has no way
+-- to intercept messages and block them from propegating, which is pretty silly.
+--
+-- So, reinterpretResize will turn a Shrink/Expand into a ResizePop, this will
+-- be consumed by the Poppable layout modifier. If the Poppable LayoutModifier
+-- is not active, it will turn the ResizePop back into a Shrink/Expand and
+-- forward it to the underlying layout.
+reinterpretResize ::
+  l a -> ModifiedLayout (ReinterpretMessage "ForPop") l a
+reinterpretResize = ModifiedLayout ReinterpretMessage
+
 poppable :: l a -> ModifiedLayout Poppable l a
 poppable = ModifiedLayout def
 
@@ -36,6 +54,15 @@ poppable = ModifiedLayout def
 data PopMessage = TogglePop | Pop | Unpop | ResizePop Float
   deriving (Typeable, Show, Eq, Ord, Message)
 
+instance DoReinterpret "ForPop" where
+  reinterpretMessage _ (fromMessage -> Just mess) =
+    return $ Just $ SomeMessage $
+      case mess of
+        Shrink -> ResizePop (-0.05)
+        Expand -> ResizePop 0.05
+
+  reinterpretMessage _ _ = return Nothing
+
 instance (Eq a) => LayoutModifier Poppable a where
 
   -- If the current layout is not popped, then just return what the underlying
@@ -59,25 +86,19 @@ instance (Eq a) => LayoutModifier Poppable a where
         (h - fromIntegral (hp * 2))
 
   -- Handle the Pop messages associated with this layout.
-  pureMess self (fromMessage -> Just mess) =
-    Just $ case mess of
-      TogglePop -> self { isPopped = not (isPopped self) }
-      Pop -> self { isPopped = True }
-      Unpop -> self { isPopped = False }
-      ResizePop amt -> self {
-          xFrac = guard (xFrac self + amt),
-          yFrac = guard (yFrac self + amt)
-        }
+  handleMessOrMaybeModifyIt self (fromMessage -> Just mess) =
+    return $ Just $ case mess of
+      TogglePop -> Left $ self { isPopped = not (isPopped self) }
+      Pop -> Left $ self { isPopped = True }
+      Unpop -> Left $ self { isPopped = False }
+      ResizePop amt | isPopped self ->
+          Left $ self {
+            xFrac = guard (xFrac self + amt),
+            yFrac = guard (yFrac self + amt)
+          }
+      ResizePop amt -> Right $ SomeMessage $
+        if amt > 0 then Expand else Shrink
     where
       guard = min 0.45 . max 0
 
-  -- Handle Shrink and Expand if it is currently in the popped state.
-  pureMess
-      self@Poppable { isPopped = True }
-      (fromMessage -> Just mess) =
-    pureMess self $ SomeMessage $
-      case mess of
-        Shrink -> ResizePop (-0.05)
-        Expand -> ResizePop 0.05
-
-  pureMess _ _ = Nothing
+  handleMessOrMaybeModifyIt _ _ = return Nothing
-- 
cgit 


From f5c6a81a4aec41fe13af6db673a7c5cad6f6b2a6 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 11 Apr 2022 23:42:58 -0600
Subject: Change LayoutDraw so mosaic looks a little more interesting.

---
 src/Rahm/Desktop/Layout/LayoutDraw.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/src/Rahm/Desktop/Layout/LayoutDraw.hs b/src/Rahm/Desktop/Layout/LayoutDraw.hs
index 99828e3..c3a1918 100644
--- a/src/Rahm/Desktop/Layout/LayoutDraw.hs
+++ b/src/Rahm/Desktop/Layout/LayoutDraw.hs
@@ -16,6 +16,7 @@ import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath ((</>))
 import Text.Printf (printf)
 import XMonad.Layout.Spacing (SpacingModifier(..), Border(..))
+import XMonad.Layout.MosaicAlt (expandWindowAlt, shrinkWindowAlt)
 
 import XMonad (X,
                Rectangle(..),
@@ -46,10 +47,15 @@ drawLayout = do
     let layout = S.layout $ S.workspace $ S.current winset
 
     -- Gotta reset the layout to a consistent state.
-    layout' <- foldM (flip ($)) layout [
+    layout' <- foldM (flip ($)) layout $ [
          handleMessage' $ ModifyWindowBorder $ const $ Border 0 0 0 0,
          handleMessage' Unpop
-       ]
+      ]
+      -- Add some changes for the Mosaic layout to handle so it get's a
+      -- unique looking icon. (The default state is pretty boring).
+      ++ replicate 10 (handleMessage' (expandWindowAlt 1))
+      ++ replicate 5 (handleMessage' (expandWindowAlt 4))
+      ++ replicate 1 (handleMessage' (expandWindowAlt 3))
 
     (cached, xpm) <- drawXpmIO layout'
 
-- 
cgit 


From e3cd7723739aed7dea5ec8bc8952e16b2cc4b06c Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 12 Apr 2022 00:23:26 -0600
Subject: Break the Flippable modifiers into their own file.

This also combines the two into a single type.
---
 src/Rahm/Desktop/Keys.hs          |  6 ++-
 src/Rahm/Desktop/Layout/Flip.hs   | 87 +++++++++++++++++++++++++++++++++++++++
 src/Rahm/Desktop/Layout/Layout.hs | 58 +-------------------------
 3 files changed, 93 insertions(+), 58 deletions(-)
 create mode 100644 src/Rahm/Desktop/Layout/Flip.hs

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 7ca6161..b8a4c4e 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -55,6 +55,7 @@ import Rahm.Desktop.Logger
 import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.Swallow
 import Rahm.Desktop.Layout.Pop (PopMessage(..))
+import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -245,10 +246,10 @@ keymap = runKeys $ do
   bind xK_f $ do
     justMod  $
       doc "Flip the current layout vertically" $
-      sendMessage FlipLayout
+      sendMessage flipVertically
     shiftMod $
       doc "Flip the current layout horizontally" $
-      sendMessage HFlipLayout
+      sendMessage flipHorizontally
 
   bind xK_g $ do
     justMod $
@@ -625,6 +626,7 @@ mouseMap = runButtons $ do
       bind button13 $ do
         noMod $ noWindow $ click >> CopyWindow.kill1
 
+
       bind button14 $ do
         noMod $ noWindow $ click >> sendMessage TogglePop
 
diff --git a/src/Rahm/Desktop/Layout/Flip.hs b/src/Rahm/Desktop/Layout/Flip.hs
new file mode 100644
index 0000000..e0d3abc
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Flip.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+-- Layout modifier to flip a layout either horizontally or vertically or both.
+module Rahm.Desktop.Layout.Flip (
+    Flip(..),
+    flippable,
+    flipVertically,
+    flipHorizontally,
+    DoFlip
+  ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+
+import Control.Arrow (second)
+import Data.List (intercalate)
+import Data.Default (Default(..))
+
+-- A flipped layout is either flipped horizontally or vertically.
+data Flip a =
+  Flip {
+    horiz :: Bool
+  , vert :: Bool
+  } deriving (Eq, Show, Ord, Read)
+
+-- Default instance for Flip. Both are set to false.
+instance Default (Flip a) where
+  def = Flip False False
+
+-- Message for altering the Flip layout modifier.
+data DoFlip where
+  -- Contains a function to modify Flip
+  DoFlip :: (forall k (a :: k). Flip a -> Flip a) -> DoFlip
+  deriving Message
+
+-- DoFlip is a monoid.
+instance Semigroup DoFlip where
+ (<>) = mappend
+instance Monoid DoFlip where
+  mempty = DoFlip id
+  mappend (DoFlip a) (DoFlip b) = DoFlip (a . b)
+
+-- Makes a layout Flippable.
+flippable :: l a -> ModifiedLayout Flip l a
+flippable = ModifiedLayout def
+
+-- Message to send a flipVertically message
+flipVertically :: DoFlip
+flipVertically = DoFlip $ \f -> f { vert = not (vert f) }
+
+-- Message to send a flipHorizontally message.
+flipHorizontally :: DoFlip
+flipHorizontally = DoFlip $ \f -> f { horiz = not (horiz f) }
+
+instance LayoutModifier Flip a where
+
+  -- Modifies the layout. For each rectangle returned from the underlying
+  -- layout, flip it relative to the screen.
+  pureModifier flip (Rectangle sx sy sw sh) stack returned =
+    (map (second doFlip) returned, Nothing)
+    where
+      -- doFlip -- the composition of maybe flipping horizontally and
+      -- vertically.
+      doFlip =
+        (if horiz flip then flipHoriz else id) .
+        (if vert flip then flipVert else id)
+
+      flipVert (Rectangle x y w h) =
+        Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
+      flipHoriz (Rectangle x y w h) =
+        Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
+  
+  -- Handle DoFlip messages.
+  pureMess flip (fromMessage -> Just (DoFlip f)) = Just (f flip)
+  pureMess _ _ = Nothing
+
+  -- Modify the description to show if the layout has been flipped.
+  modifyDescription flip (description -> descr) =
+    (++) descr $
+      if horiz flip || vert flip
+        then intercalate " and " (
+          map snd $
+            filter fst [
+              (horiz flip, "Horizontally"),
+              (vert flip, "Vertically")])
+          ++ " Flipped"
+        else ""
diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs
index 135b9a0..a871aa6 100644
--- a/src/Rahm/Desktop/Layout/Layout.hs
+++ b/src/Rahm/Desktop/Layout/Layout.hs
@@ -28,6 +28,7 @@ import Rahm.Desktop.Layout.LayoutList
 import Rahm.Desktop.Windows
 import Rahm.Desktop.Layout.ReinterpretMessage
 import Rahm.Desktop.Layout.Pop
+import Rahm.Desktop.Layout.Flip
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
@@ -90,8 +91,7 @@ reinterpretIncMaster = ModifiedLayout ReinterpretMessage
 mods =
   reinterpretResize .
     poppable .
-      ModifiedLayout (Flippable False) .
-      ModifiedLayout (HFlippable False) .
+      flippable .
       ModifiedLayout (Rotateable False)
 
 
@@ -139,25 +139,11 @@ instance DescriptionModifier ThreeColDescMod ThreeCol where
   newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
   newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
 
-newtype Flippable a = Flippable Bool -- True if flipped
-  deriving (Show, Read)
-
-newtype HFlippable a = HFlippable Bool -- True if flipped
-  deriving (Show, Read)
-
 newtype Rotateable a = Rotateable Bool -- True if rotated
   deriving (Show, Read)
 
-data FlipLayout = FlipLayout deriving (Typeable)
-
-data HFlipLayout = HFlipLayout deriving (Typeable)
-
 data DoRotate = DoRotate deriving (Typeable)
 
-instance Message FlipLayout where
-
-instance Message HFlipLayout where
-
 instance Message DoRotate where
 
 instance (Eq a) => LayoutModifier Rotateable a where
@@ -186,43 +172,3 @@ instance (Eq a) => LayoutModifier Rotateable a where
       if rot
         then descr ++ " Rotated"
         else descr
-
-instance (Eq a) => LayoutModifier Flippable a where
-  pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
-    if flip
-      then (map (second doFlip) returned, Nothing)
-      else (returned, Nothing)
-    where
-      doFlip (Rectangle x y w h) =
-        Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
-
-  pureMess (Flippable flip) message =
-    case fromMessage message of
-      Just FlipLayout -> Just (Flippable (not flip))
-      Nothing -> Nothing
-
-  modifyDescription (Flippable flipped) underlying =
-    let descr = description underlying in
-      if flipped
-        then descr ++ " Flipped"
-        else descr
-
-instance (Eq a) => LayoutModifier HFlippable a where
-  pureModifier (HFlippable flip) (Rectangle _ sy _ sh) stack returned =
-    if flip
-      then (map (second doFlip) returned, Nothing)
-      else (returned, Nothing)
-    where
-      doFlip (Rectangle x y w h) =
-        Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
-
-  pureMess (HFlippable flip) message =
-    case fromMessage message of
-      Just HFlipLayout -> Just (HFlippable (not flip))
-      Nothing -> Nothing
-
-  modifyDescription (HFlippable flipped) underlying =
-    let descr = description underlying in
-      if flipped
-        then descr ++ " HFlipped"
-        else descr
-- 
cgit 


From 9668ec077097e283435937e997edd99dbc0cfa17 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 12 Apr 2022 00:38:26 -0600
Subject: Break Rotate into it's own file.

---
 src/Rahm/Desktop/Layout/Layout.hs | 43 ++-------------------------
 src/Rahm/Desktop/Layout/Rotate.hs | 62 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 65 insertions(+), 40 deletions(-)
 create mode 100644 src/Rahm/Desktop/Layout/Rotate.hs

diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs
index a871aa6..88143cd 100644
--- a/src/Rahm/Desktop/Layout/Layout.hs
+++ b/src/Rahm/Desktop/Layout/Layout.hs
@@ -29,10 +29,13 @@ import Rahm.Desktop.Windows
 import Rahm.Desktop.Layout.ReinterpretMessage
 import Rahm.Desktop.Layout.Pop
 import Rahm.Desktop.Layout.Flip
+import Rahm.Desktop.Layout.Rotate
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
+mods = reinterpretResize . poppable . flippable . rotateable
+
 myLayout =
   fullscreenFull $
     avoidStruts $
@@ -88,12 +91,6 @@ reinterpretIncMaster ::
   l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a
 reinterpretIncMaster = ModifiedLayout ReinterpretMessage
 
-mods =
-  reinterpretResize .
-    poppable .
-      flippable .
-      ModifiedLayout (Rotateable False)
-
 
 data ModifyDescription m l a = ModifyDescription m (l a)
   deriving (Show, Read)
@@ -138,37 +135,3 @@ instance DescriptionModifier TallDescriptionModifier Tall where
 instance DescriptionModifier ThreeColDescMod ThreeCol where
   newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
   newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
-
-newtype Rotateable a = Rotateable Bool -- True if rotated
-  deriving (Show, Read)
-
-data DoRotate = DoRotate deriving (Typeable)
-
-instance Message DoRotate where
-
-instance (Eq a) => LayoutModifier Rotateable a where
-  pureModifier (Rotateable rotate) (Rectangle x' y' sw sh) _ returned =
-    if rotate
-      then (map (second (unzero . scaleRect . mirrorRect . zero)) returned, Nothing)
-      else (returned, Nothing)
-    where
-      zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
-      unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h
-
-      scaleRect (Rectangle x y w h) =
-        Rectangle (x * fi sw `div` fi sh)
-                  (y * fi sh `div` fi sw)
-                  (w * sw `div` sh)
-                  (h * sh `div` sw)
-
-      fi = fromIntegral
-
-
-  pureMess (Rotateable rot) mess =
-    fmap (\DoRotate -> Rotateable (not rot)) (fromMessage mess)
-
-  modifyDescription (Rotateable rot) underlying =
-    let descr = description underlying in
-      if rot
-        then descr ++ " Rotated"
-        else descr
diff --git a/src/Rahm/Desktop/Layout/Rotate.hs b/src/Rahm/Desktop/Layout/Rotate.hs
new file mode 100644
index 0000000..8a8583a
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Rotate.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+-- Layout modifier which optionally rotates the underlying layout. This actually
+-- uses the mirrorRect, so it's not strictly rotating, but when combined with
+-- flipping it works.
+module Rahm.Desktop.Layout.Rotate (
+  rotateable,
+  rotateLayout,
+  Rotate) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import Data.Default (Default(..))
+import Control.Arrow (second)
+
+-- Just a wrapper over a Bool.
+newtype Rotate a = Rotate Bool
+  deriving (Read, Show, Eq, Ord)
+
+-- Returns a layout that can be rotated.
+rotateable :: l a -> ModifiedLayout Rotate l a
+rotateable = ModifiedLayout def
+
+-- Message to rotate the layout.
+rotateLayout :: RotateMessage
+rotateLayout = RotateMessage $ \(Rotate n) -> Rotate (not n)
+
+-- Default instance just defaults to false..
+instance Default (Rotate a) where
+  def = Rotate False
+
+-- Rotate message is a wrapper over a function to modify a Rotate instance.
+data RotateMessage where
+  RotateMessage :: (forall k (a :: k). Rotate a -> Rotate a) -> RotateMessage
+  deriving (Message)
+
+instance (Eq a) => LayoutModifier Rotate a where
+  pureModifier (Rotate rotate) (Rectangle x' y' sw sh) _ returned =
+    if rotate
+      then (map (second (unzero . scaleRect . mirrorRect . zero)) returned, Nothing)
+      else (returned, Nothing)
+    where
+      zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
+      unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h
+
+      scaleRect (Rectangle x y w h) =
+        Rectangle (x * fi sw `div` fi sh)
+                  (y * fi sh `div` fi sw)
+                  (w * sw `div` sh)
+                  (h * sh `div` sw)
+
+      fi = fromIntegral
+
+
+  pureMess r (fromMessage -> Just (RotateMessage f)) = Just (f r)
+  pureMess _ _ = Nothing
+
+  modifyDescription (Rotate rot) underlying =
+    let descr = description underlying in
+      if rot
+        then descr ++ " Rotated"
+        else descr
-- 
cgit 


From 7e6fc4bd1427dfcfb849c9e23a64bff57b19baba Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 12 Apr 2022 01:04:05 -0600
Subject: Break out the ModifyDescription into its own file.

---
 src/Rahm/Desktop/Keys.hs          |  3 ++-
 src/Rahm/Desktop/Layout/Layout.hs | 50 +++++++--------------------------------
 2 files changed, 10 insertions(+), 43 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index b8a4c4e..c8d9092 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -56,6 +56,7 @@ import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.Swallow
 import Rahm.Desktop.Layout.Pop (PopMessage(..))
 import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
+import Rahm.Desktop.Layout.Rotate (rotateLayout)
 import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -398,7 +399,7 @@ keymap = runKeys $ do
     justMod $ doc "Run a command via Rofi" runDMenu
     shiftMod $
       doc "Rotate the current layout. (flips x, y coordinates)" $
-      sendMessage DoRotate
+      sendMessage rotateLayout
 
   bind xK_s $ do
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs
index 88143cd..2719bea 100644
--- a/src/Rahm/Desktop/Layout/Layout.hs
+++ b/src/Rahm/Desktop/Layout/Layout.hs
@@ -10,6 +10,7 @@ import XMonad.Layout.Accordion
 import Control.Applicative
 import XMonad.Layout.Spacing
 import Data.List
+import Data.Typeable (cast)
 import XMonad.Layout.Spiral
 import XMonad.Layout.ThreeColumns
 import XMonad.Layout.Grid
@@ -30,6 +31,7 @@ import Rahm.Desktop.Layout.ReinterpretMessage
 import Rahm.Desktop.Layout.Pop
 import Rahm.Desktop.Layout.Flip
 import Rahm.Desktop.Layout.Rotate
+import Rahm.Desktop.Layout.Redescribe
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
@@ -44,8 +46,8 @@ myLayout =
           mods (reinterpretIncMaster $ spiral (6/7)) |:
           mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
           mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
-          mods (ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2))) |:
-          mods (ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2))) |:
+          mods (Redescribe UsingTall (Tall 1 (3/100) (1/2))) |:
+          mods (Redescribe UsingThreeCol (ThreeCol 1 (3/100) (1/2))) |:
           mods Grid |:
           mods (Dishes 2 (1/6)) |:
           mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1) |:
@@ -91,47 +93,11 @@ reinterpretIncMaster ::
   l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a
 reinterpretIncMaster = ModifiedLayout ReinterpretMessage
 
-
-data ModifyDescription m l a = ModifyDescription m (l a)
-  deriving (Show, Read)
-
-data TallDescriptionModifier = TallDescriptionModifier
-  deriving (Show, Read)
-
-data ThreeColDescMod = ThreeColDescMod
-  deriving (Show, Read)
-
-class DescriptionModifier m l where
-  newDescription :: m -> l a -> String -> String
-
-instance (Typeable m, Show m, DescriptionModifier m l, LayoutClass l a) => LayoutClass (ModifyDescription m l) a where
-  runLayout (W.Workspace t (ModifyDescription m l) a) rect = do
-    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  doLayout (ModifyDescription m l) a s = do
-    (rects, maybeNewLayout) <- doLayout l a s
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  pureLayout (ModifyDescription m l) a s = pureLayout l a s
-
-  emptyLayout (ModifyDescription m l) a = do
-    (rects, maybeNewLayout) <- emptyLayout l a
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  handleMessage (ModifyDescription m l) a = do
-    maybeNewLayout <- handleMessage l a
-    return (ModifyDescription m <$> maybeNewLayout)
-
-  pureMessage (ModifyDescription m l) a =
-    let maybeNewLayout = pureMessage l a in
-      ModifyDescription m <$> maybeNewLayout
-
-  description (ModifyDescription m l) = newDescription m l (description l)
-
-instance DescriptionModifier TallDescriptionModifier Tall where
+data UsingTall = UsingTall deriving (Read, Show)
+instance Describer UsingTall Tall where
   newDescription _ (Tall mast _ _) _ = "Tall(" ++ show mast ++ ")"
 
-instance DescriptionModifier ThreeColDescMod ThreeCol where
+data UsingThreeCol = UsingThreeCol deriving (Read, Show)
+instance Describer UsingThreeCol ThreeCol where
   newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
   newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
-- 
cgit 


From 1fbaaa7ce69ed6320693c389bf670fd3cf20cdd1 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 12 Apr 2022 01:05:48 -0600
Subject: Move Rahm.Desktop.Layout.Layout to Rahm.Desktop.Layout

---
 src/Main.hs                           |   2 +-
 src/Rahm/Desktop/Keys.hs              |   2 +-
 src/Rahm/Desktop/Layout.hs            | 103 ++++++++++++++++++++++++++++++++++
 src/Rahm/Desktop/Layout/Layout.hs     | 103 ----------------------------------
 src/Rahm/Desktop/Layout/Redescribe.hs |  35 ++++++++++++
 5 files changed, 140 insertions(+), 105 deletions(-)
 create mode 100644 src/Rahm/Desktop/Layout.hs
 delete mode 100644 src/Rahm/Desktop/Layout/Layout.hs
 create mode 100644 src/Rahm/Desktop/Layout/Redescribe.hs

diff --git a/src/Main.hs b/src/Main.hs
index 86b6fc8..c8cdd19 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -16,7 +16,7 @@ import Rahm.Desktop.Swallow
 import Rahm.Desktop.Windows
 import Rahm.Desktop.XMobarLog
 import Rahm.Desktop.Keys
-import Rahm.Desktop.Layout.Layout
+import Rahm.Desktop.Layout
 import Rahm.Desktop.Logger
 import Rahm.Desktop.DMenu (menuCommandString)
 import Rahm.Desktop.RebindKeys
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index c8d9092..e780fbf 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -25,7 +25,7 @@ import Data.Char
 import Data.List hiding ((!!))
 import Data.List.Safe ((!!))
 import Data.Map (Map)
-import Rahm.Desktop.Layout.Layout
+import Rahm.Desktop.Layout
 import Rahm.Desktop.Marking
 import Rahm.Desktop.PromptConfig
 import System.IO
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
new file mode 100644
index 0000000..6c9ac5a
--- /dev/null
+++ b/src/Rahm/Desktop/Layout.hs
@@ -0,0 +1,103 @@
+module Rahm.Desktop.Layout where
+
+import GHC.TypeLits
+
+import Data.Proxy (Proxy(..))
+import Control.Arrow (second)
+import XMonad.Hooks.ManageDocks
+import XMonad.Layout.Circle
+import XMonad.Layout.Accordion
+import Control.Applicative
+import XMonad.Layout.Spacing
+import Data.List
+import Data.Typeable (cast)
+import XMonad.Layout.Spiral
+import XMonad.Layout.ThreeColumns
+import XMonad.Layout.Grid
+import XMonad.Layout.Dishes
+import XMonad.Layout.MosaicAlt
+import XMonad.Layout.Fullscreen
+import qualified XMonad.Layout.Dwindle as D
+import XMonad.Layout
+import XMonad.Layout.LayoutModifier
+import XMonad
+import XMonad.Core
+import XMonad.Layout.NoBorders (smartBorders, noBorders)
+
+import Rahm.Desktop.Layout.CornerLayout (Corner(..))
+import Rahm.Desktop.Layout.LayoutList
+import Rahm.Desktop.Windows
+import Rahm.Desktop.Layout.ReinterpretMessage
+import Rahm.Desktop.Layout.Pop
+import Rahm.Desktop.Layout.Flip
+import Rahm.Desktop.Layout.Rotate
+import Rahm.Desktop.Layout.Redescribe
+
+import qualified Data.Map as M
+import qualified XMonad.StackSet as W
+
+mods = reinterpretResize . poppable . flippable . rotateable
+
+myLayout =
+  fullscreenFull $
+    avoidStruts $
+      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
+        layoutZipper $
+          mods (reinterpretIncMaster $ spiral (6/7)) |:
+          mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
+          mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
+          mods (Redescribe UsingTall (Tall 1 (3/100) (1/2))) |:
+          mods (Redescribe UsingThreeCol (ThreeCol 1 (3/100) (1/2))) |:
+          mods Grid |:
+          mods (Dishes 2 (1/6)) |:
+          mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1) |:
+          nil
+
+-- Mosaic doesn't have the concept of a "Master Space", so reinterpret messages
+-- intended to modify the master space and instead have those messages expand
+-- and shrink the current window.
+--
+-- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system
+-- hacking one can do in Haskell.
+instance DoReinterpret "ForMosaic" where
+  
+  -- IncMaster message
+  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
+    fmap (SomeMessage .
+      (if n > 0
+        then expandWindowAlt
+        else shrinkWindowAlt)) <$> getFocusedWindow
+  
+  -- ResizeMaster message
+  reinterpretMessage _ (fromMessage -> Just m) = do
+    fmap (SomeMessage .
+      (case m of
+        Expand -> expandWindowAlt
+        Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
+
+  -- Messages that don't match the above, just leave it unmodified.
+  reinterpretMessage _ m = return (Just m)
+
+instance DoReinterpret "IncMasterToResizeMaster" where
+  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) =
+    return $ Just $
+      if n > 0
+        then SomeMessage Expand
+        else SomeMessage Shrink
+  reinterpretMessage _ m = return (Just m)
+
+modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a
+modifyMosaic = ModifiedLayout ReinterpretMessage
+
+reinterpretIncMaster ::
+  l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a
+reinterpretIncMaster = ModifiedLayout ReinterpretMessage
+
+data UsingTall = UsingTall deriving (Read, Show)
+instance Describer UsingTall Tall where
+  newDescription _ (Tall mast _ _) _ = "Tall(" ++ show mast ++ ")"
+
+data UsingThreeCol = UsingThreeCol deriving (Read, Show)
+instance Describer UsingThreeCol ThreeCol where
+  newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
+  newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs
deleted file mode 100644
index 2719bea..0000000
--- a/src/Rahm/Desktop/Layout/Layout.hs
+++ /dev/null
@@ -1,103 +0,0 @@
-module Rahm.Desktop.Layout.Layout where
-
-import GHC.TypeLits
-
-import Data.Proxy (Proxy(..))
-import Control.Arrow (second)
-import XMonad.Hooks.ManageDocks
-import XMonad.Layout.Circle
-import XMonad.Layout.Accordion
-import Control.Applicative
-import XMonad.Layout.Spacing
-import Data.List
-import Data.Typeable (cast)
-import XMonad.Layout.Spiral
-import XMonad.Layout.ThreeColumns
-import XMonad.Layout.Grid
-import XMonad.Layout.Dishes
-import XMonad.Layout.MosaicAlt
-import XMonad.Layout.Fullscreen
-import qualified XMonad.Layout.Dwindle as D
-import XMonad.Layout
-import XMonad.Layout.LayoutModifier
-import XMonad
-import XMonad.Core
-import XMonad.Layout.NoBorders (smartBorders, noBorders)
-
-import Rahm.Desktop.Layout.CornerLayout (Corner(..))
-import Rahm.Desktop.Layout.LayoutList
-import Rahm.Desktop.Windows
-import Rahm.Desktop.Layout.ReinterpretMessage
-import Rahm.Desktop.Layout.Pop
-import Rahm.Desktop.Layout.Flip
-import Rahm.Desktop.Layout.Rotate
-import Rahm.Desktop.Layout.Redescribe
-
-import qualified Data.Map as M
-import qualified XMonad.StackSet as W
-
-mods = reinterpretResize . poppable . flippable . rotateable
-
-myLayout =
-  fullscreenFull $
-    avoidStruts $
-      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
-        layoutZipper $
-          mods (reinterpretIncMaster $ spiral (6/7)) |:
-          mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
-          mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
-          mods (Redescribe UsingTall (Tall 1 (3/100) (1/2))) |:
-          mods (Redescribe UsingThreeCol (ThreeCol 1 (3/100) (1/2))) |:
-          mods Grid |:
-          mods (Dishes 2 (1/6)) |:
-          mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1) |:
-          nil
-
--- Mosaic doesn't have the concept of a "Master Space", so reinterpret messages
--- intended to modify the master space and instead have those messages expand
--- and shrink the current window.
---
--- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system
--- hacking one can do in Haskell.
-instance DoReinterpret "ForMosaic" where
-  
-  -- IncMaster message
-  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
-    fmap (SomeMessage .
-      (if n > 0
-        then expandWindowAlt
-        else shrinkWindowAlt)) <$> getFocusedWindow
-  
-  -- ResizeMaster message
-  reinterpretMessage _ (fromMessage -> Just m) = do
-    fmap (SomeMessage .
-      (case m of
-        Expand -> expandWindowAlt
-        Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
-
-  -- Messages that don't match the above, just leave it unmodified.
-  reinterpretMessage _ m = return (Just m)
-
-instance DoReinterpret "IncMasterToResizeMaster" where
-  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) =
-    return $ Just $
-      if n > 0
-        then SomeMessage Expand
-        else SomeMessage Shrink
-  reinterpretMessage _ m = return (Just m)
-
-modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a
-modifyMosaic = ModifiedLayout ReinterpretMessage
-
-reinterpretIncMaster ::
-  l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a
-reinterpretIncMaster = ModifiedLayout ReinterpretMessage
-
-data UsingTall = UsingTall deriving (Read, Show)
-instance Describer UsingTall Tall where
-  newDescription _ (Tall mast _ _) _ = "Tall(" ++ show mast ++ ")"
-
-data UsingThreeCol = UsingThreeCol deriving (Read, Show)
-instance Describer UsingThreeCol ThreeCol where
-  newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
-  newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
diff --git a/src/Rahm/Desktop/Layout/Redescribe.hs b/src/Rahm/Desktop/Layout/Redescribe.hs
new file mode 100644
index 0000000..c5c7472
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Redescribe.hs
@@ -0,0 +1,35 @@
+
+-- Module to enable redescribing layouts. Unlike LayoutModifiers though, this
+-- class is aware of the underlying type as it may need to access some internals
+-- to generate the new description.
+module Rahm.Desktop.Layout.Redescribe where
+
+import XMonad
+
+import qualified XMonad.StackSet as W
+import Data.Typeable (Typeable)
+
+-- Type-class to modify the description of a layout.
+class Describer m l where
+  
+  -- Returns the new description from the given description modifier, the layout
+  -- and the existing description.
+  newDescription :: m -> l a -> String -> String
+
+-- With a DescriptionModifier,
+data Redescribe m l a = Redescribe m (l a)
+  deriving (Show, Read)
+
+-- Delegates to the underlying Layout, except for the description
+instance (Typeable m, Show m, Describer m l, LayoutClass l a) =>
+    LayoutClass (Redescribe m l) a where
+
+  runLayout (W.Workspace t (Redescribe m l) a) rect = do
+    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
+    return (rects, fmap (Redescribe m) maybeNewLayout)
+
+  handleMessage (Redescribe m l) a = do
+    maybeNewLayout <- handleMessage l a
+    return (Redescribe m <$> maybeNewLayout)
+
+  description (Redescribe m l) = newDescription m l (description l)
-- 
cgit 


From 96643003bd14195f4868712789cd056e9d3581ae Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 12 Apr 2022 01:54:43 -0600
Subject: Add another layout modifier to add a hole.

This is mostly an academic exercise, as there's probably not much reason
to put a hole in the layout, but I must admit that sometimes is
aesthetically pleasing to see a little more desktop wallpaper in some
cases.
---
 src/Rahm/Desktop/Keys.hs        |  7 +++++++
 src/Rahm/Desktop/Layout.hs      |  3 ++-
 src/Rahm/Desktop/Layout/Hole.hs | 44 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 53 insertions(+), 1 deletion(-)
 create mode 100644 src/Rahm/Desktop/Layout/Hole.hs

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index e780fbf..0ff8da3 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -54,6 +54,7 @@ import Rahm.Desktop.PassMenu
 import Rahm.Desktop.Logger
 import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.Swallow
+import Rahm.Desktop.Layout.Hole (toggleHole)
 import Rahm.Desktop.Layout.Pop (PopMessage(..))
 import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.Layout.Rotate (rotateLayout)
@@ -188,6 +189,12 @@ keymap = runKeys $ do
       doc "Print this documentation." $
       logs (documentation (keymap config))
 
+  bind xK_F8 $
+
+    justMod $
+      doc "Print this documentation." $
+      sendMessage toggleHole
+
   bind xK_F10 $ do
     justMod playPauseDoc
 
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index 6c9ac5a..906a7fc 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -32,11 +32,12 @@ import Rahm.Desktop.Layout.Pop
 import Rahm.Desktop.Layout.Flip
 import Rahm.Desktop.Layout.Rotate
 import Rahm.Desktop.Layout.Redescribe
+import Rahm.Desktop.Layout.Hole
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
-mods = reinterpretResize . poppable . flippable . rotateable
+mods = reinterpretResize . poppable . flippable . rotateable . hole
 
 myLayout =
   fullscreenFull $
diff --git a/src/Rahm/Desktop/Layout/Hole.hs b/src/Rahm/Desktop/Layout/Hole.hs
new file mode 100644
index 0000000..ee59726
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Hole.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE UndecidableInstances, DeriveAnyClass #-}
+
+-- Delegates to a lower layout, but leaves a hole where the next window will go.
+module Rahm.Desktop.Layout.Hole (hole, toggleHole) where
+
+import qualified XMonad.StackSet as W
+import XMonad
+import Data.Maybe (mapMaybe)
+
+import Rahm.Desktop.Windows
+
+data Hole (l :: * -> *) (a :: *) = Hole Bool (l a)
+
+deriving instance Show (l a) => Show (Hole l a)
+deriving instance Read (l a) => Read (Hole l a)
+
+hole :: l a -> Hole l a
+hole = Hole False
+
+toggleHole :: ManageHole
+toggleHole = ManageHole $ \(Hole e l) -> Hole (not e) l
+
+data ManageHole where
+  ManageHole :: (forall l a. Hole l a -> Hole l a) -> ManageHole
+  deriving (Message)
+
+instance (LayoutClass l a, Eq a, Num a) => LayoutClass (Hole l) a where
+  runLayout (W.Workspace t (Hole enabled l) a) rect = do
+    (rects, maybeNewLayout) <- runLayout (app (-1) $ W.Workspace t l a) rect
+    return (filter ((/=(-1)) . fst) rects, fmap (Hole enabled) maybeNewLayout)
+    where
+      app x w | not enabled = w
+      app x (W.Workspace t l s) =
+        case s of
+          Nothing -> 
+            W.Workspace t l (Just $ W.Stack x [] [])
+          Just (W.Stack h c e) ->
+            W.Workspace t l (Just $ W.Stack h c (e ++ [x]))
+  
+  handleMessage h (fromMessage -> Just (ManageHole f)) =
+    return $ Just $ f h
+  handleMessage (Hole e l) a = do
+    maybeNewLayout <- handleMessage l a
+    return (Hole e <$> maybeNewLayout)
-- 
cgit 


From f8f7deeac800170a6201f74380bdfe720ee38027 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 12 Apr 2022 02:04:18 -0600
Subject: Make spacing specific to the current layout rather than all layouts.
 Not sure how I feel about it, but Imma try it out

---
 src/Rahm/Desktop/Layout.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index 906a7fc..fcf7d25 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -37,12 +37,13 @@ import Rahm.Desktop.Layout.Hole
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
-mods = reinterpretResize . poppable . flippable . rotateable . hole
+withSpacing = spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True
+mods =
+  withSpacing . reinterpretResize . poppable . flippable . rotateable . hole
 
 myLayout =
   fullscreenFull $
     avoidStruts $
-      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
         layoutZipper $
           mods (reinterpretIncMaster $ spiral (6/7)) |:
           mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
-- 
cgit 


From e0d58319014226faeff1a09c7abce7865b551b30 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 12 Apr 2022 11:09:19 -0600
Subject: Clean up Poppable so it's a proper proxy to the underlying layout
 rather than a LayoutModifier.

---
 src/Rahm/Desktop/Keys.hs              |   8 +--
 src/Rahm/Desktop/Layout.hs            |   2 +-
 src/Rahm/Desktop/Layout/LayoutDraw.hs |   4 +-
 src/Rahm/Desktop/Layout/Pop.hs        | 122 ++++++++++++++++------------------
 4 files changed, 64 insertions(+), 72 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 0ff8da3..5284a9d 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -55,7 +55,7 @@ import Rahm.Desktop.Logger
 import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.Swallow
 import Rahm.Desktop.Layout.Hole (toggleHole)
-import Rahm.Desktop.Layout.Pop (PopMessage(..))
+import Rahm.Desktop.Layout.Pop (togglePop)
 import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.Layout.Rotate (rotateLayout)
 import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
@@ -534,7 +534,7 @@ keymap = runKeys $ do
         bind xK_z $ do
           noMod -|- justMod $
             doc "Toggle zoom on the current window." $
-            sendMessage TogglePop
+            sendMessage togglePop
 
         -- Z is reserved to create sub keybindings to do various things.
         -- I don't really use these at the moment.
@@ -546,7 +546,7 @@ keymap = runKeys $ do
     -- modifier.
     shiftMod $
       doc "Toggle zoom on the current window." $
-      sendMessage TogglePop
+      sendMessage togglePop
 
   bind xF86XK_Calculator $ do
     noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
@@ -636,7 +636,7 @@ mouseMap = runButtons $ do
 
 
       bind button14 $ do
-        noMod $ noWindow $ click >> sendMessage TogglePop
+        noMod $ noWindow $ click >> sendMessage togglePop
 
       bind button15 $ do
         noMod $ noWindow $ spawnX "pavucontrol"
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index fcf7d25..aeceff9 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -39,7 +39,7 @@ import qualified XMonad.StackSet as W
 
 withSpacing = spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True
 mods =
-  withSpacing . reinterpretResize . poppable . flippable . rotateable . hole
+  withSpacing . poppable . flippable . rotateable . hole
 
 myLayout =
   fullscreenFull $
diff --git a/src/Rahm/Desktop/Layout/LayoutDraw.hs b/src/Rahm/Desktop/Layout/LayoutDraw.hs
index c3a1918..7e628fc 100644
--- a/src/Rahm/Desktop/Layout/LayoutDraw.hs
+++ b/src/Rahm/Desktop/Layout/LayoutDraw.hs
@@ -11,7 +11,7 @@ import Control.Monad.Writer (execWriter, tell)
 import Data.Foldable (find)
 import Data.Maybe (fromMaybe)
 import Rahm.Desktop.Hash (quickHash)
-import Rahm.Desktop.Layout.Pop (PopMessage(..))
+import Rahm.Desktop.Layout.Pop (setPop)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath ((</>))
 import Text.Printf (printf)
@@ -49,7 +49,7 @@ drawLayout = do
     -- Gotta reset the layout to a consistent state.
     layout' <- foldM (flip ($)) layout $ [
          handleMessage' $ ModifyWindowBorder $ const $ Border 0 0 0 0,
-         handleMessage' Unpop
+         handleMessage' $ setPop $ const False
       ]
       -- Add some changes for the Mosaic layout to handle so it get's a
       -- unique looking icon. (The default state is pretty boring).
diff --git a/src/Rahm/Desktop/Layout/Pop.hs b/src/Rahm/Desktop/Layout/Pop.hs
index 037e664..7e3dbd1 100644
--- a/src/Rahm/Desktop/Layout/Pop.hs
+++ b/src/Rahm/Desktop/Layout/Pop.hs
@@ -8,7 +8,9 @@ module Rahm.Desktop.Layout.Pop (
   Poppable(..),
   PopMessage(..),
   poppable,
-  reinterpretResize) where
+  resizePop,
+  togglePop,
+  setPop) where
 
 import XMonad
 import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
@@ -17,7 +19,7 @@ import qualified XMonad.StackSet as W
 
 import Rahm.Desktop.Layout.ReinterpretMessage
 
-data Poppable a = Poppable {
+data Poppable (l :: * -> *) (a :: *) = Poppable {
     -- True if the current window is popped out or not.
     isPopped :: Bool
 
@@ -26,79 +28,69 @@ data Poppable a = Poppable {
 
     -- Fraction of the screen height around the window.
   , yFrac :: Float
+
+  , wrap :: l  a
   } deriving (Show, Read, Eq, Ord)
 
-instance Default (Poppable a) where
-  def = Poppable {
-      isPopped = False
-    , xFrac = 0.05
-    , yFrac = 0.05
-    }
-
--- Returns a modified layout that converts Resize (Shrink/Expand) into ResizePop
--- messages. Unfortunately this is required because a LayoutModifier has no way
--- to intercept messages and block them from propegating, which is pretty silly.
---
--- So, reinterpretResize will turn a Shrink/Expand into a ResizePop, this will
--- be consumed by the Poppable layout modifier. If the Poppable LayoutModifier
--- is not active, it will turn the ResizePop back into a Shrink/Expand and
--- forward it to the underlying layout.
-reinterpretResize ::
-  l a -> ModifiedLayout (ReinterpretMessage "ForPop") l a
-reinterpretResize = ModifiedLayout ReinterpretMessage
-
-poppable :: l a -> ModifiedLayout Poppable l a
-poppable = ModifiedLayout def
-
--- Message to control the state of the popped layouts modifier.
-data PopMessage = TogglePop | Pop | Unpop | ResizePop Float
-  deriving (Typeable, Show, Eq, Ord, Message)
-
-instance DoReinterpret "ForPop" where
-  reinterpretMessage _ (fromMessage -> Just mess) =
-    return $ Just $ SomeMessage $
-      case mess of
-        Shrink -> ResizePop (-0.05)
-        Expand -> ResizePop 0.05
-
-  reinterpretMessage _ _ = return Nothing
-
-instance (Eq a) => LayoutModifier Poppable a where
+data PopMessage where
+  PopMessage :: (forall l a. Poppable l a -> Poppable l a) -> PopMessage
+  deriving (Message)
+
+resizePop :: Float -> PopMessage
+resizePop f = PopMessage $ \(Poppable b x y l) -> 
+  Poppable b (g $ x + f) (g $ y + f) l
+  where
+    g = max 0 . min 0.45
+
+setPop :: (Bool -> Bool) -> PopMessage
+setPop f = PopMessage $ \(Poppable b x y l) -> Poppable (f b) x y l
+
+togglePop :: PopMessage
+togglePop = setPop not
+
+poppable :: l a -> Poppable l a
+poppable = Poppable False 0.05 0.05
 
+instance (LayoutClass l a, Eq a) => LayoutClass (Poppable l) a where
+  
   -- If the current layout is not popped, then just return what the underlying
   -- layout returned.
-  redoLayout Poppable { isPopped = False } _ _ returned =
-     return (returned, Nothing)
 
-  -- Can't do anything with an empty stack.
-  redoLayout _ _ Nothing returned = return (returned, Nothing)
-  
-  redoLayout self (Rectangle x y w h) (Just (W.focus -> focused)) returned =
-      return ((focused, newRect) : remaining, Nothing)
+  runLayout (W.Workspace
+              t
+              (Poppable True xs ys l)
+              a@(Just (W.focus -> focused)))
+            rect@(Rectangle x y w h) = do
+    (returned, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
+    return
+      ((focused, newRect) : filter ((/=focused) . fst) returned,
+       Poppable True xs ys <$> maybeNewLayout)
     where
-      remaining = filter ((/=focused) . fst) returned
-      wp = floor $ fromIntegral w * xFrac self
-      hp = floor $ fromIntegral h * yFrac self
+      wp = floor $ fromIntegral w * xs
+      hp = floor $ fromIntegral h * ys
       newRect = Rectangle
         (x + wp)
         (y + hp)
         (w - fromIntegral (wp * 2))
         (h - fromIntegral (hp * 2))
 
-  -- Handle the Pop messages associated with this layout.
-  handleMessOrMaybeModifyIt self (fromMessage -> Just mess) =
-    return $ Just $ case mess of
-      TogglePop -> Left $ self { isPopped = not (isPopped self) }
-      Pop -> Left $ self { isPopped = True }
-      Unpop -> Left $ self { isPopped = False }
-      ResizePop amt | isPopped self ->
-          Left $ self {
-            xFrac = guard (xFrac self + amt),
-            yFrac = guard (yFrac self + amt)
-          }
-      ResizePop amt -> Right $ SomeMessage $
-        if amt > 0 then Expand else Shrink
-    where
-      guard = min 0.45 . max 0
-
-  handleMessOrMaybeModifyIt _ _ = return Nothing
+  -- If the pop is not active, just delegate to the underlying layout.
+  runLayout (W.Workspace t (Poppable b x y l) a) rect = do
+    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
+    return (rects, Poppable b x y <$> maybeNewLayout)
+
+  -- If the message is a PopMessage, handle that here.
+  handleMessage p (fromMessage -> Just (PopMessage f)) =
+    return $ Just $ f p
+
+  -- Intercept Shrink/Expand message if the pop is active, and resize the
+  -- pop size.
+  handleMessage p (fromMessage -> Just mess) | isPopped p =
+    case mess of
+      Shrink -> handleMessage p (SomeMessage $ resizePop 0.025)
+      Expand -> handleMessage p (SomeMessage $ resizePop (-0.025))
+
+  -- By default just pass the message to the underlying layout.
+  handleMessage (Poppable b x y l) mess = do
+    maybeNewLayout <- handleMessage l mess
+    return (Poppable b x y <$> maybeNewLayout)
-- 
cgit 


From 85937a13ad9a272d4c9e462b9b7a8b121ae453a6 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 12 Apr 2022 11:45:41 -0600
Subject: Change keys to make H+Space a leader key for doing layout related
 stuff. Not sure how I feel about it right now; it'll take some getting used
 to.

---
 src/Rahm/Desktop/Keys.hs | 44 ++++++++++++++++++++++++++++++++++----------
 1 file changed, 34 insertions(+), 10 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 5284a9d..33830dc 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -263,7 +263,7 @@ keymap = runKeys $ do
     justMod $
       doc "Goto a workspace\n\n\t\
 
-      \If the second character typed is alpha-numberic, jump to that\n\t\
+      \If the second character typed is alpha-numeric, jump to that\n\t\
       \workspace. The workspace is created on-the-fly if such a workspace\n\t\
       \does not exist.\n\n\t\
 
@@ -412,15 +412,39 @@ keymap = runKeys $ do
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
   bind xK_space $ do
-    justMod  $
-      doc "Use the next layout in the layout list." $ sendMessage toNextLayout
-
-    altMod   $
-      doc "Reset the layout to the default layout." $ sendMessage toFirstLayout
-
-    shiftMod $
-      doc "Use the previous layout in the layout list." $
-        sendMessage toPreviousLayout
+    justMod $ subkeys $ do
+      
+      bind xK_n $
+        noMod $ doc "Use the next layout in the layout list." $
+          sendMessage toNextLayout
+
+      bind xK_p $
+        noMod $ doc "Use the previous layout in thelayout list." $
+          sendMessage toPreviousLayout
+
+      bind xK_b $
+        noMod $ doc "Go back to the first layout in the layout list." $
+          sendMessage toFirstLayout
+
+      bind xK_h $
+        noMod $ doc "Flip the layout across the horizontal axis" $
+          sendMessage flipVertically
+
+      bind xK_v $
+        noMod $ doc "Flip the layout across the vertical axis" $
+          sendMessage flipHorizontally
+
+      bind xK_r $
+        noMod $ doc "Rotate the layout 90 degrees" $
+          sendMessage rotateLayout
+
+      bind xK_t $
+        noMod $ doc "Toggle the pop window" $
+          sendMessage togglePop
+
+      bind xK_x $
+        noMod $ doc "Toggle the hole" $
+          sendMessage toggleHole
 
   bind xK_t $ do
     justMod  $
-- 
cgit 


From 3c6a91392cc249a3e71c206dd06dd8a2aa79c329 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 12 Apr 2022 11:55:57 -0600
Subject: noMod -> (noMod -|- justMod)

---
 src/Rahm/Desktop/Keys.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 33830dc..27de459 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -412,38 +412,38 @@ keymap = runKeys $ do
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
   bind xK_space $ do
-    justMod $ subkeys $ do
+    justMod $ doc "Layout-related bindings" $ subkeys $ do
       
       bind xK_n $
-        noMod $ doc "Use the next layout in the layout list." $
+        (noMod -|- justMod) $ doc "Use the next layout in the layout list." $
           sendMessage toNextLayout
 
       bind xK_p $
-        noMod $ doc "Use the previous layout in thelayout list." $
+        (noMod -|- justMod) $ doc "Use the previous layout in the layout list." $
           sendMessage toPreviousLayout
 
       bind xK_b $
-        noMod $ doc "Go back to the first layout in the layout list." $
+        (noMod -|- justMod) $ doc "Go back to the first layout in the layout list." $
           sendMessage toFirstLayout
 
       bind xK_h $
-        noMod $ doc "Flip the layout across the horizontal axis" $
+        (noMod -|- justMod) $ doc "Flip the layout across the horizontal axis" $
           sendMessage flipVertically
 
       bind xK_v $
-        noMod $ doc "Flip the layout across the vertical axis" $
+        (noMod -|- justMod) $ doc "Flip the layout across the vertical axis" $
           sendMessage flipHorizontally
 
       bind xK_r $
-        noMod $ doc "Rotate the layout 90 degrees" $
+        (noMod -|- justMod) $ doc "Rotate the layout 90 degrees" $
           sendMessage rotateLayout
 
       bind xK_t $
-        noMod $ doc "Toggle the pop window" $
+        (noMod -|- justMod) $ doc "Toggle the pop window" $
           sendMessage togglePop
 
       bind xK_x $
-        noMod $ doc "Toggle the hole" $
+        (noMod -|- justMod) $ doc "Toggle the hole" $
           sendMessage toggleHole
 
   bind xK_t $ do
-- 
cgit 


From 2f636306406371a32e52c1f7bd7a103d4285b586 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 12 Apr 2022 12:19:02 -0600
Subject: Clean up LayoutList and move to Layout.List

---
 src/Rahm/Desktop/Keys.hs              |   2 +-
 src/Rahm/Desktop/Layout.hs            |   4 +-
 src/Rahm/Desktop/Layout/LayoutList.hs | 295 ----------------------------------
 src/Rahm/Desktop/Layout/List.hs       | 280 ++++++++++++++++++++++++++++++++
 4 files changed, 283 insertions(+), 298 deletions(-)
 delete mode 100644 src/Rahm/Desktop/Layout/LayoutList.hs
 create mode 100644 src/Rahm/Desktop/Layout/List.hs

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 27de459..87f88cf 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -45,7 +45,6 @@ import XMonad.Actions.SpawnOn as SpawnOn
 import qualified Data.Map as Map
 import qualified XMonad.StackSet as W
 
-import Rahm.Desktop.Layout.LayoutList
 import Rahm.Desktop.MouseMotion
 import Rahm.Desktop.Windows
 import Rahm.Desktop.Lib
@@ -54,6 +53,7 @@ import Rahm.Desktop.PassMenu
 import Rahm.Desktop.Logger
 import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.Swallow
+import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout)
 import Rahm.Desktop.Layout.Hole (toggleHole)
 import Rahm.Desktop.Layout.Pop (togglePop)
 import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index aeceff9..b416111 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -25,7 +25,7 @@ import XMonad.Core
 import XMonad.Layout.NoBorders (smartBorders, noBorders)
 
 import Rahm.Desktop.Layout.CornerLayout (Corner(..))
-import Rahm.Desktop.Layout.LayoutList
+import Rahm.Desktop.Layout.List
 import Rahm.Desktop.Windows
 import Rahm.Desktop.Layout.ReinterpretMessage
 import Rahm.Desktop.Layout.Pop
@@ -44,7 +44,7 @@ mods =
 myLayout =
   fullscreenFull $
     avoidStruts $
-        layoutZipper $
+        layoutList $
           mods (reinterpretIncMaster $ spiral (6/7)) |:
           mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
           mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
diff --git a/src/Rahm/Desktop/Layout/LayoutList.hs b/src/Rahm/Desktop/Layout/LayoutList.hs
deleted file mode 100644
index 3e72e99..0000000
--- a/src/Rahm/Desktop/Layout/LayoutList.hs
+++ /dev/null
@@ -1,295 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-
-{-
- - This module provides a more powerful version of the "Choose" layout that can
- - be bidirectionally navigated.
- -
- - The indexing uses a type-safe zipper to keep track of the currently-selected
- - layout.
- -}
-module Rahm.Desktop.Layout.LayoutList (
-  LayoutList,
-  layoutZipper,
-  LCons,
-  LNil,
-  toNextLayout,
-  toPreviousLayout,
-  toFirstLayout,
-  (|:),
-  nil
-  )where
-
-import Control.Applicative ((<|>))
-import Data.Void
-import Control.Monad.Identity (runIdentity)
-import Data.Maybe (fromMaybe, fromJust)
-import Control.Arrow (second)
-import XMonad
-import qualified XMonad.StackSet as W
-import Data.Proxy
-
--- Type-level lists. LNil is the final of the list. LCons contains a layout and a
--- tail.
-data LNil a = LNil deriving (Read, Show)
-data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
-
--- Sel - This defines a structure where either this selected, or some
--- other element is selected.
---
--- These types can be composed to create what is effectively a bounded integer.
--- I.e. there can be a type like
---
--- Sel (Sel (Sel (Sel End)))
---
--- Such a type is equivalent to an integer bounded at 4, because this type can
--- exist in no more than 4 states:
---
--- Sel
--- Skip Sel
--- Skip (Skip Sel)
--- Skip (Skip (Skip Sel))
---
--- Note that a type (Sel End) can only be in the Sel as End may not be
--- construted (without using undefined).
-data Sel l =
-    Sel |
-    (Selector l) => Skip l
-deriving instance (Read l, Selector l) => Read (Sel l)
-deriving instance (Show l, Selector l) => Show (Sel l)
-deriving instance (Eq l, Selector l) => Eq (Sel l)
-
--- Reimplement Void as End, just to keep the two separate, but End is for all
--- intents and purposes Void.
-data End
-deriving instance Read End
-deriving instance Show End
-deriving instance Eq End
-
-
--- Types that constitute a selection. Selections can be moved to the next
--- selection, moved to the previous selection, optionally there could be a
--- previous selection and they may be currently selected.
-class (Eq c) => Selector c where
-  -- Increments the selection to the next state
-  --
-  -- Returns Nothing if the selection class is in the final state and cannot be
-  -- incremented any farther. (This is helpful to facilitate modular
-  -- arithmatic)
-  increment :: c -> Maybe c
-
-  -- Decrements the selection to the previous state. Returns Nothing if the
-  -- state is already in its initial setting.
-  decrement :: c -> Maybe c
-
-  -- The initial state.
-  initial :: Maybe c
-
-  -- The final state.
-  final :: Maybe c
-
---
--- Is selelected can be in two states:
---
---   1. The current element is selected
---   2. The current element is not selected and another element deeper in the
---      structure is selected.
-instance (Selector t) => Selector (Sel t) where
-  -- If the current element is not selected, increment the tail.
-  increment (Skip l) = Skip <$> increment l
-  -- If the current element is selected, the increment is just the initial of
-  -- the tail.
-  increment Sel = Skip <$> initial 
-
-  -- For a selection, the initial is just this in the Sel state.
-  initial = Just Sel
-
-  -- Looks ahead at the tail, sees if it is selected, if so, select this one
-  -- instead, if the one ahead isn't selected, then decrement that one.
-  decrement (Skip t) = Just $ maybe Sel Skip (decrement t)
-  decrement Sel = Nothing
-
-  -- Navigates to the end of the structure to find the final form.
-  final = Just $ maybe Sel Skip final
-
--- The End structure (which is equivalent to Void) is the "null" selector; the
--- basecase that the Sel selector terminates at.
-instance Selector End where
-
-  -- Incrementing the End Selector doesn't do anything.
-  increment = const Nothing
-
-  -- Decrementing the End Selector doesn't do anythig
-  decrement = const Nothing
-
-  -- There is no initial value for the End selector.
-  initial = Nothing
-
-  -- There is not final state for the End selector.
-  final = Nothing
-
--- Increment a selector, but cyclicly
-incrementCycle :: (Selector c) => c -> c
-incrementCycle c =
-  case increment c of
-    Nothing -> fromMaybe c initial
-    Just x -> x
-
--- Add two selectors together, incrementing the first until the second cannot be
--- incremented anymore.
-addSelector :: (Selector c) => c -> c -> c
-addSelector c1 c2 = addSel c1 (decrement c2)
-  where
-    addSel c1 Nothing = c1
-    addSel c1 (Just c2) = addSel (incrementCycle c1) (decrement c2)
-
--- Turn an int into a selector by repeatably incrementing.
-intToSelector :: (Selector c) => Int -> c
-intToSelector 0 = fromJust initial
-intToSelector n = incrementCycle $ intToSelector (n - 1)
-
--- A LayoutList consists of a LayoutSelect type and a corresponding Selector.
-data LayoutList l a where
-  LayoutList ::
-    (LayoutSelect l a, Selector (SelectorFor l)) =>
-      SelectorFor l -> l a -> LayoutList l a
-
-deriving instance (LayoutSelect l a) => Show (LayoutList l a)
-deriving instance (LayoutSelect l a) => Read (LayoutList l a)
-
-(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
-(|:) = LCons
-
-infixr 5 |: 
-
--- Constructs a LayoutList. This function enforces that the SelectorFor l
--- is a 'Sel' type. Essentially this enforces that there must be at least one
--- underlying layout, otherwise a LayoutList cannot be constructed.
-layoutZipper :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
-  l a -> LayoutList l a
-layoutZipper = LayoutList Sel
-
--- The termination of a layout zipper.
-nil :: LNil a
-nil = LNil
-
--- Message to navigate to a layout.
-newtype NavigateLayout =
-          -- Sets the layout based on the given function.
-          NavigateLayout {
-            changeLayoutFn :: forall c. (Selector c) => c -> c
-          }
-          deriving (Typeable)
-
--- NavigateLayout instance to move to the next layout, circularly.
-toNextLayout :: NavigateLayout
-toNextLayout = NavigateLayout $ addSelector (intToSelector 1)
-
--- NavigateLayout instance to move to the previous layout, circularly.
-toPreviousLayout :: NavigateLayout
-toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
-
--- NavigateLayotu instance to move to the first layout.
-toFirstLayout :: NavigateLayout
-toFirstLayout = NavigateLayout (`fromMaybe` initial)
-
-instance Message NavigateLayout where
-
--- LayoutSelect class Describes a type that can be used to select a layout using
--- the associated type SelectorFor.
---
--- Instances of this class are LCons and LNil.
-class (Show (l a),
-       Read (l a),
-       Read (SelectorFor l),
-       Show (SelectorFor l),
-       Selector (SelectorFor l)) => LayoutSelect l a where
-
-  -- The selector that is used to update the layout corresponding to the
-  -- selector. This selector must be an instance of the Selector class.
-  type SelectorFor l :: *
-
-  -- Update applies a functor to the selected layout and maybe returns a result
-  -- and an updated layout.
-  update :: forall r m. (Monad m) =>
-    -- The selector for this type. Determines which layout the function is
-    -- applied to.
-    SelectorFor l ->
-    -- The LayoutSelect being modified.
-    l a ->
-    -- Higher-ordered function to generically apply to the Layout associated
-    -- with the Selector. Works on all LayoutClass's.
-    (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
-
-    -- Returns a result r, and an updated LayoutSelect.
-    m (Maybe (r, l a))
-
--- Instance for LayoutSelect for cons
-instance (Read (l a),
-          LayoutClass l a,
-          LayoutSelect t a,
-          Show (SelectorFor t),
-          Read (SelectorFor t)) =>
-    LayoutSelect (LCons l t) a where
-
-  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
-  -- Sel (Sel (Sel ( ... (Sel End) .. ))) where the number of Sel's match the
-  -- number of Cons in this structure enforcing safe selection.
-  type SelectorFor (LCons l t) = Sel (SelectorFor t)
-
-  -- The current layout in this Cons-list is selected.
-  update Sel (LCons layout t) fn = do
-    (r, layout') <- fn layout
-    return $ Just (r, LCons (fromMaybe layout layout') t)
-
-  -- The current layout is not selected. Move on to another layout.
-  update (Skip s) (LCons l t) fn =
-    fmap (second $ \t' -> LCons l t') <$> update s t fn
-
--- LNil is a layout select. It doesn't do anything. Indeed update really can't
--- be called on on this because that would require instantiating a End type.
-instance LayoutSelect LNil a where
-  type SelectorFor LNil = End -- LNil cannot be selected.
-  update _ _ _ = return Nothing
-
--- Instance of layout class for LayoutList. The implementation for this
--- just delegates to the underlying LayoutSelect class using the generic
--- update method.
-instance (Show (l a), Typeable l, LayoutSelect l a) =>
-    LayoutClass (LayoutList l) a where
-
-  runLayout (W.Workspace i (LayoutList idx l) ms) r = do
-    r <- update idx l $ \layout ->
-            runLayout (W.Workspace i layout ms) r
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutList idx la))
-
-  pureLayout (LayoutList idx l) r s = runIdentity $ do
-    r <- update idx l $ \layout -> return (pureLayout layout r s, Nothing)
-    case r of
-      Nothing -> return []
-      Just (r, a) -> return r
-
-  emptyLayout (LayoutList idx l) r = do
-    r <- update idx l $ \layout -> emptyLayout layout r
-    case r of
-      Nothing -> return ([], Nothing)
-      Just (r, la) -> return (r, Just (LayoutList idx la))
-
-  handleMessage (LayoutList idx l) (fromMessage -> Just (NavigateLayout fn)) =
-    return $ Just (LayoutList (fn idx) l)
-
-  handleMessage (LayoutList idx l) m = do
-    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
-    return $ LayoutList idx . snd <$> r
-
-  pureMessage (LayoutList idx l) m = runIdentity $ do
-    r <- update idx l $ \layout -> return ((), pureMessage layout m)
-    return $ LayoutList idx . snd <$> r
-
-  description (LayoutList idx l) = runIdentity $ do
-    r <- update idx l $ \l -> return (description l, Nothing)
-    return $
-      case r of
-        Nothing -> "No Layout"
-        Just (descr, _) -> descr
diff --git a/src/Rahm/Desktop/Layout/List.hs b/src/Rahm/Desktop/Layout/List.hs
new file mode 100644
index 0000000..96f9be5
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/List.hs
@@ -0,0 +1,280 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+{-
+ - This module provides a more powerful version of the "Choose" layout that can
+ - be bidirectionally navigated.
+ -
+ - The indexing uses a type-safe zipper to keep track of the currently-selected
+ - layout.
+ -}
+module Rahm.Desktop.Layout.List (
+  LayoutList,
+  layoutList,
+  LCons,
+  LNil,
+  toNextLayout,
+  toPreviousLayout,
+  toFirstLayout,
+  (|:),
+  nil
+  )where
+
+import Control.Applicative ((<|>))
+import Data.Void
+import Control.Monad.Identity (runIdentity)
+import Data.Maybe (fromMaybe, fromJust)
+import Control.Arrow (second)
+import XMonad
+import qualified XMonad.StackSet as W
+import Data.Proxy
+
+-- Type-level lists. LNil is the final of the list. LCons contains a layout and a
+-- tail.
+data LNil a = LNil deriving (Read, Show)
+data LCons l t a = LCons (l a) (t a) deriving (Read, Show)
+
+-- Sel - This defines a structure where either this selected, or some
+-- other element is selected.
+--
+-- These types can be composed to create what is effectively a bounded integer.
+-- I.e. there can be a type like
+--
+-- Sel (Sel (Sel (Sel End)))
+--
+-- Such a type is equivalent to an integer bounded at 4, because this type can
+-- exist in no more than 4 states:
+--
+-- Sel
+-- Skip Sel
+-- Skip (Skip Sel)
+-- Skip (Skip (Skip Sel))
+--
+-- Note that a type (Sel End) can only be in the Sel as End may not be
+-- construted (without using undefined).
+data Sel l =
+    Sel |
+    (Selector l) => Skip l
+deriving instance (Read l, Selector l) => Read (Sel l)
+deriving instance (Show l, Selector l) => Show (Sel l)
+deriving instance (Eq l, Selector l) => Eq (Sel l)
+
+-- Reimplement Void as End, just to keep the two separate, but End is for all
+-- intents and purposes Void.
+data End
+deriving instance Read End
+deriving instance Show End
+deriving instance Eq End
+
+
+-- Types that constitute a selection. Selections can be moved to the next
+-- selection, moved to the previous selection, optionally there could be a
+-- previous selection and they may be currently selected.
+class (Eq c) => Selector c where
+  -- Increments the selection to the next state
+  --
+  -- Returns Nothing if the selection class is in the final state and cannot be
+  -- incremented any farther. (This is helpful to facilitate modular
+  -- arithmatic)
+  increment :: c -> Maybe c
+
+  -- Decrements the selection to the previous state. Returns Nothing if the
+  -- state is already in its initial setting.
+  decrement :: c -> Maybe c
+
+  -- The initial state.
+  initial :: Maybe c
+
+  -- The final state.
+  final :: Maybe c
+
+--
+-- Is selelected can be in two states:
+--
+--   1. The current element is selected
+--   2. The current element is not selected and another element deeper in the
+--      structure is selected.
+instance (Selector t) => Selector (Sel t) where
+  -- If the current element is not selected, increment the tail.
+  increment (Skip l) = Skip <$> increment l
+  -- If the current element is selected, the increment is just the initial of
+  -- the tail.
+  increment Sel = Skip <$> initial 
+
+  -- For a selection, the initial is just this in the Sel state.
+  initial = Just Sel
+
+  -- Looks ahead at the tail, sees if it is selected, if so, select this one
+  -- instead, if the one ahead isn't selected, then decrement that one.
+  decrement (Skip t) = Just $ maybe Sel Skip (decrement t)
+  decrement Sel = Nothing
+
+  -- Navigates to the end of the structure to find the final form.
+  final = Just $ maybe Sel Skip final
+
+-- The End structure (which is equivalent to Void) is the "null" selector; the
+-- basecase that the Sel selector terminates at.
+instance Selector End where
+
+  -- Incrementing the End Selector doesn't do anything.
+  increment = const Nothing
+
+  -- Decrementing the End Selector doesn't do anythig
+  decrement = const Nothing
+
+  -- There is no initial value for the End selector.
+  initial = Nothing
+
+  -- There is not final state for the End selector.
+  final = Nothing
+
+-- Increment a selector, but cyclicly
+incrementCycle :: (Selector c) => c -> c
+incrementCycle c =
+  case increment c of
+    Nothing -> fromMaybe c initial
+    Just x -> x
+
+-- Add two selectors together, incrementing the first until the second cannot be
+-- incremented anymore.
+addSelector :: (Selector c) => c -> c -> c
+addSelector c1 c2 = addSel c1 (decrement c2)
+  where
+    addSel c1 Nothing = c1
+    addSel c1 (Just c2) = addSel (incrementCycle c1) (decrement c2)
+
+-- Turn an int into a selector by repeatably incrementing.
+intToSelector :: (Selector c) => Int -> c
+intToSelector 0 = fromJust initial
+intToSelector n = incrementCycle $ intToSelector (n - 1)
+
+-- A LayoutList consists of a LayoutSelect type and a corresponding Selector.
+data LayoutList l a where
+  LayoutList ::
+    (LayoutSelect l a, Selector (SelectorFor l)) =>
+      SelectorFor l -> l a -> LayoutList l a
+
+deriving instance (LayoutSelect l a) => Show (LayoutList l a)
+deriving instance (LayoutSelect l a) => Read (LayoutList l a)
+
+-- Cons two LayoutSelect types together.
+(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
+(|:) = LCons
+
+infixr 5 |: 
+
+-- Constructs a LayoutList. This function enforces that the SelectorFor l
+-- is a 'Sel' type. Essentially this enforces that there must be at least one
+-- underlying layout, otherwise a LayoutList cannot be constructed.
+layoutList :: (LayoutSelect l a, SelectorFor l ~ Sel n) =>
+  l a -> LayoutList l a
+layoutList = LayoutList Sel
+
+-- The termination of a layout zipper.
+nil :: LNil a
+nil = LNil
+
+-- Message to navigate to a layout.
+newtype NavigateLayout =
+          -- Sets the layout based on the given function.
+          NavigateLayout {
+            changeLayoutFn :: forall c. (Selector c) => c -> c
+          }
+          deriving (Typeable)
+
+-- NavigateLayout instance to move to the next layout, circularly.
+toNextLayout :: NavigateLayout
+toNextLayout = NavigateLayout $ addSelector (intToSelector 1)
+
+-- NavigateLayout instance to move to the previous layout, circularly.
+toPreviousLayout :: NavigateLayout
+toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
+
+-- NavigateLayotu instance to move to the first layout.
+toFirstLayout :: NavigateLayout
+toFirstLayout = NavigateLayout (`fromMaybe` initial)
+
+instance Message NavigateLayout where
+
+-- LayoutSelect class Describes a type that can be used to select a layout using
+-- the associated type SelectorFor.
+--
+-- Instances of this class are LCons and LNil.
+class (Show (l a),
+       Read (l a),
+       Read (SelectorFor l),
+       Show (SelectorFor l),
+       Selector (SelectorFor l)) => LayoutSelect l a where
+
+  -- The selector that is used to update the layout corresponding to the
+  -- selector. This selector must be an instance of the Selector class.
+  type SelectorFor l :: *
+
+  -- Update applies a functor to the selected layout and maybe returns a result
+  -- and an updated layout.
+  update :: forall r m. (Monad m) =>
+    -- The selector for this type. Determines which layout the function is
+    -- applied to.
+    SelectorFor l ->
+    -- The LayoutSelect being modified.
+    l a ->
+    -- Higher-ordered function to generically apply to the Layout associated
+    -- with the Selector. Works on all LayoutClass's.
+    (forall l'. (LayoutClass l' a) => l' a -> m (r, Maybe (l' a))) ->
+
+    -- Returns a result r, and an updated LayoutSelect.
+    m (Maybe (r, l a))
+
+-- Instance for LayoutSelect for cons
+instance (Read (l a),
+          LayoutClass l a,
+          LayoutSelect t a,
+          Show (SelectorFor t),
+          Read (SelectorFor t)) =>
+    LayoutSelect (LCons l t) a where
+
+  -- The SelectorFor Cons is Sel (SelectorFor t). This creates the structure
+  -- Sel (Sel (Sel ( ... (Sel End) .. ))) where the number of Sel's match the
+  -- number of Cons in this structure enforcing safe selection.
+  type SelectorFor (LCons l t) = Sel (SelectorFor t)
+
+  -- The current layout in this Cons-list is selected.
+  update Sel (LCons layout t) fn = do
+    (r, layout') <- fn layout
+    return $ Just (r, LCons (fromMaybe layout layout') t)
+
+  -- The current layout is not selected. Move on to another layout.
+  update (Skip s) (LCons l t) fn =
+    fmap (second $ \t' -> LCons l t') <$> update s t fn
+
+-- LNil is a layout select. It doesn't do anything. Indeed update really can't
+-- be called on on this because that would require instantiating a End type.
+instance LayoutSelect LNil a where
+  type SelectorFor LNil = End -- LNil cannot be selected.
+  update _ _ _ = return Nothing
+
+-- Instance of layout class for LayoutList. The implementation for this
+-- just delegates to the underlying LayoutSelect class using the generic
+-- update method.
+instance (Show (l a), Typeable l, LayoutSelect l a) =>
+    LayoutClass (LayoutList l) a where
+
+  runLayout (W.Workspace i (LayoutList idx l) ms) r = do
+    r <- update idx l $ \layout ->
+            runLayout (W.Workspace i layout ms) r
+    case r of
+      Nothing -> return ([], Nothing)
+      Just (r, la) -> return (r, Just (LayoutList idx la))
+
+  handleMessage (LayoutList idx l) (fromMessage -> Just (NavigateLayout fn)) =
+    return $ Just (LayoutList (fn idx) l)
+
+  handleMessage (LayoutList idx l) m = do
+    r <- update idx l $ \layout -> ((),) <$> handleMessage layout m
+    return $ LayoutList idx . snd <$> r
+
+  description (LayoutList idx l) = runIdentity $ do
+    r <- update idx l $ \l -> return (description l, Nothing)
+    return $
+      case r of
+        Nothing -> "No Layout"
+        Just (descr, _) -> descr
-- 
cgit 


From c0e224d7fabcf0d274419a5f3ae79bc4fea637f2 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 12 Apr 2022 12:24:37 -0600
Subject: Move LayoutDraw -> Layout.Draw

---
 src/Rahm/Desktop/Layout/Draw.hs       | 161 ++++++++++++++++++++++++++++++++++
 src/Rahm/Desktop/Layout/LayoutDraw.hs | 161 ----------------------------------
 src/Rahm/Desktop/XMobarLog.hs         |   2 +-
 3 files changed, 162 insertions(+), 162 deletions(-)
 create mode 100644 src/Rahm/Desktop/Layout/Draw.hs
 delete mode 100644 src/Rahm/Desktop/Layout/LayoutDraw.hs

diff --git a/src/Rahm/Desktop/Layout/Draw.hs b/src/Rahm/Desktop/Layout/Draw.hs
new file mode 100644
index 0000000..e68bb17
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Draw.hs
@@ -0,0 +1,161 @@
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
+ScopedTypeVariables, BangPatterns #-}
+module Rahm.Desktop.Layout.Draw (drawLayout) where
+
+import Control.Monad
+
+import Control.Arrow (second)
+import Control.Concurrent (threadDelay)
+import Control.Exception (handle)
+import Control.Monad.Writer (execWriter, tell)
+import Data.Foldable (find)
+import Data.Maybe (fromMaybe)
+import Rahm.Desktop.Hash (quickHash)
+import Rahm.Desktop.Layout.Pop (setPop)
+import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.FilePath ((</>))
+import Text.Printf (printf)
+import XMonad.Layout.Spacing (SpacingModifier(..), Border(..))
+import XMonad.Layout.MosaicAlt (expandWindowAlt, shrinkWindowAlt)
+
+import XMonad (X,
+               Rectangle(..),
+               Dimension,
+               LayoutClass,
+               Message,
+               Window,
+               SomeMessage(..))
+
+import qualified XMonad as X
+import qualified XMonad.StackSet as S
+
+-- Draws and returns an XPM for the current layout.
+--
+-- Returns
+--  - Bool   - true if the xpm has already been written, and is thus cached.
+--  - String - description of the current layout
+--  - String - the text to send to XMobar
+--
+-- This function actually runs the current layout's doLayout function to
+-- generate the XPM, so it's completely portable to all layouts.
+--
+-- Note this function is impure and running the layout to create the XPM is also
+-- impure. While in-practice most layouts are pure, it should be kept in mind.
+drawLayout :: X (Bool, String, String)
+drawLayout = do
+    winset <- X.gets X.windowset
+    let layout = S.layout $ S.workspace $ S.current winset
+
+    -- Gotta reset the layout to a consistent state.
+    layout' <- foldM (flip ($)) layout $ [
+         handleMessage' $ ModifyWindowBorder $ const $ Border 0 0 0 0,
+         handleMessage' $ setPop $ const False
+      ]
+      -- Add some changes for the Mosaic layout to handle so it get's a
+      -- unique looking icon. (The default state is pretty boring).
+      ++ replicate 10 (handleMessage' (expandWindowAlt 1))
+      ++ replicate 5 (handleMessage' (expandWindowAlt 4))
+      ++ replicate 1 (handleMessage' (expandWindowAlt 3))
+
+    (cached, xpm) <- drawXpmIO layout'
+
+    return (cached , X.description layout, printf "<icon=%s/>" xpm)
+
+-- Returns true if a point is inside a rectangle (inclusive).
+pointInRect :: (Dimension, Dimension) -> Rectangle -> Bool
+pointInRect (x, y) (Rectangle x' y' w h) =
+  x <= (fi x' + fi w) && x >= fi x' && y <= (fi y' + fi h) && y >= fi y'
+  where
+    fi :: (Integral a, Num b) => a -> b
+    fi = fromIntegral
+
+-- Scale factory. Scaling the rectangles before writing the XPM helps to reduce
+-- noise from things like AvoidStruts, as there is unfortunately no way to force
+-- avoid struts to be off, one can only toggle it.
+sf :: (Integral a) => a
+sf = 1024
+
+handleMessage' ::
+    (LayoutClass layout a, Message m) => m -> layout a -> X (layout a)
+handleMessage' message layout  = do
+  fromMaybe layout <$> X.handleMessage layout (SomeMessage message)
+
+-- Creates the XPM for the given layout and returns the path to it.
+--
+-- This function does run doLayout on the given layout, and that should be
+-- accounted for.
+drawXpmIO :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
+drawXpmIO l = do
+  dir <- X.getXMonadDir
+
+  let shrinkAmt = 5 -- amount to shrink the windows by to make pretty gaps.
+
+  let (w, h) = (56, 24)
+  let descr = X.description l
+  let iconCacheDir = dir </> "icons" </> "cache"
+  let iconPath = iconCacheDir </> (quickHash descr ++ ".xpm")
+
+  let colors = [
+        "#cc9a9a", "#cc9999", "#cc8080", "#cc6666",
+        "#cc4c4c", "#cc3232", "#cc1818", "#cc0000" ]
+
+  (rects', _) <-
+    X.runLayout
+      (S.Workspace "0" l (S.differentiate [1 .. 5]))
+      (Rectangle 0 0 ((w + shrinkAmt) * sf) ((h + shrinkAmt) * sf))
+
+  let rects = flip map rects' $ \(_, Rectangle x y w h) ->
+                Rectangle (x `div` sf) (y `div` sf) (w `div` sf) (h `div` sf)
+
+  X.liftIO $ do
+    exists <- doesFileExist iconPath
+    createDirectoryIfMissing True iconCacheDir
+
+    unless exists $ do
+      let xpmText = drawXpm (w, h) (zip (cycle colors) rects) 4
+      writeFile iconPath xpmText
+
+    return (exists, iconPath)
+
+--
+-- Create's an XPM, purely. Returns a string with the XPM contents.
+-- Takes as arguments
+--
+--   - dimensions of the icon.
+--   - list of (color, rectangle) pairs.
+--   - The amount to shrink the windows by for those pretty gaps.
+--
+drawXpm ::
+    (Dimension, Dimension) -> [(String, Rectangle)] -> Dimension -> String
+drawXpm (w, h) rects' shrinkAmt = execWriter $ do
+    tell "/* XPM */\n"
+    tell "static char *out[] = {\n"
+    tell $ printf "\"%d %d %d 1 \",\n" w h (length rects + 1)
+
+    let zipRects = zip ['A' .. 'Z'] rects
+
+    forM_ zipRects $ \(char, (color, _)) -> do
+      tell $ printf "\"%c c %s\",\n" char color
+    tell "\"% c None\"a,\n"
+
+    forM_ [0 .. h - 1] $ \y -> do
+      tell "\""
+      forM_ [0 .. w - 1] $ \x ->
+        (case find (matches x y) zipRects of
+          Nothing -> tell "%"
+          Just (chr, _) -> tell [chr])
+      tell "\""
+      when (y /= h - 1 - shrinkAmt) (tell ",")
+      tell "\n"
+    tell "};\n"
+
+  where
+    matches x y (_, (_, r)) = pointInRect (x, y) r
+    rects = map (second (shrink shrinkAmt)) rects'
+    guard a b = if a <= shrinkAmt then 1 else b
+    shrink amt (Rectangle x y w h) =
+      Rectangle
+        x
+        y
+        (guard w $ w - fromIntegral amt)
+        (guard h $ h - fromIntegral amt)
diff --git a/src/Rahm/Desktop/Layout/LayoutDraw.hs b/src/Rahm/Desktop/Layout/LayoutDraw.hs
deleted file mode 100644
index 7e628fc..0000000
--- a/src/Rahm/Desktop/Layout/LayoutDraw.hs
+++ /dev/null
@@ -1,161 +0,0 @@
-{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
-ScopedTypeVariables, BangPatterns #-}
-module Rahm.Desktop.Layout.LayoutDraw (drawLayout) where
-
-import Control.Monad
-
-import Control.Arrow (second)
-import Control.Concurrent (threadDelay)
-import Control.Exception (handle)
-import Control.Monad.Writer (execWriter, tell)
-import Data.Foldable (find)
-import Data.Maybe (fromMaybe)
-import Rahm.Desktop.Hash (quickHash)
-import Rahm.Desktop.Layout.Pop (setPop)
-import System.Directory (createDirectoryIfMissing, doesFileExist)
-import System.FilePath ((</>))
-import Text.Printf (printf)
-import XMonad.Layout.Spacing (SpacingModifier(..), Border(..))
-import XMonad.Layout.MosaicAlt (expandWindowAlt, shrinkWindowAlt)
-
-import XMonad (X,
-               Rectangle(..),
-               Dimension,
-               LayoutClass,
-               Message,
-               Window,
-               SomeMessage(..))
-
-import qualified XMonad as X
-import qualified XMonad.StackSet as S
-
--- Draws and returns an XPM for the current layout.
---
--- Returns
---  - Bool   - true if the xpm has already been written, and is thus cached.
---  - String - description of the current layout
---  - String - the text to send to XMobar
---
--- This function actually runs the current layout's doLayout function to
--- generate the XPM, so it's completely portable to all layouts.
---
--- Note this function is impure and running the layout to create the XPM is also
--- impure. While in-practice most layouts are pure, it should be kept in mind.
-drawLayout :: X (Bool, String, String)
-drawLayout = do
-    winset <- X.gets X.windowset
-    let layout = S.layout $ S.workspace $ S.current winset
-
-    -- Gotta reset the layout to a consistent state.
-    layout' <- foldM (flip ($)) layout $ [
-         handleMessage' $ ModifyWindowBorder $ const $ Border 0 0 0 0,
-         handleMessage' $ setPop $ const False
-      ]
-      -- Add some changes for the Mosaic layout to handle so it get's a
-      -- unique looking icon. (The default state is pretty boring).
-      ++ replicate 10 (handleMessage' (expandWindowAlt 1))
-      ++ replicate 5 (handleMessage' (expandWindowAlt 4))
-      ++ replicate 1 (handleMessage' (expandWindowAlt 3))
-
-    (cached, xpm) <- drawXpmIO layout'
-
-    return (cached , X.description layout, printf "<icon=%s/>" xpm)
-
--- Returns true if a point is inside a rectangle (inclusive).
-pointInRect :: (Dimension, Dimension) -> Rectangle -> Bool
-pointInRect (x, y) (Rectangle x' y' w h) =
-  x <= (fi x' + fi w) && x >= fi x' && y <= (fi y' + fi h) && y >= fi y'
-  where
-    fi :: (Integral a, Num b) => a -> b
-    fi = fromIntegral
-
--- Scale factory. Scaling the rectangles before writing the XPM helps to reduce
--- noise from things like AvoidStruts, as there is unfortunately no way to force
--- avoid struts to be off, one can only toggle it.
-sf :: (Integral a) => a
-sf = 1024
-
-handleMessage' ::
-    (LayoutClass layout a, Message m) => m -> layout a -> X (layout a)
-handleMessage' message layout  = do
-  fromMaybe layout <$> X.handleMessage layout (SomeMessage message)
-
--- Creates the XPM for the given layout and returns the path to it.
---
--- This function does run doLayout on the given layout, and that should be
--- accounted for.
-drawXpmIO :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
-drawXpmIO l = do
-  dir <- X.getXMonadDir
-
-  let shrinkAmt = 5 -- amount to shrink the windows by to make pretty gaps.
-
-  let (w, h) = (56, 24)
-  let descr = X.description l
-  let iconCacheDir = dir </> "icons" </> "cache"
-  let iconPath = iconCacheDir </> (quickHash descr ++ ".xpm")
-
-  let colors = [
-        "#cc9a9a", "#cc9999", "#cc8080", "#cc6666",
-        "#cc4c4c", "#cc3232", "#cc1818", "#cc0000" ]
-
-  (rects', _) <-
-    X.runLayout
-      (S.Workspace "0" l (S.differentiate [1 .. 5]))
-      (Rectangle 0 0 ((w + shrinkAmt) * sf) ((h + shrinkAmt) * sf))
-
-  let rects = flip map rects' $ \(_, Rectangle x y w h) ->
-                Rectangle (x `div` sf) (y `div` sf) (w `div` sf) (h `div` sf)
-
-  X.liftIO $ do
-    exists <- doesFileExist iconPath
-    createDirectoryIfMissing True iconCacheDir
-
-    unless exists $ do
-      let xpmText = drawXpm (w, h) (zip (cycle colors) rects) 4
-      writeFile iconPath xpmText
-
-    return (exists, iconPath)
-
---
--- Create's an XPM, purely. Returns a string with the XPM contents.
--- Takes as arguments
---
---   - dimensions of the icon.
---   - list of (color, rectangle) pairs.
---   - The amount to shrink the windows by for those pretty gaps.
---
-drawXpm ::
-    (Dimension, Dimension) -> [(String, Rectangle)] -> Dimension -> String
-drawXpm (w, h) rects' shrinkAmt = execWriter $ do
-    tell "/* XPM */\n"
-    tell "static char *out[] = {\n"
-    tell $ printf "\"%d %d %d 1 \",\n" w h (length rects + 1)
-
-    let zipRects = zip ['A' .. 'Z'] rects
-
-    forM_ zipRects $ \(char, (color, _)) -> do
-      tell $ printf "\"%c c %s\",\n" char color
-    tell "\"% c None\"a,\n"
-
-    forM_ [0 .. h - 1] $ \y -> do
-      tell "\""
-      forM_ [0 .. w - 1] $ \x ->
-        (case find (matches x y) zipRects of
-          Nothing -> tell "%"
-          Just (chr, _) -> tell [chr])
-      tell "\""
-      when (y /= h - 1 - shrinkAmt) (tell ",")
-      tell "\n"
-    tell "};\n"
-
-  where
-    matches x y (_, (_, r)) = pointInRect (x, y) r
-    rects = map (second (shrink shrinkAmt)) rects'
-    guard a b = if a <= shrinkAmt then 1 else b
-    shrink amt (Rectangle x y w h) =
-      Rectangle
-        x
-        y
-        (guard w $ w - fromIntegral amt)
-        (guard h $ h - fromIntegral amt)
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index 4b266c1..82c05b7 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -6,7 +6,7 @@ import Control.Monad.Writer (tell, execWriter)
 import Data.List (sortBy)
 import Data.Maybe (mapMaybe)
 import Data.Ord (comparing)
-import Rahm.Desktop.Layout.LayoutDraw (drawLayout)
+import Rahm.Desktop.Layout.Draw (drawLayout)
 import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
 import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Run (spawnPipe)
-- 
cgit 


From e5bee7f2f095bffdef1c31e27f4b036780b01654 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 12 Apr 2022 13:07:17 -0600
Subject: Add type-static way to get the length of a LayoutList

---
 src/Rahm/Desktop/Keys.hs        |  9 +++++++--
 src/Rahm/Desktop/Layout.hs      | 17 ++++++++++++-----
 src/Rahm/Desktop/Layout/List.hs | 35 +++++++++++++++++++++++++++++------
 3 files changed, 48 insertions(+), 13 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 87f88cf..321d185 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -53,7 +53,8 @@ import Rahm.Desktop.PassMenu
 import Rahm.Desktop.Logger
 import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.Swallow
-import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout)
+import Rahm.Desktop.Layout.List (
+  toNextLayout, toPreviousLayout, toFirstLayout, toIndexedLayout)
 import Rahm.Desktop.Layout.Hole (toggleHole)
 import Rahm.Desktop.Layout.Pop (togglePop)
 import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
@@ -438,10 +439,14 @@ keymap = runKeys $ do
         (noMod -|- justMod) $ doc "Rotate the layout 90 degrees" $
           sendMessage rotateLayout
 
-      bind xK_t $
+      bind xK_c $
         (noMod -|- justMod) $ doc "Toggle the pop window" $
           sendMessage togglePop
 
+      bind xK_t $
+        (noMod -|- justMod) $ doc "Jump to the middle layout." $
+          sendMessage (toIndexedLayout (nLayouts `div` 2))
+
       bind xK_x $
         (noMod -|- justMod) $ doc "Toggle the hole" $
           sendMessage toggleHole
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index b416111..bd875d0 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -37,13 +37,17 @@ import Rahm.Desktop.Layout.Hole
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
-withSpacing = spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True
-mods =
-  withSpacing . poppable . flippable . rotateable . hole
-
 myLayout =
   fullscreenFull $
-    avoidStruts $
+    avoidStruts myLayoutList
+
+mySpacing = spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True
+
+
+mods =
+  mySpacing . poppable . flippable . rotateable . hole
+
+myLayoutList =
         layoutList $
           mods (reinterpretIncMaster $ spiral (6/7)) |:
           mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
@@ -55,6 +59,9 @@ myLayout =
           mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1) |:
           nil
 
+nLayouts :: Int
+nLayouts = layoutListLength myLayoutList
+
 -- Mosaic doesn't have the concept of a "Master Space", so reinterpret messages
 -- intended to modify the master space and instead have those messages expand
 -- and shrink the current window.
diff --git a/src/Rahm/Desktop/Layout/List.hs b/src/Rahm/Desktop/Layout/List.hs
index 96f9be5..f533ea2 100644
--- a/src/Rahm/Desktop/Layout/List.hs
+++ b/src/Rahm/Desktop/Layout/List.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableInstances, TypeOperators #-}
 
 {-
  - This module provides a more powerful version of the "Choose" layout that can
@@ -15,18 +15,22 @@ module Rahm.Desktop.Layout.List (
   toNextLayout,
   toPreviousLayout,
   toFirstLayout,
+  toIndexedLayout,
   (|:),
-  nil
+  nil,
+  layoutListLength,
+  layoutListLengthProxy
   )where
 
 import Control.Applicative ((<|>))
-import Data.Void
+import Control.Arrow (second, (>>>))
 import Control.Monad.Identity (runIdentity)
 import Data.Maybe (fromMaybe, fromJust)
-import Control.Arrow (second)
+import Data.Proxy
+import Data.Void
+import GHC.TypeLits
 import XMonad
 import qualified XMonad.StackSet as W
-import Data.Proxy
 
 -- Type-level lists. LNil is the final of the list. LCons contains a layout and a
 -- tail.
@@ -156,6 +160,20 @@ data LayoutList l a where
 deriving instance (LayoutSelect l a) => Show (LayoutList l a)
 deriving instance (LayoutSelect l a) => Read (LayoutList l a)
 
+-- Type family to get the LengthOf a ConsList.
+type family LengthOf (x :: * -> *) :: Nat where
+  LengthOf LNil = 0
+  LengthOf (LCons l t) = 1 + LengthOf t
+
+-- Length of a LayoutList. This is calculated at Compile-time using
+-- typefamilies and Nat TypeLits.
+layoutListLength :: forall l n a. (LengthOf l ~ n, KnownNat n) => LayoutList l a -> Int
+layoutListLength = fromIntegral . natVal . layoutListLengthProxy
+
+-- Proxy for the type-level Nat length of a LayoutList.
+layoutListLengthProxy :: (LengthOf l ~ n) => LayoutList l a -> Proxy n
+layoutListLengthProxy _ = Proxy
+
 -- Cons two LayoutSelect types together.
 (|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
 (|:) = LCons
@@ -189,10 +207,15 @@ toNextLayout = NavigateLayout $ addSelector (intToSelector 1)
 toPreviousLayout :: NavigateLayout
 toPreviousLayout = NavigateLayout $ \c -> fromMaybe c (decrement c <|> final)
 
--- NavigateLayotu instance to move to the first layout.
+-- NavigateLayout instance to move to the first layout.
 toFirstLayout :: NavigateLayout
 toFirstLayout = NavigateLayout (`fromMaybe` initial)
 
+-- NavigateLayout instance to go to an indexed layout.
+toIndexedLayout :: Int -> NavigateLayout
+toIndexedLayout i = NavigateLayout $
+  (`fromMaybe` initial) >>> addSelector (intToSelector i)
+
 instance Message NavigateLayout where
 
 -- LayoutSelect class Describes a type that can be used to select a layout using
-- 
cgit 


From f85c7160e122f367a357d93689947daa1ef241ef Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 12 Apr 2022 16:44:35 -0600
Subject: Fix repeatable key to do an action when first pressed.

---
 src/Rahm/Desktop/Keys.hs | 26 +++++++++++++++++++++-----
 1 file changed, 21 insertions(+), 5 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 321d185..622fd3a 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -115,17 +115,19 @@ button15 :: Button
 button15 = 15
 
 keyBindingToKeymap :: (XConfig l -> KeyBindings) -> KeyMap l
-keyBindingToKeymap bindings config = fmap bindingToX (bindings config)
+keyBindingToKeymap bindings config = Map.mapWithKey bindingToX (bindings config)
 
   where
-    bindingToX b =
+    bindingToX :: (KeyMask, KeySym) -> Documented KeyBinding -> X ()
+    bindingToX key b =
       case b of
         Documented _ (Action x) -> x
         Documented _ (Submap mapping) ->
-          submap (fmap bindingToX mapping)
-        Documented _ (Repeat mapping) ->
+          submap (Map.mapWithKey bindingToX mapping)
+        Documented _ (Repeat mapping) -> do
+          mapM_ (bindingToX key) (Map.lookup key mapping)
           fix $ \recur ->
-            submap (fmap (\b -> bindingToX b >> recur) mapping)
+            submap (Map.mapWithKey (\k b -> bindingToX k b >> recur) mapping)
 
 keymap :: XConfig l -> KeyBindings
 keymap = runKeys $ do
@@ -451,6 +453,20 @@ keymap = runKeys $ do
         (noMod -|- justMod) $ doc "Toggle the hole" $
           sendMessage toggleHole
 
+      let spaceResize = repeatable $ do
+            bind xK_bracketright $ do
+              noMod $
+                doc "Increase the gaps between windows." $
+                sendMessage $ modifyWindowBorder 5
+
+            bind xK_bracketleft $ do
+              noMod $
+                doc "Decrease the gaps between windows." $
+                sendMessage $ modifyWindowBorder (-5)
+
+      bind xK_bracketleft $ noMod spaceResize
+      bind xK_bracketright $ noMod spaceResize
+
   bind xK_t $ do
     justMod  $
       doc "Spawn a terminal." $ spawnX (terminal config)
-- 
cgit 


From 3abdbef6e5a7d8d614e5b8be5bd8ba2fbb81d01d Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 12 Apr 2022 17:37:01 -0600
Subject: Add a Polling-style timeout to mapNextString.

It's not the best thing in the world, but it should help keep things in
a consistent state when dealing with many multi-stroke bindings.
---
 src/Rahm/Desktop/Submap.hs | 53 +++++++++++++++++++++++++++++++++++-----------
 1 file changed, 41 insertions(+), 12 deletions(-)

diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index f3b9e23..5dc6fb0 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -11,9 +11,31 @@ import XMonad hiding (keys)
 import Control.Monad.Fix (fix)
 import qualified Data.Map as Map
 import Data.Map (Map)
+import Control.Concurrent (threadDelay)
+import Data.Word (Word64)
 
 import XMonad.Actions.Submap as X
 
+
+getMaskEventWithTimeout ::
+  Int -> Display -> Word64 -> (XEventPtr -> IO a) -> IO (Maybe a)
+
+getMaskEventWithTimeout timeout d mask fn =
+  allocaXEvent $ \ptr -> do
+    val <- getMaskEventWithTimeout' ptr timeout
+    if val
+      then Just <$> fn ptr
+      else return Nothing
+
+
+  where
+    getMaskEventWithTimeout' ptr t | t <= 0 = return False
+    getMaskEventWithTimeout' ptr timeout = do
+      b <- checkMaskEvent d mask ptr
+      if b
+        then return True
+        else threadDelay 10 >> getMaskEventWithTimeout' ptr (timeout - 10)
+
 {-
  - Like submap fram XMonad.Actions.Submap, but sends the string from
  - XLookupString to the function along side the keysym.
@@ -22,27 +44,34 @@ import XMonad.Actions.Submap as X
  - but also allows submappings for keys that may not have a character associated
  - with them (for example, the function keys).
  -}
-mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X a) -> X a
+mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X ()) -> X ()
 mapNextStringWithKeysym fn = do
   XConf { theRoot = root, display = d } <- ask
   io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
 
-  (m, str, keysym) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
-    maskEvent d keyPressMask p
-    KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
-    keysym <- keycodeToKeysym d code 0
-    (_, str) <- lookupString (asKeyEvent p)
+  ret <- io $ fix $ \nextkey -> do
+    ret <-
+      getMaskEventWithTimeout 150000 d keyPressMask $ \p -> do
+        KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
+        keysym <- keycodeToKeysym d code 0
+        (_, str) <- lookupString (asKeyEvent p)
+        return (m, str, keysym)
 
-    if isModifierKey keysym
-        then nextkey
-        else return (m, str, keysym)
+    case ret of
+      Just (m, str, keysym) ->
+        if isModifierKey keysym
+            then nextkey
+            else return ret
 
-  io $ ungrabKeyboard d currentTime
+      Nothing -> return Nothing
 
-  fn m keysym str
+  io $ ungrabKeyboard d currentTime
+  case ret of 
+    Just (m, str, keysym) -> fn m keysym str
+    Nothing -> return ()
 
 {- Like submap, but on the character typed rather than the kysym. -}
-mapNextString :: (KeyMask -> String -> X a) -> X a 
+mapNextString :: (KeyMask -> String -> X ()) -> X () 
 mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
 
 {- Grabs the mouse and returns the next button press. -}
-- 
cgit 


From 7d47e54beafbd0463e1dcf25c80511342cb6daaa Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 12 Apr 2022 18:47:38 -0600
Subject: Finally fix deprecation issue

---
 src/Rahm/Desktop/Layout/Draw.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Rahm/Desktop/Layout/Draw.hs b/src/Rahm/Desktop/Layout/Draw.hs
index e68bb17..8819e8f 100644
--- a/src/Rahm/Desktop/Layout/Draw.hs
+++ b/src/Rahm/Desktop/Layout/Draw.hs
@@ -86,7 +86,7 @@ handleMessage' message layout  = do
 -- accounted for.
 drawXpmIO :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
 drawXpmIO l = do
-  dir <- X.getXMonadDir
+  dir <- X.asks (X.cfgDir . X.directories)
 
   let shrinkAmt = 5 -- amount to shrink the windows by to make pretty gaps.
 
-- 
cgit 


From cbe073ecee5a5a0230f2223bd90c2fdacce06892 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 12 Apr 2022 19:10:27 -0600
Subject: Replace submap and friends with my own versions that do the timeout.

---
 src/Rahm/Desktop/Submap.hs | 16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index 5dc6fb0..2306ee6 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -5,7 +5,9 @@ module Rahm.Desktop.Submap (
     nextButton,
     nextMotion,
     nextMotionOrButton,
-    module X) where
+    submap,
+    submapDefault,
+    submapDefaultWithKey) where
 
 import XMonad hiding (keys)
 import Control.Monad.Fix (fix)
@@ -14,8 +16,6 @@ import Data.Map (Map)
 import Control.Concurrent (threadDelay)
 import Data.Word (Word64)
 
-import XMonad.Actions.Submap as X
-
 
 getMaskEventWithTimeout ::
   Int -> Display -> Word64 -> (XEventPtr -> IO a) -> IO (Maybe a)
@@ -74,6 +74,16 @@ mapNextStringWithKeysym fn = do
 mapNextString :: (KeyMask -> String -> X ()) -> X () 
 mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
 
+submapDefaultWithKey :: ((KeyMask, KeySym) -> X ()) -> Map (KeyMask, KeySym) (X ()) -> X ()
+submapDefaultWithKey def m = mapNextStringWithKeysym $ \mask sym _ -> do
+  Map.findWithDefault (def (mask, sym)) (mask, sym) m
+
+submapDefault :: X () -> Map (KeyMask, KeySym) (X ()) -> X ()
+submapDefault def = submapDefaultWithKey (const def)
+
+submap :: Map (KeyMask, KeySym) (X ()) -> X ()
+submap = submapDefault (return ())
+
 {- Grabs the mouse and returns the next button press. -}
 nextButton :: X (ButtonMask, Button)
 nextButton = do
-- 
cgit 


From 6cee136399b92f302a9b660c140167b69b251e51 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Wed, 13 Apr 2022 00:22:08 -0600
Subject: Add ConsistentMosaic, a wrapper to make Mosaic more consistent.

Right now, Mosaic operate on the windows itself. But this means that
swapping windows can act very unintuitively. This wrapper changes
mosaci to work on window /positions/ rather than windows themselves,
so the window in position 1 will always be the same size, and when moved
to position 2, it will inherit that position's size.

There's still some buggy behavior, but it is in general much more
intuitive than it was before.
---
 package.yaml                                |  1 +
 src/Rahm/Desktop/Keys.hs                    |  5 ++-
 src/Rahm/Desktop/Layout.hs                  | 17 +++----
 src/Rahm/Desktop/Layout/ConsistentMosaic.hs | 69 +++++++++++++++++++++++++++++
 src/Rahm/Desktop/Layout/Draw.hs             |  2 +-
 5 files changed, 83 insertions(+), 11 deletions(-)
 create mode 100644 src/Rahm/Desktop/Layout/ConsistentMosaic.hs

diff --git a/package.yaml b/package.yaml
index 7e7244c..f4f5603 100644
--- a/package.yaml
+++ b/package.yaml
@@ -40,3 +40,4 @@ dependencies:
   - monad-loops
   - data-default
   - linear
+  - bimap
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 622fd3a..f7aae3c 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -60,6 +60,7 @@ import Rahm.Desktop.Layout.Pop (togglePop)
 import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.Layout.Rotate (rotateLayout)
 import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
+import Rahm.Desktop.Layout.ConsistentMosaic
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
@@ -362,7 +363,7 @@ keymap = runKeys $ do
 
     shiftMod $
       doc "For mosaic layout, shrink the size-share of the current window" $
-      withFocused $ sendMessage . shrinkWindowAlt
+      sendMessage =<< shrinkPositionAlt
 
   bind xK_m $ do
     justMod $
@@ -389,7 +390,7 @@ keymap = runKeys $ do
 
     shiftMod $
       doc "For mosaic layout, increase the size-share of the current window." $
-      withFocused $ sendMessage . expandWindowAlt
+      sendMessage =<< expandPositionAlt
 
   bind xK_q $ do
     shiftMod $
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index bd875d0..d8c3442 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -33,6 +33,7 @@ import Rahm.Desktop.Layout.Flip
 import Rahm.Desktop.Layout.Rotate
 import Rahm.Desktop.Layout.Redescribe
 import Rahm.Desktop.Layout.Hole
+import Rahm.Desktop.Layout.ConsistentMosaic
 
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
@@ -50,7 +51,7 @@ mods =
 myLayoutList =
         layoutList $
           mods (reinterpretIncMaster $ spiral (6/7)) |:
-          mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
+          mods (MosaicWrap $ modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
           mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
           mods (Redescribe UsingTall (Tall 1 (3/100) (1/2))) |:
           mods (Redescribe UsingThreeCol (ThreeCol 1 (3/100) (1/2))) |:
@@ -72,17 +73,17 @@ instance DoReinterpret "ForMosaic" where
   
   -- IncMaster message
   reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
-    fmap (SomeMessage .
-      (if n > 0
-        then expandWindowAlt
-        else shrinkWindowAlt)) <$> getFocusedWindow
+    Just . SomeMessage <$> (
+      if n > 0
+        then expandPositionAlt
+        else shrinkPositionAlt)
   
   -- ResizeMaster message
   reinterpretMessage _ (fromMessage -> Just m) = do
-    fmap (SomeMessage .
+    Just . SomeMessage <$>
       (case m of
-        Expand -> expandWindowAlt
-        Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
+        Expand -> expandPositionAlt
+        Shrink -> shrinkPositionAlt)
 
   -- Messages that don't match the above, just leave it unmodified.
   reinterpretMessage _ m = return (Just m)
diff --git a/src/Rahm/Desktop/Layout/ConsistentMosaic.hs b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
new file mode 100644
index 0000000..db1ce4e
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
@@ -0,0 +1,69 @@
+
+-- This module provides a wrapper around the Mosaic layout to create a more
+-- consistent experience where instead of the windows being the ones it works
+-- on, it instead works on the window places so things like window swapping
+-- still work as expected.
+module Rahm.Desktop.Layout.ConsistentMosaic where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Data.Maybe (mapMaybe)
+
+import XMonad.Layout.MosaicAlt
+
+import Rahm.Desktop.Windows
+import Rahm.Desktop.Logger
+
+
+newtype MosaicWrap l a = MosaicWrap (l a) deriving (Read, Show)
+
+doAlt :: (Window -> HandleWindowAlt) -> X HandleWindowAlt
+doAlt f = do
+  (W.StackSet (W.Screen (W.Workspace _ _ mStack) _ _) _ _ _)
+    <- windowset <$> get
+
+  return $
+    case mStack of
+      Nothing -> f 0
+      Just (W.Stack _ u _) -> f (fromIntegral $ length u + 100)
+
+expandPositionAlt :: X HandleWindowAlt
+expandPositionAlt = doAlt expandWindowAlt
+
+shrinkPositionAlt :: X HandleWindowAlt
+shrinkPositionAlt = doAlt shrinkWindowAlt
+
+
+instance (LayoutClass l a, Show a, Ord a, Enum a, Num a) => LayoutClass (MosaicWrap l) a where
+  
+  runLayout (W.Workspace t (MosaicWrap l) (id -> Just s)) rect = do
+    let zs = zipStack [100..] s
+        s' = mapStack fst zs
+        m = Map.fromList (W.integrate zs)
+
+    (rects, maybeNewLayout) <- runLayout (W.Workspace t l (Just s')) rect
+    let rects' =
+          flip mapMaybe rects $ \(place, rect) ->
+            (,rect) <$> Map.lookup place m
+
+    return (rects', MosaicWrap <$> maybeNewLayout)
+
+    where
+      zipStack as (W.Stack b c d) =
+        let (cz, bz : dz) = splitAt (length c) as in
+          W.Stack (bz, b) (zip (reverse cz) c) (zip dz d)
+
+
+  runLayout (W.Workspace t (MosaicWrap l) a) rect = do
+    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
+    return (rects, MosaicWrap <$> maybeNewLayout)
+    
+
+  -- By default just pass the message to the underlying layout.
+  handleMessage (MosaicWrap l) mess = do
+    maybeNewLayout <- handleMessage l mess
+    return (MosaicWrap <$> maybeNewLayout)
+
+  description _ = "ConsistentMosaic"
diff --git a/src/Rahm/Desktop/Layout/Draw.hs b/src/Rahm/Desktop/Layout/Draw.hs
index 8819e8f..aa4dba3 100644
--- a/src/Rahm/Desktop/Layout/Draw.hs
+++ b/src/Rahm/Desktop/Layout/Draw.hs
@@ -136,7 +136,7 @@ drawXpm (w, h) rects' shrinkAmt = execWriter $ do
 
     forM_ zipRects $ \(char, (color, _)) -> do
       tell $ printf "\"%c c %s\",\n" char color
-    tell "\"% c None\"a,\n"
+    tell "\"% c None\",\n"
 
     forM_ [0 .. h - 1] $ \y -> do
       tell "\""
-- 
cgit 


From 0dfe872da02d5d63eb2b334decd3a8292aff3ca3 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 13 Apr 2022 11:17:12 -0600
Subject: Consistent timeouts using the clock rather than counting threadDelay.
 Add timeout to nextButton

---
 package.yaml               |  2 +-
 src/Rahm/Desktop/KeysM.hs  |  2 +-
 src/Rahm/Desktop/Submap.hs | 43 ++++++++++++++++++++++++++-----------------
 3 files changed, 28 insertions(+), 19 deletions(-)

diff --git a/package.yaml b/package.yaml
index f4f5603..056b5b0 100644
--- a/package.yaml
+++ b/package.yaml
@@ -40,4 +40,4 @@ dependencies:
   - monad-loops
   - data-default
   - linear
-  - bimap
+  - time
diff --git a/src/Rahm/Desktop/KeysM.hs b/src/Rahm/Desktop/KeysM.hs
index dcbce2a..403b3fc 100644
--- a/src/Rahm/Desktop/KeysM.hs
+++ b/src/Rahm/Desktop/KeysM.hs
@@ -470,7 +470,7 @@ documentation = execWriter . document' ""
         group (\(_, Documented doc _) -> doc) (sortOn (snd . fst) $ Map.toList b)
 
     prettyShow :: (KeyMask, KeySym) -> String
-    prettyShow (mask, key) = printf "<%s%s>" (showMask mask) (keysymToString key)
+    prettyShow (mask, key) = printf "%s%s" (showMask mask) (keysymToString key)
 
     hasSubmap b = case b of
       Action _ -> False
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index 2306ee6..da9fe77 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -15,26 +15,36 @@ import qualified Data.Map as Map
 import Data.Map (Map)
 import Control.Concurrent (threadDelay)
 import Data.Word (Word64)
+import Data.Time.Clock.POSIX
+
+
+currentTimeMillis :: IO Int
+currentTimeMillis = round . (*1000) <$> getPOSIXTime
 
 
 getMaskEventWithTimeout ::
   Int -> Display -> Word64 -> (XEventPtr -> IO a) -> IO (Maybe a)
 
-getMaskEventWithTimeout timeout d mask fn =
+getMaskEventWithTimeout timeout d mask fn = do
+  curTime <- currentTimeMillis
   allocaXEvent $ \ptr -> do
-    val <- getMaskEventWithTimeout' ptr timeout
+    val <- getMaskEventWithTimeout' ptr (curTime + timeout)
     if val
       then Just <$> fn ptr
       else return Nothing
 
 
   where
-    getMaskEventWithTimeout' ptr t | t <= 0 = return False
     getMaskEventWithTimeout' ptr timeout = do
-      b <- checkMaskEvent d mask ptr
-      if b
-        then return True
-        else threadDelay 10 >> getMaskEventWithTimeout' ptr (timeout - 10)
+      curTime <- currentTimeMillis
+
+      if curTime >= timeout
+        then return False
+        else do
+          b <- checkMaskEvent d mask ptr
+          if b
+            then return True
+            else threadDelay 1000 >> getMaskEventWithTimeout' ptr timeout
 
 {-
  - Like submap fram XMonad.Actions.Submap, but sends the string from
@@ -51,7 +61,7 @@ mapNextStringWithKeysym fn = do
 
   ret <- io $ fix $ \nextkey -> do
     ret <-
-      getMaskEventWithTimeout 150000 d keyPressMask $ \p -> do
+      getMaskEventWithTimeout 1000 d keyPressMask $ \p -> do
         KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
         keysym <- keycodeToKeysym d code 0
         (_, str) <- lookupString (asKeyEvent p)
@@ -84,14 +94,14 @@ submapDefault def = submapDefaultWithKey (const def)
 submap :: Map (KeyMask, KeySym) (X ()) -> X ()
 submap = submapDefault (return ())
 
-{- Grabs the mouse and returns the next button press. -}
-nextButton :: X (ButtonMask, Button)
+-- Returns the next button press, or Nothing if the timeout expires before the
+-- next button is pressed.
+nextButton :: X (Maybe (ButtonMask, Button))
 nextButton = do
   XConf { theRoot = root, display = d } <- ask
   io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime
 
-  ret <- io $ allocaXEvent $ \xEv -> do
-    maskEvent d buttonPressMask xEv
+  ret <- io $ getMaskEventWithTimeout 1000 d buttonPressMask $ \xEv -> do
     ButtonEvent { ev_button = button, ev_state = m } <- getEvent xEv
     return (m, button)
 
@@ -136,8 +146,7 @@ nextMotionOrButton = do
 submapButtonsWithKey ::
     ((ButtonMask, Button) -> Window -> X ()) -> Map (ButtonMask, Button) (Window -> X ()) -> Window -> X ()
 submapButtonsWithKey defaultAction actions window = do
-  arg <- nextButton
-
-  case Map.lookup arg actions of
-    Nothing -> defaultAction arg window
-    Just fn -> fn window
+  maybe (return ()) (\arg ->
+    case Map.lookup arg actions of
+      Nothing -> defaultAction arg window
+      Just fn -> fn window) =<< nextButton
-- 
cgit 


From c92cd07aaf7c54cd528166fc46dbade8008f5392 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 13 Apr 2022 18:29:27 -0600
Subject: [WIP] Working on better workspaces

---
 src/Rahm/Desktop/Keys.hs       |  95 +++++++++++++++-------------
 src/Rahm/Desktop/Lib.hs        | 108 ++------------------------------
 src/Rahm/Desktop/Marking.hs    |   8 ++-
 src/Rahm/Desktop/Workspaces.hs | 136 +++++++++++++++++++++++++++++++++++++++++
 src/Rahm/Desktop/XMobarLog.hs  |   2 +-
 5 files changed, 201 insertions(+), 148 deletions(-)
 create mode 100644 src/Rahm/Desktop/Workspaces.hs

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index f7aae3c..2f30763 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -61,6 +61,7 @@ import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.Layout.Rotate (rotateLayout)
 import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
 import Rahm.Desktop.Layout.ConsistentMosaic
+import Rahm.Desktop.Workspaces
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
@@ -264,6 +265,19 @@ keymap = runKeys $ do
       sendMessage flipHorizontally
 
   bind xK_g $ do
+    let selectWorkspace :: (KeySym, String) -> Maybe (X WorkspaceId)
+        selectWorkspace s = case s of
+          (_, [ch]) | isAlphaNum ch -> Just $ return [ch]
+          (_, "]") -> Just $ adjacentWorkspace next =<< getCurrentWorkspace
+          (_, "[") -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace
+          (_, "}") -> Just $ adjacentScreen next
+          (_, "{") -> Just $ adjacentScreen prev
+          (_, "/") -> Just $ runMaybeT $ do
+            windowId <- askWindowId
+            workspaceWithWindow askWindowId
+          (_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace
+          _ -> Nothing
+    
     justMod $
       doc "Goto a workspace\n\n\t\
 
@@ -279,35 +293,45 @@ keymap = runKeys $ do
          \<space>: Jump to the accompaning workspace.\n\t\t\
          \F1: display this help.\n" $
       mapNextStringWithKeysym $ \_ keysym str ->
-        case (keysym, str) of
-          (_, [ch]) | isAlphaNum ch -> gotoWorkspace ch
-          (_, "]") -> pushHistory $ withRelativeWorkspace next W.greedyView
-          (_, "[") -> pushHistory $ withRelativeWorkspace prev W.greedyView
-          (_, "}") -> windows screenRotateForward
-          (_, "{") -> windows screenRotateBackward
-          (_, " ") -> gotoAccompaningWorkspace
-
+        case ((keysym, str), selectWorkspace (keysym, str)) of
+          (_, Just w) -> pushHistory $ gotoWorkspace =<< w
           -- Test binding. Tests that I can still submap keysyms alone (keys
           -- where XLookupString won't return anything helpful.)
-          (f, _) | f == xK_F1 -> 
+          ((f, _), _) | f == xK_F1 -> 
             (safeSpawn "gxmessage" [
               "-fn", "Source Code Pro",
               documentation (keymap config)] :: X ())
-
           _ -> return ()
+
     shiftMod $
       doc "Move the currently focused window to another workspace" $
-      mapNextString $ \_ str ->
-        case str of
-          [ch] | isAlphaNum ch -> shiftToWorkspace ch
-          "]" -> withRelativeWorkspace next W.shift
-          "[" -> withRelativeWorkspace prev W.shift
+      mapNextStringWithKeysym $ \_ keysym str ->
+        case ((keysym, str), selectWorkspace (keysym, str)) of
+          (_, Just w) -> shiftToWorkspace =<< w
+          _ -> return ()
+
+    controlMod $
+      doc "Move the current focused window to another workspace and view that workspace" $
+      mapNextStringWithKeysym $ \_ keysym str ->
+        case ((keysym, str), selectWorkspace (keysym, str)) of
+          (_, Just w) -> pushHistory $ do
+            ws <- w
+            shiftToWorkspace ws
+            gotoWorkspace ws
+          _ -> return ()
+
+    altMod $
+      doc "Copy a window to the given workspace" $
+      mapNextStringWithKeysym $ \_ keysym str ->
+        case ((keysym, str), selectWorkspace (keysym, str)) of
+          (_, Just ws) -> windows . CopyWindow.copy =<< ws
           _ -> return ()
+
     shiftAltMod $
       doc "Swap this workspace with another workspace (rename)." $
-      mapNextString $ \_ str ->
-        case str of
-          [ch] | isAlphaNum ch -> swapWorkspace ch
+      mapNextStringWithKeysym $ \_ keysym str ->
+        case ((keysym, str), selectWorkspace (keysym, str)) of
+          (_, Just ws) -> swapWorkspace =<< ws
           _ -> return ()
 
   bind xK_h $ do
@@ -373,16 +397,6 @@ keymap = runKeys $ do
           [ch] | isAlphaNum ch -> markCurrentWindow ch
           _ -> return ()
 
-  bind xK_n $ do
-    justMod $
-      doc "Shift to the next workspace." $
-      withRelativeWorkspace next W.greedyView
-
-  bind xK_p $ do
-    justMod $
-      doc "Shift to the previous workspace." $
-      withRelativeWorkspace prev W.greedyView
-
   bind xK_plus $ do
     justMod $
       doc "Increase the number of windows in the master region." $
@@ -511,14 +525,6 @@ keymap = runKeys $ do
       doc "Less often used keybindings." $
       subkeys $ do
 
-        bind xK_g $ do
-          (justMod -|- noMod) $
-            doc "Copy a window to the given workspace" $
-            mapNextString $ \_ s ->
-              case s of
-                [ch] | isAlphaNum ch -> windows (CopyWindow.copy s)
-                _ -> return ()
-
         bind xK_p $ do
           (justMod -|- noMod) $
             doc "Go to the prior window in the history" historyPrev
@@ -660,10 +666,12 @@ mouseMap = runButtons $ do
     justMod $ \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster
 
   bind button6 $
-    justMod $ noWindow (withRelativeWorkspace prev W.greedyView)
+    justMod $
+      noWindow (viewAdjacent prev)
 
   bind button7 $
-    justMod $ noWindow (withRelativeWorkspace next W.greedyView)
+    justMod $
+      noWindow (viewAdjacent next)
 
   bind button8 $
     justMod $ noWindow mediaPrev
@@ -675,7 +683,7 @@ mouseMap = runButtons $ do
     noMod $ subMouse $ do
 
       bind button3 $
-        noMod $ noWindow (gotoWorkspace 's')
+        noMod $ noWindow (gotoWorkspace "s")
 
       bind button13 $ do
         noMod $ noWindow $ click >> CopyWindow.kill1
@@ -714,7 +722,10 @@ mouseMap = runButtons $ do
   bind button15 $ do
 
     noMod $ subMouse $ do
-      bind button13 $ noMod $ noWindow gotoAccompaningWorkspace
+      bind button13 $
+        noMod $
+          noWindow $
+            gotoWorkspace =<< (accompaningWorkspace <$> getCurrentWorkspace)
 
       bind button15 $ do
         noMod $ noWindow jumpToLast
@@ -723,8 +734,8 @@ mouseMap = runButtons $ do
       let workspaceButtons = [
             (button2, swapMaster),
 
-            (button9, withRelativeWorkspace next W.greedyView),
-            (button8, withRelativeWorkspace prev W.greedyView),
+            (button9, viewAdjacent next),
+            (button8, viewAdjacent prev),
 
             (button4, windows W.focusUp),
             (button5, windows W.focusDown),
diff --git a/src/Rahm/Desktop/Lib.hs b/src/Rahm/Desktop/Lib.hs
index 2f90d0a..3b4ee9c 100644
--- a/src/Rahm/Desktop/Lib.hs
+++ b/src/Rahm/Desktop/Lib.hs
@@ -25,86 +25,12 @@ import Data.Ord (comparing)
 import qualified XMonad.StackSet as S
 import Rahm.Desktop.Windows
 
-type WorkspaceName = Char
-newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a)
-
 data WinPrompt = WinPrompt
 
 instance XPrompt WinPrompt where
     showXPrompt _ = "[Window] "
     commandToComplete _ = id
 
-data WorkspaceState = Current | Hidden | Visible
-  deriving (Ord, Eq, Enum)
-
--- Returns all the workspaces that are either visible, current or Hidden but
--- have windows and that workspace's state.
---
--- In other words, filters out workspaces that have no windows and are not
--- visible.
---
--- This function will sort the result by the workspace tag.
-getPopulatedWorkspaces ::
-  (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, S.Workspace i l a)]
-getPopulatedWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
-  sortOn (tag . snd) $
-    mapMaybe (\w@(S.Workspace _ _ s) -> fmap (const (Hidden, w)) s) hi ++
-      map (\(S.Screen w _ _) -> (Visible, w)) vis ++
-        [(Current, cur)]
-
-getHorizontallyOrderedScreens ::
-  StackSet wid l a ScreenId ScreenDetail ->
-    [Screen wid l a ScreenId ScreenDetail]
--- ^ Returns a list of screens ordered from leftmost to rightmost.
-getHorizontallyOrderedScreens windowSet =
-    flip sortBy screens $ \sc1 sc2 ->
-      let (SD (Rectangle x1 _ _ _)) = screenDetail sc1
-          (SD (Rectangle x2 _ _ _)) = screenDetail sc2
-          in x1 `compare` x2
-    where
-      screens = current windowSet : visible windowSet
-
-getCurrentWorkspace :: X WorkspaceName
-getCurrentWorkspace = withWindowSet $
-  \(StackSet (Screen (Workspace t _ _) _ _) _ _ _) -> do
-    return (head t)
-
-gotoAccompaningWorkspace :: X ()
-gotoAccompaningWorkspace = do
-  cur <- getCurrentWorkspace
-  if isUpper cur
-    then gotoWorkspace (toLower cur)
-    else gotoWorkspace (toUpper cur)
-
-gotoWorkspace :: WorkspaceName -> X ()
-gotoWorkspace ch = pushHistory $ do
-  addHiddenWorkspace [ch]
-  windows $ greedyView $ return ch
-
-shiftToWorkspace :: WorkspaceName -> X ()
-shiftToWorkspace ch = do
-  addHiddenWorkspace [ch]
-  (windows . shift . return) ch
-
-swapWorkspace :: WorkspaceName -> X ()
-swapWorkspace toWorkspaceName = do
-  addHiddenWorkspace [toWorkspaceName]
-  windows $ \ss -> do
-    let fromWorkspace = tag $ workspace $ current ss
-        toWorkspace = [toWorkspaceName] in
-      StackSet (swapSc fromWorkspace toWorkspace $ current ss)
-                (map (swapSc fromWorkspace toWorkspace) $ visible ss)
-                (map (swapWs fromWorkspace toWorkspace) $ hidden ss)
-                (floating ss)
-  where
-    swapSc fromWorkspace toWorkspace (Screen ws a b) =
-        Screen (swapWs fromWorkspace toWorkspace ws) a b
-
-    swapWs fromWorkspace toWorkspace ws@(Workspace t' l s)
-        | t' == fromWorkspace = Workspace toWorkspace l s
-        | t' == toWorkspace = Workspace fromWorkspace l s
-        | otherwise = ws
-
 fuzzyCompletion :: String -> String -> Bool
 fuzzyCompletion str0 str1 =
   all (`isInfixOf`l0) ws
@@ -121,38 +47,16 @@ getString = runQuery $ do
       then t
       else printf "%s - %s" t a
 
-withRelativeWorkspace :: Selector -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
-withRelativeWorkspace (Selector selector) fn =
-  windows $ \ss ->
-    let tags = sort (tag . snd  <$> filter (\x -> fst x /= Visible ) (getPopulatedWorkspaces ss))
-        from = tag $ workspace $ current ss
-        to = selector from tags
-    in fn to ss
-
-next :: Selector
-next = Selector $ \a l -> select a l l
-  where select n (x:y:xs) _ | n == x = y
-        select n [x] (y:_) | n == x = y
-        select n (x:xs) orig = select n xs orig
-        select n _ _ = n
-
-prev :: Selector
-prev = Selector $ \a l ->
-  let (Selector fn) = next in fn a (reverse l)
+askWindowId :: X (Maybe Window)
+askWindowId = pushHistory $ do
+  windowTitlesToWinId <- withWindowSet $ \ss ->
+    Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
 
-withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
-withScreen fn n = do
-  windows $ \windowSet ->
-    case getHorizontallyOrderedScreens windowSet !! n of
-      Nothing -> windowSet
-      Just screen -> fn (tag $ workspace screen) windowSet
+  runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
 
 windowJump :: X ()
 windowJump = pushHistory $ do
-  windowTitlesToWinId <- withWindowSet $ \ss ->
-    Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
-
-  windowId <- runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
+  windowId <- askWindowId
 
   case windowId of
     Nothing -> return ()
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 8ca50fd..1144ad7 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -94,7 +94,7 @@ instance ExtensionClass MarkState where
 changeHistory :: (History Spot -> History Spot) -> (MarkState -> MarkState)
 changeHistory fn ms = ms { windowHistory = fn (windowHistory ms)}
 
-withMaybeFocused :: (Maybe Window -> X ()) -> X ()
+withMaybeFocused :: (Maybe Window -> X a) -> X a
 withMaybeFocused f = withWindowSet $ f . peek
 
 normalizeWindows :: X ()
@@ -118,7 +118,7 @@ markCurrentWindow mark = do
           markStateMap = Map.insert mark win ms
         }
 
-pushHistory :: X () -> X ()
+pushHistory :: X a -> X a
 pushHistory fn = do
   withMaybeFocused $ \maybeWindowBefore -> do
     case maybeWindowBefore of
@@ -128,7 +128,7 @@ pushHistory fn = do
         withWindowSet $ \ws ->
           XS.modify $ changeHistory (historyPush (TagSpot (currentTag ws)))
 
-    fn
+    ret <- fn
 
     withMaybeFocused $ \maybeWindowAfter ->
       case maybeWindowAfter of
@@ -138,6 +138,8 @@ pushHistory fn = do
           withWindowSet $ \ws ->
             XS.modify $ changeHistory (historyPush $ TagSpot $ currentTag ws)
 
+    return ret
+
 withHistory :: (History Spot -> X ()) -> X ()
 withHistory fn = do
   MarkState { windowHistory = w } <- XS.get
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
new file mode 100644
index 0000000..87d112e
--- /dev/null
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -0,0 +1,136 @@
+
+-- Common ways to select workspaces
+module Rahm.Desktop.Workspaces where
+
+import Prelude hiding ((!!))
+
+import Control.Arrow (second, (&&&))
+import qualified XMonad.StackSet as W
+import XMonad
+
+import Data.List.Safe ((!!))
+
+import XMonad.Actions.DynamicWorkspaces
+import Data.List (sortOn, sort, sortBy, find)
+import Data.Maybe (mapMaybe, fromMaybe)
+import Data.Char (isUpper, toUpper, toLower)
+
+newtype Selector = Selector (forall a. (a -> Bool) -> [a] -> Maybe a)
+
+data WorkspaceState = Current | Hidden | Visible
+  deriving (Ord, Eq, Enum)
+
+-- Returns all the workspaces that are either visible, current or Hidden but
+-- have windows and that workspace's state.
+--
+-- In other words, filters out workspaces that have no windows and are not
+-- visible.
+--
+-- This function will sort the result by the workspace tag.
+getPopulatedWorkspaces ::
+  (Ord i) => W.StackSet i l a sid sd -> [(WorkspaceState, W.Workspace i l a)]
+getPopulatedWorkspaces (W.StackSet (W.Screen cur _ _) vis hi _) =
+  sortOn (W.tag . snd) $
+    mapMaybe (\w@(W.Workspace _ _ s) -> fmap (const (Hidden, w)) s) hi ++
+      map (\(W.Screen w _ _) -> (Visible, w)) vis ++
+        [(Current, cur)]
+
+next :: Selector
+next = Selector $ \f l -> select f l l
+  where select f (x:y:xs) _ | f x = Just y
+        select f [x] (y:_) | f x = Just y
+        select f (x:xs) orig = select f xs orig
+        select f _ _ = Nothing
+
+prev :: Selector
+prev = Selector $ \f l ->
+  let (Selector fn) = next in fn f (reverse l)
+
+getCurrentWorkspace :: X WorkspaceId
+getCurrentWorkspace = withWindowSet $
+  \(W.StackSet (W.Screen (W.Workspace t _ _) _ _) _ _ _) -> do
+    return t
+
+getHorizontallyOrderedScreens ::
+  W.StackSet wid l a ScreenId ScreenDetail ->
+    [(Bool, W.Screen wid l a ScreenId ScreenDetail)]
+-- ^ Returns a list of screens ordered from leftmost to rightmost.
+getHorizontallyOrderedScreens windowSet =
+    flip sortBy screens $ \sc1 sc2 ->
+      let (SD (Rectangle x1 _ _ _)) = W.screenDetail (snd sc1)
+          (SD (Rectangle x2 _ _ _)) = W.screenDetail (snd sc2)
+          in x1 `compare` x2
+    where
+      screens = (True, W.current windowSet) : map (False,) (W.visible windowSet)
+
+gotoWorkspace :: WorkspaceId -> X ()
+gotoWorkspace wid = do
+  addHiddenWorkspace wid
+  windows $ W.greedyView wid
+
+shiftToWorkspace :: WorkspaceId -> X ()
+shiftToWorkspace t = do
+  addHiddenWorkspace t
+  windows . W.shift $ t
+
+
+accompaningWorkspace :: WorkspaceId -> WorkspaceId
+accompaningWorkspace [s] = return $
+    if isUpper s
+      then toLower s
+      else toUpper s
+accompaningWorkspace s = s
+
+swapWorkspace :: WorkspaceId -> X ()
+swapWorkspace toWorkspace = do
+  addHiddenWorkspace toWorkspace
+  windows $ \ss -> do
+    let fromWorkspace = W.tag $ W.workspace $ W.current ss in
+      W.StackSet (swapSc fromWorkspace toWorkspace $ W.current ss)
+                (map (swapSc fromWorkspace toWorkspace) $ W.visible ss)
+                (map (swapWs fromWorkspace toWorkspace) $ W.hidden ss)
+                (W.floating ss)
+  where
+    swapSc fromWorkspace toWorkspace (W.Screen ws a b) =
+        W.Screen (swapWs fromWorkspace toWorkspace ws) a b
+
+    swapWs fromWorkspace toWorkspace ws@(W.Workspace t' l s)
+        | t' == fromWorkspace = W.Workspace toWorkspace l s
+        | t' == toWorkspace = W.Workspace fromWorkspace l s
+        | otherwise = ws
+
+adjacentWorkspace :: Selector -> WorkspaceId -> X WorkspaceId
+adjacentWorkspace (Selector selector) from = 
+  withWindowSet $ \ss ->
+    let tags = sort $
+                 W.tag . snd  <$> (filter (\x -> fst x /= Visible) $
+                    getPopulatedWorkspaces ss)
+        in
+        return $ fromMaybe from $ selector (==from) tags
+
+viewAdjacent :: Selector -> X ()
+viewAdjacent sel =
+  gotoWorkspace =<< (adjacentWorkspace sel =<< getCurrentWorkspace)
+
+adjacentScreen :: Selector -> X WorkspaceId
+adjacentScreen (Selector f) = do
+  (screens, current) <-
+    withWindowSet $ return . (getHorizontallyOrderedScreens &&& W.current)
+
+  return $ W.tag $ W.workspace $ fromMaybe current (snd <$> f fst screens)
+
+withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
+withScreen fn n = do
+  windows $ \windowSet ->
+    case map snd (getHorizontallyOrderedScreens windowSet) !! n of
+      Nothing -> windowSet
+      Just screen -> fn (W.tag $ W.workspace screen) windowSet
+
+
+workspaceWithWindow :: Window -> X (Maybe WorkspaceId)
+workspaceWithWindow wid = withWindowSet $ \(W.StackSet c v h _) ->
+  return $
+    W.tag <$>
+      find (\(W.Workspace _ _ stack) -> wid `elem` W.integrate' stack)
+        (map W.workspace (c : v) ++ h)
+  
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index 82c05b7..4f8bbb8 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -11,7 +11,7 @@ import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
 import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Run (spawnPipe)
 import XMonad (X)
-import Rahm.Desktop.Lib (getPopulatedWorkspaces, WorkspaceState(..))
+import Rahm.Desktop.Workspaces (getPopulatedWorkspaces, WorkspaceState(..))
 import Text.Printf
 
 import qualified XMonad as X
-- 
cgit 


From 3cc28186cd3ab934e29c4864f7c6b074475906a1 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Thu, 14 Apr 2022 01:24:30 -0600
Subject: Make workspaces more consistent

---
 src/Rahm/Desktop/Keys.hs       | 44 +++++++++++++++++++++++++++---------------
 src/Rahm/Desktop/Workspaces.hs | 28 ++++++++++++++++++++-------
 2 files changed, 49 insertions(+), 23 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 2f30763..6e16c25 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -5,6 +5,7 @@ import Data.Monoid (Endo(..))
 import Control.Monad.Trans.Class
 import Control.Monad.Reader
 import Control.Monad.Writer
+import Control.Monad.Trans.Maybe
 import Control.Monad.Loops (iterateWhile)
 import Control.Monad.Fix (fix)
 import Graphics.X11.ExtraTypes.XF86;
@@ -267,30 +268,38 @@ keymap = runKeys $ do
   bind xK_g $ do
     let selectWorkspace :: (KeySym, String) -> Maybe (X WorkspaceId)
         selectWorkspace s = case s of
-          (_, [ch]) | isAlphaNum ch -> Just $ return [ch]
+          (_, [ch]) | isAlphaNum ch || ch == '*' -> Just $ return [ch]
           (_, "]") -> Just $ adjacentWorkspace next =<< getCurrentWorkspace
           (_, "[") -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace
           (_, "}") -> Just $ adjacentScreen next
           (_, "{") -> Just $ adjacentScreen prev
-          (_, "/") -> Just $ runMaybeT $ do
-            windowId <- askWindowId
-            workspaceWithWindow askWindowId
+          (_, "^") -> Just firstWorkspaceId
+          (_, "$") -> Just lastWorkspaceId
+          (_, "/") -> Just $ do
+                        cur <- getCurrentWorkspace
+                        fromMaybe cur <$> runMaybeT (do
+                          windowId <- MaybeT askWindowId
+                          MaybeT $ workspaceWithWindow windowId)
           (_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace
           _ -> Nothing
     
     justMod $
-      doc "Goto a workspace\n\n\t\
-
-      \If the second character typed is alpha-numeric, jump to that\n\t\
-      \workspace. The workspace is created on-the-fly if such a workspace\n\t\
-      \does not exist.\n\n\t\
-
-      \If the second character typed is:\n\t\t\
-         \]: go to the next workspace\n\t\t\
-         \[: go to the previous workspace\n\t\t\
-         \}: cycle the workspaces on the screens to the right\n\t\t\
-         \{: cycle the workspaces on the screens to the left\n\t\t\
-         \<space>: Jump to the accompaning workspace.\n\t\t\
+      doc "Goto/Send/Etc To a workspace\n\n\t\
+
+      \Workspaces are alphanumeric characters. So if the next key typed is an\n\t\
+      \alphanumeric character, that's the workspace to operate on\n\n\
+
+      \The following special characters can also reference workspaces:\n\t\t\
+         \]: The next non-visible workspace\n\t\t\
+         \[: The previous non-visible workspace\n\t\t\
+         \}: The workspace on the screen to the right\n\t\t\
+         \{: The workspace on the screen to the left\n\t\t\
+         \<space>: The accompaningWorkspace (toggled case)\n\t\t\
+         \/: Prompt to select a window, and reference that workspace\n\t\t\
+         \^: The first populated workspace\n\t\t\
+         \$: The last populated workspace\n\t\t\
+         \*: The hidden workspace.\n\t\t\
+         \_: Black hole. Sending a window here closes it.\n\t\t\
          \F1: display this help.\n" $
       mapNextStringWithKeysym $ \_ keysym str ->
         case ((keysym, str), selectWorkspace (keysym, str)) of
@@ -308,6 +317,7 @@ keymap = runKeys $ do
       mapNextStringWithKeysym $ \_ keysym str ->
         case ((keysym, str), selectWorkspace (keysym, str)) of
           (_, Just w) -> shiftToWorkspace =<< w
+          ((_, "_"), _) -> CopyWindow.kill1
           _ -> return ()
 
     controlMod $
@@ -332,6 +342,8 @@ keymap = runKeys $ do
       mapNextStringWithKeysym $ \_ keysym str ->
         case ((keysym, str), selectWorkspace (keysym, str)) of
           (_, Just ws) -> swapWorkspace =<< ws
+          ((_, "_"), _) ->
+            mapM_ (\w -> focus w >> CopyWindow.kill1) =<< windowsInCurrentWorkspace
           _ -> return ()
 
   bind xK_h $ do
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index 87d112e..2a266b7 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -28,12 +28,13 @@ data WorkspaceState = Current | Hidden | Visible
 --
 -- This function will sort the result by the workspace tag.
 getPopulatedWorkspaces ::
-  (Ord i) => W.StackSet i l a sid sd -> [(WorkspaceState, W.Workspace i l a)]
+  W.StackSet String l a sid sd -> [(WorkspaceState, W.Workspace String l a)]
 getPopulatedWorkspaces (W.StackSet (W.Screen cur _ _) vis hi _) =
-  sortOn (W.tag . snd) $
-    mapMaybe (\w@(W.Workspace _ _ s) -> fmap (const (Hidden, w)) s) hi ++
-      map (\(W.Screen w _ _) -> (Visible, w)) vis ++
-        [(Current, cur)]
+  filter ((/="*") . W.tag . snd) $
+    sortOn (W.tag . snd) $
+      mapMaybe (\w@(W.Workspace _ _ s) -> fmap (const (Hidden, w)) s) hi ++
+        map (\(W.Screen w _ _) -> (Visible, w)) vis ++
+          [(Current, cur)]
 
 next :: Selector
 next = Selector $ \f l -> select f l l
@@ -46,11 +47,24 @@ prev :: Selector
 prev = Selector $ \f l ->
   let (Selector fn) = next in fn f (reverse l)
 
+lastWorkspaceId :: X WorkspaceId
+lastWorkspaceId =
+  W.tag . snd . last <$> withWindowSet (return . getPopulatedWorkspaces)
+
+firstWorkspaceId :: X WorkspaceId
+firstWorkspaceId =
+  W.tag . snd . head <$> withWindowSet (return . getPopulatedWorkspaces)
+
 getCurrentWorkspace :: X WorkspaceId
 getCurrentWorkspace = withWindowSet $
   \(W.StackSet (W.Screen (W.Workspace t _ _) _ _) _ _ _) -> do
     return t
 
+windowsInCurrentWorkspace :: X [Window]
+windowsInCurrentWorkspace = withWindowSet $
+  \(W.StackSet (W.Screen (W.Workspace _ _ s) _ _) _ _ _) -> do
+    return $ W.integrate' s
+
 getHorizontallyOrderedScreens ::
   W.StackSet wid l a ScreenId ScreenDetail ->
     [(Bool, W.Screen wid l a ScreenId ScreenDetail)]
@@ -103,7 +117,7 @@ adjacentWorkspace :: Selector -> WorkspaceId -> X WorkspaceId
 adjacentWorkspace (Selector selector) from = 
   withWindowSet $ \ss ->
     let tags = sort $
-                 W.tag . snd  <$> (filter (\x -> fst x /= Visible) $
+                 W.tag . snd  <$> filter (\x -> fst x /= Visible) (
                     getPopulatedWorkspaces ss)
         in
         return $ fromMaybe from $ selector (==from) tags
@@ -117,7 +131,7 @@ adjacentScreen (Selector f) = do
   (screens, current) <-
     withWindowSet $ return . (getHorizontallyOrderedScreens &&& W.current)
 
-  return $ W.tag $ W.workspace $ fromMaybe current (snd <$> f fst screens)
+  return $ W.tag $ W.workspace $ maybe current snd (f fst screens)
 
 withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
 withScreen fn n = do
-- 
cgit 


From 0992b3df262c9ac91cc87133bd451ddcd4fcc6ad Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 14 Apr 2022 12:11:45 -0600
Subject: Minor changes

---
 src/Rahm/Desktop/Keys.hs       | 36 ++++++++++++++++++++++++------------
 src/Rahm/Desktop/Workspaces.hs | 13 ++++++++++---
 2 files changed, 34 insertions(+), 15 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 6e16c25..1bf1b2f 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -269,17 +269,18 @@ keymap = runKeys $ do
     let selectWorkspace :: (KeySym, String) -> Maybe (X WorkspaceId)
         selectWorkspace s = case s of
           (_, [ch]) | isAlphaNum ch || ch == '*' -> Just $ return [ch]
-          (_, "]") -> Just $ adjacentWorkspace next =<< getCurrentWorkspace
-          (_, "[") -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace
+          (_, "]") -> Just $ adjacentWorkspaceNotVisible next
+                               =<< getCurrentWorkspace
+          (_, "[") -> Just $ adjacentWorkspaceNotVisible prev
+                               =<< getCurrentWorkspace
+          (_, ")") -> Just $ adjacentWorkspace next =<< getCurrentWorkspace
+          (_, "(") -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace
           (_, "}") -> Just $ adjacentScreen next
           (_, "{") -> Just $ adjacentScreen prev
           (_, "^") -> Just firstWorkspaceId
           (_, "$") -> Just lastWorkspaceId
-          (_, "/") -> Just $ do
-                        cur <- getCurrentWorkspace
-                        fromMaybe cur <$> runMaybeT (do
-                          windowId <- MaybeT askWindowId
-                          MaybeT $ workspaceWithWindow windowId)
+          (_, "/") -> Just $ fromMaybe <$> getCurrentWorkspace <*> runMaybeT (
+              (MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
           (_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace
           _ -> Nothing
     
@@ -289,9 +290,11 @@ keymap = runKeys $ do
       \Workspaces are alphanumeric characters. So if the next key typed is an\n\t\
       \alphanumeric character, that's the workspace to operate on\n\n\
 
-      \The following special characters can also reference workspaces:\n\t\t\
-         \]: The next non-visible workspace\n\t\t\
-         \[: The previous non-visible workspace\n\t\t\
+      \\tThe following special characters can also reference workspaces:\n\t\t\
+         \]: The next workspace, skipping those already visible.\n\t\t\
+         \[: The previous workspace, skipping those already visible.\n\t\t\
+         \): The next workspace.\n\t\t\
+         \(: The previous workspace.\n\t\t\
          \}: The workspace on the screen to the right\n\t\t\
          \{: The workspace on the screen to the left\n\t\t\
          \<space>: The accompaningWorkspace (toggled case)\n\t\t\
@@ -299,8 +302,9 @@ keymap = runKeys $ do
          \^: The first populated workspace\n\t\t\
          \$: The last populated workspace\n\t\t\
          \*: The hidden workspace.\n\t\t\
-         \_: Black hole. Sending a window here closes it.\n\t\t\
-         \F1: display this help.\n" $
+         \_: Black hole. Sending a window here closes it.\n\n\t\
+      \Other keybindings starting with H-g\n\t\t\
+         \F1: display this help.\n\n\t" $
       mapNextStringWithKeysym $ \_ keysym str ->
         case ((keysym, str), selectWorkspace (keysym, str)) of
           (_, Just w) -> pushHistory $ gotoWorkspace =<< w
@@ -725,6 +729,14 @@ mouseMap = runButtons $ do
     bind button2 $ noMod $ windows . W.sink
     bind button3 $ noMod mouseResizeWindow
 
+    let swapButtons = [
+          (button6, windows W.swapDown),
+          (button7, windows W.swapUp)
+          ]
+
+    forM_ (map fst swapButtons) $ \b ->
+      bind b $ noMod $ \w -> click >> (continuous swapButtons b) w
+
     bind button13 $ noMod $ subMouse $ do
       bind button13 $ noMod $ subMouse $ do
         bind button13 $ noMod $ noWindow $ spawnX "xsecurelock"
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index 2a266b7..1349fea 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -113,8 +113,8 @@ swapWorkspace toWorkspace = do
         | t' == toWorkspace = W.Workspace fromWorkspace l s
         | otherwise = ws
 
-adjacentWorkspace :: Selector -> WorkspaceId -> X WorkspaceId
-adjacentWorkspace (Selector selector) from = 
+adjacentWorkspaceNotVisible :: Selector -> WorkspaceId -> X WorkspaceId
+adjacentWorkspaceNotVisible (Selector selector) from = 
   withWindowSet $ \ss ->
     let tags = sort $
                  W.tag . snd  <$> filter (\x -> fst x /= Visible) (
@@ -122,9 +122,16 @@ adjacentWorkspace (Selector selector) from =
         in
         return $ fromMaybe from $ selector (==from) tags
 
+adjacentWorkspace :: Selector -> WorkspaceId -> X WorkspaceId
+adjacentWorkspace (Selector selector) from = 
+  withWindowSet $ \ss ->
+    let tags = sort $ W.tag . snd  <$> getPopulatedWorkspaces ss
+        in
+        return $ fromMaybe from $ selector (==from) tags
+
 viewAdjacent :: Selector -> X ()
 viewAdjacent sel =
-  gotoWorkspace =<< (adjacentWorkspace sel =<< getCurrentWorkspace)
+  gotoWorkspace =<< (adjacentWorkspaceNotVisible sel =<< getCurrentWorkspace)
 
 adjacentScreen :: Selector -> X WorkspaceId
 adjacentScreen (Selector f) = do
-- 
cgit 


From 643642e5e76fd5278a26f560dca60e5b18ac8933 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 14 Apr 2022 16:50:03 -0600
Subject: Rename KeysM -> Keys/Dsl

---
 src/Main.hs                  |   1 -
 src/Rahm/Desktop/Keys.hs     |  81 +++----
 src/Rahm/Desktop/Keys/Dsl.hs | 496 +++++++++++++++++++++++++++++++++++++++++++
 src/Rahm/Desktop/KeysM.hs    | 495 ------------------------------------------
 4 files changed, 539 insertions(+), 534 deletions(-)
 create mode 100644 src/Rahm/Desktop/Keys/Dsl.hs
 delete mode 100644 src/Rahm/Desktop/KeysM.hs

diff --git a/src/Main.hs b/src/Main.hs
index c8cdd19..56c66f5 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -20,7 +20,6 @@ import Rahm.Desktop.Layout
 import Rahm.Desktop.Logger
 import Rahm.Desktop.DMenu (menuCommandString)
 import Rahm.Desktop.RebindKeys
-import Rahm.Desktop.KeysM
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as W
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 1bf1b2f..fec7ce5 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -1,67 +1,66 @@
 module Rahm.Desktop.Keys (applyKeys) where
 
-import XMonad.Util.Run (safeSpawn)
-import Data.Monoid (Endo(..))
-import Control.Monad.Trans.Class
-import Control.Monad.Reader
-import Control.Monad.Writer
-import Control.Monad.Trans.Maybe
-import Control.Monad.Loops (iterateWhile)
-import Control.Monad.Fix (fix)
-import Graphics.X11.ExtraTypes.XF86;
-import Rahm.Desktop.KeysM
-import Rahm.Desktop.SwapMaster (swapMaster)
-import XMonad.Hooks.ManageDocks
-import XMonad.Layout.MosaicAlt
-import Graphics.X11.ExtraTypes.XorgDefault
-import System.Process
-import XMonad.Util.Ungrab
-import XMonad.Layout.Spacing
-import Data.Maybe (isJust, fromMaybe)
-import Debug.Trace
 import Control.Applicative
-import Prelude hiding ((!!))
 import Control.Monad
+import Control.Monad.Fix (fix)
+import Control.Monad.Loops (iterateWhile)
+import Control.Monad.Reader
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Maybe
+import Control.Monad.Writer
 import Data.Char
 import Data.List hiding ((!!))
 import Data.List.Safe ((!!))
 import Data.Map (Map)
-import Rahm.Desktop.Layout
-import Rahm.Desktop.Marking
-import Rahm.Desktop.PromptConfig
+import Data.Maybe (isJust, fromMaybe)
+import Data.Monoid (Endo(..))
+import Debug.Trace
+import Graphics.X11.ExtraTypes.XF86;
+import Graphics.X11.ExtraTypes.XorgDefault
+import Prelude hiding ((!!))
 import System.IO
+import System.Process
 import Text.Printf
 import XMonad
-import Rahm.Desktop.Submap
+import XMonad.Actions.CopyWindow as CopyWindow
+import XMonad.Actions.RotSlaves
+import XMonad.Actions.SpawnOn as SpawnOn
 import XMonad.Actions.WindowNavigation
+import XMonad.Hooks.ManageDocks
+import XMonad.Layout.MosaicAlt
+import XMonad.Layout.Spacing
 import XMonad.Prompt
 import XMonad.Prompt.Input
 import XMonad.Prompt.Shell
 import XMonad.Util.CustomKeys
+import XMonad.Util.Run (safeSpawn)
 import XMonad.Util.Scratchpad
-import XMonad.Actions.RotSlaves
-import XMonad.Actions.CopyWindow as CopyWindow
-import XMonad.Actions.SpawnOn as SpawnOn
+import XMonad.Util.Ungrab
 
 import qualified Data.Map as Map
 import qualified XMonad.StackSet as W
 
-import Rahm.Desktop.MouseMotion
-import Rahm.Desktop.Windows
-import Rahm.Desktop.Lib
 import Rahm.Desktop.DMenu
-import Rahm.Desktop.PassMenu
-import Rahm.Desktop.Logger
-import Rahm.Desktop.RebindKeys
-import Rahm.Desktop.Swallow
-import Rahm.Desktop.Layout.List (
-  toNextLayout, toPreviousLayout, toFirstLayout, toIndexedLayout)
+import Rahm.Desktop.Keys.Dsl
+import Rahm.Desktop.Layout
+import Rahm.Desktop.Layout.ConsistentMosaic
+import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.Layout.Hole (toggleHole)
+import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout, toIndexedLayout)
 import Rahm.Desktop.Layout.Pop (togglePop)
-import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.Layout.Rotate (rotateLayout)
+import Rahm.Desktop.Lib
+import Rahm.Desktop.Logger
+import Rahm.Desktop.Marking
+import Rahm.Desktop.MouseMotion
+import Rahm.Desktop.PassMenu
+import Rahm.Desktop.PromptConfig
+import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
-import Rahm.Desktop.Layout.ConsistentMosaic
+import Rahm.Desktop.Submap
+import Rahm.Desktop.Swallow
+import Rahm.Desktop.SwapMaster (swapMaster)
+import Rahm.Desktop.Windows
 import Rahm.Desktop.Workspaces
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -851,8 +850,14 @@ windowSpecificBindings config = do
       rawMask (controlMask .|. shiftMask) $ emitKey (0, xK_Home)
 
     bind xK_d $
+      rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_Tab)
+
+    bind xK_Escape $
       rawMask controlMask $ emitKey (controlMask, xK_w)
 
+    bind xK_i $ do
+      rawMask controlMask $ emitKey (controlMask, xK_Tab)
+
     bind xK_F2 $
       -- Experimental.
       noMod $ logs "This is a test"
diff --git a/src/Rahm/Desktop/Keys/Dsl.hs b/src/Rahm/Desktop/Keys/Dsl.hs
new file mode 100644
index 0000000..2c596fc
--- /dev/null
+++ b/src/Rahm/Desktop/Keys/Dsl.hs
@@ -0,0 +1,496 @@
+-- Domain-specific language for configuring key/button bindings.
+module Rahm.Desktop.Keys.Dsl where
+
+import Data.List
+import Data.Bits ((.&.))
+import Control.Monad.Writer
+import Text.Printf
+import Control.Arrow (second, first)
+import Control.Monad (void)
+import Control.Monad.State (State(..), modify', get, execState)
+import XMonad
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+data Documented t = Documented String t
+
+data KeyBinding =
+       Action (X ()) |
+       Submap KeyBindings |
+       Repeat KeyBindings
+
+type KeyBindings = Map (KeyMask, KeySym) (Documented KeyBinding)
+
+type ButtonBinding = Window -> X ()
+type ButtonBindings = Map (KeyMask, Button) ButtonBinding
+
+{- Module that defines a DSL for binding keys. -}
+newtype KeysM l a = KeysM (State (XConfig l, KeyBindings) a)
+  deriving (Functor, Applicative, Monad)
+
+newtype ButtonsM l a = ButtonsM (State (XConfig l, ButtonBindings) a)
+  deriving (Functor, Applicative, Monad)
+
+newtype BindingBuilder b a = BindingBuilder (State (KeyMask, [(KeyMask, b)]) a)
+  deriving (Functor, Applicative, Monad)
+
+class HasConfig m where
+  getConfig :: m l (XConfig l)
+
+class Bindable k where
+  type BindableValue k :: *
+  type BindableMonad k :: (* -> *) -> * -> *
+
+  bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
+  -- section :: String -> BindableMonad k l () -> BindableMonad k l ()
+
+class Binding k b where
+  toB :: k -> b
+
+  rawMask :: KeyMask -> k -> BindingBuilder b ()
+  rawMask m x = BindingBuilder $ modify' (second ((m, toB x):))
+
+instance Binding (X ()) (Documented KeyBinding) where
+  toB = Documented "" . Action
+
+instance Binding KeyBindings (Documented KeyBinding) where
+  toB = Documented "" . Submap
+
+instance Binding a (Documented a) where
+  toB = Documented ""
+
+instance Binding a a where
+  toB = id
+
+doc :: (Binding k (Documented KeyBinding)) => String -> k -> Documented KeyBinding
+doc str k = let (Documented _ t) = toB k in Documented str t
+
+runKeys :: KeysM l a -> XConfig l -> KeyBindings
+runKeys (KeysM stateM) config =
+  snd $ execState stateM (config, Map.empty)
+
+runButtons :: ButtonsM l a -> XConfig l -> ButtonBindings
+runButtons (ButtonsM stateM) config =
+  snd $ execState stateM (config, Map.empty)
+
+instance HasConfig KeysM where
+  getConfig = fst <$> KeysM get
+
+instance HasConfig ButtonsM where
+  getConfig = fst <$> ButtonsM get
+
+{- Generally it is assumed that the mod key shoud be pressed, but not always. -}
+noMod :: (Binding k b) => k -> BindingBuilder b ()
+noMod = rawMask 0
+
+maskMod :: (Binding k b) => KeyMask -> k -> BindingBuilder b ()
+maskMod mask action = do
+  modMask <- fst <$> BindingBuilder get
+  rawMask (modMask .|. mask) action
+
+altMask :: KeyMask
+altMask = mod1Mask
+
+hyperMask :: KeyMask
+hyperMask = mod3Mask
+
+altgrMask :: KeyMask
+altgrMask = 0x80
+
+superMask :: KeyMask
+superMask = mod4Mask
+
+justMod :: (Binding k b) => k -> BindingBuilder b ()
+justMod = maskMod 0
+
+instance Bindable KeySym where
+  type BindableValue KeySym = Documented KeyBinding
+  type BindableMonad KeySym = KeysM
+
+  -- bind :: KeySym -> BindingBuilder (X x) a -> KeysM l ()
+  bind key (BindingBuilder stM) = do
+    m <- modMask <$> getConfig
+    let (_, values) = execState stM (m, [])
+
+    KeysM $ modify' $ second $
+      flip (<>) (Map.fromList (map (\(m, v) -> ((m, key), v)) values))
+
+
+instance Bindable Button where
+  type BindableValue Button = ButtonBinding
+  type BindableMonad Button = ButtonsM
+
+  -- bind :: KeySym -> BindingBuilder (Window -> X ()) a -> ButtonsM l ()
+  bind button (BindingBuilder stM) = do
+    m <- modMask <$> getConfig
+    let (_, values) = execState stM (m, [])
+
+    ButtonsM $ modify' $ second $
+      flip (<>) (Map.fromList (map (\(m, v) -> ((m, button), v)) values))
+
+shiftControlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltSuperHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftControlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltSuperHyperMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask)
+
+shiftControlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltSuperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. altgrMask)
+
+shiftControlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltSuperMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask)
+
+shiftControlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask .|. altgrMask)
+
+shiftControlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltHyperMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask)
+
+shiftControlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altMask .|. altgrMask)
+
+shiftControlAltMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltMod =
+  maskMod (shiftMask .|. controlMask .|. altMask)
+
+shiftControlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlSuperHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftControlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlSuperHyperMod =
+  maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask)
+
+shiftControlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlSuperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. superMask .|. altgrMask)
+
+shiftControlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlSuperMod =
+  maskMod (shiftMask .|. controlMask .|. superMask)
+
+shiftControlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlHyperAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. hyperMask .|. altgrMask)
+
+shiftControlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlHyperMod =
+  maskMod (shiftMask .|. controlMask .|. hyperMask)
+
+shiftControlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlAltgrMod =
+  maskMod (shiftMask .|. controlMask .|. altgrMask)
+
+shiftControlMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftControlMod =
+  maskMod (shiftMask .|. controlMask)
+
+shiftAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltSuperHyperAltgrMod =
+  maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltSuperHyperMod =
+  maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask)
+
+shiftAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltSuperAltgrMod =
+  maskMod (shiftMask .|. altMask .|. superMask .|. altgrMask)
+
+shiftAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltSuperMod =
+  maskMod (shiftMask .|. altMask .|. superMask)
+
+shiftAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltHyperAltgrMod =
+  maskMod (shiftMask .|. altMask .|. hyperMask .|. altgrMask)
+
+shiftAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltHyperMod =
+  maskMod (shiftMask .|. altMask .|. hyperMask)
+
+shiftAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltAltgrMod =
+  maskMod (shiftMask .|. altMask .|. altgrMask)
+
+shiftAltMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltMod =
+  maskMod (shiftMask .|. altMask)
+
+shiftSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftSuperHyperAltgrMod =
+  maskMod (shiftMask .|. superMask .|. hyperMask .|. altgrMask)
+
+shiftSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftSuperHyperMod =
+  maskMod (shiftMask .|. superMask .|. hyperMask)
+
+shiftSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftSuperAltgrMod =
+  maskMod (shiftMask .|. superMask .|. altgrMask)
+
+shiftSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftSuperMod =
+  maskMod (shiftMask .|. superMask)
+
+shiftHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftHyperAltgrMod =
+  maskMod (shiftMask .|. hyperMask .|. altgrMask)
+
+shiftHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftHyperMod =
+  maskMod (shiftMask .|. hyperMask)
+
+shiftAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftAltgrMod =
+  maskMod (shiftMask .|. altgrMask)
+
+shiftMod :: (Binding k b) => k -> BindingBuilder b ()
+shiftMod = maskMod shiftMask
+
+controlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltSuperHyperAltgrMod =
+  maskMod (controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+controlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltSuperHyperMod =
+  maskMod (controlMask .|. altMask .|. superMask .|. hyperMask)
+
+controlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltSuperAltgrMod =
+  maskMod (controlMask .|. altMask .|. superMask .|. altgrMask)
+
+controlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltSuperMod =
+  maskMod (controlMask .|. altMask .|. superMask)
+
+controlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltHyperAltgrMod =
+  maskMod (controlMask .|. altMask .|. hyperMask .|. altgrMask)
+
+controlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltHyperMod =
+  maskMod (controlMask .|. altMask .|. hyperMask)
+
+controlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltAltgrMod =
+  maskMod (controlMask .|. altMask .|. altgrMask)
+
+controlAltMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltMod =
+  maskMod (controlMask .|. altMask)
+
+controlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlSuperHyperAltgrMod =
+  maskMod (controlMask .|. superMask .|. hyperMask .|. altgrMask)
+
+controlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlSuperHyperMod =
+  maskMod (controlMask .|. superMask .|. hyperMask)
+
+controlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlSuperAltgrMod =
+  maskMod (controlMask .|. superMask .|. altgrMask)
+
+controlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlSuperMod =
+  maskMod (controlMask .|. superMask)
+
+controlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlHyperAltgrMod =
+  maskMod (controlMask .|. hyperMask .|. altgrMask)
+
+controlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+controlHyperMod =
+  maskMod (controlMask .|. hyperMask)
+
+controlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+controlAltgrMod =
+  maskMod (controlMask .|. altgrMask)
+
+controlMod :: (Binding k b) => k -> BindingBuilder b ()
+controlMod = maskMod controlMask
+
+altSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+altSuperHyperAltgrMod =
+  maskMod (altMask .|. superMask .|. hyperMask .|. altgrMask)
+
+altSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+altSuperHyperMod =
+  maskMod (altMask .|. superMask .|. hyperMask)
+
+altSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+altSuperAltgrMod =
+  maskMod (altMask .|. superMask .|. altgrMask)
+
+altSuperMod :: (Binding k b) => k -> BindingBuilder b ()
+altSuperMod =
+  maskMod (altMask .|. superMask)
+
+altHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+altHyperAltgrMod =
+  maskMod (altMask .|. hyperMask .|. altgrMask)
+
+altHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+altHyperMod =
+  maskMod (altMask .|. hyperMask)
+
+altAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+altAltgrMod =
+  maskMod (altMask .|. altgrMask)
+
+altMod :: (Binding k b) => k -> BindingBuilder b ()
+altMod = maskMod altMask
+
+superHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+superHyperAltgrMod =
+  maskMod (superMask .|. hyperMask .|. altgrMask)
+
+superHyperMod :: (Binding k b) => k -> BindingBuilder b ()
+superHyperMod =
+  maskMod (superMask .|. hyperMask)
+
+superAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+superAltgrMod =
+  maskMod (superMask .|. altgrMask)
+
+superMod :: (Binding k b) => k -> BindingBuilder b ()
+superMod = maskMod superMask
+
+hyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
+hyperAltgrMod =
+  maskMod (hyperMask .|. altgrMask)
+
+hyperMod :: (Binding k b) => k -> BindingBuilder b ()
+hyperMod = maskMod hyperMask
+
+altgrMod :: (Binding k b) => k -> BindingBuilder b ()
+altgrMod = maskMod altgrMask
+
+{- Can combine two or more of the functions above to apply the same action to
+ - multiple masks. -}
+(-|-) :: (Binding k b) =>
+          (k -> BindingBuilder b ()) ->
+          (k -> BindingBuilder b ()) ->
+          k -> BindingBuilder b ()
+(-|-) fn1 fn2 f = fn1 f >> fn2 f
+
+{- Meant for submapping, binds all alphanumeric charactes to (fn c). -}
+mapNumbersAndAlpha :: KeyMask -> (Char -> X ()) -> KeysM l ()
+mapNumbersAndAlpha km fn = do
+  mapNumbers km fn
+  mapAlpha km fn
+
+{- Meant for submapping. This binds all numbers to (fn x) where x is the number
+ - pressed and fn is the function provided. -}
+mapNumbers :: KeyMask -> (Char -> X ()) -> KeysM l ()
+mapNumbers km fn = do
+  mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch))
+    [ (xK_0, '0')
+    , (xK_1, '1')
+    , (xK_2, '2')
+    , (xK_3, '3')
+    , (xK_4, '4')
+    , (xK_5, '5')
+    , (xK_6, '6')
+    , (xK_7, '7')
+    , (xK_8, '8')
+    , (xK_9, '9')
+    -- Programmer Dvorak shifts the numbers so I have to map to their unshifted
+    -- form.
+    , (xK_bracketright, '6')
+    , (xK_exclam, '8')
+    , (xK_bracketleft, '7')
+    , (xK_braceleft, '5')
+    , (xK_braceright, '3')
+    , (xK_parenleft, '1')
+    , (xK_equal, '9')
+    , (xK_asterisk, '0')
+    , (xK_parenright, '2')
+    , (xK_plus, '4') ]
+
+{- Meant for submapping. This binds all alpha charactes to (fn c) where c is the
+ - character pressed and fn is the function provided. -}
+mapAlpha :: KeyMask -> (Char -> X ()) -> KeysM l ()
+mapAlpha km fn =
+  mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch)) [
+    (xK_a, 'a')
+  , (xK_b, 'b')
+  , (xK_c, 'c')
+  , (xK_d, 'd')
+  , (xK_e, 'e')
+  , (xK_f, 'f')
+  , (xK_g, 'g')
+  , (xK_h, 'h')
+  , (xK_i, 'i')
+  , (xK_j, 'j')
+  , (xK_k, 'k')
+  , (xK_l, 'l')
+  , (xK_m, 'm')
+  , (xK_n, 'n')
+  , (xK_o, 'o')
+  , (xK_p, 'p')
+  , (xK_q, 'q')
+  , (xK_r, 'r')
+  , (xK_s, 's')
+  , (xK_t, 't')
+  , (xK_u, 'u')
+  , (xK_v, 'v')
+  , (xK_w, 'w')
+  , (xK_x, 'x')
+  , (xK_y, 'y')
+  , (xK_z, 'z')
+  ]
+
+
+documentation :: KeyBindings -> String
+documentation = execWriter . document' ""
+  where
+    document' pref keybindings =
+      forM_ (sortOn (map (\(a, b) -> (b, a)) . snd . snd) $ Map.toList (keyBindingsToList keybindings)) $ \(doc, (thing, keys)) -> do
+        when ((not $ null doc) || hasSubmap thing) $
+          tell $ printf "%s%s: %s\n" pref (intercalate " or " $ map prettyShow keys) doc
+        case thing of
+          Action _ -> return ()
+          Submap submap -> document' (pref ++ "  ") submap
+          Repeat submap -> do
+            tell pref
+            tell "  (repeatable):\n"
+            document' (pref ++ "    ") submap
+
+    keyBindingsToList :: KeyBindings -> Map String (KeyBinding, [(KeyMask, KeySym)])
+    keyBindingsToList b =
+      fmap (\list -> ((\(_, Documented _ t) -> t) (head list), map fst list)) $
+        group (\(_, Documented doc _) -> doc) (sortOn (snd . fst) $ Map.toList b)
+
+    prettyShow :: (KeyMask, KeySym) -> String
+    prettyShow (mask, key) = printf "%s%s" (showMask mask) (keysymToString key)
+
+    hasSubmap b = case b of
+      Action _ -> False
+      _ -> True
+
+
+    showMask :: KeyMask -> String
+    showMask mask =
+      let masks = [(shiftMask, "S"),
+                   (altMask, "A"),
+                   (mod3Mask, "H"),
+                   (mod4Mask, "M"),
+                   (altgrMask, "AGr"),
+                   (controlMask, "C")] in
+
+              concatMap ((++"-") . snd) $ filter ((/=0) . (.&.mask) . fst) masks
+
+
+    group :: (Ord b) => (a -> b) -> [a] -> (Map b [a])
+    group fn = Map.fromListWith (++) . map (first fn . (\a -> (a, [a])))
+
+
diff --git a/src/Rahm/Desktop/KeysM.hs b/src/Rahm/Desktop/KeysM.hs
deleted file mode 100644
index 403b3fc..0000000
--- a/src/Rahm/Desktop/KeysM.hs
+++ /dev/null
@@ -1,495 +0,0 @@
-module Rahm.Desktop.KeysM where
-
-import Data.List
-import Data.Bits ((.&.))
-import Control.Monad.Writer
-import Text.Printf
-import Control.Arrow (second, first)
-import Control.Monad (void)
-import Control.Monad.State (State(..), modify', get, execState)
-import XMonad
-import Data.Map (Map)
-import qualified Data.Map as Map
-
-data Documented t = Documented String t
-
-data KeyBinding =
-       Action (X ()) |
-       Submap KeyBindings |
-       Repeat KeyBindings
-
-type KeyBindings = Map (KeyMask, KeySym) (Documented KeyBinding)
-
-type ButtonBinding = Window -> X ()
-type ButtonBindings = Map (KeyMask, Button) ButtonBinding
-
-{- Module that defines a DSL for binding keys. -}
-newtype KeysM l a = KeysM (State (XConfig l, KeyBindings) a)
-  deriving (Functor, Applicative, Monad)
-
-newtype ButtonsM l a = ButtonsM (State (XConfig l, ButtonBindings) a)
-  deriving (Functor, Applicative, Monad)
-
-newtype BindingBuilder b a = BindingBuilder (State (KeyMask, [(KeyMask, b)]) a)
-  deriving (Functor, Applicative, Monad)
-
-class HasConfig m where
-  getConfig :: m l (XConfig l)
-
-class Bindable k where
-  type BindableValue k :: *
-  type BindableMonad k :: (* -> *) -> * -> *
-
-  bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
-  -- section :: String -> BindableMonad k l () -> BindableMonad k l ()
-
-class Binding k b where
-  toB :: k -> b
-
-  rawMask :: KeyMask -> k -> BindingBuilder b ()
-  rawMask m x = BindingBuilder $ modify' (second ((m, toB x):))
-
-instance Binding (X ()) (Documented KeyBinding) where
-  toB = Documented "" . Action
-
-instance Binding KeyBindings (Documented KeyBinding) where
-  toB = Documented "" . Submap
-
-instance Binding a (Documented a) where
-  toB = Documented ""
-
-instance Binding a a where
-  toB = id
-
-doc :: (Binding k (Documented KeyBinding)) => String -> k -> Documented KeyBinding
-doc str k = let (Documented _ t) = toB k in Documented str t
-
-runKeys :: KeysM l a -> XConfig l -> KeyBindings
-runKeys (KeysM stateM) config =
-  snd $ execState stateM (config, Map.empty)
-
-runButtons :: ButtonsM l a -> XConfig l -> ButtonBindings
-runButtons (ButtonsM stateM) config =
-  snd $ execState stateM (config, Map.empty)
-
-instance HasConfig KeysM where
-  getConfig = fst <$> KeysM get
-
-instance HasConfig ButtonsM where
-  getConfig = fst <$> ButtonsM get
-
-{- Generally it is assumed that the mod key shoud be pressed, but not always. -}
-noMod :: (Binding k b) => k -> BindingBuilder b ()
-noMod = rawMask 0
-
-maskMod :: (Binding k b) => KeyMask -> k -> BindingBuilder b ()
-maskMod mask action = do
-  modMask <- fst <$> BindingBuilder get
-  rawMask (modMask .|. mask) action
-
-altMask :: KeyMask
-altMask = mod1Mask
-
-hyperMask :: KeyMask
-hyperMask = mod3Mask
-
-altgrMask :: KeyMask
-altgrMask = 0x80
-
-superMask :: KeyMask
-superMask = mod4Mask
-
-justMod :: (Binding k b) => k -> BindingBuilder b ()
-justMod = maskMod 0
-
-instance Bindable KeySym where
-  type BindableValue KeySym = Documented KeyBinding
-  type BindableMonad KeySym = KeysM
-
-  -- bind :: KeySym -> BindingBuilder (X x) a -> KeysM l ()
-  bind key (BindingBuilder stM) = do
-    m <- modMask <$> getConfig
-    let (_, values) = execState stM (m, [])
-
-    KeysM $ modify' $ second $
-      flip (<>) (Map.fromList (map (\(m, v) -> ((m, key), v)) values))
-
-
-instance Bindable Button where
-  type BindableValue Button = ButtonBinding
-  type BindableMonad Button = ButtonsM
-
-  -- bind :: KeySym -> BindingBuilder (Window -> X ()) a -> ButtonsM l ()
-  bind button (BindingBuilder stM) = do
-    m <- modMask <$> getConfig
-    let (_, values) = execState stM (m, [])
-
-    ButtonsM $ modify' $ second $
-      flip (<>) (Map.fromList (map (\(m, v) -> ((m, button), v)) values))
-
-shiftControlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltSuperHyperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
-
-shiftControlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltSuperHyperMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask)
-
-shiftControlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltSuperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. altgrMask)
-
-shiftControlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltSuperMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. superMask)
-
-shiftControlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltHyperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask .|. altgrMask)
-
-shiftControlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltHyperMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask)
-
-shiftControlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. altMask .|. altgrMask)
-
-shiftControlAltMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltMod =
-  maskMod (shiftMask .|. controlMask .|. altMask)
-
-shiftControlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlSuperHyperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask .|. altgrMask)
-
-shiftControlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlSuperHyperMod =
-  maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask)
-
-shiftControlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlSuperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. superMask .|. altgrMask)
-
-shiftControlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlSuperMod =
-  maskMod (shiftMask .|. controlMask .|. superMask)
-
-shiftControlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlHyperAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. hyperMask .|. altgrMask)
-
-shiftControlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlHyperMod =
-  maskMod (shiftMask .|. controlMask .|. hyperMask)
-
-shiftControlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlAltgrMod =
-  maskMod (shiftMask .|. controlMask .|. altgrMask)
-
-shiftControlMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftControlMod =
-  maskMod (shiftMask .|. controlMask)
-
-shiftAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltSuperHyperAltgrMod =
-  maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
-
-shiftAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltSuperHyperMod =
-  maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask)
-
-shiftAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltSuperAltgrMod =
-  maskMod (shiftMask .|. altMask .|. superMask .|. altgrMask)
-
-shiftAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltSuperMod =
-  maskMod (shiftMask .|. altMask .|. superMask)
-
-shiftAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltHyperAltgrMod =
-  maskMod (shiftMask .|. altMask .|. hyperMask .|. altgrMask)
-
-shiftAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltHyperMod =
-  maskMod (shiftMask .|. altMask .|. hyperMask)
-
-shiftAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltAltgrMod =
-  maskMod (shiftMask .|. altMask .|. altgrMask)
-
-shiftAltMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltMod =
-  maskMod (shiftMask .|. altMask)
-
-shiftSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftSuperHyperAltgrMod =
-  maskMod (shiftMask .|. superMask .|. hyperMask .|. altgrMask)
-
-shiftSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftSuperHyperMod =
-  maskMod (shiftMask .|. superMask .|. hyperMask)
-
-shiftSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftSuperAltgrMod =
-  maskMod (shiftMask .|. superMask .|. altgrMask)
-
-shiftSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftSuperMod =
-  maskMod (shiftMask .|. superMask)
-
-shiftHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftHyperAltgrMod =
-  maskMod (shiftMask .|. hyperMask .|. altgrMask)
-
-shiftHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftHyperMod =
-  maskMod (shiftMask .|. hyperMask)
-
-shiftAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftAltgrMod =
-  maskMod (shiftMask .|. altgrMask)
-
-shiftMod :: (Binding k b) => k -> BindingBuilder b ()
-shiftMod = maskMod shiftMask
-
-controlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltSuperHyperAltgrMod =
-  maskMod (controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
-
-controlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltSuperHyperMod =
-  maskMod (controlMask .|. altMask .|. superMask .|. hyperMask)
-
-controlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltSuperAltgrMod =
-  maskMod (controlMask .|. altMask .|. superMask .|. altgrMask)
-
-controlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltSuperMod =
-  maskMod (controlMask .|. altMask .|. superMask)
-
-controlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltHyperAltgrMod =
-  maskMod (controlMask .|. altMask .|. hyperMask .|. altgrMask)
-
-controlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltHyperMod =
-  maskMod (controlMask .|. altMask .|. hyperMask)
-
-controlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltAltgrMod =
-  maskMod (controlMask .|. altMask .|. altgrMask)
-
-controlAltMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltMod =
-  maskMod (controlMask .|. altMask)
-
-controlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlSuperHyperAltgrMod =
-  maskMod (controlMask .|. superMask .|. hyperMask .|. altgrMask)
-
-controlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlSuperHyperMod =
-  maskMod (controlMask .|. superMask .|. hyperMask)
-
-controlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlSuperAltgrMod =
-  maskMod (controlMask .|. superMask .|. altgrMask)
-
-controlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlSuperMod =
-  maskMod (controlMask .|. superMask)
-
-controlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlHyperAltgrMod =
-  maskMod (controlMask .|. hyperMask .|. altgrMask)
-
-controlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-controlHyperMod =
-  maskMod (controlMask .|. hyperMask)
-
-controlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-controlAltgrMod =
-  maskMod (controlMask .|. altgrMask)
-
-controlMod :: (Binding k b) => k -> BindingBuilder b ()
-controlMod = maskMod controlMask
-
-altSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-altSuperHyperAltgrMod =
-  maskMod (altMask .|. superMask .|. hyperMask .|. altgrMask)
-
-altSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-altSuperHyperMod =
-  maskMod (altMask .|. superMask .|. hyperMask)
-
-altSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-altSuperAltgrMod =
-  maskMod (altMask .|. superMask .|. altgrMask)
-
-altSuperMod :: (Binding k b) => k -> BindingBuilder b ()
-altSuperMod =
-  maskMod (altMask .|. superMask)
-
-altHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-altHyperAltgrMod =
-  maskMod (altMask .|. hyperMask .|. altgrMask)
-
-altHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-altHyperMod =
-  maskMod (altMask .|. hyperMask)
-
-altAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-altAltgrMod =
-  maskMod (altMask .|. altgrMask)
-
-altMod :: (Binding k b) => k -> BindingBuilder b ()
-altMod = maskMod altMask
-
-superHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-superHyperAltgrMod =
-  maskMod (superMask .|. hyperMask .|. altgrMask)
-
-superHyperMod :: (Binding k b) => k -> BindingBuilder b ()
-superHyperMod =
-  maskMod (superMask .|. hyperMask)
-
-superAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-superAltgrMod =
-  maskMod (superMask .|. altgrMask)
-
-superMod :: (Binding k b) => k -> BindingBuilder b ()
-superMod = maskMod superMask
-
-hyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
-hyperAltgrMod =
-  maskMod (hyperMask .|. altgrMask)
-
-hyperMod :: (Binding k b) => k -> BindingBuilder b ()
-hyperMod = maskMod hyperMask
-
-altgrMod :: (Binding k b) => k -> BindingBuilder b ()
-altgrMod = maskMod altgrMask
-
-{- Can combine two or more of the functions above to apply the same action to
- - multiple masks. -}
-(-|-) :: (Binding k b) =>
-          (k -> BindingBuilder b ()) ->
-          (k -> BindingBuilder b ()) ->
-          k -> BindingBuilder b ()
-(-|-) fn1 fn2 f = fn1 f >> fn2 f
-
-{- Meant for submapping, binds all alphanumeric charactes to (fn c). -}
-mapNumbersAndAlpha :: KeyMask -> (Char -> X ()) -> KeysM l ()
-mapNumbersAndAlpha km fn = do
-  mapNumbers km fn
-  mapAlpha km fn
-
-{- Meant for submapping. This binds all numbers to (fn x) where x is the number
- - pressed and fn is the function provided. -}
-mapNumbers :: KeyMask -> (Char -> X ()) -> KeysM l ()
-mapNumbers km fn = do
-  mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch))
-    [ (xK_0, '0')
-    , (xK_1, '1')
-    , (xK_2, '2')
-    , (xK_3, '3')
-    , (xK_4, '4')
-    , (xK_5, '5')
-    , (xK_6, '6')
-    , (xK_7, '7')
-    , (xK_8, '8')
-    , (xK_9, '9')
-    -- Programmer Dvorak shifts the numbers so I have to map to their unshifted
-    -- form.
-    , (xK_bracketright, '6')
-    , (xK_exclam, '8')
-    , (xK_bracketleft, '7')
-    , (xK_braceleft, '5')
-    , (xK_braceright, '3')
-    , (xK_parenleft, '1')
-    , (xK_equal, '9')
-    , (xK_asterisk, '0')
-    , (xK_parenright, '2')
-    , (xK_plus, '4') ]
-
-{- Meant for submapping. This binds all alpha charactes to (fn c) where c is the
- - character pressed and fn is the function provided. -}
-mapAlpha :: KeyMask -> (Char -> X ()) -> KeysM l ()
-mapAlpha km fn =
-  mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch)) [
-    (xK_a, 'a')
-  , (xK_b, 'b')
-  , (xK_c, 'c')
-  , (xK_d, 'd')
-  , (xK_e, 'e')
-  , (xK_f, 'f')
-  , (xK_g, 'g')
-  , (xK_h, 'h')
-  , (xK_i, 'i')
-  , (xK_j, 'j')
-  , (xK_k, 'k')
-  , (xK_l, 'l')
-  , (xK_m, 'm')
-  , (xK_n, 'n')
-  , (xK_o, 'o')
-  , (xK_p, 'p')
-  , (xK_q, 'q')
-  , (xK_r, 'r')
-  , (xK_s, 's')
-  , (xK_t, 't')
-  , (xK_u, 'u')
-  , (xK_v, 'v')
-  , (xK_w, 'w')
-  , (xK_x, 'x')
-  , (xK_y, 'y')
-  , (xK_z, 'z')
-  ]
-
-
-documentation :: KeyBindings -> String
-documentation = execWriter . document' ""
-  where
-    document' pref keybindings =
-      forM_ (sortOn (map (\(a, b) -> (b, a)) . snd . snd) $ Map.toList (keyBindingsToList keybindings)) $ \(doc, (thing, keys)) -> do
-        when ((not $ null doc) || hasSubmap thing) $
-          tell $ printf "%s%s: %s\n" pref (intercalate " or " $ map prettyShow keys) doc
-        case thing of
-          Action _ -> return ()
-          Submap submap -> document' (pref ++ "  ") submap
-          Repeat submap -> do
-            tell pref
-            tell "  (repeatable):\n"
-            document' (pref ++ "    ") submap
-
-    keyBindingsToList :: KeyBindings -> Map String (KeyBinding, [(KeyMask, KeySym)])
-    keyBindingsToList b =
-      fmap (\list -> ((\(_, Documented _ t) -> t) (head list), map fst list)) $
-        group (\(_, Documented doc _) -> doc) (sortOn (snd . fst) $ Map.toList b)
-
-    prettyShow :: (KeyMask, KeySym) -> String
-    prettyShow (mask, key) = printf "%s%s" (showMask mask) (keysymToString key)
-
-    hasSubmap b = case b of
-      Action _ -> False
-      _ -> True
-
-
-    showMask :: KeyMask -> String
-    showMask mask =
-      let masks = [(shiftMask, "S"),
-                   (altMask, "A"),
-                   (mod3Mask, "H"),
-                   (mod4Mask, "M"),
-                   (altgrMask, "AGr"),
-                   (controlMask, "C")] in
-
-              concatMap ((++"-") . snd) $ filter ((/=0) . (.&.mask) . fst) masks
-
-
-    group :: (Ord b) => (a -> b) -> [a] -> (Map b [a])
-    group fn = Map.fromListWith (++) . map (first fn . (\a -> (a, [a])))
-
-
-- 
cgit 


From a14486b47a51e772a3b230bc82390cb667f2ecd5 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 14 Apr 2022 23:09:50 -0600
Subject: Some changes to marking

---
 src/Rahm/Desktop/Keys.hs    | 9 +++++++++
 src/Rahm/Desktop/Marking.hs | 7 ++++++-
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index fec7ce5..d302b59 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -150,6 +150,15 @@ keymap = runKeys $ do
           _ -> return ()
 
     shiftMod $
+      doc "Move the marked windo to the current workspace." $
+      mapNextString $ \_ str ->
+        case str of
+          [ch] | isAlphaNum ch -> do
+            ws <- getCurrentWorkspace
+            maybe (return ()) (windows . W.shiftWin ws) =<< markToWindow ch
+          _ -> return ()
+
+    controlMod $
       doc "Swap the current window with a mark." $
       mapNextString $ \_ str ->
         case str of
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 1144ad7..98c96bb 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -2,7 +2,7 @@ module Rahm.Desktop.Marking (
   historyNext, historyPrev,
   markCurrentWindow, pushHistory,
   jumpToMark, jumpToLast, swapWithLastMark,
-  swapWithMark
+  swapWithMark, markToWindow
   ) where
 
 import Rahm.Desktop.Windows (mapWindows, findWindow, getLocationWorkspace)
@@ -185,6 +185,11 @@ swapWithLastMark = pushHistory $ withHistory $ \hist -> do
       windows $ swapWithFocused win
     Nothing -> return ()
 
+markToWindow :: Mark -> X (Maybe Window)
+markToWindow m = do
+  MarkState { markStateMap = mp } <- XS.get
+  return $ Map.lookup m mp
+
 swapWithMark :: Mark -> X ()
 swapWithMark mark = pushHistory $ do
   MarkState {markStateMap = m} <- XS.get
-- 
cgit 


From 588e87efb099927fda713380e5bf64e8c7f1fdcd Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Fri, 15 Apr 2022 01:14:50 -0600
Subject: [WIP] - Window change hooks

---
 src/Rahm/Desktop/History.hs            | 25 +++++++++++++++++++
 src/Rahm/Desktop/Hooks/WindowChange.hs | 45 ++++++++++++++++++++++++++++++++++
 2 files changed, 70 insertions(+)
 create mode 100644 src/Rahm/Desktop/History.hs
 create mode 100644 src/Rahm/Desktop/Hooks/WindowChange.hs

diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs
new file mode 100644
index 0000000..8aff845
--- /dev/null
+++ b/src/Rahm/Desktop/History.hs
@@ -0,0 +1,25 @@
+module Rahm.Desktop.History where
+
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Default
+
+import Rahm.Desktop.Hooks.WindowChange
+
+data History = History {
+    currentIndex :: Int
+  , history :: IntMap Location
+  }
+
+instance Default History where
+  def = History 0 IntMap.empty
+
+addToHistory :: Location -> History -> History
+addToHistory loc (History currentIndex hist) =
+  let hist' = if currentIndex > 100
+                then IntMap.delete (currentIndex - 100) hist
+                else hist
+    in History (currentIndex + 1 ) (IntMap.insert currentIndex loc hist)
+
+historyHook :: Location -> Location -> X ()
+historyHook = undefined
diff --git a/src/Rahm/Desktop/Hooks/WindowChange.hs b/src/Rahm/Desktop/Hooks/WindowChange.hs
new file mode 100644
index 0000000..0038f47
--- /dev/null
+++ b/src/Rahm/Desktop/Hooks/WindowChange.hs
@@ -0,0 +1,45 @@
+module Rahm.Desktop.Hooks.WindowChange where
+
+import XMonad
+import Control.Monad
+import qualified XMonad.Util.ExtensibleState as XS
+import Data.Default
+import Rahm.Desktop.Workspaces
+
+import qualified XMonad.StackSet as W
+
+data Location = Location WorkspaceId (Maybe Window)
+  deriving (Read, Show, Eq)
+
+newtype LastLocation = LastLocation (Maybe Location)
+  deriving (Read, Show)
+
+instance Default LastLocation where
+  def = LastLocation Nothing
+
+instance ExtensionClass LastLocation where
+  initialValue = def
+  extensionType = PersistentExtension
+
+-- Creates a log hook from the function provided.
+--
+-- The first argument to the function is the old window, the second argument in
+-- the new window.
+withLocationChangeHook :: (Location -> Location -> X ()) -> XConfig l -> XConfig l
+withLocationChangeHook fn config =
+  config {
+    logHook = do
+      logHook config
+
+      currentLocation <-
+        Location <$> getCurrentWorkspace <*> withWindowSet (return . W.peek)
+
+      LastLocation last <- XS.get
+
+      whenJust last $ \lastLocation ->
+        when (lastLocation /= currentLocation) $
+          fn lastLocation currentLocation
+
+      XS.put $ LastLocation $ Just currentLocation
+      return ()
+  }
-- 
cgit 


From 7a5051f7955a8b4e69b2c28b5a9b34f9730e21f0 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Fri, 15 Apr 2022 23:55:35 -0600
Subject: Make history much, much more reliable.

This time history is being done using a hook to keep track of history.
This means I don't have to manually call pushHistory every time I focus
a new window.
---
 src/Main.hs                 |  11 +++-
 src/Rahm/Desktop/History.hs |  91 +++++++++++++++++++++++++++-----
 src/Rahm/Desktop/Keys.hs    |  39 +++++++++-----
 src/Rahm/Desktop/Lib.hs     |   4 +-
 src/Rahm/Desktop/Marking.hs | 124 ++------------------------------------------
 src/Rahm/Desktop/Submap.hs  |   2 +-
 6 files changed, 122 insertions(+), 149 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 56c66f5..edce3fb 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -11,6 +11,7 @@ import XMonad.Layout.Fullscreen (fullscreenEventHook)
 import System.Environment (setEnv)
 import Data.Monoid
 import qualified Data.Map as Map
+import Text.Printf
 
 import Rahm.Desktop.Swallow
 import Rahm.Desktop.Windows
@@ -20,6 +21,8 @@ import Rahm.Desktop.Layout
 import Rahm.Desktop.Logger
 import Rahm.Desktop.DMenu (menuCommandString)
 import Rahm.Desktop.RebindKeys
+import Rahm.Desktop.Hooks.WindowChange
+import Rahm.Desktop.History
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as W
@@ -35,8 +38,8 @@ main = do
 
   xmobar <- spawnXMobar
 
-  (=<<) X.xmonad $
-    applyKeys $ ewmh $ docks $  def
+  (=<<) X.xmonad $ 
+    applyKeys $ withLocationChangeHook historyHook $ ewmh $ docks $  def
        { terminal    = "alacritty"
        , modMask     = mod3Mask
        , borderWidth = 2
@@ -75,6 +78,10 @@ main = do
        }
 
 
+changeHook :: Location -> Location -> X ()
+changeHook l1 l2 = do
+  logs $ printf "Change %s -> %s" (show l1) (show l2)
+
 doCenterFloat :: ManageHook
 doCenterFloat =
   ask >>= \w -> doF . W.float w . centerRect . snd =<< liftX (floatLocation w)
diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs
index 8aff845..dfecc63 100644
--- a/src/Rahm/Desktop/History.hs
+++ b/src/Rahm/Desktop/History.hs
@@ -1,25 +1,92 @@
 module Rahm.Desktop.History where
 
+import XMonad
+import Text.Printf
+import qualified XMonad.StackSet as W
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
 import Data.Default
+import qualified XMonad.Util.ExtensibleState as XS
 
+import Data.Foldable (toList)
+import Rahm.Desktop.Workspaces (gotoWorkspace)
 import Rahm.Desktop.Hooks.WindowChange
+import Rahm.Desktop.Logger
+import Rahm.Desktop.Marking
+import Data.Sequence (Seq(..))
+import qualified Data.Sequence as Seq
 
-data History = History {
-    currentIndex :: Int
-  , history :: IntMap Location
-  }
+data BoundedSeqZipper a = BoundedSeqZipper Int (Seq a) (Seq a)
+  deriving (Eq, Show, Ord, Read)
+
+instance Functor BoundedSeqZipper where
+  fmap fn (BoundedSeqZipper i h t) = BoundedSeqZipper i (fmap fn h) (fmap fn t)
+
+zipperDbgPrint :: (Show a) => BoundedSeqZipper a -> String
+zipperDbgPrint (BoundedSeqZipper _ h (c :<| t)) =
+  concat $
+    map (printf " %s " . show) (toList h) ++
+    [printf "[%s]" (show c)] ++
+    map (printf " %s " . show) (toList t)
+zipperDbgPrint _ = "<empty>"
+
+pushZipper :: a -> BoundedSeqZipper a -> BoundedSeqZipper a
+pushZipper e (BoundedSeqZipper maxSize _ (tail :|> _))
+    | maxSize <= Seq.length tail =
+  BoundedSeqZipper maxSize mempty (e :<| tail)
+pushZipper e (BoundedSeqZipper maxSize _ tail) =
+  BoundedSeqZipper maxSize mempty (e :<| tail)
+
+getZipper :: BoundedSeqZipper a -> Maybe a
+getZipper (BoundedSeqZipper _ _ (e :<| _)) = Just e
+getZipper _ = Nothing
+
+zipperBack :: BoundedSeqZipper a -> BoundedSeqZipper a
+zipperBack (BoundedSeqZipper s h (e :<| t)) = BoundedSeqZipper s (e :<| h) t
+zipperBack b = b
+
+zipperForward :: BoundedSeqZipper a -> BoundedSeqZipper a
+zipperForward (BoundedSeqZipper s (e :<| h) t) = BoundedSeqZipper s h (e :<| t)
+zipperForward b = b
+
+newtype History = History {
+  currentZipper :: BoundedSeqZipper Location
+} deriving (Read, Show)
 
 instance Default History where
-  def = History 0 IntMap.empty
+  def = History (BoundedSeqZipper 1000 mempty mempty)
 
-addToHistory :: Location -> History -> History
-addToHistory loc (History currentIndex hist) =
-  let hist' = if currentIndex > 100
-                then IntMap.delete (currentIndex - 100) hist
-                else hist
-    in History (currentIndex + 1 ) (IntMap.insert currentIndex loc hist)
+instance ExtensionClass History where
+  initialValue = def
+  -- extensionType = PersistentExtension
+
+historyBack :: X ()
+historyBack = do
+  History z <- XS.get
+  let z' = zipperBack z
+  mapM_ focusLocation (getZipper z')
+  XS.put (History z')
+
+historyForward :: X ()
+historyForward = do
+  History z <- XS.get
+  let z' = zipperForward z
+  mapM_ focusLocation (getZipper z')
+  XS.put (History z')
+
+lastWindow :: X (Maybe Location)
+lastWindow = getZipper . zipperBack . currentZipper <$> XS.get
+
+jumpToLastLocation :: X ()
+jumpToLastLocation = mapM_ focusLocation =<< lastWindow
+  
 
 historyHook :: Location -> Location -> X ()
-historyHook = undefined
+historyHook (Location ws _) l@(Location ws' _) | ws /= ws' = do
+  XS.modify $ \(History z) -> History (pushZipper l z)
+
+historyHook _ _ = return ()
+
+focusLocation :: Location -> X ()
+focusLocation (Location ws Nothing) = gotoWorkspace ws
+focusLocation (Location _ (Just win)) = windows $ W.focusWindow win
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index d302b59..ebc8b7f 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -62,6 +62,7 @@ import Rahm.Desktop.Swallow
 import Rahm.Desktop.SwapMaster (swapMaster)
 import Rahm.Desktop.Windows
 import Rahm.Desktop.Workspaces
+import Rahm.Desktop.History
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
@@ -143,10 +144,10 @@ keymap = runKeys $ do
       doc "Jumps between marks." $
       mapNextString $ \_ str ->
         case str of
-          ['\''] -> jumpToLast
+          ['\''] -> jumpToLastLocation
           [ch] | isAlphaNum ch -> jumpToMark ch
-          "[" -> historyPrev
-          "]" -> historyNext
+          "[" -> historyBack
+          "]" -> historyForward
           _ -> return ()
 
     shiftMod $
@@ -162,7 +163,7 @@ keymap = runKeys $ do
       doc "Swap the current window with a mark." $
       mapNextString $ \_ str ->
         case str of
-          ['\''] ->  swapWithLastMark
+          -- ['\''] ->  swapWithLastMark
           [ch] | isAlphaNum ch -> swapWithMark ch
           _ -> return ()
 
@@ -315,7 +316,7 @@ keymap = runKeys $ do
          \F1: display this help.\n\n\t" $
       mapNextStringWithKeysym $ \_ keysym str ->
         case ((keysym, str), selectWorkspace (keysym, str)) of
-          (_, Just w) -> pushHistory $ gotoWorkspace =<< w
+          (_, Just w) -> gotoWorkspace =<< w
           -- Test binding. Tests that I can still submap keysyms alone (keys
           -- where XLookupString won't return anything helpful.)
           ((f, _), _) | f == xK_F1 -> 
@@ -336,7 +337,7 @@ keymap = runKeys $ do
       doc "Move the current focused window to another workspace and view that workspace" $
       mapNextStringWithKeysym $ \_ keysym str ->
         case ((keysym, str), selectWorkspace (keysym, str)) of
-          (_, Just w) -> pushHistory $ do
+          (_, Just w) -> do
             ws <- w
             shiftToWorkspace ws
             gotoWorkspace ws
@@ -377,7 +378,7 @@ keymap = runKeys $ do
       sendMessage Shrink
 
     shiftMod $
-      doc "Go to the previous window in history." historyPrev
+      doc "Go to the previous window in history." historyBack
 
   bind xK_k $ do
     justMod $
@@ -385,7 +386,7 @@ keymap = runKeys $ do
       sendMessage Expand
 
     shiftMod $
-      doc "Go to the next window in history." historyNext
+      doc "Go to the next window in history." historyForward
 
   bind xK_l $ do
     justMod    $
@@ -551,7 +552,7 @@ keymap = runKeys $ do
 
         bind xK_p $ do
           (justMod -|- noMod) $
-            doc "Go to the prior window in the history" historyPrev
+            doc "Go to the prior window in the history" historyBack
 
         bind xK_t $ do
           (justMod -|- noMod) $ logs "Test Log"
@@ -562,7 +563,7 @@ keymap = runKeys $ do
         --     spawnX (terminal config ++ " -t Notes -e notes new")
         bind xK_n $ do
           (justMod -|- noMod) $
-            doc "Go to the next window in the history" historyNext
+            doc "Go to the next window in the history" historyForward
 
         bind xK_c $ do
           shiftMod $
@@ -606,6 +607,18 @@ keymap = runKeys $ do
             doc "Set the volume of an application via rofi." $
             spawnX "set-volume.sh -a"
 
+        let navigateHistory = repeatable $ do
+              bind xK_bracketright $ do
+                noMod $
+                  doc "Move forward in location history" historyForward
+
+              bind xK_bracketleft $ do
+                noMod $
+                  doc "Move backward in location history" historyBack
+
+        bind xK_bracketleft $ noMod navigateHistory
+        bind xK_bracketright $ noMod navigateHistory
+
         -- Double-tap Z to toggle zoom.
         bind xK_z $ do
           noMod -|- justMod $
@@ -723,8 +736,8 @@ mouseMap = runButtons $ do
             (button4, increaseVolume),
             (button5, decreaseVolume),
             (button2, playPause),
-            (button9, historyNext),
-            (button8, historyPrev),
+            (button9, historyForward),
+            (button8, historyBack),
             (button6, mediaPrev),
             (button7, mediaNext)
             ]
@@ -760,7 +773,7 @@ mouseMap = runButtons $ do
             gotoWorkspace =<< (accompaningWorkspace <$> getCurrentWorkspace)
 
       bind button15 $ do
-        noMod $ noWindow jumpToLast
+        noMod $ noWindow jumpToLastLocation
 
 
       let workspaceButtons = [
diff --git a/src/Rahm/Desktop/Lib.hs b/src/Rahm/Desktop/Lib.hs
index 3b4ee9c..c7cfca4 100644
--- a/src/Rahm/Desktop/Lib.hs
+++ b/src/Rahm/Desktop/Lib.hs
@@ -48,14 +48,14 @@ getString = runQuery $ do
       else printf "%s - %s" t a
 
 askWindowId :: X (Maybe Window)
-askWindowId = pushHistory $ do
+askWindowId = do
   windowTitlesToWinId <- withWindowSet $ \ss ->
     Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
 
   runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
 
 windowJump :: X ()
-windowJump = pushHistory $ do
+windowJump = do
   windowId <- askWindowId
 
   case windowId of
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 98c96bb..639aae2 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -1,7 +1,6 @@
 module Rahm.Desktop.Marking (
-  historyNext, historyPrev,
-  markCurrentWindow, pushHistory,
-  jumpToMark, jumpToLast, swapWithLastMark,
+  markCurrentWindow,
+  jumpToMark, 
   swapWithMark, markToWindow
   ) where
 
@@ -27,81 +26,19 @@ import qualified Data.Map as Map
 
 type Mark = Char
 
-historySize = 100 -- max number of history elements the tail.
-
-data History a = History [a] (Seq a)
-  deriving (Read, Show)
-
-instance Default (History a) where
-  
-  def = History [] Seq.empty
-
-seqPush :: a -> Seq a -> Seq a
-seqPush elem s@(seq :|> _) | Seq.length s >= historySize = elem :<| seq
-seqPush elem s = elem :<| s
-
-historyForward :: History a -> History a
-historyForward (History (a:as) tail) = History as (seqPush a tail)
-historyForward z = z
-
-historyBackward :: History a -> History a
-historyBackward (History head (a :<| as)) = History (a : head) as
-historyBackward z = z
-
-historyCurrent :: History a -> Maybe a
-historyCurrent (History (a:_) _) = Just a
-historyCurrent _ = Nothing
-
-historyPush :: (Eq a) => a -> History a -> History a
-historyPush a h@(History (w : _) _) | a == w = h
-historyPush a (History (w : _) tail) = History [a] (seqPush w tail)
-historyPush a (History _ tail) = History [a] tail
-
-historySwap :: History a -> History a
-historySwap (History (a:as) (t :<| ts)) = History (t : as) (seqPush a ts)
-historySwap z = z
-
-historyLast :: History a -> Maybe a
-historyLast (History _ (t :<| _)) = Just t
-historyLast _ = Nothing
-
-data Spot =
-        WindowSpot Window | -- Focus is on a window.
-        TagSpot String -- Focus is on an (empty) tag
-        deriving (Read, Show, Eq, Ord)
-
-greedyFocus :: Spot -> X ()
-greedyFocus (WindowSpot win) = do
-     ws <- withWindowSet $ \ss ->
-             return $ getLocationWorkspace =<< findWindow ss win
- 
-     mapM_ (windows . greedyView . tag) ws
-     focus win
-greedyFocus (TagSpot tag) =
-  windows $ greedyView tag
-
 data MarkState =
   MarkState {
     markStateMap :: Map Mark Window
-  , windowHistory :: History Spot
   } deriving (Read, Show)
 
 
 instance ExtensionClass MarkState where
-  initialValue = MarkState Map.empty def
+  initialValue = MarkState Map.empty
   extensionType = PersistentExtension
 
-changeHistory :: (History Spot -> History Spot) -> (MarkState -> MarkState)
-changeHistory fn ms = ms { windowHistory = fn (windowHistory ms)}
-
 withMaybeFocused :: (Maybe Window -> X a) -> X a
 withMaybeFocused f = withWindowSet $ f . peek
 
-normalizeWindows :: X ()
-normalizeWindows = do
-  MarkState { windowHistory = h } <- XS.get
-  mapM_ greedyFocus (historyCurrent h)
-
 -- greedyFocus :: Window -> X ()
 -- greedyFocus win = do
 --     ws <- withWindowSet $ \ss ->
@@ -118,45 +55,12 @@ markCurrentWindow mark = do
           markStateMap = Map.insert mark win ms
         }
 
-pushHistory :: X a -> X a
-pushHistory fn = do
-  withMaybeFocused $ \maybeWindowBefore -> do
-    case maybeWindowBefore of
-      (Just windowBefore) ->
-        XS.modify $ changeHistory (historyPush (WindowSpot windowBefore))
-      Nothing -> 
-        withWindowSet $ \ws ->
-          XS.modify $ changeHistory (historyPush (TagSpot (currentTag ws)))
-
-    ret <- fn
-
-    withMaybeFocused $ \maybeWindowAfter ->
-      case maybeWindowAfter of
-        Just windowAfter ->
-          XS.modify $ changeHistory (historyPush $ WindowSpot windowAfter)
-        Nothing ->
-          withWindowSet $ \ws ->
-            XS.modify $ changeHistory (historyPush $ TagSpot $ currentTag ws)
-
-    return ret
-
-withHistory :: (History Spot -> X ()) -> X ()
-withHistory fn = do
-  MarkState { windowHistory = w } <- XS.get
-  fn w
-
-jumpToLast :: X ()
-jumpToLast = do
-  XS.modify (changeHistory historySwap)
-  normalizeWindows
-
 jumpToMark :: Mark -> X ()
 jumpToMark mark = do
   MarkState {markStateMap = m} <- XS.get
   case Map.lookup mark m of
     Nothing -> return ()
-    Just w -> pushHistory $
-      greedyFocus (WindowSpot w)
+    Just w ->  windows $ focusWindow w
 
 setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
 setFocusedWindow
@@ -177,34 +81,16 @@ swapWithFocused winToSwap stackSet =
           mapWindows (
             \w -> if w == winToSwap then focused else w) stackSet
 
-swapWithLastMark :: X ()
-swapWithLastMark = pushHistory $ withHistory $ \hist -> do
-
-  case historyLast hist of
-    Just (WindowSpot win) ->
-      windows $ swapWithFocused win
-    Nothing -> return ()
-
 markToWindow :: Mark -> X (Maybe Window)
 markToWindow m = do
   MarkState { markStateMap = mp } <- XS.get
   return $ Map.lookup m mp
 
 swapWithMark :: Mark -> X ()
-swapWithMark mark = pushHistory $ do
+swapWithMark mark = do
   MarkState {markStateMap = m} <- XS.get
 
   case Map.lookup mark m of
     Nothing -> return ()
     Just winToSwap -> do
       windows $ swapWithFocused winToSwap
-
-historyPrev :: X ()
-historyPrev = do
-  XS.modify $ changeHistory historyBackward
-  normalizeWindows
-
-historyNext :: X ()
-historyNext = do
-  XS.modify $ changeHistory historyForward
-  normalizeWindows
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index da9fe77..ad245ab 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -61,7 +61,7 @@ mapNextStringWithKeysym fn = do
 
   ret <- io $ fix $ \nextkey -> do
     ret <-
-      getMaskEventWithTimeout 1000 d keyPressMask $ \p -> do
+      getMaskEventWithTimeout 2000 d keyPressMask $ \p -> do
         KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
         keysym <- keycodeToKeysym d code 0
         (_, str) <- lookupString (asKeyEvent p)
-- 
cgit 


From d1a00e6e42b4b513f7de66a9e710f62faca2ef00 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sat, 16 Apr 2022 00:20:03 -0600
Subject: fix some hlint warnings

---
 src/Rahm/Desktop/History.hs                   |  2 +-
 src/Rahm/Desktop/Keys.hs                      | 16 +++++++++-------
 src/Rahm/Desktop/Layout.hs                    |  4 ++--
 src/Rahm/Desktop/Layout/ConsistentMosaic.hs   |  4 ++--
 src/Rahm/Desktop/Layout/Flip.hs               |  2 +-
 src/Rahm/Desktop/Layout/Hole.hs               |  4 ++--
 src/Rahm/Desktop/Layout/List.hs               |  4 ++--
 src/Rahm/Desktop/Layout/Pop.hs                |  4 ++--
 src/Rahm/Desktop/Layout/Redescribe.hs         |  2 +-
 src/Rahm/Desktop/Layout/ReinterpretMessage.hs |  2 +-
 src/Rahm/Desktop/Marking.hs                   |  4 ++--
 src/Rahm/Desktop/Submap.hs                    |  4 ++--
 src/Rahm/Desktop/Workspaces.hs                |  6 +++---
 src/Rahm/Desktop/XMobarLog.hs                 |  2 +-
 14 files changed, 31 insertions(+), 29 deletions(-)

diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs
index dfecc63..5e15fe6 100644
--- a/src/Rahm/Desktop/History.hs
+++ b/src/Rahm/Desktop/History.hs
@@ -79,7 +79,7 @@ lastWindow = getZipper . zipperBack . currentZipper <$> XS.get
 
 jumpToLastLocation :: X ()
 jumpToLastLocation = mapM_ focusLocation =<< lastWindow
-  
+
 
 historyHook :: Location -> Location -> X ()
 historyHook (Location ws _) l@(Location ws' _) | ws /= ws' = do
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index ebc8b7f..3e660b5 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -292,7 +292,7 @@ keymap = runKeys $ do
               (MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
           (_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace
           _ -> Nothing
-    
+
     justMod $
       doc "Goto/Send/Etc To a workspace\n\n\t\
 
@@ -319,7 +319,7 @@ keymap = runKeys $ do
           (_, Just w) -> gotoWorkspace =<< w
           -- Test binding. Tests that I can still submap keysyms alone (keys
           -- where XLookupString won't return anything helpful.)
-          ((f, _), _) | f == xK_F1 -> 
+          ((f, _), _) | f == xK_F1 ->
             (safeSpawn "gxmessage" [
               "-fn", "Source Code Pro",
               documentation (keymap config)] :: X ())
@@ -456,7 +456,7 @@ keymap = runKeys $ do
 
   bind xK_space $ do
     justMod $ doc "Layout-related bindings" $ subkeys $ do
-      
+
       bind xK_n $
         (noMod -|- justMod) $ doc "Use the next layout in the layout list." $
           sendMessage toNextLayout
@@ -616,8 +616,10 @@ keymap = runKeys $ do
                 noMod $
                   doc "Move backward in location history" historyBack
 
-        bind xK_bracketleft $ noMod navigateHistory
-        bind xK_bracketright $ noMod navigateHistory
+        bind xK_bracketleft $ noMod $
+          doc "Move forward in location history" navigateHistory
+        bind xK_bracketright $ noMod $
+          doc "Move backward in location history" navigateHistory
 
         -- Double-tap Z to toggle zoom.
         bind xK_z $ do
@@ -756,7 +758,7 @@ mouseMap = runButtons $ do
           ]
 
     forM_ (map fst swapButtons) $ \b ->
-      bind b $ noMod $ \w -> click >> (continuous swapButtons b) w
+      bind b $ noMod $ \w -> click >> continuous swapButtons b w
 
     bind button13 $ noMod $ subMouse $ do
       bind button13 $ noMod $ subMouse $ do
@@ -770,7 +772,7 @@ mouseMap = runButtons $ do
       bind button13 $
         noMod $
           noWindow $
-            gotoWorkspace =<< (accompaningWorkspace <$> getCurrentWorkspace)
+            gotoWorkspace . accompaningWorkspace =<< getCurrentWorkspace
 
       bind button15 $ do
         noMod $ noWindow jumpToLastLocation
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index d8c3442..f6e714c 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -70,14 +70,14 @@ nLayouts = layoutListLength myLayoutList
 -- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system
 -- hacking one can do in Haskell.
 instance DoReinterpret "ForMosaic" where
-  
+
   -- IncMaster message
   reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
     Just . SomeMessage <$> (
       if n > 0
         then expandPositionAlt
         else shrinkPositionAlt)
-  
+
   -- ResizeMaster message
   reinterpretMessage _ (fromMessage -> Just m) = do
     Just . SomeMessage <$>
diff --git a/src/Rahm/Desktop/Layout/ConsistentMosaic.hs b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
index db1ce4e..a84a2f1 100644
--- a/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
+++ b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
@@ -37,7 +37,7 @@ shrinkPositionAlt = doAlt shrinkWindowAlt
 
 
 instance (LayoutClass l a, Show a, Ord a, Enum a, Num a) => LayoutClass (MosaicWrap l) a where
-  
+
   runLayout (W.Workspace t (MosaicWrap l) (id -> Just s)) rect = do
     let zs = zipStack [100..] s
         s' = mapStack fst zs
@@ -59,7 +59,7 @@ instance (LayoutClass l a, Show a, Ord a, Enum a, Num a) => LayoutClass (MosaicW
   runLayout (W.Workspace t (MosaicWrap l) a) rect = do
     (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
     return (rects, MosaicWrap <$> maybeNewLayout)
-    
+
 
   -- By default just pass the message to the underlying layout.
   handleMessage (MosaicWrap l) mess = do
diff --git a/src/Rahm/Desktop/Layout/Flip.hs b/src/Rahm/Desktop/Layout/Flip.hs
index e0d3abc..fe425e9 100644
--- a/src/Rahm/Desktop/Layout/Flip.hs
+++ b/src/Rahm/Desktop/Layout/Flip.hs
@@ -69,7 +69,7 @@ instance LayoutModifier Flip a where
         Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
       flipHoriz (Rectangle x y w h) =
         Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
-  
+
   -- Handle DoFlip messages.
   pureMess flip (fromMessage -> Just (DoFlip f)) = Just (f flip)
   pureMess _ _ = Nothing
diff --git a/src/Rahm/Desktop/Layout/Hole.hs b/src/Rahm/Desktop/Layout/Hole.hs
index ee59726..3f7c9b7 100644
--- a/src/Rahm/Desktop/Layout/Hole.hs
+++ b/src/Rahm/Desktop/Layout/Hole.hs
@@ -32,11 +32,11 @@ instance (LayoutClass l a, Eq a, Num a) => LayoutClass (Hole l) a where
       app x w | not enabled = w
       app x (W.Workspace t l s) =
         case s of
-          Nothing -> 
+          Nothing ->
             W.Workspace t l (Just $ W.Stack x [] [])
           Just (W.Stack h c e) ->
             W.Workspace t l (Just $ W.Stack h c (e ++ [x]))
-  
+
   handleMessage h (fromMessage -> Just (ManageHole f)) =
     return $ Just $ f h
   handleMessage (Hole e l) a = do
diff --git a/src/Rahm/Desktop/Layout/List.hs b/src/Rahm/Desktop/Layout/List.hs
index f533ea2..77b53c9 100644
--- a/src/Rahm/Desktop/Layout/List.hs
+++ b/src/Rahm/Desktop/Layout/List.hs
@@ -102,7 +102,7 @@ instance (Selector t) => Selector (Sel t) where
   increment (Skip l) = Skip <$> increment l
   -- If the current element is selected, the increment is just the initial of
   -- the tail.
-  increment Sel = Skip <$> initial 
+  increment Sel = Skip <$> initial
 
   -- For a selection, the initial is just this in the Sel state.
   initial = Just Sel
@@ -178,7 +178,7 @@ layoutListLengthProxy _ = Proxy
 (|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
 (|:) = LCons
 
-infixr 5 |: 
+infixr 5 |:
 
 -- Constructs a LayoutList. This function enforces that the SelectorFor l
 -- is a 'Sel' type. Essentially this enforces that there must be at least one
diff --git a/src/Rahm/Desktop/Layout/Pop.hs b/src/Rahm/Desktop/Layout/Pop.hs
index 7e3dbd1..e06ff25 100644
--- a/src/Rahm/Desktop/Layout/Pop.hs
+++ b/src/Rahm/Desktop/Layout/Pop.hs
@@ -37,7 +37,7 @@ data PopMessage where
   deriving (Message)
 
 resizePop :: Float -> PopMessage
-resizePop f = PopMessage $ \(Poppable b x y l) -> 
+resizePop f = PopMessage $ \(Poppable b x y l) ->
   Poppable b (g $ x + f) (g $ y + f) l
   where
     g = max 0 . min 0.45
@@ -52,7 +52,7 @@ poppable :: l a -> Poppable l a
 poppable = Poppable False 0.05 0.05
 
 instance (LayoutClass l a, Eq a) => LayoutClass (Poppable l) a where
-  
+
   -- If the current layout is not popped, then just return what the underlying
   -- layout returned.
 
diff --git a/src/Rahm/Desktop/Layout/Redescribe.hs b/src/Rahm/Desktop/Layout/Redescribe.hs
index c5c7472..036bc88 100644
--- a/src/Rahm/Desktop/Layout/Redescribe.hs
+++ b/src/Rahm/Desktop/Layout/Redescribe.hs
@@ -11,7 +11,7 @@ import Data.Typeable (Typeable)
 
 -- Type-class to modify the description of a layout.
 class Describer m l where
-  
+
   -- Returns the new description from the given description modifier, the layout
   -- and the existing description.
   newDescription :: m -> l a -> String -> String
diff --git a/src/Rahm/Desktop/Layout/ReinterpretMessage.hs b/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
index 8f6a78d..e3434b1 100644
--- a/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
+++ b/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
@@ -31,7 +31,7 @@ data ReinterpretMessage k a = ReinterpretMessage
 
 -- Instance for ReinterpretMessage as a Layout modifier.
 instance (DoReinterpret k) =>
-      LayoutModifier (ReinterpretMessage k) a where 
+      LayoutModifier (ReinterpretMessage k) a where
 
   handleMessOrMaybeModifyIt self message = do
 
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 639aae2..b1783cc 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -1,6 +1,6 @@
 module Rahm.Desktop.Marking (
   markCurrentWindow,
-  jumpToMark, 
+  jumpToMark,
   swapWithMark, markToWindow
   ) where
 
@@ -43,7 +43,7 @@ withMaybeFocused f = withWindowSet $ f . peek
 -- greedyFocus win = do
 --     ws <- withWindowSet $ \ss ->
 --             return $ getLocationWorkspace =<< findWindow ss win
--- 
+--
 --     mapM_ (windows . greedyView . tag) ws
 --     focus win
 
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index ad245ab..5db8928 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -76,12 +76,12 @@ mapNextStringWithKeysym fn = do
       Nothing -> return Nothing
 
   io $ ungrabKeyboard d currentTime
-  case ret of 
+  case ret of
     Just (m, str, keysym) -> fn m keysym str
     Nothing -> return ()
 
 {- Like submap, but on the character typed rather than the kysym. -}
-mapNextString :: (KeyMask -> String -> X ()) -> X () 
+mapNextString :: (KeyMask -> String -> X ()) -> X ()
 mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
 
 submapDefaultWithKey :: ((KeyMask, KeySym) -> X ()) -> Map (KeyMask, KeySym) (X ()) -> X ()
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index 1349fea..de481ac 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -114,7 +114,7 @@ swapWorkspace toWorkspace = do
         | otherwise = ws
 
 adjacentWorkspaceNotVisible :: Selector -> WorkspaceId -> X WorkspaceId
-adjacentWorkspaceNotVisible (Selector selector) from = 
+adjacentWorkspaceNotVisible (Selector selector) from =
   withWindowSet $ \ss ->
     let tags = sort $
                  W.tag . snd  <$> filter (\x -> fst x /= Visible) (
@@ -123,7 +123,7 @@ adjacentWorkspaceNotVisible (Selector selector) from =
         return $ fromMaybe from $ selector (==from) tags
 
 adjacentWorkspace :: Selector -> WorkspaceId -> X WorkspaceId
-adjacentWorkspace (Selector selector) from = 
+adjacentWorkspace (Selector selector) from =
   withWindowSet $ \ss ->
     let tags = sort $ W.tag . snd  <$> getPopulatedWorkspaces ss
         in
@@ -154,4 +154,4 @@ workspaceWithWindow wid = withWindowSet $ \(W.StackSet c v h _) ->
     W.tag <$>
       find (\(W.Workspace _ _ stack) -> wid `elem` W.integrate' stack)
         (map W.workspace (c : v) ++ h)
-  
+
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index 4f8bbb8..f2cccf8 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -60,7 +60,7 @@ xMobarLogHook (XMobarLog xmproc) = do
       tell $ "<fc=#404040>│ </fc><fc=#a0a0a0><fn=3>"
       tell $ title
       tell $ "</fn></fc>"
-  
+
   where
     toAction [ch] | (ch >= 'A' && ch <= 'Z') ||
                     (ch >= 'a' && ch <= 'z') ||
-- 
cgit 


From 65456557536f7886ae079fa2b980a1ef7f0619c0 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sat, 16 Apr 2022 00:54:01 -0600
Subject: Remove the "│" from xmobar. I think it makes it cleaner, but it is
 not a slam dunk.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 extras/HOME/.xmobarrc                | 10 +++++-----
 extras/HOME/.xmonad/xmobar-bluetooth |  4 ++--
 extras/HOME/.xmonad/xmobar-weather   |  2 +-
 src/Rahm/Desktop/XMobarLog.hs        |  4 ++--
 4 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index aa252f7..c536f7e 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -28,12 +28,12 @@ Config
    , sepChar = "%"
    , alignSep = "}{"
    , template =
-      " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc><fc=#404040> │\
-      \</fc>%UnsafeStdinReader%}\
+      " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc> \
+      \%UnsafeStdinReader%}\
       \{ %cpu% %memory% <fc=#404040>\
-      \│</fc> %weather% <fc=#404040>│\
-      \</fc> <fc=#a0a0a0>%media%</fc> <fc=#404040>│ \
-      \</fc>%bluetooth%%bat% <fc=#404040>│</fc> <fn=2><fc=#606060>%time%</fc></fn> "
+      \ %weather% \
+      \</fc> <fc=#a0a0a0>%media%</fc> \
+      \%bluetooth%%bat% <fn=2><fc=#606060>%time%</fc></fn> "
    , commands = [
        Run UnsafeStdinReader,
        Run Date "%m/%d %H:%M:%S" "time" 10,
diff --git a/extras/HOME/.xmonad/xmobar-bluetooth b/extras/HOME/.xmonad/xmobar-bluetooth
index 16a6d70..3d65ee7 100755
--- a/extras/HOME/.xmonad/xmobar-bluetooth
+++ b/extras/HOME/.xmonad/xmobar-bluetooth
@@ -13,10 +13,10 @@ if [ -d /sys/class/bluetooth ] ; then
     fi
 
     if [ "$key" == "Connected" -a "$value" == "yes" ] ; then
-      exec echo "<fc=#4287f5></fc> <fc=#a0a0a0><fn=3>$cur</fn></fc> <fc=#404040>│</fc> "
+      exec echo "<fc=#4287f5></fc> <fc=#a0a0a0><fn=3>$cur</fn></fc>  "
     fi
   done
 
 fi
 
-exec echo "<fc=#404040></fc> <fc=#404040>│</fc> "
+exec echo "<fc=#404040></fc>  "
diff --git a/extras/HOME/.xmonad/xmobar-weather b/extras/HOME/.xmonad/xmobar-weather
index 0fee524..7399969 100755
--- a/extras/HOME/.xmonad/xmobar-weather
+++ b/extras/HOME/.xmonad/xmobar-weather
@@ -100,4 +100,4 @@ if ($is_day) {
   $conditions = %conditions_night{$sky_conditions};  
 }
 
-printf("<fc=#a0a0a0><fn=3>$city</fn> <fn=3>$dir</fn> <fn=3>${wind_speed}</fn></fc> $conditions<fn=3>   <fc=#a0a0a0>%.0f°F</fc></fn>\n", $temp);
+printf("<fc=#a0a0a0><fn=3>$city</fn><fn=3>$dir</fn><fn=3>${wind_speed}</fn></fc> $conditions<fn=3>  <fc=#a0a0a0>%.0f°F</fc></fn>\n", $temp);
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index f2cccf8..637670e 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -46,7 +46,7 @@ xMobarLogHook (XMobarLog xmproc) = do
     hPutStrLn xmproc $ trunc 80 $ execWriter $ do
       tell " "
       tell layoutXpm
-      tell $ "<fc=#404040> │ </fc>"
+      tell $ "  "
 
       forM_ wss $ \(t, ws) -> do
         case t of
@@ -57,7 +57,7 @@ xMobarLogHook (XMobarLog xmproc) = do
         tell $ toAction $ S.tag ws
         tell " </fc></fn>"
 
-      tell $ "<fc=#404040>│ </fc><fc=#a0a0a0><fn=3>"
+      tell $ " <fc=#a0a0a0><fn=3>"
       tell $ title
       tell $ "</fn></fc>"
 
-- 
cgit 


From e7d0c65ef807cf6d595273a764ec95d17c8708b5 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sat, 16 Apr 2022 11:33:57 -0600
Subject: Switch Ctrl-i and Ctrl-d for chrome bindings

---
 src/Rahm/Desktop/Keys.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index d302b59..6912473 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -859,13 +859,13 @@ windowSpecificBindings config = do
       rawMask (controlMask .|. shiftMask) $ emitKey (0, xK_Home)
 
     bind xK_d $
-      rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_Tab)
+      rawMask controlMask $ emitKey (controlMask, xK_Tab)
 
     bind xK_Escape $
       rawMask controlMask $ emitKey (controlMask, xK_w)
 
     bind xK_i $ do
-      rawMask controlMask $ emitKey (controlMask, xK_Tab)
+      rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_Tab)
 
     bind xK_F2 $
       -- Experimental.
-- 
cgit 


From 9dc562c177fef4ad3b25bfac348c21a6c57839f5 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 17 Apr 2022 23:15:55 -0600
Subject: Starting to implement window management language

---
 src/Main.hs                            |   1 +
 src/Rahm/Desktop/Common.hs             |  86 ++++++++++++++++++++++
 src/Rahm/Desktop/History.hs            |  37 ++++++----
 src/Rahm/Desktop/Hooks/WindowChange.hs |  16 ++---
 src/Rahm/Desktop/Keys.hs               |  70 ++++++------------
 src/Rahm/Desktop/Lib.hs                |  63 ----------------
 src/Rahm/Desktop/Marking.hs            | 127 +++++++++++++++++++++++----------
 src/Rahm/Desktop/Workspaces.hs         |  38 +++++++---
 8 files changed, 260 insertions(+), 178 deletions(-)
 create mode 100644 src/Rahm/Desktop/Common.hs
 delete mode 100644 src/Rahm/Desktop/Lib.hs

diff --git a/src/Main.hs b/src/Main.hs
index edce3fb..5c1a4e0 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -14,6 +14,7 @@ import qualified Data.Map as Map
 import Text.Printf
 
 import Rahm.Desktop.Swallow
+import Rahm.Desktop.Common
 import Rahm.Desktop.Windows
 import Rahm.Desktop.XMobarLog
 import Rahm.Desktop.Keys
diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
new file mode 100644
index 0000000..926d5ff
--- /dev/null
+++ b/src/Rahm/Desktop/Common.hs
@@ -0,0 +1,86 @@
+module Rahm.Desktop.Common where
+
+import Prelude hiding ((!!))
+
+import Control.Monad.Trans.Maybe
+import XMonad.Actions.DynamicWorkspaces
+import XMonad.Util.Run
+import XMonad.Prompt
+import XMonad.Prompt.Input
+import XMonad.Prompt.Shell
+
+import Rahm.Desktop.PromptConfig
+
+import Data.Char
+import Data.List hiding ((!!))
+import Data.List.Safe ((!!))
+import Data.Maybe
+import Text.Printf
+import XMonad hiding (workspaces, Screen)
+import XMonad.StackSet hiding (filter, focus)
+import qualified Data.Map as Map
+import Rahm.Desktop.DMenu
+import Data.Ord (comparing)
+
+import qualified XMonad.StackSet as S
+import Rahm.Desktop.Windows
+
+-- A location is a workspace and maybe a window with that workspace.
+data Location = Location {
+    locationWorkspace :: WorkspaceId,
+    locationWindow :: Maybe Window
+  } deriving (Read, Show, Eq, Ord)
+
+focusLocation :: Location -> X ()
+focusLocation (Location ws Nothing) = windows $ S.greedyView ws
+focusLocation (Location _ (Just win)) = windows $ S.focusWindow win
+
+masterWindow :: MaybeT X Window
+masterWindow = MaybeT $ withWindowSet $ \ss ->
+  let windows = (S.integrate' . S.stack . S.workspace . S.current) ss
+    in case windows of
+      (a:_) -> return $ Just a
+      _ -> return Nothing
+
+data WinPrompt = WinPrompt
+
+instance XPrompt WinPrompt where
+    showXPrompt _ = "[Window] "
+    commandToComplete _ = id
+
+fuzzyCompletion :: String -> String -> Bool
+fuzzyCompletion str0 str1 =
+  all (`isInfixOf`l0) ws
+  where
+    ws = filter (not . all isSpace) $ words (map toLower str0)
+    l0 = map toLower str1
+
+getString :: Window -> X String
+getString = runQuery $ do
+  t <- title
+  a <- appName
+  return $
+    if map toLower a `isInfixOf` map toLower t
+      then t
+      else printf "%s - %s" t a
+
+askWindowId :: X (Maybe Window)
+askWindowId = do
+  windowTitlesToWinId <- withWindowSet $ \ss ->
+    Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
+
+  runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
+
+windowJump :: X ()
+windowJump = mapM_ focus =<< askWindowId
+
+gotoWorkspace :: WorkspaceId -> X ()
+gotoWorkspace wid = do
+  addHiddenWorkspace wid
+  windows $ S.greedyView wid
+
+getCurrentWorkspace :: X WorkspaceId
+getCurrentWorkspace = withWindowSet $
+  \(S.StackSet (S.Screen (S.Workspace t _ _) _ _) _ _ _) -> do
+    return t
+
diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs
index 5e15fe6..9195a92 100644
--- a/src/Rahm/Desktop/History.hs
+++ b/src/Rahm/Desktop/History.hs
@@ -9,10 +9,9 @@ import Data.Default
 import qualified XMonad.Util.ExtensibleState as XS
 
 import Data.Foldable (toList)
-import Rahm.Desktop.Workspaces (gotoWorkspace)
 import Rahm.Desktop.Hooks.WindowChange
+import Rahm.Desktop.Common
 import Rahm.Desktop.Logger
-import Rahm.Desktop.Marking
 import Data.Sequence (Seq(..))
 import qualified Data.Sequence as Seq
 
@@ -60,6 +59,20 @@ instance ExtensionClass History where
   initialValue = def
   -- extensionType = PersistentExtension
 
+pastHistory :: Int -> X (Maybe Location)
+pastHistory i = do
+  History (BoundedSeqZipper _ _ t) <- XS.get
+  return $ t Seq.!? i
+
+getMostRecentLocationInHistory :: X (Maybe Location)
+getMostRecentLocationInHistory = do
+  History z <- XS.get
+  case z of
+    (BoundedSeqZipper _ (_ :|> h) _) -> return $ Just h
+    (BoundedSeqZipper _ _ (t :<| _)) -> return $ Just t
+    _ -> return Nothing
+
+
 historyBack :: X ()
 historyBack = do
   History z <- XS.get
@@ -74,19 +87,19 @@ historyForward = do
   mapM_ focusLocation (getZipper z')
   XS.put (History z')
 
-lastWindow :: X (Maybe Location)
-lastWindow = getZipper . zipperBack . currentZipper <$> XS.get
+lastLocation :: X (Maybe Location)
+lastLocation = getZipper . zipperBack . currentZipper <$> XS.get
 
-jumpToLastLocation :: X ()
-jumpToLastLocation = mapM_ focusLocation =<< lastWindow
+nextLocation :: X (Maybe Location)
+nextLocation = getZipper . zipperForward . currentZipper <$> XS.get
 
+jumpToLastLocation :: X ()
+jumpToLastLocation = mapM_ focusLocation =<< lastLocation
 
-historyHook :: Location -> Location -> X ()
-historyHook (Location ws _) l@(Location ws' _) | ws /= ws' = do
+historyHook :: Maybe Location -> Location -> X ()
+historyHook Nothing loc =
+  XS.modify $ \(History z) -> History (pushZipper loc z)
+historyHook (Just (Location ws _)) l@(Location ws' _) | ws /= ws' = do
   XS.modify $ \(History z) -> History (pushZipper l z)
 
 historyHook _ _ = return ()
-
-focusLocation :: Location -> X ()
-focusLocation (Location ws Nothing) = gotoWorkspace ws
-focusLocation (Location _ (Just win)) = windows $ W.focusWindow win
diff --git a/src/Rahm/Desktop/Hooks/WindowChange.hs b/src/Rahm/Desktop/Hooks/WindowChange.hs
index 0038f47..ec8e445 100644
--- a/src/Rahm/Desktop/Hooks/WindowChange.hs
+++ b/src/Rahm/Desktop/Hooks/WindowChange.hs
@@ -4,13 +4,10 @@ import XMonad
 import Control.Monad
 import qualified XMonad.Util.ExtensibleState as XS
 import Data.Default
-import Rahm.Desktop.Workspaces
+import Rahm.Desktop.Common
 
 import qualified XMonad.StackSet as W
 
-data Location = Location WorkspaceId (Maybe Window)
-  deriving (Read, Show, Eq)
-
 newtype LastLocation = LastLocation (Maybe Location)
   deriving (Read, Show)
 
@@ -20,12 +17,14 @@ instance Default LastLocation where
 instance ExtensionClass LastLocation where
   initialValue = def
   extensionType = PersistentExtension
-
+  
 -- Creates a log hook from the function provided.
 --
 -- The first argument to the function is the old window, the second argument in
 -- the new window.
-withLocationChangeHook :: (Location -> Location -> X ()) -> XConfig l -> XConfig l
+--
+-- If the first window is Nothing, this is the first time XMonad started.
+withLocationChangeHook :: (Maybe Location -> Location -> X ()) -> XConfig l -> XConfig l
 withLocationChangeHook fn config =
   config {
     logHook = do
@@ -36,9 +35,8 @@ withLocationChangeHook fn config =
 
       LastLocation last <- XS.get
 
-      whenJust last $ \lastLocation ->
-        when (lastLocation /= currentLocation) $
-          fn lastLocation currentLocation
+      when (last /= Just currentLocation) $
+        fn last currentLocation
 
       XS.put $ LastLocation $ Just currentLocation
       return ()
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 74960df..1369a17 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -6,7 +6,6 @@ import Control.Monad.Fix (fix)
 import Control.Monad.Loops (iterateWhile)
 import Control.Monad.Reader
 import Control.Monad.Trans.Class
-import Control.Monad.Trans.Maybe
 import Control.Monad.Writer
 import Data.Char
 import Data.List hiding ((!!))
@@ -49,7 +48,7 @@ import Rahm.Desktop.Layout.Hole (toggleHole)
 import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout, toIndexedLayout)
 import Rahm.Desktop.Layout.Pop (togglePop)
 import Rahm.Desktop.Layout.Rotate (rotateLayout)
-import Rahm.Desktop.Lib
+import Rahm.Desktop.Common
 import Rahm.Desktop.Logger
 import Rahm.Desktop.Marking
 import Rahm.Desktop.MouseMotion
@@ -142,30 +141,13 @@ keymap = runKeys $ do
   bind xK_apostrophe $ do
     justMod $
       doc "Jumps between marks." $
-      mapNextString $ \_ str ->
-        case str of
-          ['\''] -> jumpToLastLocation
-          [ch] | isAlphaNum ch -> jumpToMark ch
-          "[" -> historyBack
-          "]" -> historyForward
-          _ -> return ()
+      mapNextString $ const (mapM_ focusLocation <=< markToLocation)
 
     shiftMod $
-      doc "Move the marked windo to the current workspace." $
-      mapNextString $ \_ str ->
-        case str of
-          [ch] | isAlphaNum ch -> do
-            ws <- getCurrentWorkspace
-            maybe (return ()) (windows . W.shiftWin ws) =<< markToWindow ch
-          _ -> return ()
-
-    controlMod $
-      doc "Swap the current window with a mark." $
-      mapNextString $ \_ str ->
-        case str of
-          -- ['\''] ->  swapWithLastMark
-          [ch] | isAlphaNum ch -> swapWithMark ch
-          _ -> return ()
+      doc "Move the marked window to the current workspace." $
+      mapNextString $ \_ str -> do
+        mapM_ (\loc -> moveLocationToWorkspace loc <$> getCurrentWorkspace)
+          =<< markToLocation str
 
   bind xK_BackSpace $ do
     -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
@@ -275,23 +257,6 @@ keymap = runKeys $ do
       sendMessage flipHorizontally
 
   bind xK_g $ do
-    let selectWorkspace :: (KeySym, String) -> Maybe (X WorkspaceId)
-        selectWorkspace s = case s of
-          (_, [ch]) | isAlphaNum ch || ch == '*' -> Just $ return [ch]
-          (_, "]") -> Just $ adjacentWorkspaceNotVisible next
-                               =<< getCurrentWorkspace
-          (_, "[") -> Just $ adjacentWorkspaceNotVisible prev
-                               =<< getCurrentWorkspace
-          (_, ")") -> Just $ adjacentWorkspace next =<< getCurrentWorkspace
-          (_, "(") -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace
-          (_, "}") -> Just $ adjacentScreen next
-          (_, "{") -> Just $ adjacentScreen prev
-          (_, "^") -> Just firstWorkspaceId
-          (_, "$") -> Just lastWorkspaceId
-          (_, "/") -> Just $ fromMaybe <$> getCurrentWorkspace <*> runMaybeT (
-              (MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
-          (_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace
-          _ -> Nothing
 
     justMod $
       doc "Goto/Send/Etc To a workspace\n\n\t\
@@ -315,7 +280,7 @@ keymap = runKeys $ do
       \Other keybindings starting with H-g\n\t\t\
          \F1: display this help.\n\n\t" $
       mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace (keysym, str)) of
+        case ((keysym, str), selectWorkspace str) of
           (_, Just w) -> gotoWorkspace =<< w
           -- Test binding. Tests that I can still submap keysyms alone (keys
           -- where XLookupString won't return anything helpful.)
@@ -328,7 +293,7 @@ keymap = runKeys $ do
     shiftMod $
       doc "Move the currently focused window to another workspace" $
       mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace (keysym, str)) of
+        case ((keysym, str), selectWorkspace str) of
           (_, Just w) -> shiftToWorkspace =<< w
           ((_, "_"), _) -> CopyWindow.kill1
           _ -> return ()
@@ -336,7 +301,7 @@ keymap = runKeys $ do
     controlMod $
       doc "Move the current focused window to another workspace and view that workspace" $
       mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace (keysym, str)) of
+        case ((keysym, str), selectWorkspace str) of
           (_, Just w) -> do
             ws <- w
             shiftToWorkspace ws
@@ -346,14 +311,14 @@ keymap = runKeys $ do
     altMod $
       doc "Copy a window to the given workspace" $
       mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace (keysym, str)) of
+        case ((keysym, str), selectWorkspace str) of
           (_, Just ws) -> windows . CopyWindow.copy =<< ws
           _ -> return ()
 
     shiftAltMod $
       doc "Swap this workspace with another workspace (rename)." $
       mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace (keysym, str)) of
+        case ((keysym, str), selectWorkspace str) of
           (_, Just ws) -> swapWorkspace =<< ws
           ((_, "_"), _) ->
             mapM_ (\w -> focus w >> CopyWindow.kill1) =<< windowsInCurrentWorkspace
@@ -419,7 +384,7 @@ keymap = runKeys $ do
       doc "Mark the current window with the next typed character." $
       mapNextString $ \_ str ->
         case str of
-          [ch] | isAlphaNum ch -> markCurrentWindow ch
+          [ch] | isAlpha ch -> markCurrentWindow str
           _ -> return ()
 
   bind xK_plus $ do
@@ -452,6 +417,17 @@ keymap = runKeys $ do
       sendMessage rotateLayout
 
   bind xK_s $ do
+    justMod $
+      mapNextString $ \_ mark -> do
+        loc' <- markToLocation mark
+        case loc' of
+          Nothing -> return ()
+          Just loc -> do
+            mapM_ setAlternateWindow (locationWindow loc)
+            mapNextString $ \_ ws -> do
+              mapM_ (moveLocationToWorkspace loc=<<) (selectWorkspace ws)
+
+
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
   bind xK_space $ do
diff --git a/src/Rahm/Desktop/Lib.hs b/src/Rahm/Desktop/Lib.hs
deleted file mode 100644
index c7cfca4..0000000
--- a/src/Rahm/Desktop/Lib.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-module Rahm.Desktop.Lib where
-
-import Prelude hiding ((!!))
-
-import XMonad.Actions.DynamicWorkspaces
-import XMonad.Util.Run
-import XMonad.Prompt
-import XMonad.Prompt.Input
-import XMonad.Prompt.Shell
-
-import Rahm.Desktop.PromptConfig
-
-import Data.Char
-import Data.List hiding ((!!))
-import Data.List.Safe ((!!))
-import Data.Maybe
-import Rahm.Desktop.Marking
-import Text.Printf
-import XMonad hiding (workspaces, Screen)
-import XMonad.StackSet hiding (filter, focus)
-import qualified Data.Map as Map
-import Rahm.Desktop.DMenu
-import Data.Ord (comparing)
-
-import qualified XMonad.StackSet as S
-import Rahm.Desktop.Windows
-
-data WinPrompt = WinPrompt
-
-instance XPrompt WinPrompt where
-    showXPrompt _ = "[Window] "
-    commandToComplete _ = id
-
-fuzzyCompletion :: String -> String -> Bool
-fuzzyCompletion str0 str1 =
-  all (`isInfixOf`l0) ws
-  where
-    ws = filter (not . all isSpace) $ words (map toLower str0)
-    l0 = map toLower str1
-
-getString :: Window -> X String
-getString = runQuery $ do
-  t <- title
-  a <- appName
-  return $
-    if map toLower a `isInfixOf` map toLower t
-      then t
-      else printf "%s - %s" t a
-
-askWindowId :: X (Maybe Window)
-askWindowId = do
-  windowTitlesToWinId <- withWindowSet $ \ss ->
-    Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
-
-  runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
-
-windowJump :: X ()
-windowJump = do
-  windowId <- askWindowId
-
-  case windowId of
-    Nothing -> return ()
-    Just wid -> focus wid
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index b1783cc..5caaa3b 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -1,44 +1,50 @@
 module Rahm.Desktop.Marking (
   markCurrentWindow,
   jumpToMark,
-  swapWithMark, markToWindow
+  markToLocation,
+  moveLocationToWorkspace,
+  setAlternateWindow,
+  getAlternateWindow
   ) where
-
-import Rahm.Desktop.Windows (mapWindows, findWindow, getLocationWorkspace)
-import XMonad
-import XMonad.StackSet hiding (focus)
+import Data.Ord (Down(..))
+import Control.Exception
+import Control.Monad (when)
+import Control.Monad.Trans.Maybe
+import Data.Char (isAlpha, isDigit, ord)
 import Data.IORef
+import Data.List (sortOn, sort, sortBy, find)
 import Data.Map (Map)
-import Control.Monad (when)
-
+import Data.Maybe (catMaybes)
+import Data.Sequence (Seq(..))
+import Rahm.Desktop.Common
+import Rahm.Desktop.History
+import Rahm.Desktop.Hooks.WindowChange
+import Rahm.Desktop.Windows (mapWindows, findWindow, getLocationWorkspace)
+import Rahm.Desktop.Workspaces
+import System.Environment
 import System.FilePath
 import System.IO
-import Control.Exception
-import System.Environment
+import XMonad
+import XMonad.StackSet hiding (focus)
+import qualified Data.Map as Map
 import qualified Data.Sequence as Seq
-import Data.Sequence (Seq(..))
-
 import qualified XMonad.Util.ExtensibleState as XS
 
-import qualified Data.Map as Map
-
 {- Submodule that handles marking windows so they can be jumped back to. -}
 
-type Mark = Char
+type Mark = String
 
 data MarkState =
   MarkState {
-    markStateMap :: Map Mark Window
+    markStateMap :: Map Mark Location
+  , alternateWindow :: Maybe Window
   } deriving (Read, Show)
 
 
 instance ExtensionClass MarkState where
-  initialValue = MarkState Map.empty
+  initialValue = MarkState Map.empty Nothing
   extensionType = PersistentExtension
 
-withMaybeFocused :: (Maybe Window -> X a) -> X a
-withMaybeFocused f = withWindowSet $ f . peek
-
 -- greedyFocus :: Window -> X ()
 -- greedyFocus win = do
 --     ws <- withWindowSet $ \ss ->
@@ -47,20 +53,34 @@ withMaybeFocused f = withWindowSet $ f . peek
 --     mapM_ (windows . greedyView . tag) ws
 --     focus win
 
+setAlternateWindow :: Window -> X ()
+setAlternateWindow win = XS.modify (\m -> m { alternateWindow = Just win }) 
+
+getAlternateWindow :: MaybeT X Window
+getAlternateWindow = MaybeT $ alternateWindow <$> XS.get
+
+withMaybeFocused :: (Maybe Window -> X a) -> X a
+withMaybeFocused f = withWindowSet $ f . peek
+
+getCurrentLocation :: X Location
+getCurrentLocation =
+  (\ws -> withMaybeFocused (return . Location ws)) =<< getCurrentWorkspace
+
+
 markCurrentWindow :: Mark -> X ()
 markCurrentWindow mark = do
+  ws <- getCurrentWorkspace
+  
   withFocused $ \win ->
     XS.modify $ \state@MarkState {markStateMap = ms} ->
         state {
-          markStateMap = Map.insert mark win ms
+          markStateMap = Map.insert mark (Location ws $ Just win) ms
         }
 
 jumpToMark :: Mark -> X ()
 jumpToMark mark = do
   MarkState {markStateMap = m} <- XS.get
-  case Map.lookup mark m of
-    Nothing -> return ()
-    Just w ->  windows $ focusWindow w
+  mapM_ focusLocation $ Map.lookup mark m
 
 setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
 setFocusedWindow
@@ -81,16 +101,51 @@ swapWithFocused winToSwap stackSet =
           mapWindows (
             \w -> if w == winToSwap then focused else w) stackSet
 
-markToWindow :: Mark -> X (Maybe Window)
-markToWindow m = do
-  MarkState { markStateMap = mp } <- XS.get
-  return $ Map.lookup m mp
-
-swapWithMark :: Mark -> X ()
-swapWithMark mark = do
-  MarkState {markStateMap = m} <- XS.get
-
-  case Map.lookup mark m of
-    Nothing -> return ()
-    Just winToSwap -> do
-      windows $ swapWithFocused winToSwap
+moveLocationToWorkspace :: Location -> WorkspaceId ->  X ()
+moveLocationToWorkspace (Location _ (Just win)) wid =
+  windows $ shiftWin wid win
+moveLocationToWorkspace _ _ = return ()
+
+windowRect :: Window -> X (Maybe Rectangle)
+windowRect win = withDisplay $ \dpy -> (do
+  (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
+  return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw))
+    `catchX` return Nothing
+
+getWindowsAndRects :: X [(Window, Rectangle)]
+getWindowsAndRects =
+  catMaybes <$> (mapM (\w -> fmap (w,) <$> windowRect w)
+    =<< withWindowSet (return . allWindows))
+
+windowLocation :: Window -> MaybeT X Location
+windowLocation win = do
+  tag <- MaybeT $ withWindowSet $ return . findTag win
+  return (Location tag (Just win))
+
+markToLocation :: Mark -> X (Maybe Location)
+markToLocation mark =
+  case mark of
+    [ch] | isAlpha ch -> Map.lookup mark . markStateMap <$> XS.get
+    "0" -> getMostRecentLocationInHistory
+    [ch] | isDigit ch -> pastHistory (ord ch - 0x30)
+    "." -> Just <$> getCurrentLocation
+    "\"" -> nextLocation
+    "'" -> lastLocation
+    "/" -> runMaybeT $ windowLocation =<< MaybeT askWindowId
+    "^" -> do
+          rects <- sortOn (\(_, Rectangle x _ _ _) -> x) <$> getWindowsAndRects
+          case rects of
+            ((w, _) : _) -> runMaybeT (windowLocation w)
+            _ -> return Nothing
+    "$" -> do
+          rects <- sortOn (Down . \(_, Rectangle x _ _ _) -> x)
+                     <$> getWindowsAndRects
+          case rects of
+            ((w, _) : _) -> runMaybeT (windowLocation w)
+            _ -> return Nothing
+
+    "*" -> runMaybeT (windowLocation =<< masterWindow)
+
+    "@" -> runMaybeT (windowLocation =<< getAlternateWindow)
+
+    _ -> return Nothing
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index de481ac..3a26823 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -4,16 +4,19 @@ module Rahm.Desktop.Workspaces where
 
 import Prelude hiding ((!!))
 
+import Control.Monad.Trans.Maybe
 import Control.Arrow (second, (&&&))
 import qualified XMonad.StackSet as W
 import XMonad
 
 import Data.List.Safe ((!!))
 
+import Rahm.Desktop.Common
+import Rahm.Desktop.History
 import XMonad.Actions.DynamicWorkspaces
 import Data.List (sortOn, sort, sortBy, find)
 import Data.Maybe (mapMaybe, fromMaybe)
-import Data.Char (isUpper, toUpper, toLower)
+import Data.Char (isUpper, toUpper, toLower, isAlphaNum)
 
 newtype Selector = Selector (forall a. (a -> Bool) -> [a] -> Maybe a)
 
@@ -55,11 +58,6 @@ firstWorkspaceId :: X WorkspaceId
 firstWorkspaceId =
   W.tag . snd . head <$> withWindowSet (return . getPopulatedWorkspaces)
 
-getCurrentWorkspace :: X WorkspaceId
-getCurrentWorkspace = withWindowSet $
-  \(W.StackSet (W.Screen (W.Workspace t _ _) _ _) _ _ _) -> do
-    return t
-
 windowsInCurrentWorkspace :: X [Window]
 windowsInCurrentWorkspace = withWindowSet $
   \(W.StackSet (W.Screen (W.Workspace _ _ s) _ _) _ _ _) -> do
@@ -77,11 +75,6 @@ getHorizontallyOrderedScreens windowSet =
     where
       screens = (True, W.current windowSet) : map (False,) (W.visible windowSet)
 
-gotoWorkspace :: WorkspaceId -> X ()
-gotoWorkspace wid = do
-  addHiddenWorkspace wid
-  windows $ W.greedyView wid
-
 shiftToWorkspace :: WorkspaceId -> X ()
 shiftToWorkspace t = do
   addHiddenWorkspace t
@@ -155,3 +148,26 @@ workspaceWithWindow wid = withWindowSet $ \(W.StackSet c v h _) ->
       find (\(W.Workspace _ _ stack) -> wid `elem` W.integrate' stack)
         (map W.workspace (c : v) ++ h)
 
+selectWorkspace :: String -> Maybe (X WorkspaceId)
+selectWorkspace s = case s of
+  [ch] | isAlphaNum ch || ch == '*' -> Just $ return [ch]
+  "]" -> Just $ adjacentWorkspaceNotVisible next
+                  =<< getCurrentWorkspace
+  "[" -> Just $ adjacentWorkspaceNotVisible prev
+                  =<< getCurrentWorkspace
+  ")" -> Just $ adjacentWorkspace next =<< getCurrentWorkspace
+  "(" -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace
+  "}" -> Just $ adjacentScreen next
+  "{" -> Just $ adjacentScreen prev
+  "^" -> Just firstWorkspaceId
+  "'" -> Just $ do
+           l <- lastLocation
+           case l of
+            Just (Location ws _) -> return ws
+            Nothing -> getCurrentWorkspace
+  "." -> Just getCurrentWorkspace
+  "$" -> Just lastWorkspaceId
+  "/" -> Just $ fromMaybe <$> getCurrentWorkspace <*> runMaybeT (
+      (MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
+  " " -> Just $ accompaningWorkspace <$> getCurrentWorkspace
+  _ -> Nothing
-- 
cgit 


From dac3bec93f90b58d1bf97e81d992651b1cf83458 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 18 Apr 2022 01:31:22 -0600
Subject: Add basic language for moving windows around

---
 src/Rahm/Desktop/Common.hs     |  17 ++++++
 src/Rahm/Desktop/Keys.hs       |  88 +++++++++++-----------------
 src/Rahm/Desktop/Lang.hs       | 127 +++++++++++++++++++++++++++++++++++++++++
 src/Rahm/Desktop/Marking.hs    |  98 ++++++++++++++++---------------
 src/Rahm/Desktop/Submap.hs     |  20 ++++---
 src/Rahm/Desktop/Workspaces.hs |  24 --------
 6 files changed, 242 insertions(+), 132 deletions(-)
 create mode 100644 src/Rahm/Desktop/Lang.hs

diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index 926d5ff..5a5aecf 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -2,6 +2,7 @@ module Rahm.Desktop.Common where
 
 import Prelude hiding ((!!))
 
+import Control.Monad (void)
 import Control.Monad.Trans.Maybe
 import XMonad.Actions.DynamicWorkspaces
 import XMonad.Util.Run
@@ -42,6 +43,14 @@ masterWindow = MaybeT $ withWindowSet $ \ss ->
       (a:_) -> return $ Just a
       _ -> return Nothing
 
+windowsInWorkspace :: WorkspaceId -> X [Location]
+windowsInWorkspace wid =
+  withWindowSet $
+    return . concatMap (\ws ->
+      if S.tag ws == wid
+        then map (Location wid . Just) $ S.integrate' (S.stack ws)
+        else []) . S.workspaces
+
 data WinPrompt = WinPrompt
 
 instance XPrompt WinPrompt where
@@ -84,3 +93,11 @@ getCurrentWorkspace = withWindowSet $
   \(S.StackSet (S.Screen (S.Workspace t _ _) _ _) _ _ _) -> do
     return t
 
+getCurrentLocation :: X Location
+getCurrentLocation = do
+  ws <- getCurrentWorkspace
+  win <- withWindowSet (return . peek)
+  return (Location ws win)
+
+runMaybeT_ :: (Monad m) => MaybeT m a -> m ()
+runMaybeT_  = void . runMaybeT
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 1369a17..23927ef 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -1,5 +1,6 @@
 module Rahm.Desktop.Keys (applyKeys) where
 
+import Control.Monad.Trans.Maybe
 import Control.Applicative
 import Control.Monad
 import Control.Monad.Fix (fix)
@@ -11,7 +12,7 @@ import Data.Char
 import Data.List hiding ((!!))
 import Data.List.Safe ((!!))
 import Data.Map (Map)
-import Data.Maybe (isJust, fromMaybe)
+import Data.Maybe (isJust, fromMaybe, mapMaybe)
 import Data.Monoid (Endo(..))
 import Debug.Trace
 import Graphics.X11.ExtraTypes.XF86;
@@ -51,6 +52,7 @@ import Rahm.Desktop.Layout.Rotate (rotateLayout)
 import Rahm.Desktop.Common
 import Rahm.Desktop.Logger
 import Rahm.Desktop.Marking
+import Rahm.Desktop.Lang
 import Rahm.Desktop.MouseMotion
 import Rahm.Desktop.PassMenu
 import Rahm.Desktop.PromptConfig
@@ -141,13 +143,11 @@ keymap = runKeys $ do
   bind xK_apostrophe $ do
     justMod $
       doc "Jumps between marks." $
-      mapNextString $ const (mapM_ focusLocation <=< markToLocation)
-
-    shiftMod $
-      doc "Move the marked window to the current workspace." $
-      mapNextString $ \_ str -> do
-        mapM_ (\loc -> moveLocationToWorkspace loc <$> getCurrentWorkspace)
-          =<< markToLocation str
+      runMaybeT_ $ do
+        l <- readNextLocationSet
+        case l of
+          (h:_) -> lift (focusLocation h)
+          _ -> return ()
 
   bind xK_BackSpace $ do
     -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
@@ -279,50 +279,23 @@ keymap = runKeys $ do
          \_: Black hole. Sending a window here closes it.\n\n\t\
       \Other keybindings starting with H-g\n\t\t\
          \F1: display this help.\n\n\t" $
-      mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace str) of
-          (_, Just w) -> gotoWorkspace =<< w
-          -- Test binding. Tests that I can still submap keysyms alone (keys
-          -- where XLookupString won't return anything helpful.)
-          ((f, _), _) | f == xK_F1 ->
-            (safeSpawn "gxmessage" [
-              "-fn", "Source Code Pro",
-              documentation (keymap config)] :: X ())
-          _ -> return ()
+      runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace
 
     shiftMod $
       doc "Move the currently focused window to another workspace" $
-      mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace str) of
-          (_, Just w) -> shiftToWorkspace =<< w
-          ((_, "_"), _) -> CopyWindow.kill1
-          _ -> return ()
+      runMaybeT_ $ do
+        ws <- readNextWorkspace
+        loc <- lift getCurrentLocation
+        lift $ moveLocationToWorkspaceFn ws loc
 
     controlMod $
       doc "Move the current focused window to another workspace and view that workspace" $
-      mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace str) of
-          (_, Just w) -> do
-            ws <- w
-            shiftToWorkspace ws
-            gotoWorkspace ws
-          _ -> return ()
-
-    altMod $
-      doc "Copy a window to the given workspace" $
-      mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace str) of
-          (_, Just ws) -> windows . CopyWindow.copy =<< ws
-          _ -> return ()
-
-    shiftAltMod $
-      doc "Swap this workspace with another workspace (rename)." $
-      mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace str) of
-          (_, Just ws) -> swapWorkspace =<< ws
-          ((_, "_"), _) ->
-            mapM_ (\w -> focus w >> CopyWindow.kill1) =<< windowsInCurrentWorkspace
-          _ -> return ()
+      runMaybeT_ $ do
+        ws <- readNextWorkspace
+        loc <- lift getCurrentLocation
+        lift $ do
+          moveLocationToWorkspaceFn ws loc
+          gotoWorkspaceFn ws
 
   bind xK_h $ do
     justMod $
@@ -382,7 +355,7 @@ keymap = runKeys $ do
   bind xK_m $ do
     justMod $
       doc "Mark the current window with the next typed character." $
-      mapNextString $ \_ str ->
+      runMaybeT_ $ mapNextString $ \_ str -> lift $
         case str of
           [ch] | isAlpha ch -> markCurrentWindow str
           _ -> return ()
@@ -417,16 +390,19 @@ keymap = runKeys $ do
       sendMessage rotateLayout
 
   bind xK_s $ do
-    justMod $
-      mapNextString $ \_ mark -> do
-        loc' <- markToLocation mark
-        case loc' of
-          Nothing -> return ()
-          Just loc -> do
-            mapM_ setAlternateWindow (locationWindow loc)
-            mapNextString $ \_ ws -> do
-              mapM_ (moveLocationToWorkspace loc=<<) (selectWorkspace ws)
+    justMod $ runMaybeT_ $ do
+      locations <- readNextLocationSet 
+
+      workspace <- readNextWorkspace
+      mapM_ (lift . moveLocationToWorkspaceFn workspace) locations
 
+      lift $ setAlternateWindows (mapMaybe locationWindow locations)
+      forM_ locations $ \loc ->
+        case locationWindow loc of
+          Nothing -> return ()
+          Just win -> do
+            lift $ logs $ printf "setAlternate %s %s" (show win) (show $ locationWorkspace loc)
+            lift $ setAlternateWorkspace win (locationWorkspace loc)
 
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
diff --git a/src/Rahm/Desktop/Lang.hs b/src/Rahm/Desktop/Lang.hs
new file mode 100644
index 0000000..374500d
--- /dev/null
+++ b/src/Rahm/Desktop/Lang.hs
@@ -0,0 +1,127 @@
+module Rahm.Desktop.Lang where
+
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Class
+
+import Data.Char (isAlphaNum, isAlpha, isDigit, ord)
+import XMonad.Actions.CopyWindow as CopyWindow
+import XMonad.Util.Run (safeSpawn)
+import qualified XMonad.StackSet as W
+
+import Rahm.Desktop.Common
+import Rahm.Desktop.Keys.Dsl
+import Rahm.Desktop.History
+import Rahm.Desktop.Marking
+import Rahm.Desktop.Workspaces
+import Rahm.Desktop.Submap
+import Rahm.Desktop.Logger
+
+import Text.Printf
+
+import XMonad
+
+data Workspace =
+  Workspace {
+    moveLocationToWorkspaceFn :: Location -> X ()
+  , gotoWorkspaceFn :: X ()
+  , workspaceName :: String
+  }
+
+justWorkspace :: String -> Workspace
+justWorkspace s =
+  Workspace {
+    moveLocationToWorkspaceFn = flip moveLocationToWorkspace s
+  , gotoWorkspaceFn = gotoWorkspace s
+  , workspaceName = s
+  }
+
+blackHoleWorkspace :: Workspace
+blackHoleWorkspace =
+  Workspace {
+    moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow
+  , gotoWorkspaceFn = return () -- can't navigate to black hole
+  , workspaceName = "blackhole"
+  }
+
+alternateWorkspace :: Workspace
+alternateWorkspace =
+  Workspace {
+    moveLocationToWorkspaceFn  = \l@(Location _ maybeWin) -> do
+      logs $ "Moving Location: " ++ show l
+      case maybeWin of
+        Nothing -> return ()
+        Just win -> do
+          alter <- getAlternateWorkspace win
+          logs $ printf "Moving %s to %s" (show win) (show alter)
+          mapM_ (moveLocationToWorkspace l) alter
+
+  , gotoWorkspaceFn = do
+      (Location _ maybeWin) <- getCurrentLocation
+      case maybeWin of
+        Nothing -> return ()
+        Just win -> do
+          mapM_ gotoWorkspace =<<  getAlternateWorkspace win
+
+  , workspaceName = "@"
+  }
+
+readNextWorkspace :: MaybeT X Workspace
+readNextWorkspace =
+  mapNextStringWithKeysym $ \mask sym str ->
+    case (mask, sym, str) of
+      (_, _, [ch]) | isAlphaNum ch || ch == '*' -> return $ justWorkspace [ch]
+      (_, _, "[") -> lift $ 
+        justWorkspace <$>
+          (adjacentWorkspaceNotVisible prev =<< getCurrentWorkspace)
+      (_, _, "]") -> lift $
+        justWorkspace <$>
+          (adjacentWorkspaceNotVisible next =<< getCurrentWorkspace)
+      (_, _, "(") -> lift $ 
+        justWorkspace <$>
+          (adjacentWorkspace prev =<< getCurrentWorkspace)
+      (_, _, ")") -> lift $
+        justWorkspace <$>
+          (adjacentWorkspace next =<< getCurrentWorkspace)
+      (_, _, "}") -> lift $ justWorkspace <$> adjacentScreen next
+      (_, _, "{") -> lift $ justWorkspace <$> adjacentScreen prev
+      (_, _, "^") -> lift $ justWorkspace <$> firstWorkspaceId
+      (_, _, "'") -> justWorkspace . locationWorkspace <$> MaybeT lastLocation
+      (_, _, ".") -> lift $ justWorkspace <$> getCurrentWorkspace
+      (_, _, "$") -> lift $ justWorkspace <$> lastWorkspaceId
+      (_, _, "/") -> do
+        justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
+      (_, _, " ") -> lift $
+        justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
+      (_, _, "_") -> return blackHoleWorkspace
+      (_, _, "-") -> return alternateWorkspace
+      _ -> MaybeT (return Nothing)
+
+readNextLocationSet :: MaybeT X [Location]
+readNextLocationSet =
+  mapNextStringWithKeysym $ \mask sym str ->
+    case (mask, sym, str) of
+      (_, _, [ch]) | isAlpha ch -> lift $ getMarkedLocations [ch]
+      (_, _, "0") -> (:[]) <$> MaybeT getMostRecentLocationInHistory
+      (_, _, [ch]) | isDigit ch ->
+        (:[]) <$> MaybeT (pastHistory (ord ch - 0x30))
+      (_, _, ".") -> (:[]) <$> lift getCurrentLocation
+      (_, _, "^") -> (:[]) <$> farLeftWindow
+      (_, _, "$") -> (:[]) <$> farRightWindow
+      (_, _, "\"") -> (:[]) <$> MaybeT nextLocation
+      (_, _, "'") -> (:[]) <$>  MaybeT lastLocation
+      (_, _, "*") -> (:[]) <$> (windowLocation =<< masterWindow)
+      (_, _, "-") -> mapM windowLocation =<< lift getAlternateWindows
+      (_, _, "/") -> (:[]) <$> (windowLocation =<< MaybeT askWindowId)
+      (_, _, "%") ->
+        mapM windowLocation =<< lift (withWindowSet (return . W.allWindows))
+      (_, _, "@") -> (lift . windowsInWorkspace . workspaceName) =<< readNextWorkspace
+      (_, _, "&") -> do
+        l1 <- readNextLocationSet
+        l2 <- readNextLocationSet
+        return (l1 ++ l2)
+      (_, _, "\\") -> do
+        l1 <- readNextLocationSet
+        l2 <- readNextLocationSet
+        return $ filter (not . flip elem l2) l1
+        
+      _ -> MaybeT (return Nothing)
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 5caaa3b..f4e0d9a 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -1,18 +1,29 @@
 module Rahm.Desktop.Marking (
   markCurrentWindow,
   jumpToMark,
-  markToLocation,
   moveLocationToWorkspace,
-  setAlternateWindow,
-  getAlternateWindow
+  setAlternateWindows,
+  getAlternateWindows,
+  setAlternateWorkspace,
+  getAlternateWorkspace,
+  getMarkedLocations,
+  farLeftWindow,
+  farRightWindow,
+  windowLocation
   ) where
+
+import Prelude hiding (head)
+
+import Data.Maybe (fromMaybe)
+import Control.Monad.Trans (lift)
 import Data.Ord (Down(..))
 import Control.Exception
-import Control.Monad (when)
+import Control.Monad (when, (<=<))
 import Control.Monad.Trans.Maybe
 import Data.Char (isAlpha, isDigit, ord)
 import Data.IORef
 import Data.List (sortOn, sort, sortBy, find)
+import Data.List.Safe (head)
 import Data.Map (Map)
 import Data.Maybe (catMaybes)
 import Data.Sequence (Seq(..))
@@ -36,13 +47,14 @@ type Mark = String
 
 data MarkState =
   MarkState {
-    markStateMap :: Map Mark Location
-  , alternateWindow :: Maybe Window
+    markStateMap :: Map Mark [Location]
+  , alternateWindows :: [Window]
+  , alternateWorkspaces :: Map Window WorkspaceId
   } deriving (Read, Show)
 
 
 instance ExtensionClass MarkState where
-  initialValue = MarkState Map.empty Nothing
+  initialValue = MarkState Map.empty [] Map.empty
   extensionType = PersistentExtension
 
 -- greedyFocus :: Window -> X ()
@@ -53,19 +65,24 @@ instance ExtensionClass MarkState where
 --     mapM_ (windows . greedyView . tag) ws
 --     focus win
 
-setAlternateWindow :: Window -> X ()
-setAlternateWindow win = XS.modify (\m -> m { alternateWindow = Just win }) 
+setAlternateWorkspace :: Window -> WorkspaceId -> X ()
+setAlternateWorkspace win wid =
+  XS.modify $ \m -> m {
+      alternateWorkspaces = Map.insert win wid (alternateWorkspaces m)
+    }
 
-getAlternateWindow :: MaybeT X Window
-getAlternateWindow = MaybeT $ alternateWindow <$> XS.get
+getAlternateWorkspace :: Window -> X (Maybe WorkspaceId)
+getAlternateWorkspace window =
+  Map.lookup window . alternateWorkspaces <$> XS.get
 
-withMaybeFocused :: (Maybe Window -> X a) -> X a
-withMaybeFocused f = withWindowSet $ f . peek
+setAlternateWindows :: [Window] -> X ()
+setAlternateWindows wins = XS.modify (\m -> m { alternateWindows = wins }) 
 
-getCurrentLocation :: X Location
-getCurrentLocation =
-  (\ws -> withMaybeFocused (return . Location ws)) =<< getCurrentWorkspace
+getAlternateWindows :: X [Window]
+getAlternateWindows = alternateWindows <$> XS.get
 
+withMaybeFocused :: (Maybe Window -> X a) -> X a
+withMaybeFocused f = withWindowSet $ f . peek
 
 markCurrentWindow :: Mark -> X ()
 markCurrentWindow mark = do
@@ -74,13 +91,18 @@ markCurrentWindow mark = do
   withFocused $ \win ->
     XS.modify $ \state@MarkState {markStateMap = ms} ->
         state {
-          markStateMap = Map.insert mark (Location ws $ Just win) ms
+          markStateMap = Map.insertWith (++) mark [Location ws $ Just win] ms
         }
 
 jumpToMark :: Mark -> X ()
 jumpToMark mark = do
   MarkState {markStateMap = m} <- XS.get
-  mapM_ focusLocation $ Map.lookup mark m
+  mapM_ focusLocation $ head =<< Map.lookup mark m
+
+getMarkedLocations :: Mark -> X [Location]
+getMarkedLocations mark = do
+  MarkState {markStateMap = m} <- XS.get
+  return (fromMaybe [] $ Map.lookup mark m)
 
 setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
 setFocusedWindow
@@ -122,30 +144,16 @@ windowLocation win = do
   tag <- MaybeT $ withWindowSet $ return . findTag win
   return (Location tag (Just win))
 
-markToLocation :: Mark -> X (Maybe Location)
-markToLocation mark =
-  case mark of
-    [ch] | isAlpha ch -> Map.lookup mark . markStateMap <$> XS.get
-    "0" -> getMostRecentLocationInHistory
-    [ch] | isDigit ch -> pastHistory (ord ch - 0x30)
-    "." -> Just <$> getCurrentLocation
-    "\"" -> nextLocation
-    "'" -> lastLocation
-    "/" -> runMaybeT $ windowLocation =<< MaybeT askWindowId
-    "^" -> do
-          rects <- sortOn (\(_, Rectangle x _ _ _) -> x) <$> getWindowsAndRects
-          case rects of
-            ((w, _) : _) -> runMaybeT (windowLocation w)
-            _ -> return Nothing
-    "$" -> do
-          rects <- sortOn (Down . \(_, Rectangle x _ _ _) -> x)
-                     <$> getWindowsAndRects
-          case rects of
-            ((w, _) : _) -> runMaybeT (windowLocation w)
-            _ -> return Nothing
-
-    "*" -> runMaybeT (windowLocation =<< masterWindow)
-
-    "@" -> runMaybeT (windowLocation =<< getAlternateWindow)
-
-    _ -> return Nothing
+farLeftWindow :: MaybeT X Location
+farLeftWindow = do
+  rects <- lift $ sortOn (\(_, Rectangle x _ _ _) -> x) <$> getWindowsAndRects
+  case rects of
+    ((w, _) : _) -> windowLocation w
+    _ -> MaybeT (return Nothing)
+
+farRightWindow :: MaybeT X Location
+farRightWindow = do
+  rects <- lift $ sortOn (Down . \(_, Rectangle x _ _ _) -> x) <$> getWindowsAndRects
+  case rects of
+    ((w, _) : _) -> windowLocation w
+    _ -> MaybeT (return Nothing)
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index 5db8928..48a3144 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -9,6 +9,10 @@ module Rahm.Desktop.Submap (
     submapDefault,
     submapDefaultWithKey) where
 
+import Rahm.Desktop.Common
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans
+import Control.Monad (void)
 import XMonad hiding (keys)
 import Control.Monad.Fix (fix)
 import qualified Data.Map as Map
@@ -54,7 +58,8 @@ getMaskEventWithTimeout timeout d mask fn = do
  - but also allows submappings for keys that may not have a character associated
  - with them (for example, the function keys).
  -}
-mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X ()) -> X ()
+mapNextStringWithKeysym ::
+  (KeyMask -> KeySym -> String -> MaybeT X a) -> MaybeT X a
 mapNextStringWithKeysym fn = do
   XConf { theRoot = root, display = d } <- ask
   io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
@@ -76,17 +81,18 @@ mapNextStringWithKeysym fn = do
       Nothing -> return Nothing
 
   io $ ungrabKeyboard d currentTime
-  case ret of
-    Just (m, str, keysym) -> fn m keysym str
-    Nothing -> return ()
+
+  (m, str, keysym) <- MaybeT $ return ret
+  fn m keysym str
 
 {- Like submap, but on the character typed rather than the kysym. -}
-mapNextString :: (KeyMask -> String -> X ()) -> X ()
+mapNextString :: (KeyMask -> String -> MaybeT X a) -> MaybeT X a
 mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
 
 submapDefaultWithKey :: ((KeyMask, KeySym) -> X ()) -> Map (KeyMask, KeySym) (X ()) -> X ()
-submapDefaultWithKey def m = mapNextStringWithKeysym $ \mask sym _ -> do
-  Map.findWithDefault (def (mask, sym)) (mask, sym) m
+submapDefaultWithKey def m = runMaybeT_ $
+  mapNextStringWithKeysym $ \mask sym _ -> lift $ do
+     Map.findWithDefault (def (mask, sym)) (mask, sym) m
 
 submapDefault :: X () -> Map (KeyMask, KeySym) (X ()) -> X ()
 submapDefault def = submapDefaultWithKey (const def)
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index 3a26823..f11520a 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -147,27 +147,3 @@ workspaceWithWindow wid = withWindowSet $ \(W.StackSet c v h _) ->
     W.tag <$>
       find (\(W.Workspace _ _ stack) -> wid `elem` W.integrate' stack)
         (map W.workspace (c : v) ++ h)
-
-selectWorkspace :: String -> Maybe (X WorkspaceId)
-selectWorkspace s = case s of
-  [ch] | isAlphaNum ch || ch == '*' -> Just $ return [ch]
-  "]" -> Just $ adjacentWorkspaceNotVisible next
-                  =<< getCurrentWorkspace
-  "[" -> Just $ adjacentWorkspaceNotVisible prev
-                  =<< getCurrentWorkspace
-  ")" -> Just $ adjacentWorkspace next =<< getCurrentWorkspace
-  "(" -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace
-  "}" -> Just $ adjacentScreen next
-  "{" -> Just $ adjacentScreen prev
-  "^" -> Just firstWorkspaceId
-  "'" -> Just $ do
-           l <- lastLocation
-           case l of
-            Just (Location ws _) -> return ws
-            Nothing -> getCurrentWorkspace
-  "." -> Just getCurrentWorkspace
-  "$" -> Just lastWorkspaceId
-  "/" -> Just $ fromMaybe <$> getCurrentWorkspace <*> runMaybeT (
-      (MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
-  " " -> Just $ accompaningWorkspace <$> getCurrentWorkspace
-  _ -> Nothing
-- 
cgit 


From 8b6c4a54f79b35ba153acf6dd6b6f1804237c545 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 18 Apr 2022 10:11:05 -0600
Subject: Extend marking language to the mark command itself

---
 src/Rahm/Desktop/Keys.hs    | 7 ++++---
 src/Rahm/Desktop/Marking.hs | 8 ++++++++
 2 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 23927ef..da3b695 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -355,10 +355,11 @@ keymap = runKeys $ do
   bind xK_m $ do
     justMod $
       doc "Mark the current window with the next typed character." $
-      runMaybeT_ $ mapNextString $ \_ str -> lift $
+      runMaybeT_ $ do
+       locs <- readNextLocationSet
+       mapNextString $ \_ str -> lift $
         case str of
-          [ch] | isAlpha ch -> markCurrentWindow str
-          _ -> return ()
+          [ch] | isAlpha ch -> markAllLocations str locs
 
   bind xK_plus $ do
     justMod $
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index f4e0d9a..90808cf 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -7,6 +7,7 @@ module Rahm.Desktop.Marking (
   setAlternateWorkspace,
   getAlternateWorkspace,
   getMarkedLocations,
+  markAllLocations,
   farLeftWindow,
   farRightWindow,
   windowLocation
@@ -84,6 +85,13 @@ getAlternateWindows = alternateWindows <$> XS.get
 withMaybeFocused :: (Maybe Window -> X a) -> X a
 withMaybeFocused f = withWindowSet $ f . peek
 
+markAllLocations :: Mark -> [Location]  -> X ()
+markAllLocations mark locs =
+  XS.modify $ \m ->
+    m {
+      markStateMap = Map.insert mark locs (markStateMap m)
+    }
+
 markCurrentWindow :: Mark -> X ()
 markCurrentWindow mark = do
   ws <- getCurrentWorkspace
-- 
cgit 


From 75886bd10e782425179f244d0a650d9861bc2843 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 18 Apr 2022 16:38:05 -0600
Subject: Rename Lang to WindowManagementLanguage (Moved to Wml.hs). Add more
 features to it.

---
 src/Rahm/Desktop/Common.hs   |  13 ++-
 src/Rahm/Desktop/DMenu.hs    |   2 +-
 src/Rahm/Desktop/Keys.hs     |  12 +--
 src/Rahm/Desktop/Keys/Wml.hs | 252 +++++++++++++++++++++++++++++++++++++++++++
 src/Rahm/Desktop/Lang.hs     | 127 ----------------------
 src/Rahm/Desktop/Marking.hs  |   6 --
 6 files changed, 264 insertions(+), 148 deletions(-)
 create mode 100644 src/Rahm/Desktop/Keys/Wml.hs
 delete mode 100644 src/Rahm/Desktop/Lang.hs

diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index 5a5aecf..c12322a 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -57,13 +57,6 @@ instance XPrompt WinPrompt where
     showXPrompt _ = "[Window] "
     commandToComplete _ = id
 
-fuzzyCompletion :: String -> String -> Bool
-fuzzyCompletion str0 str1 =
-  all (`isInfixOf`l0) ws
-  where
-    ws = filter (not . all isSpace) $ words (map toLower str0)
-    l0 = map toLower str1
-
 getString :: Window -> X String
 getString = runQuery $ do
   t <- title
@@ -88,6 +81,12 @@ gotoWorkspace wid = do
   addHiddenWorkspace wid
   windows $ S.greedyView wid
 
+moveLocationToWorkspace :: Location -> WorkspaceId ->  X ()
+moveLocationToWorkspace (Location _ (Just win)) wid = do
+  addHiddenWorkspace wid
+  windows $ shiftWin wid win
+moveLocationToWorkspace _ _ = return ()
+
 getCurrentWorkspace :: X WorkspaceId
 getCurrentWorkspace = withWindowSet $
   \(S.StackSet (S.Screen (S.Workspace t _ _) _ _) _ _ _) -> do
diff --git a/src/Rahm/Desktop/DMenu.hs b/src/Rahm/Desktop/DMenu.hs
index 62ecdd3..d20d001 100644
--- a/src/Rahm/Desktop/DMenu.hs
+++ b/src/Rahm/Desktop/DMenu.hs
@@ -16,7 +16,7 @@ data Colors =
   }  | DefaultColors
 
 menuCommand :: [String]
-menuCommand = ["rofi", "-monitor", "-4", "-dmenu", "-sort", "-levenshtein-sort"]
+menuCommand = ["rofi", "-monitor", "-4", "-i", "-dmenu", "-sort", "-levenshtein-sort"]
 
 menuCommandString :: String
 menuCommandString = unwords menuCommand
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index da3b695..6973b81 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -52,7 +52,7 @@ import Rahm.Desktop.Layout.Rotate (rotateLayout)
 import Rahm.Desktop.Common
 import Rahm.Desktop.Logger
 import Rahm.Desktop.Marking
-import Rahm.Desktop.Lang
+import Rahm.Desktop.Keys.Wml
 import Rahm.Desktop.MouseMotion
 import Rahm.Desktop.PassMenu
 import Rahm.Desktop.PromptConfig
@@ -140,7 +140,7 @@ keymap = runKeys $ do
   let subkeys keysM = Submap (runKeys keysM config)
       repeatable keysM = Repeat (runKeys keysM config)
 
-  bind xK_apostrophe $ do
+  forM_ [xK_apostrophe, xK_w] $ \k -> bind k $ do
     justMod $
       doc "Jumps between marks." $
       runMaybeT_ $ do
@@ -189,8 +189,9 @@ keymap = runKeys $ do
   bind xK_F8 $
 
     justMod $
-      doc "Print this documentation." $
-      sendMessage toggleHole
+      doc "Experimental" $ do
+        (logs . printf "WS: %s" . show . fmap workspaceName) =<< workspaceForString ",^"
+        (logs . printf "Wins: %s" . show) =<< locationSetForString "&s@,^"
 
   bind xK_F10 $ do
     justMod playPauseDoc
@@ -489,9 +490,6 @@ keymap = runKeys $ do
         bind xK_v $
           justMod (return () :: X ())
 
-  bind xK_w $ do
-    justMod $ doc "Jump to a window (via rofi)" windowJump
-
   bind xK_x $ do
     justMod $
       doc "Toggles respect for struts." $
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
new file mode 100644
index 0000000..47be2e7
--- /dev/null
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -0,0 +1,252 @@
+-- Wml: Window Management Language.
+--
+-- Parser for WML objects
+--
+-- Some examples of WML objects are:
+--
+-- a          // The workspace or window (context dependent) tagged 'a'
+-- @a         // All windows on workspace 'a' or the workspace with window 'a'
+-- ,.         // The workspace to to the right of the current one.
+-- @,.        // All windows on the workspace to the right of the current one.
+-- @,^        // All the windows on the screen second from the left
+-- &z!~@,,^   // The window tagged with z and The last window on the screen third from the left
+-- @@s        // All the windows that share a workspace with the window tagged s
+-- \%@s       // All windows except those on workspace 's'
+module Rahm.Desktop.Keys.Wml where
+
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.State as S
+import Control.Monad.Trans.Class
+import Control.Monad (join, forM_)
+
+import Data.Char (isAlphaNum, isAlpha, isDigit, ord)
+import Data.Maybe (fromMaybe)
+import XMonad.Actions.CopyWindow as CopyWindow
+import XMonad.Util.Run (safeSpawn)
+import Prelude hiding (head, last)
+import Data.List.Safe (head, last)
+import qualified XMonad.StackSet as W
+
+import Rahm.Desktop.Common
+import Rahm.Desktop.Keys.Dsl
+import Rahm.Desktop.History
+import Rahm.Desktop.Marking
+import Rahm.Desktop.Workspaces
+import Rahm.Desktop.Submap
+import Rahm.Desktop.Logger
+
+import Text.Printf
+
+import XMonad
+
+data Workspace =
+  Workspace {
+    moveLocationToWorkspaceFn :: Location -> X ()
+  , gotoWorkspaceFn :: X ()
+  , workspaceName :: String
+  }
+
+justWorkspace :: String -> Workspace
+justWorkspace s =
+  Workspace {
+    moveLocationToWorkspaceFn = flip moveLocationToWorkspace s
+  , gotoWorkspaceFn = gotoWorkspace s
+  , workspaceName = s
+  }
+
+blackHoleWorkspace :: Workspace
+blackHoleWorkspace =
+  Workspace {
+    moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow
+  , gotoWorkspaceFn = return () -- can't navigate to black hole
+  , workspaceName = "blackhole"
+  }
+
+alternateWorkspace :: Workspace
+alternateWorkspace =
+  Workspace {
+    moveLocationToWorkspaceFn  = \l@(Location _ maybeWin) -> do
+      logs $ "Moving Location: " ++ show l
+      case maybeWin of
+        Nothing -> return ()
+        Just win -> do
+          alter <- getAlternateWorkspace win
+          logs $ printf "Moving %s to %s" (show win) (show alter)
+          mapM_ (moveLocationToWorkspace l) alter
+
+  , gotoWorkspaceFn = do
+      (Location _ maybeWin) <- getCurrentLocation
+      case maybeWin of
+        Nothing -> return ()
+        Just win -> do
+          mapM_ gotoWorkspace =<<  getAlternateWorkspace win
+
+  , workspaceName = "@"
+  }
+
+floatWorkspace :: Workspace -> Workspace
+floatWorkspace ws =
+  Workspace {
+    moveLocationToWorkspaceFn = \location -> do
+      forM_ (locationWindow location) $ \win -> do
+        logs $ "Float " ++ show win
+        windows $ W.float win (W.RationalRect 0 0 100 100)
+        withWindowSet $ logs . show . W.floating
+      moveLocationToWorkspaceFn ws location
+  , gotoWorkspaceFn = gotoWorkspaceFn ws
+  , workspaceName = workspaceName ws
+  }
+
+joinMaybe :: (Monad m) => MaybeT m (Maybe a) -> MaybeT m a
+joinMaybe (MaybeT ma) = MaybeT $ join <$> ma
+
+class (Monad m) => KeyFeeder m where
+  fromX :: X a -> m a
+
+  fromMaybeTX :: MaybeT X a -> MaybeT m a
+  fromMaybeTX = mapMaybeT fromX
+
+  readNextKey ::
+    (KeyMask -> KeySym -> String -> MaybeT m a) -> MaybeT m a
+
+instance KeyFeeder X where
+  fromX = id
+  readNextKey = mapNextStringWithKeysym
+
+newtype FeedKeys a = FeedKeys { unFeedKeys :: StateT String X a }
+   deriving (Monad, Functor, Applicative)
+
+instance KeyFeeder FeedKeys where
+  fromX = FeedKeys . lift
+
+  readNextKey fn = do
+    ls <- lift $ FeedKeys S.get
+    case ls of
+      (h:t) -> do
+        lift $ FeedKeys $ S.put t
+        fn 0 0 [h]
+      _ -> MaybeT (return Nothing)
+
+feedKeys :: String -> MaybeT FeedKeys a -> X (Maybe a)
+feedKeys s mf = flip evalStateT s . unFeedKeys $ runMaybeT mf
+
+feedKeysT :: String -> MaybeT FeedKeys a -> MaybeT X a
+feedKeysT s mf = MaybeT $ feedKeys s mf
+
+-- Allows a reference to a workspace in terms of its description in the window
+-- management language.
+workspaceForStringT :: String -> MaybeT X Workspace
+workspaceForStringT str = feedKeysT str readNextWorkspace
+
+-- Like the above, but unwrap the MaybeT
+workspaceForString :: String -> X (Maybe Workspace)
+workspaceForString = runMaybeT . workspaceForStringT
+
+-- Like the above, but unwrap the MaybeT
+locationSetForStringT :: String -> MaybeT X [Location]
+locationSetForStringT s = feedKeysT s readNextLocationSet
+
+locationSetForString :: String -> X [Location]
+locationSetForString s = fromMaybe [] <$> (runMaybeT $ locationSetForStringT s)
+
+-- Returns the next workspaces associated with the next set of keystrokes.
+readNextWorkspace :: (KeyFeeder m) => MaybeT m Workspace
+readNextWorkspace =
+  readNextKey $ \mask sym str ->
+    case (mask, sym, str) of
+      (_, _, [ch]) | isAlphaNum ch || ch == '*' -> return $ justWorkspace [ch]
+      (_, _, "[") -> mt $ 
+        justWorkspace <$>
+           (adjacentWorkspaceNotVisible prev =<< getCurrentWorkspace)
+      (_, _, "]") -> mt $
+        justWorkspace <$>
+          (adjacentWorkspaceNotVisible next =<< getCurrentWorkspace)
+      (_, _, "(") -> mt $ 
+        justWorkspace <$>
+          (adjacentWorkspace prev =<< getCurrentWorkspace)
+      (_, _, ")") -> mt $
+        justWorkspace <$>
+          (adjacentWorkspace next =<< getCurrentWorkspace)
+      (_, _, "}") -> mt $ justWorkspace <$> adjacentScreen next
+      (_, _, "{") -> mt $ justWorkspace <$> adjacentScreen prev
+      (_, _, "^") -> mapMaybeT fromX $ MaybeT $
+        withWindowSet $ \ws -> return $
+          (fmap (justWorkspace . W.tag . W.workspace . snd) . head)
+            (getHorizontallyOrderedScreens ws)
+      (_, _, "'") -> fromMaybeTX $ justWorkspace . locationWorkspace <$> MaybeT lastLocation
+      (_, _, ".") -> mt $ justWorkspace <$> getCurrentWorkspace
+      (_, _, "$") -> MaybeT $ fromX $
+        withWindowSet $ \ws -> return $
+          (fmap (justWorkspace . W.tag . W.workspace . snd) . last)
+            (getHorizontallyOrderedScreens ws)
+      (_, _, ":") -> floatWorkspace <$> readNextWorkspace
+      (_, _, ",") -> do
+        ws <- readNextWorkspace
+        screens <-
+          mt $
+            map (W.tag . W.workspace . snd)
+              <$> withWindowSet (return . getHorizontallyOrderedScreens)
+
+        let (_, rest) = break (==workspaceName ws) (screens ++ screens)
+
+        justWorkspace <$> (MaybeT $ return $ head $ tail $ rest)
+
+      (_, _, "/") -> fromMaybeTX $ do
+        justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
+
+      (_, _, "@") -> do
+        loc <- readNextLocationSet
+        MaybeT (return $ (justWorkspace . locationWorkspace) <$> head loc)
+
+      (_, _, " ") -> mt $
+        justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
+      (_, _, "_") -> return blackHoleWorkspace
+      (_, _, "-") -> return alternateWorkspace
+      _ -> MaybeT (return Nothing)
+  where
+    mt :: (KeyFeeder m) => X a -> MaybeT m a
+    mt = lift . fromX
+
+readNextLocationSet :: (KeyFeeder m) => MaybeT m [Location]
+readNextLocationSet =
+  readNextKey $ \mask sym str ->
+    case (mask, sym, str) of
+      (_, _, [ch]) | isAlpha ch -> mt $ getMarkedLocations [ch]
+      (_, _, "0") -> (:[]) <$> MaybeT (fromX getMostRecentLocationInHistory)
+      (_, _, [ch]) | isDigit ch ->
+        (:[]) <$> MaybeT (fromX $ pastHistory (ord ch - 0x30))
+      (_, _, ".") -> (:[]) <$> mt getCurrentLocation
+      (_, _, "^") -> (:[]) <$> fromMaybeTX farLeftWindow
+      (_, _, "$") -> (:[]) <$> fromMaybeTX farRightWindow
+      (_, _, "\"") -> (:[]) <$> MaybeT (fromX nextLocation)
+      (_, _, "'") -> (:[]) <$>  MaybeT (fromX lastLocation)
+      (_, _, "*") -> fromMaybeTX $ (:[]) <$> (windowLocation =<< masterWindow)
+      (_, _, "-") -> fromMaybeTX $
+        mapM windowLocation =<< lift getAlternateWindows
+      (_, _, "/") -> fromMaybeTX $
+        (:[]) <$> (windowLocation =<< MaybeT askWindowId)
+      (_, _, "%") -> fromMaybeTX $
+        mapM windowLocation =<< lift (withWindowSet (return . W.allWindows))
+      (_, _, "@") ->
+        (mt . windowsInWorkspace . workspaceName) =<< readNextWorkspace
+      (_, _, "!") -> (:[]) <$> (joinMaybe $ head <$> readNextLocationSet)
+      (_, _, ",") -> tail <$> readNextLocationSet
+      (_, _, "~") -> reverse <$> readNextLocationSet
+      (_, _, "?") -> do
+        l1 <- readNextLocationSet
+        l2 <- readNextLocationSet
+        return $ if null l1 then l2 else l1
+
+      (_, _, "&") -> do
+        l1 <- readNextLocationSet
+        l2 <- readNextLocationSet
+        return (l1 ++ l2)
+      (_, _, "\\") -> do
+        l1 <- readNextLocationSet
+        l2 <- readNextLocationSet
+        return $ filter (not . flip elem l2) l1
+        
+      _ -> MaybeT (return Nothing)
+  where
+    mt :: (KeyFeeder m) => X a -> MaybeT m a
+    mt = lift . fromX
diff --git a/src/Rahm/Desktop/Lang.hs b/src/Rahm/Desktop/Lang.hs
deleted file mode 100644
index 374500d..0000000
--- a/src/Rahm/Desktop/Lang.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-module Rahm.Desktop.Lang where
-
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Class
-
-import Data.Char (isAlphaNum, isAlpha, isDigit, ord)
-import XMonad.Actions.CopyWindow as CopyWindow
-import XMonad.Util.Run (safeSpawn)
-import qualified XMonad.StackSet as W
-
-import Rahm.Desktop.Common
-import Rahm.Desktop.Keys.Dsl
-import Rahm.Desktop.History
-import Rahm.Desktop.Marking
-import Rahm.Desktop.Workspaces
-import Rahm.Desktop.Submap
-import Rahm.Desktop.Logger
-
-import Text.Printf
-
-import XMonad
-
-data Workspace =
-  Workspace {
-    moveLocationToWorkspaceFn :: Location -> X ()
-  , gotoWorkspaceFn :: X ()
-  , workspaceName :: String
-  }
-
-justWorkspace :: String -> Workspace
-justWorkspace s =
-  Workspace {
-    moveLocationToWorkspaceFn = flip moveLocationToWorkspace s
-  , gotoWorkspaceFn = gotoWorkspace s
-  , workspaceName = s
-  }
-
-blackHoleWorkspace :: Workspace
-blackHoleWorkspace =
-  Workspace {
-    moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow
-  , gotoWorkspaceFn = return () -- can't navigate to black hole
-  , workspaceName = "blackhole"
-  }
-
-alternateWorkspace :: Workspace
-alternateWorkspace =
-  Workspace {
-    moveLocationToWorkspaceFn  = \l@(Location _ maybeWin) -> do
-      logs $ "Moving Location: " ++ show l
-      case maybeWin of
-        Nothing -> return ()
-        Just win -> do
-          alter <- getAlternateWorkspace win
-          logs $ printf "Moving %s to %s" (show win) (show alter)
-          mapM_ (moveLocationToWorkspace l) alter
-
-  , gotoWorkspaceFn = do
-      (Location _ maybeWin) <- getCurrentLocation
-      case maybeWin of
-        Nothing -> return ()
-        Just win -> do
-          mapM_ gotoWorkspace =<<  getAlternateWorkspace win
-
-  , workspaceName = "@"
-  }
-
-readNextWorkspace :: MaybeT X Workspace
-readNextWorkspace =
-  mapNextStringWithKeysym $ \mask sym str ->
-    case (mask, sym, str) of
-      (_, _, [ch]) | isAlphaNum ch || ch == '*' -> return $ justWorkspace [ch]
-      (_, _, "[") -> lift $ 
-        justWorkspace <$>
-          (adjacentWorkspaceNotVisible prev =<< getCurrentWorkspace)
-      (_, _, "]") -> lift $
-        justWorkspace <$>
-          (adjacentWorkspaceNotVisible next =<< getCurrentWorkspace)
-      (_, _, "(") -> lift $ 
-        justWorkspace <$>
-          (adjacentWorkspace prev =<< getCurrentWorkspace)
-      (_, _, ")") -> lift $
-        justWorkspace <$>
-          (adjacentWorkspace next =<< getCurrentWorkspace)
-      (_, _, "}") -> lift $ justWorkspace <$> adjacentScreen next
-      (_, _, "{") -> lift $ justWorkspace <$> adjacentScreen prev
-      (_, _, "^") -> lift $ justWorkspace <$> firstWorkspaceId
-      (_, _, "'") -> justWorkspace . locationWorkspace <$> MaybeT lastLocation
-      (_, _, ".") -> lift $ justWorkspace <$> getCurrentWorkspace
-      (_, _, "$") -> lift $ justWorkspace <$> lastWorkspaceId
-      (_, _, "/") -> do
-        justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
-      (_, _, " ") -> lift $
-        justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
-      (_, _, "_") -> return blackHoleWorkspace
-      (_, _, "-") -> return alternateWorkspace
-      _ -> MaybeT (return Nothing)
-
-readNextLocationSet :: MaybeT X [Location]
-readNextLocationSet =
-  mapNextStringWithKeysym $ \mask sym str ->
-    case (mask, sym, str) of
-      (_, _, [ch]) | isAlpha ch -> lift $ getMarkedLocations [ch]
-      (_, _, "0") -> (:[]) <$> MaybeT getMostRecentLocationInHistory
-      (_, _, [ch]) | isDigit ch ->
-        (:[]) <$> MaybeT (pastHistory (ord ch - 0x30))
-      (_, _, ".") -> (:[]) <$> lift getCurrentLocation
-      (_, _, "^") -> (:[]) <$> farLeftWindow
-      (_, _, "$") -> (:[]) <$> farRightWindow
-      (_, _, "\"") -> (:[]) <$> MaybeT nextLocation
-      (_, _, "'") -> (:[]) <$>  MaybeT lastLocation
-      (_, _, "*") -> (:[]) <$> (windowLocation =<< masterWindow)
-      (_, _, "-") -> mapM windowLocation =<< lift getAlternateWindows
-      (_, _, "/") -> (:[]) <$> (windowLocation =<< MaybeT askWindowId)
-      (_, _, "%") ->
-        mapM windowLocation =<< lift (withWindowSet (return . W.allWindows))
-      (_, _, "@") -> (lift . windowsInWorkspace . workspaceName) =<< readNextWorkspace
-      (_, _, "&") -> do
-        l1 <- readNextLocationSet
-        l2 <- readNextLocationSet
-        return (l1 ++ l2)
-      (_, _, "\\") -> do
-        l1 <- readNextLocationSet
-        l2 <- readNextLocationSet
-        return $ filter (not . flip elem l2) l1
-        
-      _ -> MaybeT (return Nothing)
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 90808cf..1ea9782 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -1,7 +1,6 @@
 module Rahm.Desktop.Marking (
   markCurrentWindow,
   jumpToMark,
-  moveLocationToWorkspace,
   setAlternateWindows,
   getAlternateWindows,
   setAlternateWorkspace,
@@ -131,11 +130,6 @@ swapWithFocused winToSwap stackSet =
           mapWindows (
             \w -> if w == winToSwap then focused else w) stackSet
 
-moveLocationToWorkspace :: Location -> WorkspaceId ->  X ()
-moveLocationToWorkspace (Location _ (Just win)) wid =
-  windows $ shiftWin wid win
-moveLocationToWorkspace _ _ = return ()
-
 windowRect :: Window -> X (Maybe Rectangle)
 windowRect win = withDisplay $ \dpy -> (do
   (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
-- 
cgit 


From 25958a8363691a86a60667ca4f92b65247c51d89 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Mon, 18 Apr 2022 20:47:07 -0600
Subject: Change window border when selecting windows

---
 src/Rahm/Desktop/Common.hs   | 35 +++++++++++++++++++++++++++++++----
 src/Rahm/Desktop/Keys.hs     | 29 ++++++++++++++++-------------
 src/Rahm/Desktop/Keys/Wml.hs | 40 ++++++++++++++++++++++++++++++++--------
 src/Rahm/Desktop/Submap.hs   |  2 +-
 4 files changed, 80 insertions(+), 26 deletions(-)

diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index c12322a..9187edf 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -2,13 +2,14 @@ module Rahm.Desktop.Common where
 
 import Prelude hiding ((!!))
 
-import Control.Monad (void)
+import Control.Monad (void, when, forM_)
 import Control.Monad.Trans.Maybe
 import XMonad.Actions.DynamicWorkspaces
 import XMonad.Util.Run
 import XMonad.Prompt
 import XMonad.Prompt.Input
 import XMonad.Prompt.Shell
+import XMonad.Util.XUtils
 
 import Rahm.Desktop.PromptConfig
 
@@ -66,15 +67,41 @@ getString = runQuery $ do
       then t
       else printf "%s - %s" t a
 
-askWindowId :: X (Maybe Window)
+askWindowId :: X (Maybe [Window])
 askWindowId = do
   windowTitlesToWinId <- withWindowSet $ \ss ->
-    Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
+    Map.fromListWith (++) <$> mapM (\wid -> (,) <$> getString wid <*> return [wid]) (allWindows ss)
 
   runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
 
 windowJump :: X ()
-windowJump = mapM_ focus =<< askWindowId
+windowJump = (mapM_ (focus . head)) =<< askWindowId
+
+-- Temporarily set the border color of the given windows.
+withBorderColor :: String -> [Window] -> X a -> X a
+withBorderColor color wins fn = do
+  d <- asks display
+  px <- stringToPixel d color
+  oPx <- stringToPixel d =<< asks (normalBorderColor . config)
+  fPx <- stringToPixel d =<< asks (focusedBorderColor . config)
+
+  colorName <- io (pixelToString d px)
+  oColorName <- io (pixelToString d oPx)
+  fColorName <- io (pixelToString d fPx)
+
+  forM_ wins $ \w ->
+    setWindowBorderWithFallback d w colorName px
+
+  ret <- fn
+
+  withFocused $ \fw -> do
+    forM_ wins $ \w ->
+      when (w /= fw) $
+        setWindowBorderWithFallback d w oColorName oPx
+
+    setWindowBorderWithFallback d fw fColorName fPx
+
+  return ret
 
 gotoWorkspace :: WorkspaceId -> X ()
 gotoWorkspace wid = do
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 6973b81..69873e4 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -32,6 +32,7 @@ import XMonad.Layout.Spacing
 import XMonad.Prompt
 import XMonad.Prompt.Input
 import XMonad.Prompt.Shell
+import XMonad.Util.XUtils
 import XMonad.Util.CustomKeys
 import XMonad.Util.Run (safeSpawn)
 import XMonad.Util.Scratchpad
@@ -392,19 +393,21 @@ keymap = runKeys $ do
       sendMessage rotateLayout
 
   bind xK_s $ do
-    justMod $ runMaybeT_ $ do
-      locations <- readNextLocationSet 
-
-      workspace <- readNextWorkspace
-      mapM_ (lift . moveLocationToWorkspaceFn workspace) locations
-
-      lift $ setAlternateWindows (mapMaybe locationWindow locations)
-      forM_ locations $ \loc ->
-        case locationWindow loc of
-          Nothing -> return ()
-          Just win -> do
-            lift $ logs $ printf "setAlternate %s %s" (show win) (show $ locationWorkspace loc)
-            lift $ setAlternateWorkspace win (locationWorkspace loc)
+    justMod $ do
+      locations <- fromMaybe [] <$> runMaybeT readNextLocationSet
+      let locationWindows = mapMaybe locationWindow locations
+
+      withBorderColor "#00ffff" locationWindows $ do
+        runMaybeT_ $ do
+          workspace <- readNextWorkspace
+          mapM_ (lift . moveLocationToWorkspaceFn workspace) locations
+
+          lift $ setAlternateWindows locationWindows
+          forM_ locations $ \loc ->
+            case locationWindow loc of
+              Nothing -> return ()
+              Just win -> do
+                lift $ setAlternateWorkspace win (locationWorkspace loc)
 
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 47be2e7..21b8c4c 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -18,9 +18,11 @@ import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.State as S
 import Control.Monad.Trans.Class
 import Control.Monad (join, forM_)
+import Data.List (sortOn, intercalate)
+import Data.Ord (Down(..))
 
 import Data.Char (isAlphaNum, isAlpha, isDigit, ord)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, catMaybes)
 import XMonad.Actions.CopyWindow as CopyWindow
 import XMonad.Util.Run (safeSpawn)
 import Prelude hiding (head, last)
@@ -191,8 +193,19 @@ readNextWorkspace =
 
         justWorkspace <$> (MaybeT $ return $ head $ tail $ rest)
 
+      (_, _, ";") -> do
+        ws <- readNextWorkspace
+        screens <-
+          mt $
+            map (W.tag . W.workspace . snd)
+              <$> withWindowSet (return . getHorizontallyOrderedScreens)
+
+        let (front, _) = break (==workspaceName ws) (screens ++ screens)
+
+        justWorkspace <$> (MaybeT $ return $ last $ front)
+
       (_, _, "/") -> fromMaybeTX $ do
-        justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
+        justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT ((head=<<) <$> askWindowId))
 
       (_, _, "@") -> do
         loc <- readNextLocationSet
@@ -220,13 +233,20 @@ readNextLocationSet =
       (_, _, "$") -> (:[]) <$> fromMaybeTX farRightWindow
       (_, _, "\"") -> (:[]) <$> MaybeT (fromX nextLocation)
       (_, _, "'") -> (:[]) <$>  MaybeT (fromX lastLocation)
-      (_, _, "*") -> fromMaybeTX $ (:[]) <$> (windowLocation =<< masterWindow)
+      (_, _, "*") -> mt $ do -- All visible windows.
+        wins <- withWindowSet $
+          return . concatMap (W.integrate' . W.stack . W.workspace) . W.screens
+
+        catMaybes <$> mapM (runMaybeT . windowLocation) wins
+        
       (_, _, "-") -> fromMaybeTX $
         mapM windowLocation =<< lift getAlternateWindows
       (_, _, "/") -> fromMaybeTX $
-        (:[]) <$> (windowLocation =<< MaybeT askWindowId)
-      (_, _, "%") -> fromMaybeTX $
-        mapM windowLocation =<< lift (withWindowSet (return . W.allWindows))
+        (mapM windowLocation =<< MaybeT askWindowId)
+      (_, _, "%") -> fromMaybeTX $ do
+        ret <- mapM windowLocation =<< lift (withWindowSet (return . sortOn Down . W.allWindows))
+        lift $ logs $ "allWindows " ++ intercalate "\n"  (map show ret)
+        return ret
       (_, _, "@") ->
         (mt . windowsInWorkspace . workspaceName) =<< readNextWorkspace
       (_, _, "!") -> (:[]) <$> (joinMaybe $ head <$> readNextLocationSet)
@@ -236,15 +256,19 @@ readNextLocationSet =
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
         return $ if null l1 then l2 else l1
-
-      (_, _, "&") -> do
+      (_, _, "|") -> do
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
         return (l1 ++ l2)
+      (_, _, "_") -> return []
       (_, _, "\\") -> do
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
         return $ filter (not . flip elem l2) l1
+      (_, _, "&") -> do -- intersection
+        l1 <- readNextLocationSet
+        l2 <- readNextLocationSet
+        return $ filter (flip elem l2) l1
         
       _ -> MaybeT (return Nothing)
   where
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index 48a3144..5a05f9e 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -66,7 +66,7 @@ mapNextStringWithKeysym fn = do
 
   ret <- io $ fix $ \nextkey -> do
     ret <-
-      getMaskEventWithTimeout 2000 d keyPressMask $ \p -> do
+      getMaskEventWithTimeout 5000 d keyPressMask $ \p -> do
         KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
         keysym <- keycodeToKeysym d code 0
         (_, str) <- lookupString (asKeyEvent p)
-- 
cgit 


From 41b4bf01d61a0d42d27145700e41318715b37e1f Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Mon, 18 Apr 2022 23:00:26 -0600
Subject: Highlight windows for marking too

---
 src/Rahm/Desktop/Keys.hs | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 69873e4..9ae9c30 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -354,14 +354,16 @@ keymap = runKeys $ do
       doc "For mosaic layout, shrink the size-share of the current window" $
       sendMessage =<< shrinkPositionAlt
 
-  bind xK_m $ do
+  bind xK_m $
     justMod $
-      doc "Mark the current window with the next typed character." $
-      runMaybeT_ $ do
-       locs <- readNextLocationSet
-       mapNextString $ \_ str -> lift $
-        case str of
-          [ch] | isAlpha ch -> markAllLocations str locs
+      doc "Mark the current window with the next typed character." $ do
+      locs <- fromMaybe [] <$> runMaybeT readNextLocationSet
+      withBorderColor "#00ffff" (mapMaybe locationWindow locs) $ do
+        runMaybeT_ $ do
+         mapNextString $ \_ str -> lift $
+          case str of
+            [ch] | isAlpha ch -> markAllLocations str locs
+            _ -> return ()
 
   bind xK_plus $ do
     justMod $
-- 
cgit 


From 01fb3d10f6031dea250a2489f82db50687068646 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sat, 16 Apr 2022 01:12:22 -0600
Subject: xmobar remove transparancy

---
 extras/HOME/.xmobarrc | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index c536f7e..ae534e9 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -14,7 +14,7 @@ Config
    , borderWidth = 2
    , bgColor = "#000000"
    , fgColor = "white"
-   , alpha = 230                 -- default: 255
+   , alpha = 255                 -- default: 255
    , position = TopSize C 99 50
   , textOffset = -1             -- default: -1
    , iconOffset = -1             -- default: -1
-- 
cgit 


From f605cc29d376dfd5acb138c06de0eced1974f9d3 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 19 Apr 2022 01:30:50 -0600
Subject: Update readme

---
 README.md | 232 +++++++++++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 176 insertions(+), 56 deletions(-)

diff --git a/README.md b/README.md
index a3783d6..d65c147 100644
--- a/README.md
+++ b/README.md
@@ -1,85 +1,53 @@
 # Rahm's Rice'd Desktop Environment
 
-This is Rahm's desktop environment. Namely it's an amalgamation of scripts,
-executables, scum, villany, and configuration all duct-taped together to create
-a marginally functional desktop environment of dubious stability, but it seems
-to be pretty good.
+This is Rahm's Desktop Environment. It is a *very* configured XMonad/XMobar
+based desktop environment.
 
 [![Screenshot](screenshot.jpg)](https://git.josher.dev/cgit/rde.git/)
 
-(BTW, I'm not actually in Dallas, I'm in the same place as Mr. Money Moustache,
-and yes, I use Arch btw)
-
 # Requirements
 
-* Definitely need GHC. If you use Hugs, you deserve the pain.
-* X11, duh!
-* Xinerama is helpful
+* GHC
+* X11
+* Xinerama
 * Monofur NERD Font. Should be included with the NERD fonts package.
-* GCC, because when I take off my Functional Programmer hat, I put on my
-  systems-dev glasses.
-* Perl, because when I take off my systems-dev glasses, I put on my UNIX beard.
-* Not Python, because when I take off the UNIX beard I skip the Soy latte and go
-  back to the FP hat.
-* Knowledge of Linux/Unix or an intense desire for masochism (which, as
-  long as it's consensual, I'm totally fine with.)
-* Linux. BSD support is coming, be patient!!
-  * Not Winblows -- Get out of here
-  * Not MacOS -- I don't have a clever pejorative.
-
+* GCC
+* Perl
+* Knowledge of Linux/Unix
+* Linux, maybe Mac
 
 # Configuration
 
 ## Window Manager
 
-The window manager is XMonad, obviously, but _heavily_ configured.
-
-The way I configured XMonad is to be similar to Vim in that some keys are
-actually modal. I.e. require another key-press to effectuate the system
-
-Probably the biggest difference between this configuration and standard
-configurations is that there are _many_ workspaces. Actually, there are 36
-workspaces, one for each letter and digit (in the English alphabet).
+The Window Manager is a *heavily* configured XMonad. Many of the keys are
+designed to be reminiscent of Vim.
 
-Navigating between all these workspaces is easy, though, just type Mod+g
-followed by the workspace you're trying to go to! (G stands for 'go' btw).
+Similar to Vim, Rde contains within it, its own kind of "language" called WML
+(Window management language) to describe workspaces and windows to make very
+powerful key bindngs. See the section about Window Management Language.
 
 ### Some things to note
 
-I type in Programmer Dvorak (because of course I do) so many of the key bindings
-make little to no sense on QWERTY layout and should probably be changed by the
-user. It's in my TODO list to make a QWERTY variant, but I haven't gotten to it.
-
-_Also_ my ModKey is the Hyper key (because of course it is!), which the astute
-among you might notice does not actually exist on the keyboard. Aha! [Rahm's XKb
-Layout](https://git.josher.dev/cgit/rkb.git) strikes again! I have remapped
-pretty much all my modifier keys and reanimated the long-dead Hyper key! "But,
-Rahm, you handsome, yet dark and mysterious \*nix landchad, why would you use
-such a key no one uses?", I hear you ask. Well, my delightful, yet young
-compatriot, it is precisely because no one uses it that I use it. See, it is a
-decent way of preventing conflicting bindings in other applications! Plus it
-opens the door for using the Super key is [Rahm's patched
-Alacritty](https://git.josher.dev/cgit/r-alacritty.git) and thus use it in
-[Rahm's patched Neovim](https://git.josher.dev/cgit/rneovim.git) to potentially
-program some of [Rahm's STM32 Christmas
-Lights](https://git.josher.dev/cgit/stm34l4.git). **Anyway**, the salient point
-is that I recommend you learn Programmer Dvorak and switch your keyboard layout
-to [Rahm's XKb Layout](https://git.josher.dev/cgit/rkb.git), but in the off
-chance you decide against that, you can change the mod key to Super in
-`Main.hs`.
+I type in Programmer Dvorak, which means some of the key bindings make more
+sense on the Dvorak layout vs QWERTY layout, but many of the keybindings should
+work well in both.
+
+The mod key is by default set to the Hyper Key. One would probably want to
+change this in `Main.hs` before using this. Chose the hyper key to avoid conflicts
+with other applications.
 
 ## Bar
 
-The Bar Is XMobar, of course, but again, heavily modified.
+The Bar is XMobar, pretty heavily configured and leverages the number of scripts
+that ship with Rde.
 
 ### Features
 
   * OS Logo
     * For Debian, Arch, Ubuntu and BSD
   * Kernel version
-  * Date
-  * Shows workspace layout as icon (I'm quite proud of this! It took forever to
-    get working!)
+  * Shows workspace layout as icon
   * Workspaces
     * Red is current
     * Blue is not current, but visible
@@ -91,6 +59,7 @@ The Bar Is XMobar, of course, but again, heavily modified.
   * Spotify Info
   * Bluetooth Info
   * Battery Info
+  * Date
 
 ## Battery
 
@@ -124,3 +93,154 @@ If you haven't paired your bluetooth device yet, maybe you should use
 ## Compositor
 
 Picom/Compton is my compositor, and it mostly works, but sometimes doesn't.
+
+## Window Management Language (WML)
+
+There are some commands that operate on "Window Management Objects," (WMO) there
+are two types of WMOs, Workspaces and Windows.
+
+WML consists of a verb, and objects to operate on. For example: typing `<M-g>a`
+will "goto" the workspace 'a'. Typing '<M-w>s' will go to the window tagged with
+'s'. Thats pretty simple> However things get more complex. For example:
+
+  * `<M-s>\%@.,,^` Shift all windows not on the current workspace to the
+    workspace on the third monitor from the left. 
+
+  * `<M-s>\%*_` Kill all the Windows not currently visible
+
+  * `<M-g>,.` Switch to the workspace to the right of the current workspace
+
+  * `<M-s>,,~@.,.` Move all but the last two windows on the current workspace to
+    the next monitor
+
+  * `<M-s>|@a@b.` Move all the windows on workspaces 'a' and 'b' to the current
+    workspace.
+
+  * `<M-s>--` Undo the last shift.
+
+It looks complicated, but it's actually quite simple. All WML "sentances" start
+with a "verb", which is usually triggered with a mod key. What comes next
+depends to the verb.
+
+### Verbs
+
+  * `<M-g>[Workspace]` *goto*, jumps to a workspace
+  * `<M-s>[WindowSet][Workspace]` *shift*, shifts windows to a workspace.
+  * `<M-m>[WindowSet][:alpha:]` *mark*, marks a window with the given alpha
+    character.
+  * `<M-w>[WindowSet]` *navigate*, Navigates to the first window in the
+    referenced windowset.
+
+#### Workspace Object
+
+Workspace object describe a place where windows can go. In XMonad workspaces can
+either be hidden or visible. On a multi monitor setup multiple workspaces may be
+visible at a single time.
+
+The base of the Workspace object is the workspace tag. These are any alpha
+numeric characters and are referenced by their tag. Thus the keystroke 'a'
+references the 'a' workspace, 'b' references the 'b' workspace, 'π' references
+thes 'π' workspace (yes, any alphanumeric character work).
+
+So `<M-g>a` will simply go to the 'a' workspace.
+
+That's pretty simple, but things get more interesting when using special
+workspaces.
+
+   * *x* | *x* is alphanumeric: the workspace with that tag 
+   * `.`: The current workspace
+   * `[`: The next non-visible workspace to the right of this one.
+   * `]`: The next non-visible workspace to the left of this one.
+   * `{`: The workspace on the screen to the left of the current workspace
+     (equivalent to `;.`)
+   * `}`: The workspace on the screen to the right of the current workspace.
+     (equivalent to `,.`)
+   * `(`: The next workspace to the right
+   * `)`: The next workspace to the left
+   * `^`: The workspace on the rightmost screen.
+   * `$`: The workspace on the leftmost screen.
+   * `,`: The workspace on the monitor to the right of the next typed workspace
+     (i.e. `,a` is the workspace to the right of workspace a. '
+   * `;`: Like `,`, but to the left.
+   * `/`: Search for a window and reference the workspace on that window.
+   * `@`: The workspace associated with the following window set object. (i.e.
+     `@a` references the workspace the window marked a is on)
+   * ` ` (space): The current workspace's associated workspace. The associated
+     workspace is the workspace with the tag of the toggled case (i.e.
+     Associated workspace for 'a' is 'A' and vice versa). Note that workspaces
+     with number tags do not have associated workspaces.
+   * `_`: The black hole "workspace." Cannot be travelled to, but sending a
+     window to it will kill it.
+   * `-`: The alternate workspace. Each window has an alternate workspace, which
+     is generally the last workspace that contained that window. Sending a
+     window to the alternate workspace will send it to the last workspace it was
+     a part of.
+   * `*`: The hidden workspace. Acts just like other base workspaces except that
+     it does not show up in the workspace list in XMobar and cannot be navigated
+     to using `[` or `]` .
+
+#### WindowSet Objects
+
+Window set object reference sets of windows. Operations that only require one
+Window will use the first element in the windowset referenced.
+
+Windows can be marked using the `M-m` verb.
+
+Like workspaces, the base are alpha (non-numeric), and these referenced marked
+windows, but there are also special marks and operators to better describe
+exactly what one is wanting to do.
+
+
+    * *x* | x is alpha: The windows marked with *x*
+    * `.`: The current window.
+    * `^`: The window on the far left (across all screens)
+    * `$`: The window on the far right (across all screens)
+    * `'`: The last window
+    * `*`: All currently visible windows
+    * `-`: The windows used in the last command. (NOTE: <M-s>-- will send last
+      referenced windows to where they came from -- basically undo)
+    * `/`: Search for a window and select all the ones with that title
+    * `%`: All windows
+    * `_`: No windows
+    * `@`: All the windows on the next entered workspace. (i.e. @,. references
+      all windows on the creen to the right of the current workspace).
+    * `!`: The first window in the following windowset (i.e. !@.
+      references the master window on the current workspace).
+    * `,`: The following window set, but without the first element.
+    * `~`: The following window set, but reversed (i.e. `!~@.` references the
+      last window on the current workspace`
+    * `?`: takes two window sets, if the first one is empty, then return the
+      second one, otherwise return the first.
+    * `|`: The union of the next two window sets (i.e. `|@.a` is the union of
+      the windows on the current workspace and the windows marked with 'a'.
+    * `&`: The intersection between the next two window sets.
+    * `\\`: The difference between two window sets. (i.e. `\%a` references all
+      windows except those marked with 'a')
+
+#### Revisiting Examples
+
+  * `<M-s>\%@.,,^` *Shift all windows not on the current workspace to the
+    workspace on the third monitor from the left.*
+
+      * `<M-s>`: we're shifting windows to a workspace.
+      * `\%@.`: All windows not on the current workspace (`\\` is the set
+        difference operator, `%` is all windows, `@.` is all windows on the
+        current workspace)
+      * `,,^`: Third screen from the left. `^` references the far left screen,
+        the `,` (applied twice) shifts that to the right once.
+
+  * `<M-s>\%*_` *Kill all the Windows not currently visible*
+
+      * `<M-s>` we're shifting windows.
+      * `\%*` All windows except those visible.
+      * `_` The black hole workspace. Kills windows sent to it.
+
+  * `<M-s>,,~@.,.` Move all but the last two windows on the current workspace to
+    the next monitor
+
+      * `<M-s>`: We're shifting windows to a workspace
+      * `,,~@.`: `@.` references the windows on the current workspace, `~`
+        reverses that list, and `,` (applied twice) takes the first element off
+        the list. So it's all windows on the current workspace, except the last
+        two.
+      * `,.`: The workspace on the screen to the right.
-- 
cgit 


From f0789e78ecd145590a104052d562334fd92ac5d9 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 19 Apr 2022 01:35:49 -0600
Subject: Fixup some readme things

---
 README.md | 63 +++++++++++++++++++++++++++++++--------------------------------
 1 file changed, 31 insertions(+), 32 deletions(-)

diff --git a/README.md b/README.md
index d65c147..c97e0ce 100644
--- a/README.md
+++ b/README.md
@@ -99,9 +99,9 @@ Picom/Compton is my compositor, and it mostly works, but sometimes doesn't.
 There are some commands that operate on "Window Management Objects," (WMO) there
 are two types of WMOs, Workspaces and Windows.
 
-WML consists of a verb, and objects to operate on. For example: typing `<M-g>a`
-will "goto" the workspace 'a'. Typing '<M-w>s' will go to the window tagged with
-'s'. Thats pretty simple> However things get more complex. For example:
+WML consists of "sentences," and sentences  and objects to operate on. For example: typing `<M-g>a`
+will "goto" the workspace 'a'. Typing `<M-w>s` will go to the window tagged with
+'s'. Thats pretty simple, However things get more complex. For example:
 
   * `<M-s>\%@.,,^` Shift all windows not on the current workspace to the
     workspace on the third monitor from the left. 
@@ -119,7 +119,7 @@ will "goto" the workspace 'a'. Typing '<M-w>s' will go to the window tagged with
   * `<M-s>--` Undo the last shift.
 
 It looks complicated, but it's actually quite simple. All WML "sentances" start
-with a "verb", which is usually triggered with a mod key. What comes next
+have a "verb", which is usually triggered with a mod key. What comes next
 depends to the verb.
 
 ### Verbs
@@ -190,32 +190,31 @@ Like workspaces, the base are alpha (non-numeric), and these referenced marked
 windows, but there are also special marks and operators to better describe
 exactly what one is wanting to do.
 
-
-    * *x* | x is alpha: The windows marked with *x*
-    * `.`: The current window.
-    * `^`: The window on the far left (across all screens)
-    * `$`: The window on the far right (across all screens)
-    * `'`: The last window
-    * `*`: All currently visible windows
-    * `-`: The windows used in the last command. (NOTE: <M-s>-- will send last
-      referenced windows to where they came from -- basically undo)
-    * `/`: Search for a window and select all the ones with that title
-    * `%`: All windows
-    * `_`: No windows
-    * `@`: All the windows on the next entered workspace. (i.e. @,. references
-      all windows on the creen to the right of the current workspace).
-    * `!`: The first window in the following windowset (i.e. !@.
-      references the master window on the current workspace).
-    * `,`: The following window set, but without the first element.
-    * `~`: The following window set, but reversed (i.e. `!~@.` references the
-      last window on the current workspace`
-    * `?`: takes two window sets, if the first one is empty, then return the
-      second one, otherwise return the first.
-    * `|`: The union of the next two window sets (i.e. `|@.a` is the union of
-      the windows on the current workspace and the windows marked with 'a'.
-    * `&`: The intersection between the next two window sets.
-    * `\\`: The difference between two window sets. (i.e. `\%a` references all
-      windows except those marked with 'a')
+   * *x* | x is alpha: The windows marked with *x*
+   * `.`: The current window.
+   * `^`: The window on the far left (across all screens)
+   * `$`: The window on the far right (across all screens)
+   * `'`: The last window
+   * `*`: All currently visible windows
+   * `-`: The windows used in the last command. (NOTE: <M-s>-- will send last
+     referenced windows to where they came from -- basically undo)
+   * `/`: Search for a window and select all the ones with that title
+   * `%`: All windows
+   * `_`: No windows
+   * `@`: All the windows on the next entered workspace. (i.e. @,. references
+     all windows on the creen to the right of the current workspace).
+   * `!`: The first window in the following windowset (i.e. !@.
+     references the master window on the current workspace).
+   * `,`: The following window set, but without the first element.
+   * `~`: The following window set, but reversed (i.e. `!~@.` references the
+     last window on the current workspace`
+   * `?`: takes two window sets, if the first one is empty, then return the
+     second one, otherwise return the first.
+   * `|`: The union of the next two window sets (i.e. `|@.a` is the union of
+     the windows on the current workspace and the windows marked with 'a'.
+   * `&`: The intersection between the next two window sets.
+   * `\`: The difference between two window sets. (i.e. `\%a` references all
+     windows except those marked with 'a')
 
 #### Revisiting Examples
 
@@ -235,8 +234,8 @@ exactly what one is wanting to do.
       * `\%*` All windows except those visible.
       * `_` The black hole workspace. Kills windows sent to it.
 
-  * `<M-s>,,~@.,.` Move all but the last two windows on the current workspace to
-    the next monitor
+  * `<M-s>,,~@.,.` *Move all but the last two windows on the current workspace to
+    the next monitor*
 
       * `<M-s>`: We're shifting windows to a workspace
       * `,,~@.`: `@.` references the windows on the current workspace, `~`
-- 
cgit 


From 5cf7821e666eb70d09e0f54fdfa683472a2a3f65 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 19 Apr 2022 18:22:40 -0600
Subject: Better alignment of xmobar widgets

---
 extras/HOME/.xmobarrc                | 10 ++++++----
 extras/HOME/.xmonad/xmobar-bluetooth |  2 +-
 extras/HOME/.xmonad/xmobar-media     |  2 +-
 extras/HOME/.xmonad/xmobar-weather   |  4 ++--
 4 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index ae534e9..25568bd 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -30,10 +30,12 @@ Config
    , template =
       " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc> \
       \%UnsafeStdinReader%}\
-      \{ %cpu% %memory% <fc=#404040>\
-      \ %weather% \
-      \</fc> <fc=#a0a0a0>%media%</fc> \
-      \%bluetooth%%bat% <fn=2><fc=#606060>%time%</fc></fn> "
+      \{ %cpu% %memory%<fc=#404040>\
+      \<action=alacritty -t 'Floating Term' -e sh -c 'curl wttr.in ; read i'>\
+      \%weather%\
+      \</action>\
+      \</fc><fc=#a0a0a0>%media%</fc>\
+      \%bluetooth%%bat%<fn=2><fc=#606060>  %time%</fc></fn> "
    , commands = [
        Run UnsafeStdinReader,
        Run Date "%m/%d %H:%M:%S" "time" 10,
diff --git a/extras/HOME/.xmonad/xmobar-bluetooth b/extras/HOME/.xmonad/xmobar-bluetooth
index 3d65ee7..56a7521 100755
--- a/extras/HOME/.xmonad/xmobar-bluetooth
+++ b/extras/HOME/.xmonad/xmobar-bluetooth
@@ -19,4 +19,4 @@ if [ -d /sys/class/bluetooth ] ; then
 
 fi
 
-exec echo "<fc=#404040></fc>  "
+exec echo "<fc=#404040></fc> "
diff --git a/extras/HOME/.xmonad/xmobar-media b/extras/HOME/.xmonad/xmobar-media
index 7232900..56c4d03 100755
--- a/extras/HOME/.xmonad/xmobar-media
+++ b/extras/HOME/.xmonad/xmobar-media
@@ -3,7 +3,7 @@
 title="$(spotify-control getTitle)"
 
 if [[ "$?" -eq 0 ]] ; then
-  echo "<fc=#1aa54b></fc>  <fn=3>$title</fn>"
+  echo "<fc=#1aa54b></fc> <fn=3>$title</fn>  "
 else
   echo "<fc=#404040> </fc>"
 fi
diff --git a/extras/HOME/.xmonad/xmobar-weather b/extras/HOME/.xmonad/xmobar-weather
index 7399969..fdcd40f 100755
--- a/extras/HOME/.xmonad/xmobar-weather
+++ b/extras/HOME/.xmonad/xmobar-weather
@@ -15,7 +15,7 @@ $content = `curl "https://api.sunrise-sunset.org/json?lat=$lat&lng=$lon&formatte
 die "Unable to get sunrise/sunset data" unless defined $content;
 
 if (length($content) == 0) {
-  printf("<fc=#404040>X</fc>");
+  printf("<fc=#404040></fc> ");
   exit
 }
 
@@ -100,4 +100,4 @@ if ($is_day) {
   $conditions = %conditions_night{$sky_conditions};  
 }
 
-printf("<fc=#a0a0a0><fn=3>$city</fn><fn=3>$dir</fn><fn=3>${wind_speed}</fn></fc> $conditions<fn=3>  <fc=#a0a0a0>%.0f°F</fc></fn>\n", $temp);
+printf("<fc=#a0a0a0><fn=3>$city</fn> <fn=3>$dir</fn> <fn=3>${wind_speed}</fn></fc> $conditions<fn=3> <fc=#a0a0a0>%.0f°F</fc></fn>  \n", $temp);
-- 
cgit 


From decdf01bd651cfb0bd77e496143c364389e90008 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 19 Apr 2022 21:33:51 -0600
Subject: Add : object to reference floating windows

---
 README.md                    |  1 +
 src/Rahm/Desktop/Keys/Wml.hs | 21 ++++++++++++++-------
 2 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/README.md b/README.md
index c97e0ce..7661ba3 100644
--- a/README.md
+++ b/README.md
@@ -205,6 +205,7 @@ exactly what one is wanting to do.
      all windows on the creen to the right of the current workspace).
    * `!`: The first window in the following windowset (i.e. !@.
      references the master window on the current workspace).
+   * `:`: The floating windows.
    * `,`: The following window set, but without the first element.
    * `~`: The following window set, but reversed (i.e. `!~@.` references the
      last window on the current workspace`
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 21b8c4c..babf3b5 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -21,6 +21,7 @@ import Control.Monad (join, forM_)
 import Data.List (sortOn, intercalate)
 import Data.Ord (Down(..))
 
+import qualified Data.Map as Map
 import Data.Char (isAlphaNum, isAlpha, isDigit, ord)
 import Data.Maybe (fromMaybe, catMaybes)
 import XMonad.Actions.CopyWindow as CopyWindow
@@ -149,7 +150,7 @@ locationSetForStringT :: String -> MaybeT X [Location]
 locationSetForStringT s = feedKeysT s readNextLocationSet
 
 locationSetForString :: String -> X [Location]
-locationSetForString s = fromMaybe [] <$> (runMaybeT $ locationSetForStringT s)
+locationSetForString s = fromMaybe [] <$> runMaybeT (locationSetForStringT s)
 
 -- Returns the next workspaces associated with the next set of keystrokes.
 readNextWorkspace :: (KeyFeeder m) => MaybeT m Workspace
@@ -191,7 +192,7 @@ readNextWorkspace =
 
         let (_, rest) = break (==workspaceName ws) (screens ++ screens)
 
-        justWorkspace <$> (MaybeT $ return $ head $ tail $ rest)
+        justWorkspace <$> MaybeT (return $ head $ tail rest)
 
       (_, _, ";") -> do
         ws <- readNextWorkspace
@@ -202,14 +203,14 @@ readNextWorkspace =
 
         let (front, _) = break (==workspaceName ws) (screens ++ screens)
 
-        justWorkspace <$> (MaybeT $ return $ last $ front)
+        justWorkspace <$> MaybeT (return $ last front)
 
       (_, _, "/") -> fromMaybeTX $ do
         justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT ((head=<<) <$> askWindowId))
 
       (_, _, "@") -> do
         loc <- readNextLocationSet
-        MaybeT (return $ (justWorkspace . locationWorkspace) <$> head loc)
+        MaybeT (return $ justWorkspace . locationWorkspace <$> head loc)
 
       (_, _, " ") -> mt $
         justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
@@ -242,16 +243,22 @@ readNextLocationSet =
       (_, _, "-") -> fromMaybeTX $
         mapM windowLocation =<< lift getAlternateWindows
       (_, _, "/") -> fromMaybeTX $
-        (mapM windowLocation =<< MaybeT askWindowId)
+        mapM windowLocation =<< MaybeT askWindowId
       (_, _, "%") -> fromMaybeTX $ do
         ret <- mapM windowLocation =<< lift (withWindowSet (return . sortOn Down . W.allWindows))
         lift $ logs $ "allWindows " ++ intercalate "\n"  (map show ret)
         return ret
       (_, _, "@") ->
         (mt . windowsInWorkspace . workspaceName) =<< readNextWorkspace
-      (_, _, "!") -> (:[]) <$> (joinMaybe $ head <$> readNextLocationSet)
+      (_, _, "!") -> (:[]) <$> joinMaybe (head <$> readNextLocationSet)
       (_, _, ",") -> tail <$> readNextLocationSet
       (_, _, "~") -> reverse <$> readNextLocationSet
+      (_, _, ":") -> mt $
+        withWindowSet $
+          fmap catMaybes .
+          mapM (runMaybeT . windowLocation) .
+          Map.keys .
+          W.floating
       (_, _, "?") -> do
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
@@ -268,7 +275,7 @@ readNextLocationSet =
       (_, _, "&") -> do -- intersection
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
-        return $ filter (flip elem l2) l1
+        return $ filter (`elem` l2) l1
         
       _ -> MaybeT (return Nothing)
   where
-- 
cgit 


From cfa9b9fbefa247ce06ed1e985fdfacf162f781c8 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 19 Apr 2022 22:45:32 -0600
Subject: Add :: object to tile windows onto a workspace

---
 README.md                    | 30 ++++++++++++++++++++++++++++++
 src/Rahm/Desktop/Keys/Wml.hs | 33 +++++++++++++++++++++++++--------
 2 files changed, 55 insertions(+), 8 deletions(-)

diff --git a/README.md b/README.md
index 7661ba3..06a8631 100644
--- a/README.md
+++ b/README.md
@@ -116,6 +116,10 @@ will "goto" the workspace 'a'. Typing `<M-w>s` will go to the window tagged with
   * `<M-s>|@a@b.` Move all the windows on workspaces 'a' and 'b' to the current
     workspace.
 
+  * `<M-s>%.<M-s>%:s` Float all windows.
+
+  * `<M-s>%.<M-s>%::s` Sink all windows.
+
   * `<M-s>--` Undo the last shift.
 
 It looks complicated, but it's actually quite simple. All WML "sentances" start
@@ -162,6 +166,10 @@ workspaces.
    * `,`: The workspace on the monitor to the right of the next typed workspace
      (i.e. `,a` is the workspace to the right of workspace a. '
    * `;`: Like `,`, but to the left.
+   * `:`: Delegates to the next workspace, but float windows sent to it. (i.e.
+     `<M-s>@.:.` will float all the windows on the current screen.
+   * `::`: Delegates to the next workspace, but sink windows sent to it. (i.e.
+     `<M-s>@.::.` will sink all the windows on the current screen.
    * `/`: Search for a window and reference the workspace on that window.
    * `@`: The workspace associated with the following window set object. (i.e.
      `@a` references the workspace the window marked a is on)
@@ -244,3 +252,25 @@ exactly what one is wanting to do.
         the list. So it's all windows on the current workspace, except the last
         two.
       * `,.`: The workspace on the screen to the right.
+
+  * `<M-s>%.<M-s>%:-`: *Float all windows*
+
+      * `<M-s>%.` Moves all the windows to the current workspace.
+      * `<M-s>%:.` Moves all the windows back to where they came from, but
+        floats them.
+
+#### Some Identities
+
+  * `<M-s>..` is a No-op. It move the current window to the current workspace,
+    which does nothing.
+
+  * `&x_` References nothing for any x because `_` is the empty windowset.
+
+  * `|_x` References x for any x.
+
+  * `<M-g>.` Is a No-op. It just goes to the current workspace
+
+  * `<M-s>@xx` is a no-op for any x because it just moves all windows on
+    workspace x to worksapce x.
+
+  * `,;x` is just references x for any x because the `;` undos the `,`
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index babf3b5..0dfb852 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -17,9 +17,10 @@ module Rahm.Desktop.Keys.Wml where
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.State as S
 import Control.Monad.Trans.Class
-import Control.Monad (join, forM_)
+import Control.Monad (join, forM_, unless)
 import Data.List (sortOn, intercalate)
 import Data.Ord (Down(..))
+import Data.Typeable (cast)
 
 import qualified Data.Map as Map
 import Data.Char (isAlphaNum, isAlpha, isDigit, ord)
@@ -43,10 +44,11 @@ import Text.Printf
 import XMonad
 
 data Workspace =
-  Workspace {
+  forall a. (Typeable a) => Workspace {
     moveLocationToWorkspaceFn :: Location -> X ()
   , gotoWorkspaceFn :: X ()
   , workspaceName :: String
+  , extraWorkspaceData :: a
   }
 
 justWorkspace :: String -> Workspace
@@ -55,6 +57,7 @@ justWorkspace s =
     moveLocationToWorkspaceFn = flip moveLocationToWorkspace s
   , gotoWorkspaceFn = gotoWorkspace s
   , workspaceName = s
+  , extraWorkspaceData = ()
   }
 
 blackHoleWorkspace :: Workspace
@@ -63,6 +66,7 @@ blackHoleWorkspace =
     moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow
   , gotoWorkspaceFn = return () -- can't navigate to black hole
   , workspaceName = "blackhole"
+  , extraWorkspaceData = ()
   }
 
 alternateWorkspace :: Workspace
@@ -85,19 +89,32 @@ alternateWorkspace =
           mapM_ gotoWorkspace =<<  getAlternateWorkspace win
 
   , workspaceName = "@"
+  , extraWorkspaceData = ()
   }
 
+newtype FloatWorkspace = FloatWorkspace Workspace
+
 floatWorkspace :: Workspace -> Workspace
-floatWorkspace ws =
+floatWorkspace ws@Workspace { extraWorkspaceData = d } =
   Workspace {
     moveLocationToWorkspaceFn = \location -> do
+
       forM_ (locationWindow location) $ \win -> do
-        logs $ "Float " ++ show win
-        windows $ W.float win (W.RationalRect 0 0 100 100)
-        withWindowSet $ logs . show . W.floating
-      moveLocationToWorkspaceFn ws location
+        case cast d of
+          Just (FloatWorkspace ws') -> do
+            windows $ W.sink win
+            moveLocationToWorkspaceFn ws' location
+          Nothing -> do
+            windows $ \ss ->
+              if win `Map.member` W.floating ss
+                then ss -- win is already floating
+                else W.float win (W.RationalRect (1/8) (1/8) (6/8) (6/8)) ss
+            moveLocationToWorkspaceFn ws location
+
+
   , gotoWorkspaceFn = gotoWorkspaceFn ws
   , workspaceName = workspaceName ws
+  , extraWorkspaceData = FloatWorkspace ws
   }
 
 joinMaybe :: (Monad m) => MaybeT m (Maybe a) -> MaybeT m a
@@ -248,7 +265,7 @@ readNextLocationSet =
         ret <- mapM windowLocation =<< lift (withWindowSet (return . sortOn Down . W.allWindows))
         lift $ logs $ "allWindows " ++ intercalate "\n"  (map show ret)
         return ret
-      (_, _, "@") ->
+      (_, _, s) | s == "\t" || s == "@" || s == "\n" ->
         (mt . windowsInWorkspace . workspaceName) =<< readNextWorkspace
       (_, _, "!") -> (:[]) <$> joinMaybe (head <$> readNextLocationSet)
       (_, _, ",") -> tail <$> readNextLocationSet
-- 
cgit 


From 6bfec2037120cd5e3dbd46f7f911fbfb9b718daf Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Wed, 20 Apr 2022 00:56:29 -0600
Subject: Add macro support to WML.

Macros may be defined by using <M-d>

<M-d>w begins defining a windowset macro
<M-d>t begins defining a workspace macro

The next character typed is the key chord to save the macro to. The next
sequence of keys read up until the Return key is the macro value. This
macro may then be used as WML objects.

Macros are pretty primitive right now. I need to think about if it would
be worthwhile to make these macros either take arguments or add some
kind of state to WML a la sed to take a step to make the language Turing
complete, and if such a development would actually be desirable. If
anything it would be an academic exercise.
---
 README.md                    | 27 ++++++++++++++---
 src/Rahm/Desktop/Keys.hs     | 19 +++++++-----
 src/Rahm/Desktop/Keys/Wml.hs | 72 +++++++++++++++++++++++++++++++++-----------
 3 files changed, 89 insertions(+), 29 deletions(-)

diff --git a/README.md b/README.md
index 06a8631..0d6bfb9 100644
--- a/README.md
+++ b/README.md
@@ -155,10 +155,6 @@ workspaces.
    * `.`: The current workspace
    * `[`: The next non-visible workspace to the right of this one.
    * `]`: The next non-visible workspace to the left of this one.
-   * `{`: The workspace on the screen to the left of the current workspace
-     (equivalent to `;.`)
-   * `}`: The workspace on the screen to the right of the current workspace.
-     (equivalent to `,.`)
    * `(`: The next workspace to the right
    * `)`: The next workspace to the left
    * `^`: The workspace on the rightmost screen.
@@ -274,3 +270,26 @@ exactly what one is wanting to do.
     workspace x to worksapce x.
 
   * `,;x` is just references x for any x because the `;` undos the `,`
+
+#### Macros
+
+Remembering and using some of these key sequences can be troublesome, especially
+if that key sequences is used often. For this reason, RDE has the ability to
+record macros to reference these objects.
+
+To record a macro, type `<M-d>` then if
+  * You want to record a windowset macro, type `w`
+    1. Type the key chord to record the macro to (Ctrl+characters work well)
+    1. Type the key sequence to record and hit `<Return>`
+  * You want to record a workspace macro, type `t`
+    1. Type the key chord to record the macro to (Ctrl+characters work well)
+    1. Type the key sequence to record and hit `<Return>`
+
+Example:
+
+If one types `<M-d>w+\@..<Return>` this will record the macro `\@..` (Which
+references all windows on the current workspace except the current window) as
+`+`, so now one can type `<M-s>+_` to kill all the windows on the current
+workspace except the current window.
+
+NOTE: Recursive macros are not prohibited. Be careful!
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 9ae9c30..a453df1 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -187,13 +187,6 @@ keymap = runKeys $ do
       doc "Print this documentation." $
       logs (documentation (keymap config))
 
-  bind xK_F8 $
-
-    justMod $
-      doc "Experimental" $ do
-        (logs . printf "WS: %s" . show . fmap workspaceName) =<< workspaceForString ",^"
-        (logs . printf "Wins: %s" . show) =<< locationSetForString "&s@,^"
-
   bind xK_F10 $ do
     justMod playPauseDoc
 
@@ -299,6 +292,18 @@ keymap = runKeys $ do
           moveLocationToWorkspaceFn ws loc
           gotoWorkspaceFn ws
 
+  bind xK_d $
+    justMod $
+    doc "Record (define) macros." $
+      subkeys $ do
+      bind xK_w $ noMod $
+        doc "Record a windowset macro" $
+        runMaybeT_ readWindowsetMacro
+
+      bind xK_t $ noMod $
+        doc "Record a workspace macro" $
+        runMaybeT_ readWorkspaceMacro
+
   bind xK_h $ do
     justMod $
       doc "Focus on the next window down in the stack" $
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 0dfb852..7659a7d 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -14,6 +14,7 @@
 -- \%@s       // All windows except those on workspace 's'
 module Rahm.Desktop.Keys.Wml where
 
+import qualified XMonad.Util.ExtensibleState as XS
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.State as S
 import Control.Monad.Trans.Class
@@ -23,6 +24,7 @@ import Data.Ord (Down(..))
 import Data.Typeable (cast)
 
 import qualified Data.Map as Map
+import Data.Map (Map)
 import Data.Char (isAlphaNum, isAlpha, isDigit, ord)
 import Data.Maybe (fromMaybe, catMaybes)
 import XMonad.Actions.CopyWindow as CopyWindow
@@ -43,6 +45,17 @@ import Text.Printf
 
 import XMonad
 
+type KeyString = [(KeyMask, KeySym, String)]
+
+data Macros = Macros {
+  workspaceMacros :: Map (KeyMask, KeySym) KeyString
+, windowsetMacros :: Map (KeyMask, KeySym) KeyString
+} deriving (Read, Show)
+
+instance ExtensionClass Macros where
+  initialValue = Macros Map.empty Map.empty
+  extensionType = PersistentExtension
+
 data Workspace =
   forall a. (Typeable a) => Workspace {
     moveLocationToWorkspaceFn :: Location -> X ()
@@ -51,6 +64,27 @@ data Workspace =
   , extraWorkspaceData :: a
   }
 
+readWorkspaceMacro :: MaybeT X ()
+readWorkspaceMacro =
+  mapNextStringWithKeysym $ \mask sym _ -> do
+    macro <- readMacroString
+    lift $ XS.modify $ \m -> m {
+      workspaceMacros = Map.insert (mask, sym) macro (workspaceMacros m) }
+
+readWindowsetMacro :: MaybeT X ()
+readWindowsetMacro =
+  mapNextStringWithKeysym $ \mask sym _ -> do
+    macro <- readMacroString
+    lift $ XS.modify $ \m -> m {
+      windowsetMacros = Map.insert (mask, sym) macro (windowsetMacros m) }
+
+readMacroString :: MaybeT X KeyString
+readMacroString = do
+  mapNextStringWithKeysym $ \m k s -> case (m, k, s) of
+    _ | k == xK_Return  -> return []
+    _ | k == xK_Escape  -> MaybeT $ return Nothing
+    r -> ([r]++) <$> readMacroString
+
 justWorkspace :: String -> Workspace
 justWorkspace s =
   Workspace {
@@ -133,7 +167,7 @@ instance KeyFeeder X where
   fromX = id
   readNextKey = mapNextStringWithKeysym
 
-newtype FeedKeys a = FeedKeys { unFeedKeys :: StateT String X a }
+newtype FeedKeys a = FeedKeys { unFeedKeys :: StateT KeyString X a }
    deriving (Monad, Functor, Applicative)
 
 instance KeyFeeder FeedKeys where
@@ -142,32 +176,32 @@ instance KeyFeeder FeedKeys where
   readNextKey fn = do
     ls <- lift $ FeedKeys S.get
     case ls of
-      (h:t) -> do
+      ((mask, sym, str):t) -> do
         lift $ FeedKeys $ S.put t
-        fn 0 0 [h]
+        fn mask sym str
       _ -> MaybeT (return Nothing)
 
-feedKeys :: String -> MaybeT FeedKeys a -> X (Maybe a)
+feedKeys :: KeyString -> MaybeT FeedKeys a -> X (Maybe a)
 feedKeys s mf = flip evalStateT s . unFeedKeys $ runMaybeT mf
 
-feedKeysT :: String -> MaybeT FeedKeys a -> MaybeT X a
+feedKeysT :: KeyString -> MaybeT FeedKeys a -> MaybeT X a
 feedKeysT s mf = MaybeT $ feedKeys s mf
 
 -- Allows a reference to a workspace in terms of its description in the window
 -- management language.
-workspaceForStringT :: String -> MaybeT X Workspace
-workspaceForStringT str = feedKeysT str readNextWorkspace
+workspaceForKeysT :: KeyString -> MaybeT X Workspace
+workspaceForKeysT str = feedKeysT str readNextWorkspace
 
 -- Like the above, but unwrap the MaybeT
-workspaceForString :: String -> X (Maybe Workspace)
-workspaceForString = runMaybeT . workspaceForStringT
+workspaceForKeys :: KeyString -> X (Maybe Workspace)
+workspaceForKeys = runMaybeT . workspaceForKeysT
 
 -- Like the above, but unwrap the MaybeT
-locationSetForStringT :: String -> MaybeT X [Location]
-locationSetForStringT s = feedKeysT s readNextLocationSet
+locationSetForKeysT :: KeyString -> MaybeT X [Location]
+locationSetForKeysT s = feedKeysT s readNextLocationSet
 
-locationSetForString :: String -> X [Location]
-locationSetForString s = fromMaybe [] <$> runMaybeT (locationSetForStringT s)
+locationSetForKeys :: KeyString -> X [Location]
+locationSetForKeys s = fromMaybe [] <$> runMaybeT (locationSetForKeysT s)
 
 -- Returns the next workspaces associated with the next set of keystrokes.
 readNextWorkspace :: (KeyFeeder m) => MaybeT m Workspace
@@ -187,8 +221,6 @@ readNextWorkspace =
       (_, _, ")") -> mt $
         justWorkspace <$>
           (adjacentWorkspace next =<< getCurrentWorkspace)
-      (_, _, "}") -> mt $ justWorkspace <$> adjacentScreen next
-      (_, _, "{") -> mt $ justWorkspace <$> adjacentScreen prev
       (_, _, "^") -> mapMaybeT fromX $ MaybeT $
         withWindowSet $ \ws -> return $
           (fmap (justWorkspace . W.tag . W.workspace . snd) . head)
@@ -233,7 +265,9 @@ readNextWorkspace =
         justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
       (_, _, "_") -> return blackHoleWorkspace
       (_, _, "-") -> return alternateWorkspace
-      _ -> MaybeT (return Nothing)
+      (mask, keysym, _) -> do
+        macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . workspaceMacros <$> XS.get)
+        fromMaybeTX $ workspaceForKeysT macro
   where
     mt :: (KeyFeeder m) => X a -> MaybeT m a
     mt = lift . fromX
@@ -293,8 +327,10 @@ readNextLocationSet =
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
         return $ filter (`elem` l2) l1
-        
-      _ -> MaybeT (return Nothing)
+      (mask, keysym, _) -> do
+        macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . windowsetMacros <$> XS.get)
+        lift $ fromX $ logs $ "Executing Macro: " ++ show macro
+        fromMaybeTX $ locationSetForKeysT macro
   where
     mt :: (KeyFeeder m) => X a -> MaybeT m a
     mt = lift . fromX
-- 
cgit 


From 8df47403a0f5ed1a3ef853e25868fa305b2f3a1b Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 21 Apr 2022 17:04:08 -0600
Subject: Some changes to XMobar look and feel

---
 extras/HOME/.xmobarrc           | 12 ++++++------
 src/Rahm/Desktop/Layout/Draw.hs | 24 +++++++++++++++---------
 src/Rahm/Desktop/XMobarLog.hs   |  4 ++--
 3 files changed, 23 insertions(+), 17 deletions(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index 25568bd..e5f9167 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -2,8 +2,8 @@ Config
    { font = "xft:Monofur Nerd Font:size=12"
    , additionalFonts = [
        "xft:Monofur bold Nerd Font:style=bold:size=12",
-       "xft:Monofur Bold Nerd Font:size=9",
-       "xft:Monofur Nerd Font:size=9",
+       "xft:Monofur bold Nerd Font:size=9",
+       "xft:Monofur bold Nerd Font:style=bold:size=10",
        "xft:Monofur Nerd Font:size=6",
        "xft:Monofur bold Nerd Font:size=20",
        "xft:Monofur Nerd Font:style=bold:size=10",
@@ -30,17 +30,17 @@ Config
    , template =
       " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc> \
       \%UnsafeStdinReader%}\
-      \{ %cpu% %memory%<fc=#404040>\
+      \{ %cpu% %memory%   <fc=#404040>\
       \<action=alacritty -t 'Floating Term' -e sh -c 'curl wttr.in ; read i'>\
       \%weather%\
       \</action>\
       \</fc><fc=#a0a0a0>%media%</fc>\
-      \%bluetooth%%bat%<fn=2><fc=#606060>  %time%</fc></fn> "
+      \%bluetooth%%bat%<fn=3><fc=#8888ff>  %time%</fc></fn> "
    , commands = [
        Run UnsafeStdinReader,
        Run Date "%m/%d %H:%M:%S" "time" 10,
        Run Cpu [
-           "-t", "<fn=3><fc=#000000><bar></fc></fn>",
+           "-t", "<fn=3><fc=#202020><bar></fc></fn>",
            "-L", "3",
          "-H", "50",
          "-b", "-",
@@ -49,7 +49,7 @@ Config
          "--high", "#ff8888"
        ] 10,
        Run Memory [
-         "-t", "<fn=3><fc=#000000><usedbar></fc></fn>",
+         "-t", "<fn=3><fc=#202020><usedbar></fc></fn>",
          "-L", "3",
          "-H", "50",
          "-b", "-",
diff --git a/src/Rahm/Desktop/Layout/Draw.hs b/src/Rahm/Desktop/Layout/Draw.hs
index aa4dba3..8380e98 100644
--- a/src/Rahm/Desktop/Layout/Draw.hs
+++ b/src/Rahm/Desktop/Layout/Draw.hs
@@ -130,23 +130,29 @@ drawXpm ::
 drawXpm (w, h) rects' shrinkAmt = execWriter $ do
     tell "/* XPM */\n"
     tell "static char *out[] = {\n"
-    tell $ printf "\"%d %d %d 1 \",\n" w h (length rects + 1)
+    tell $ printf "\"%d %d %d 1 \",\n" (w + 7) (h + 7) (length rects + 1)
 
     let zipRects = zip ['A' .. 'Z'] rects
 
     forM_ zipRects $ \(char, (color, _)) -> do
       tell $ printf "\"%c c %s\",\n" char color
-    tell "\"% c None\",\n"
-
-    forM_ [0 .. h - 1] $ \y -> do
-      tell "\""
-      forM_ [0 .. w - 1] $ \x ->
+    tell "\"% c #000000\",\n"
+
+    forM_ [0..2] $ \_ -> do
+      tell "\"%%%"
+      forM_ [0 .. w] $ \_ -> tell "%"
+      tell "%%%\"\n"
+    forM_ [0 .. h] $ \y -> do
+      tell "\"%%%"
+      forM_ [0 .. w] $ \x ->
         (case find (matches x y) zipRects of
           Nothing -> tell "%"
           Just (chr, _) -> tell [chr])
-      tell "\""
-      when (y /= h - 1 - shrinkAmt) (tell ",")
-      tell "\n"
+      tell "%%%\"\n"
+    forM_ [0..2] $ \_ -> do
+      tell "\"%%%"
+      forM_ [0 .. w] $ \_ -> tell "%"
+      tell "%%%\"\n"
     tell "};\n"
 
   where
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index 637670e..d0dcc4f 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -46,7 +46,7 @@ xMobarLogHook (XMobarLog xmproc) = do
     hPutStrLn xmproc $ trunc 80 $ execWriter $ do
       tell " "
       tell layoutXpm
-      tell $ "  "
+      tell $ "   "
 
       forM_ wss $ \(t, ws) -> do
         case t of
@@ -57,7 +57,7 @@ xMobarLogHook (XMobarLog xmproc) = do
         tell $ toAction $ S.tag ws
         tell " </fc></fn>"
 
-      tell $ " <fc=#a0a0a0><fn=3>"
+      tell $ "   <fc=#ff8888><fn=3>"
       tell $ title
       tell $ "</fn></fc>"
 
-- 
cgit 


From fd7831aba6f1698883906258a0a1966880427d94 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Fri, 22 Apr 2022 00:27:36 -0600
Subject: Infrastructure for better logging, finally!

Right now all existing logs are logged at Info, but this will
change. This should make it significantly easier to debug
things wit log levels like Trace. I may at some point define more
log level endpoints or come up with a more expressive logging
system, but this is a good start.
---
 src/Main.hs                     |  5 +++--
 src/Rahm/Desktop/Keys.hs        | 16 +++++++-------
 src/Rahm/Desktop/Keys/Wml.hs    |  8 +++----
 src/Rahm/Desktop/Logger.hs      | 48 +++++++++++++++++++++++++++--------------
 src/Rahm/Desktop/MouseMotion.hs |  4 ++--
 5 files changed, 49 insertions(+), 32 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 5c1a4e0..17f6207 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -29,6 +29,7 @@ import qualified XMonad as X
 import qualified XMonad.StackSet as W
 
 main = do
+  putStrLn "Welcome To RDE!"
 
   -- Execute some commands.
   homeDir <- getHomeDirectory
@@ -80,8 +81,8 @@ main = do
 
 
 changeHook :: Location -> Location -> X ()
-changeHook l1 l2 = do
-  logs $ printf "Change %s -> %s" (show l1) (show l2)
+changeHook l1 l2 =
+  logs Info "Change %s -> %s" (show l1) (show l2)
 
 doCenterFloat :: ManageHook
 doCenterFloat =
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index a453df1..c8abbf0 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -172,7 +172,7 @@ keymap = runKeys $ do
     -- things all for BS security theater, but I guess there might be some way
     -- to do this via XTest?
     shiftMod $ forAllWindows  $ \w -> do
-      logs $ "Try send to " ++ show w
+      logs Info "Try send to %s" (show w)
       sendKey (0, xK_a) w
 
     justMod $
@@ -185,7 +185,7 @@ keymap = runKeys $ do
 
     justMod $
       doc "Print this documentation." $
-      logs (documentation (keymap config))
+      (logs Info "%s" (documentation (keymap config)) :: X ())
 
   bind xK_F10 $ do
     justMod playPauseDoc
@@ -221,7 +221,7 @@ keymap = runKeys $ do
         withScreen W.shift idx
 
       altgrMod $
-        logs "Test altgr"
+        (logs Info "Test altgr" :: X ())
 
   bind xK_bracketright $ do
     justMod $
@@ -391,7 +391,7 @@ keymap = runKeys $ do
       bind xK_q $
         (justMod -|- noMod) $
           doc "EXPERIMENTAL: Move mouse to control media." $
-            mouseRotateMotion (logs "CW") (logs "CCW")
+            mouseRotateMotion (logs Info "CW") (logs Info "CCW")
 
   bind xK_r $ do
     justMod $ doc "Run a command via Rofi" runDMenu
@@ -516,7 +516,7 @@ keymap = runKeys $ do
             doc "Go to the prior window in the history" historyBack
 
         bind xK_t $ do
-          (justMod -|- noMod) $ logs "Test Log"
+          (justMod -|- noMod) $ (logs Info "Test Log" :: X ())
 
         -- bind xK_n $ do
         --   (justMod -|- noMod) $
@@ -845,7 +845,7 @@ windowSpecificBindings config = do
 
     bind xK_F2 $
       -- Experimental.
-      noMod $ logs "This is a test"
+      noMod $ (logs Info "This is a test" :: X ())
 
   -- Add a binding to xev as a test.
   configureIf (title =? "Event Tester") $
@@ -878,9 +878,9 @@ windowBindings xconfig =
       map <- execWriterT $ windowSpecificBindings xconfig
       w <- ask
 
-      liftX $ logs $ printf "For Window: %s" (show w)
+      liftX $ logs Info "For Window: %s" (show w)
       forM_ (Map.toList map) $ \(key, action) -> do
-        liftX $ logs $ printf "   -- remap: %s" (show key)
+        liftX $ logs Info "   -- remap: %s" (show key)
         remapKey key action
 
 applyKeys :: XConfig l -> IO (XConfig l)
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 7659a7d..dd82922 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -107,12 +107,12 @@ alternateWorkspace :: Workspace
 alternateWorkspace =
   Workspace {
     moveLocationToWorkspaceFn  = \l@(Location _ maybeWin) -> do
-      logs $ "Moving Location: " ++ show l
+      logs Info "Moving Location: %s" (show l)
       case maybeWin of
         Nothing -> return ()
         Just win -> do
           alter <- getAlternateWorkspace win
-          logs $ printf "Moving %s to %s" (show win) (show alter)
+          logs Info "Moving %s to %s" (show win) (show alter)
           mapM_ (moveLocationToWorkspace l) alter
 
   , gotoWorkspaceFn = do
@@ -297,7 +297,7 @@ readNextLocationSet =
         mapM windowLocation =<< MaybeT askWindowId
       (_, _, "%") -> fromMaybeTX $ do
         ret <- mapM windowLocation =<< lift (withWindowSet (return . sortOn Down . W.allWindows))
-        lift $ logs $ "allWindows " ++ intercalate "\n"  (map show ret)
+        lift $ logs Info "allWindows %s" (intercalate "\n"  (map show ret))
         return ret
       (_, _, s) | s == "\t" || s == "@" || s == "\n" ->
         (mt . windowsInWorkspace . workspaceName) =<< readNextWorkspace
@@ -329,7 +329,7 @@ readNextLocationSet =
         return $ filter (`elem` l2) l1
       (mask, keysym, _) -> do
         macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . windowsetMacros <$> XS.get)
-        lift $ fromX $ logs $ "Executing Macro: " ++ show macro
+        lift $ fromX $ logs Info "Executing Macro: %s" (show macro)
         fromMaybeTX $ locationSetForKeysT macro
   where
     mt :: (KeyFeeder m) => X a -> MaybeT m a
diff --git a/src/Rahm/Desktop/Logger.hs b/src/Rahm/Desktop/Logger.hs
index c73942f..3da70d1 100644
--- a/src/Rahm/Desktop/Logger.hs
+++ b/src/Rahm/Desktop/Logger.hs
@@ -1,32 +1,48 @@
 module Rahm.Desktop.Logger where
 
+import Control.Monad (when)
 import XMonad
 import qualified XMonad.Util.ExtensibleState as XS
 import System.IO
 
 import Rahm.Desktop.NoPersist
+import Text.Printf
+
+data LogLevel = Trace | Debug | Info | Warn | Error | Fatal
+  deriving (Show, Read, Ord, Eq, Enum)
 
 newtype LoggerState =
   LoggerState {
-    logHandle :: Maybe (NoPersist Handle)
-  }
+    logLevel :: LogLevel
+  } deriving (Show, Read, Eq)
 
 instance ExtensionClass LoggerState where
-  initialValue = LoggerState Nothing
+  initialValue = LoggerState Info
+  extensionType = PersistentExtension
+
+class (PrintfType (Printf t)) => LoggerType t where
+  type EndResult t :: *
+  type Printf t :: *
+
+  gp :: (String -> EndResult t) -> Printf t -> t
+
+instance (PrintfArg a, LoggerType b) => LoggerType (a -> b) where
+  type EndResult (a -> b) = EndResult b
+  type Printf (a -> b) = a -> Printf b
+
+  gp f g a = gp f (g a)
 
-logs :: String -> X ()
-logs s = do
-  LoggerState handle' <- XS.get
+instance (a ~ ()) => LoggerType (X a) where
+  type EndResult (X a) = X ()
+  type Printf (X a) = String
 
-  handle <-
-    case handle' of
-      Nothing -> do
-        handle <- io $ openFile "/tmp/xmonad.log" AppendMode
-        XS.put $ LoggerState $ Just $ NoPersist handle
-        return handle
+  gp fn str = fn str
 
-      Just (NoPersist h) -> return h
+logs :: (LoggerType r, EndResult r ~ X ()) => LogLevel -> String -> r
+logs ll fmt = gp (\s -> do
+  LoggerState ll' <- XS.get
+  when (ll >= ll') $
+    io $ putStrLn ("[" ++ show ll ++ "] " ++ s)) (printf fmt)
 
-  io $ do
-    hPutStrLn handle s
-    hFlush handle
+test :: X ()
+test = logs Info "Test %s"
diff --git a/src/Rahm/Desktop/MouseMotion.hs b/src/Rahm/Desktop/MouseMotion.hs
index b5e8874..cacb52f 100644
--- a/src/Rahm/Desktop/MouseMotion.hs
+++ b/src/Rahm/Desktop/MouseMotion.hs
@@ -39,7 +39,7 @@ motion = MouseMotionM $ do
   ev <- nextMotionOrButton
   case ev of
     Right button -> do
-      logs ("Button " ++ show button)
+      logs Info "Button %s" (show button)
       return Nothing
 
     Left motion -> return (Just $ uncurry V2 motion)
@@ -93,4 +93,4 @@ mouseRotateMotion clockWise counterClockwise = execMouseMotionM doMouse
   where
     doMouse = forever $ do
       v <- motion
-      liftMouseMotionM $ logs $ "Motion: " ++ show v
+      liftMouseMotionM $ logs Info "Motion: %s" (show v)
-- 
cgit 


From 7dfbd2e4bc893f7527f9cc4ebf9c474ddfb0dc65 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 22 Apr 2022 16:22:30 -0600
Subject: Some new styling and better logging capabilites

---
 extras/HOME/.xmobarrc         | 18 +++++++++---------
 extras/HOME/.xmonad/startup   |  6 ++++++
 src/Rahm/Desktop/Keys.hs      | 14 ++++++++++++++
 src/Rahm/Desktop/Logger.hs    | 37 ++++++++++++++++++++-----------------
 src/Rahm/Desktop/XMobarLog.hs | 43 ++++++++++++++++++++++++++++---------------
 5 files changed, 77 insertions(+), 41 deletions(-)

diff --git a/extras/HOME/.xmobarrc b/extras/HOME/.xmobarrc
index e5f9167..85e3cea 100644
--- a/extras/HOME/.xmobarrc
+++ b/extras/HOME/.xmobarrc
@@ -29,13 +29,13 @@ Config
    , alignSep = "}{"
    , template =
       " %logo%  <fc=#a0a0a0><fn=3>%uname%</fn></fc> \
-      \%UnsafeStdinReader%}\
-      \{ %cpu% %memory%   <fc=#404040>\
+      \%UnsafeStdinReader%}{\
+      \ %cpu% %memory%      <fc=#404040>\
       \<action=alacritty -t 'Floating Term' -e sh -c 'curl wttr.in ; read i'>\
-      \%weather%\
+      \%weather%   \
       \</action>\
-      \</fc><fc=#a0a0a0>%media%</fc>\
-      \%bluetooth%%bat%<fn=3><fc=#8888ff>  %time%</fc></fn> "
+      \</fc><fc=#a0a0a0>%media%   </fc>\
+      \%bluetooth%   %bat%<fn=3><fc=#8888ff>     %time%</fc></fn> "
    , commands = [
        Run UnsafeStdinReader,
        Run Date "%m/%d %H:%M:%S" "time" 10,
@@ -43,8 +43,8 @@ Config
            "-t", "<fn=3><fc=#202020><bar></fc></fn>",
            "-L", "3",
          "-H", "50",
-         "-b", "-",
-         "-f", "-",
+         "-b", "▄",
+         "-f", "▄",
          "--normal", "#88ff88",
          "--high", "#ff8888"
        ] 10,
@@ -52,8 +52,8 @@ Config
          "-t", "<fn=3><fc=#202020><usedbar></fc></fn>",
          "-L", "3",
          "-H", "50",
-         "-b", "-",
-         "-f", "-",
+         "-b", "▄",
+         "-f", "▄",
          "--normal", "#88ff88",
          "--high", "#ff8888"
        ] 10,
diff --git a/extras/HOME/.xmonad/startup b/extras/HOME/.xmonad/startup
index 5656e09..b5a2c1f 100755
--- a/extras/HOME/.xmonad/startup
+++ b/extras/HOME/.xmonad/startup
@@ -42,6 +42,12 @@ hostname_boson() {
   ~/.fehbg
 }
 
+hostname_rahm.bld.corp.google.com() {
+  ~/.local/keysym/setxkbmap.sh
+  ~/.fehbg
+  nohup /usr/bin/picom --experimental-backends --backend glx &>/dev/null &
+}
+
 
 common
 
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index c8abbf0..d0305b3 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -73,6 +73,9 @@ type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
 spawnX :: String -> X ()
 spawnX = spawn
 
+safeSpawnX :: String -> [String] -> X ()
+safeSpawnX = safeSpawn
+
 noWindow :: b -> Window -> b
 noWindow = const
 
@@ -600,6 +603,17 @@ keymap = runKeys $ do
       doc "Toggle zoom on the current window." $
       sendMessage togglePop
 
+  bind xK_F8 $ do
+    justMod $ do
+      ll <- getLogLevel
+      let next = if minBound == ll then maxBound else pred ll
+
+      safeSpawnX "notify-send"
+        ["-t", "2000", printf "LogLevel set to %s" (show next)]
+      setLogLevel next
+      logs next "LogLevel set to %s." (show next)
+      
+
   bind xF86XK_Calculator $ do
     noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
 
diff --git a/src/Rahm/Desktop/Logger.hs b/src/Rahm/Desktop/Logger.hs
index 3da70d1..95a65ca 100644
--- a/src/Rahm/Desktop/Logger.hs
+++ b/src/Rahm/Desktop/Logger.hs
@@ -1,15 +1,16 @@
 module Rahm.Desktop.Logger where
 
-import Control.Monad (when)
+import Control.Monad (when, forM_, join)
 import XMonad
 import qualified XMonad.Util.ExtensibleState as XS
 import System.IO
+import Data.Time.LocalTime (getZonedTime)
 
 import Rahm.Desktop.NoPersist
 import Text.Printf
 
 data LogLevel = Trace | Debug | Info | Warn | Error | Fatal
-  deriving (Show, Read, Ord, Eq, Enum)
+  deriving (Show, Read, Ord, Eq, Enum, Bounded)
 
 newtype LoggerState =
   LoggerState {
@@ -21,28 +22,30 @@ instance ExtensionClass LoggerState where
   extensionType = PersistentExtension
 
 class (PrintfType (Printf t)) => LoggerType t where
-  type EndResult t :: *
   type Printf t :: *
-
-  gp :: (String -> EndResult t) -> Printf t -> t
+  gp :: Printf t -> (String -> X ()) -> t
 
 instance (PrintfArg a, LoggerType b) => LoggerType (a -> b) where
-  type EndResult (a -> b) = EndResult b
   type Printf (a -> b) = a -> Printf b
-
-  gp f g a = gp f (g a)
+  gp g f a = gp (g a) f
 
 instance (a ~ ()) => LoggerType (X a) where
-  type EndResult (X a) = X ()
   type Printf (X a) = String
+  gp str fn = fn str
 
-  gp fn str = fn str
+getLogLevel :: X LogLevel
+getLogLevel = logLevel <$> XS.get
 
-logs :: (LoggerType r, EndResult r ~ X ()) => LogLevel -> String -> r
-logs ll fmt = gp (\s -> do
-  LoggerState ll' <- XS.get
-  when (ll >= ll') $
-    io $ putStrLn ("[" ++ show ll ++ "] " ++ s)) (printf fmt)
+setLogLevel :: LogLevel -> X ()
+setLogLevel ll = do
+  XS.put $ LoggerState ll
+  join $ asks (logHook . config)
 
-test :: X ()
-test = logs Info "Test %s"
+logs :: (LoggerType r) => LogLevel -> String -> r
+logs ll fmt = gp (printf fmt) $ \ss -> do
+  LoggerState ll' <- XS.get
+  io $ do
+    zoneTime <- getZonedTime
+    when (ll >= ll') $
+      forM_ (lines ss) $ \s ->
+        putStrLn (printf "[%s %s] - %s" (take 23 $ show zoneTime) (show ll) s)
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index d0dcc4f..6ec4ac7 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -13,6 +13,7 @@ import XMonad.Util.Run (spawnPipe)
 import XMonad (X)
 import Rahm.Desktop.Workspaces (getPopulatedWorkspaces, WorkspaceState(..))
 import Text.Printf
+import Rahm.Desktop.Logger
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as S
@@ -38,28 +39,33 @@ xMobarLogHook :: XMobarLog -> X ()
 xMobarLogHook (XMobarLog xmproc) = do
   (_, _, layoutXpm) <- drawLayout
 
+  loglevel <- getLogLevel
+
   winset <- X.gets X.windowset
   title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
   let wss = getPopulatedWorkspaces winset
 
-  X.liftIO $ do
-    hPutStrLn xmproc $ trunc 80 $ execWriter $ do
-      tell " "
-      tell layoutXpm
-      tell $ "   "
+  let log = trunc 80 $ execWriter $ do
+              tell " "
+              tell layoutXpm
+              tell $ "   "
+              tell $ logLevelToXMobar loglevel
+
+              forM_ wss $ \(t, ws) -> do
+                case t of
+                  Current -> tell "<fn=1><fc=#ff8888>"
+                  Visible -> tell "<fn=6><fc=#8888ff>"
+                  Hidden -> tell "<fn=2><fc=#888888>"
 
-      forM_ wss $ \(t, ws) -> do
-        case t of
-          Current -> tell "<fn=1><fc=#ff8888>"
-          Visible -> tell "<fn=6><fc=#8888ff>"
-          Hidden -> tell "<fn=2><fc=#888888>"
+                tell $ toAction $ S.tag ws
+                tell " </fc></fn>"
 
-        tell $ toAction $ S.tag ws
-        tell " </fc></fn>"
+              tell $ "   <fc=#ff8888><fn=3>"
+              tell $ title
+              tell $ "</fn></fc>"
 
-      tell $ "   <fc=#ff8888><fn=3>"
-      tell $ title
-      tell $ "</fn></fc>"
+  logs Trace "XMobar: %s" log
+  X.io $ hPutStrLn xmproc log
 
   where
     toAction [ch] | (ch >= 'A' && ch <= 'Z') ||
@@ -68,6 +74,13 @@ xMobarLogHook (XMobarLog xmproc) = do
                       printf "<action=`xdotool key 'Hyper_L+g' '%s'` button=1><action=`xdotool key 'Hyper_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
     toAction ch = ch
 
+    logLevelToXMobar Trace = "<fn=3><fc=#88ffff>[Trace]</fc></fn>   "
+    logLevelToXMobar Debug = "<fn=3><fc=#ff88ff>[Debug]</fc></fn>   "
+    logLevelToXMobar Warn  = "<fn=3><fc=#ffff88>[Warn] </fc></fn>   "
+    logLevelToXMobar Error = "<fn=3><fc=#ff8888>[Error]</fc></fn>   "
+    logLevelToXMobar Fatal = "<fn=3><fc=#888888>[Fatal]</fc></fn>   "
+    logLevelToXMobar _ = ""
+
 -- Truncate an XMobar string to the provided number of _visible_ characters.
 -- This is to keep long window titles from overrunning the whole bar.
 trunc :: Int -> String -> String
-- 
cgit 


From 32a394483e5d8f571b27a70f9a7156cae1ed6180 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 22 Apr 2022 18:03:27 -0600
Subject: Run hlint

---
 src/Rahm/Desktop/Common.hs      |  2 +-
 src/Rahm/Desktop/Keys.hs        | 10 +++++-----
 src/Rahm/Desktop/Keys/Dsl.hs    |  6 +++---
 src/Rahm/Desktop/Layout/Draw.hs |  4 ++--
 src/Rahm/Desktop/Marking.hs     |  7 +++----
 src/Rahm/Desktop/XMobarLog.hs   | 15 ++++++++-------
 6 files changed, 22 insertions(+), 22 deletions(-)

diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index 9187edf..6d86c0e 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -75,7 +75,7 @@ askWindowId = do
   runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
 
 windowJump :: X ()
-windowJump = (mapM_ (focus . head)) =<< askWindowId
+windowJump = mapM_ (focus . head) =<< askWindowId
 
 -- Temporarily set the border color of the given windows.
 withBorderColor :: String -> [Window] -> X a -> X a
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index d0305b3..728db52 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -187,7 +187,7 @@ keymap = runKeys $ do
   bind xK_F7 $
 
     justMod $
-      doc "Print this documentation." $
+      doc "Print this documentation."
       (logs Info "%s" (documentation (keymap config)) :: X ())
 
   bind xK_F10 $ do
@@ -223,7 +223,7 @@ keymap = runKeys $ do
         doc ("Move the current window to screne " ++ show idx) $
         withScreen W.shift idx
 
-      altgrMod $
+      altgrMod
         (logs Info "Test altgr" :: X ())
 
   bind xK_bracketright $ do
@@ -519,7 +519,7 @@ keymap = runKeys $ do
             doc "Go to the prior window in the history" historyBack
 
         bind xK_t $ do
-          (justMod -|- noMod) $ (logs Info "Test Log" :: X ())
+          (justMod -|- noMod) (logs Info "Test Log" :: X ())
 
         -- bind xK_n $ do
         --   (justMod -|- noMod) $
@@ -612,7 +612,7 @@ keymap = runKeys $ do
         ["-t", "2000", printf "LogLevel set to %s" (show next)]
       setLogLevel next
       logs next "LogLevel set to %s." (show next)
-      
+
 
   bind xF86XK_Calculator $ do
     noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
@@ -859,7 +859,7 @@ windowSpecificBindings config = do
 
     bind xK_F2 $
       -- Experimental.
-      noMod $ (logs Info "This is a test" :: X ())
+      noMod (logs Info "This is a test" :: X ())
 
   -- Add a binding to xev as a test.
   configureIf (title =? "Event Tester") $
diff --git a/src/Rahm/Desktop/Keys/Dsl.hs b/src/Rahm/Desktop/Keys/Dsl.hs
index 2c596fc..55912f8 100644
--- a/src/Rahm/Desktop/Keys/Dsl.hs
+++ b/src/Rahm/Desktop/Keys/Dsl.hs
@@ -455,7 +455,7 @@ documentation = execWriter . document' ""
   where
     document' pref keybindings =
       forM_ (sortOn (map (\(a, b) -> (b, a)) . snd . snd) $ Map.toList (keyBindingsToList keybindings)) $ \(doc, (thing, keys)) -> do
-        when ((not $ null doc) || hasSubmap thing) $
+        when (not (null doc) || hasSubmap thing) $
           tell $ printf "%s%s: %s\n" pref (intercalate " or " $ map prettyShow keys) doc
         case thing of
           Action _ -> return ()
@@ -467,7 +467,7 @@ documentation = execWriter . document' ""
 
     keyBindingsToList :: KeyBindings -> Map String (KeyBinding, [(KeyMask, KeySym)])
     keyBindingsToList b =
-      fmap (\list -> ((\(_, Documented _ t) -> t) (head list), map fst list)) $
+      (\list -> ((\(_, Documented _ t) -> t) (head list), map fst list)) <$>
         group (\(_, Documented doc _) -> doc) (sortOn (snd . fst) $ Map.toList b)
 
     prettyShow :: (KeyMask, KeySym) -> String
@@ -490,7 +490,7 @@ documentation = execWriter . document' ""
               concatMap ((++"-") . snd) $ filter ((/=0) . (.&.mask) . fst) masks
 
 
-    group :: (Ord b) => (a -> b) -> [a] -> (Map b [a])
+    group :: (Ord b) => (a -> b) -> [a] -> Map b [a]
     group fn = Map.fromListWith (++) . map (first fn . (\a -> (a, [a])))
 
 
diff --git a/src/Rahm/Desktop/Layout/Draw.hs b/src/Rahm/Desktop/Layout/Draw.hs
index 8380e98..165af75 100644
--- a/src/Rahm/Desktop/Layout/Draw.hs
+++ b/src/Rahm/Desktop/Layout/Draw.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
-ScopedTypeVariables, BangPatterns #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, ScopedTypeVariables #-}
+
 module Rahm.Desktop.Layout.Draw (drawLayout) where
 
 import Control.Monad
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 1ea9782..3b4873d 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -14,7 +14,7 @@ module Rahm.Desktop.Marking (
 
 import Prelude hiding (head)
 
-import Data.Maybe (fromMaybe)
+import Data.Maybe ( fromMaybe, catMaybes )
 import Control.Monad.Trans (lift)
 import Data.Ord (Down(..))
 import Control.Exception
@@ -25,7 +25,6 @@ import Data.IORef
 import Data.List (sortOn, sort, sortBy, find)
 import Data.List.Safe (head)
 import Data.Map (Map)
-import Data.Maybe (catMaybes)
 import Data.Sequence (Seq(..))
 import Rahm.Desktop.Common
 import Rahm.Desktop.History
@@ -76,7 +75,7 @@ getAlternateWorkspace window =
   Map.lookup window . alternateWorkspaces <$> XS.get
 
 setAlternateWindows :: [Window] -> X ()
-setAlternateWindows wins = XS.modify (\m -> m { alternateWindows = wins }) 
+setAlternateWindows wins = XS.modify (\m -> m { alternateWindows = wins })
 
 getAlternateWindows :: X [Window]
 getAlternateWindows = alternateWindows <$> XS.get
@@ -94,7 +93,7 @@ markAllLocations mark locs =
 markCurrentWindow :: Mark -> X ()
 markCurrentWindow mark = do
   ws <- getCurrentWorkspace
-  
+
   withFocused $ \win ->
     XS.modify $ \state@MarkState {markStateMap = ms} ->
         state {
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index 6ec4ac7..629e021 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -6,6 +6,7 @@ import Control.Monad.Writer (tell, execWriter)
 import Data.List (sortBy)
 import Data.Maybe (mapMaybe)
 import Data.Ord (comparing)
+import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
 import Rahm.Desktop.Layout.Draw (drawLayout)
 import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
 import XMonad.Util.NamedWindows (getName)
@@ -48,7 +49,7 @@ xMobarLogHook (XMobarLog xmproc) = do
   let log = trunc 80 $ execWriter $ do
               tell " "
               tell layoutXpm
-              tell $ "   "
+              tell "   "
               tell $ logLevelToXMobar loglevel
 
               forM_ wss $ \(t, ws) -> do
@@ -60,17 +61,17 @@ xMobarLogHook (XMobarLog xmproc) = do
                 tell $ toAction $ S.tag ws
                 tell " </fc></fn>"
 
-              tell $ "   <fc=#ff8888><fn=3>"
-              tell $ title
-              tell $ "</fn></fc>"
+              tell "   <fc=#ff8888><fn=3>"
+              tell title
+              tell "</fn></fc>"
 
   logs Trace "XMobar: %s" log
   X.io $ hPutStrLn xmproc log
 
   where
-    toAction [ch] | (ch >= 'A' && ch <= 'Z') ||
-                    (ch >= 'a' && ch <= 'z') ||
-                    (ch >= '0' && ch <= '9') =
+    toAction [ch] | (isAsciiUpper ch) ||
+                    (isAsciiLower ch) ||
+                    (isDigit ch) =
                       printf "<action=`xdotool key 'Hyper_L+g' '%s'` button=1><action=`xdotool key 'Hyper_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
     toAction ch = ch
 
-- 
cgit 


From 72414e1732064079719b1f1021dc4badce654903 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 24 Apr 2022 20:34:51 -0600
Subject: Add R.D.StackSet as a replacement for StackSet.

---
 package.yaml                                |  1 +
 src/Main.hs                                 |  5 +--
 src/Rahm/Desktop/Common.hs                  | 31 +++++++++++-------
 src/Rahm/Desktop/History.hs                 |  2 +-
 src/Rahm/Desktop/Hooks/WindowChange.hs      |  2 +-
 src/Rahm/Desktop/Keys.hs                    | 51 +++++++++++++++++------------
 src/Rahm/Desktop/Keys/Wml.hs                |  2 +-
 src/Rahm/Desktop/Layout.hs                  |  2 +-
 src/Rahm/Desktop/Layout/ConsistentMosaic.hs |  2 +-
 src/Rahm/Desktop/Layout/CornerLayout.hs     |  2 +-
 src/Rahm/Desktop/Layout/Draw.hs             |  2 +-
 src/Rahm/Desktop/Layout/Hole.hs             |  2 +-
 src/Rahm/Desktop/Layout/List.hs             |  2 +-
 src/Rahm/Desktop/Layout/Pop.hs              |  2 +-
 src/Rahm/Desktop/Layout/Redescribe.hs       |  2 +-
 src/Rahm/Desktop/Marking.hs                 |  2 +-
 src/Rahm/Desktop/ScreenRotate.hs            |  2 +-
 src/Rahm/Desktop/StackSet.hs                | 51 +++++++++++++++++++++++++++++
 src/Rahm/Desktop/SwapMaster.hs              |  2 +-
 src/Rahm/Desktop/Windows.hs                 |  2 +-
 src/Rahm/Desktop/Workspaces.hs              | 27 +--------------
 src/Rahm/Desktop/XMobarLog.hs               | 15 ++++++---
 22 files changed, 131 insertions(+), 80 deletions(-)
 create mode 100644 src/Rahm/Desktop/StackSet.hs

diff --git a/package.yaml b/package.yaml
index 056b5b0..cd62c0e 100644
--- a/package.yaml
+++ b/package.yaml
@@ -41,3 +41,4 @@ dependencies:
   - data-default
   - linear
   - time
+  - prettyprinter
diff --git a/src/Main.hs b/src/Main.hs
index 17f6207..bb39e14 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -26,7 +26,7 @@ import Rahm.Desktop.Hooks.WindowChange
 import Rahm.Desktop.History
 
 import qualified XMonad as X
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 
 main = do
   putStrLn "Welcome To RDE!"
@@ -39,6 +39,7 @@ main = do
   setEnv "ROFI" menuCommandString
 
   xmobar <- spawnXMobar
+  count <- fromIntegral . screenCount <$> openDisplay ""
 
   (=<<) X.xmonad $ 
     applyKeys $ withLocationChangeHook historyHook $ ewmh $ docks $  def
@@ -68,7 +69,7 @@ main = do
          -- with something. However, this configuration only supports 36
          -- monitors on boot. If you need more than 36 monitors, you'll have to
          -- configure those ones after starting XMonad.
-       , workspaces = map return (['0'..'9'] ++ ['a'..'z'])
+       , workspaces = map return (take count $ ['0'..'9'] ++ ['a'..'z'])
        , handleEventHook =
            composeAll [
              fullscreenEventHook,
diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index 6d86c0e..273984e 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -4,7 +4,6 @@ import Prelude hiding ((!!))
 
 import Control.Monad (void, when, forM_)
 import Control.Monad.Trans.Maybe
-import XMonad.Actions.DynamicWorkspaces
 import XMonad.Util.Run
 import XMonad.Prompt
 import XMonad.Prompt.Input
@@ -19,12 +18,11 @@ import Data.List.Safe ((!!))
 import Data.Maybe
 import Text.Printf
 import XMonad hiding (workspaces, Screen)
-import XMonad.StackSet hiding (filter, focus)
 import qualified Data.Map as Map
 import Rahm.Desktop.DMenu
 import Data.Ord (comparing)
 
-import qualified XMonad.StackSet as S
+import qualified Rahm.Desktop.StackSet as S
 import Rahm.Desktop.Windows
 
 -- A location is a workspace and maybe a window with that workspace.
@@ -70,7 +68,7 @@ getString = runQuery $ do
 askWindowId :: X (Maybe [Window])
 askWindowId = do
   windowTitlesToWinId <- withWindowSet $ \ss ->
-    Map.fromListWith (++) <$> mapM (\wid -> (,) <$> getString wid <*> return [wid]) (allWindows ss)
+    Map.fromListWith (++) <$> mapM (\wid -> (,) <$> getString wid <*> return [wid]) (S.allWindows ss)
 
   runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
 
@@ -103,15 +101,26 @@ withBorderColor color wins fn = do
 
   return ret
 
+withBorderWidth :: Int -> [Window] -> X a -> X a
+withBorderWidth width ws fn = do
+  d <- asks display
+
+  forM_ ws $ \window ->
+    io $ setWindowBorderWidth d window $ fromIntegral width
+
+  ret <- fn 
+
+  forM_ ws $ \window ->
+    io $ setWindowBorderWidth d window 2
+
+  return ret
+
 gotoWorkspace :: WorkspaceId -> X ()
-gotoWorkspace wid = do
-  addHiddenWorkspace wid
-  windows $ S.greedyView wid
+gotoWorkspace wid = windows $ S.greedyView wid
 
 moveLocationToWorkspace :: Location -> WorkspaceId ->  X ()
-moveLocationToWorkspace (Location _ (Just win)) wid = do
-  addHiddenWorkspace wid
-  windows $ shiftWin wid win
+moveLocationToWorkspace (Location _ (Just win)) wid =
+  windows $ S.shiftWin wid win
 moveLocationToWorkspace _ _ = return ()
 
 getCurrentWorkspace :: X WorkspaceId
@@ -122,7 +131,7 @@ getCurrentWorkspace = withWindowSet $
 getCurrentLocation :: X Location
 getCurrentLocation = do
   ws <- getCurrentWorkspace
-  win <- withWindowSet (return . peek)
+  win <- withWindowSet (return . S.peek)
   return (Location ws win)
 
 runMaybeT_ :: (Monad m) => MaybeT m a -> m ()
diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs
index 9195a92..516cd94 100644
--- a/src/Rahm/Desktop/History.hs
+++ b/src/Rahm/Desktop/History.hs
@@ -2,7 +2,7 @@ module Rahm.Desktop.History where
 
 import XMonad
 import Text.Printf
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
 import Data.Default
diff --git a/src/Rahm/Desktop/Hooks/WindowChange.hs b/src/Rahm/Desktop/Hooks/WindowChange.hs
index ec8e445..3bc66a4 100644
--- a/src/Rahm/Desktop/Hooks/WindowChange.hs
+++ b/src/Rahm/Desktop/Hooks/WindowChange.hs
@@ -6,7 +6,7 @@ import qualified XMonad.Util.ExtensibleState as XS
 import Data.Default
 import Rahm.Desktop.Common
 
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 
 newtype LastLocation = LastLocation (Maybe Location)
   deriving (Read, Show)
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 728db52..a8b05a4 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -37,9 +37,9 @@ import XMonad.Util.CustomKeys
 import XMonad.Util.Run (safeSpawn)
 import XMonad.Util.Scratchpad
 import XMonad.Util.Ungrab
+import Prettyprinter
 
 import qualified Data.Map as Map
-import qualified XMonad.StackSet as W
 
 import Rahm.Desktop.DMenu
 import Rahm.Desktop.Keys.Dsl
@@ -64,6 +64,7 @@ import Rahm.Desktop.Swallow
 import Rahm.Desktop.SwapMaster (swapMaster)
 import Rahm.Desktop.Windows
 import Rahm.Desktop.Workspaces
+import qualified Rahm.Desktop.StackSet as W
 import Rahm.Desktop.History
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -280,11 +281,11 @@ keymap = runKeys $ do
       runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace
 
     shiftMod $
-      doc "Move the currently focused window to another workspace" $
+      doc "Swap a workspace with another workspace." $
       runMaybeT_ $ do
-        ws <- readNextWorkspace
-        loc <- lift getCurrentLocation
-        lift $ moveLocationToWorkspaceFn ws loc
+        ws1 <- readNextWorkspace
+        ws2 <- readNextWorkspace
+        lift $ windows $ W.swapWorkspaces (workspaceName ws1) (workspaceName ws2)
 
     controlMod $
       doc "Move the current focused window to another workspace and view that workspace" $
@@ -366,12 +367,14 @@ keymap = runKeys $ do
     justMod $
       doc "Mark the current window with the next typed character." $ do
       locs <- fromMaybe [] <$> runMaybeT readNextLocationSet
-      withBorderColor "#00ffff" (mapMaybe locationWindow locs) $ do
-        runMaybeT_ $ do
-         mapNextString $ \_ str -> lift $
-          case str of
-            [ch] | isAlpha ch -> markAllLocations str locs
-            _ -> return ()
+      let wins = mapMaybe locationWindow locs
+      withBorderWidth 4 wins $
+        withBorderColor "#00ffff" wins $ do
+          runMaybeT_ $ do
+           mapNextString $ \_ str -> lift $
+            case str of
+              [ch] | isAlpha ch -> markAllLocations str locs
+              _ -> return ()
 
   bind xK_plus $ do
     justMod $
@@ -407,17 +410,18 @@ keymap = runKeys $ do
       locations <- fromMaybe [] <$> runMaybeT readNextLocationSet
       let locationWindows = mapMaybe locationWindow locations
 
-      withBorderColor "#00ffff" locationWindows $ do
-        runMaybeT_ $ do
-          workspace <- readNextWorkspace
-          mapM_ (lift . moveLocationToWorkspaceFn workspace) locations
+      withBorderWidth 4 locationWindows $
+        withBorderColor "#00ffff" locationWindows $ do
+          runMaybeT_ $ do
+            workspace <- readNextWorkspace
+            mapM_ (lift . moveLocationToWorkspaceFn workspace) locations
 
-          lift $ setAlternateWindows locationWindows
-          forM_ locations $ \loc ->
-            case locationWindow loc of
-              Nothing -> return ()
-              Just win -> do
-                lift $ setAlternateWorkspace win (locationWorkspace loc)
+            lift $ setAlternateWindows locationWindows
+            forM_ locations $ \loc ->
+              case locationWindow loc of
+                Nothing -> return ()
+                Just win -> do
+                  lift $ setAlternateWorkspace win (locationWorkspace loc)
 
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
@@ -613,6 +617,11 @@ keymap = runKeys $ do
       setLogLevel next
       logs next "LogLevel set to %s." (show next)
 
+    shiftMod $ do
+      ss <- withWindowSet return
+      logs Info "Current Stack Set:%s"
+        (show $ viaShow $ W.mapLayout (const ()) ss)
+
 
   bind xF86XK_Calculator $ do
     noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index dd82922..5ce455c 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -31,7 +31,7 @@ import XMonad.Actions.CopyWindow as CopyWindow
 import XMonad.Util.Run (safeSpawn)
 import Prelude hiding (head, last)
 import Data.List.Safe (head, last)
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 
 import Rahm.Desktop.Common
 import Rahm.Desktop.Keys.Dsl
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index f6e714c..ea80ba9 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -36,7 +36,7 @@ import Rahm.Desktop.Layout.Hole
 import Rahm.Desktop.Layout.ConsistentMosaic
 
 import qualified Data.Map as M
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 
 myLayout =
   fullscreenFull $
diff --git a/src/Rahm/Desktop/Layout/ConsistentMosaic.hs b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
index a84a2f1..0a6215a 100644
--- a/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
+++ b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
@@ -6,7 +6,7 @@
 module Rahm.Desktop.Layout.ConsistentMosaic where
 
 import XMonad
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 import qualified Data.Map as Map
 import Data.Map (Map)
 import Data.Maybe (mapMaybe)
diff --git a/src/Rahm/Desktop/Layout/CornerLayout.hs b/src/Rahm/Desktop/Layout/CornerLayout.hs
index f0952c7..7cf4421 100644
--- a/src/Rahm/Desktop/Layout/CornerLayout.hs
+++ b/src/Rahm/Desktop/Layout/CornerLayout.hs
@@ -4,7 +4,7 @@ module Rahm.Desktop.Layout.CornerLayout where
 
 import Data.Typeable (Typeable)
 import XMonad (LayoutClass(..), Rectangle(..), Resize(..), fromMessage)
-import qualified XMonad.StackSet as S
+import qualified Rahm.Desktop.StackSet as S
 
 data Corner a = Corner Rational Rational
   deriving (Show, Typeable, Read)
diff --git a/src/Rahm/Desktop/Layout/Draw.hs b/src/Rahm/Desktop/Layout/Draw.hs
index 165af75..ff90b9e 100644
--- a/src/Rahm/Desktop/Layout/Draw.hs
+++ b/src/Rahm/Desktop/Layout/Draw.hs
@@ -27,7 +27,7 @@ import XMonad (X,
                SomeMessage(..))
 
 import qualified XMonad as X
-import qualified XMonad.StackSet as S
+import qualified Rahm.Desktop.StackSet as S
 
 -- Draws and returns an XPM for the current layout.
 --
diff --git a/src/Rahm/Desktop/Layout/Hole.hs b/src/Rahm/Desktop/Layout/Hole.hs
index 3f7c9b7..f6632d5 100644
--- a/src/Rahm/Desktop/Layout/Hole.hs
+++ b/src/Rahm/Desktop/Layout/Hole.hs
@@ -3,7 +3,7 @@
 -- Delegates to a lower layout, but leaves a hole where the next window will go.
 module Rahm.Desktop.Layout.Hole (hole, toggleHole) where
 
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 import XMonad
 import Data.Maybe (mapMaybe)
 
diff --git a/src/Rahm/Desktop/Layout/List.hs b/src/Rahm/Desktop/Layout/List.hs
index 77b53c9..d6ab6ba 100644
--- a/src/Rahm/Desktop/Layout/List.hs
+++ b/src/Rahm/Desktop/Layout/List.hs
@@ -30,7 +30,7 @@ import Data.Proxy
 import Data.Void
 import GHC.TypeLits
 import XMonad
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 
 -- Type-level lists. LNil is the final of the list. LCons contains a layout and a
 -- tail.
diff --git a/src/Rahm/Desktop/Layout/Pop.hs b/src/Rahm/Desktop/Layout/Pop.hs
index e06ff25..a7e2762 100644
--- a/src/Rahm/Desktop/Layout/Pop.hs
+++ b/src/Rahm/Desktop/Layout/Pop.hs
@@ -15,7 +15,7 @@ module Rahm.Desktop.Layout.Pop (
 import XMonad
 import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
 import Data.Default (Default(..))
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 
 import Rahm.Desktop.Layout.ReinterpretMessage
 
diff --git a/src/Rahm/Desktop/Layout/Redescribe.hs b/src/Rahm/Desktop/Layout/Redescribe.hs
index 036bc88..7f955d8 100644
--- a/src/Rahm/Desktop/Layout/Redescribe.hs
+++ b/src/Rahm/Desktop/Layout/Redescribe.hs
@@ -6,7 +6,7 @@ module Rahm.Desktop.Layout.Redescribe where
 
 import XMonad
 
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 import Data.Typeable (Typeable)
 
 -- Type-class to modify the description of a layout.
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 3b4873d..9bc2cb6 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -35,7 +35,7 @@ import System.Environment
 import System.FilePath
 import System.IO
 import XMonad
-import XMonad.StackSet hiding (focus)
+import Rahm.Desktop.StackSet hiding (focus)
 import qualified Data.Map as Map
 import qualified Data.Sequence as Seq
 import qualified XMonad.Util.ExtensibleState as XS
diff --git a/src/Rahm/Desktop/ScreenRotate.hs b/src/Rahm/Desktop/ScreenRotate.hs
index 1f238b1..718976d 100644
--- a/src/Rahm/Desktop/ScreenRotate.hs
+++ b/src/Rahm/Desktop/ScreenRotate.hs
@@ -1,6 +1,6 @@
 module Rahm.Desktop.ScreenRotate where
 
-import XMonad.StackSet as W
+import Rahm.Desktop.StackSet as W
 
 screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
 screenRotateBackward (W.StackSet current visible others floating) = do
diff --git a/src/Rahm/Desktop/StackSet.hs b/src/Rahm/Desktop/StackSet.hs
new file mode 100644
index 0000000..251bee3
--- /dev/null
+++ b/src/Rahm/Desktop/StackSet.hs
@@ -0,0 +1,51 @@
+module Rahm.Desktop.StackSet (
+  masterWindow,
+  findWorkspace,
+  ensureWorkspace,
+  swapWorkspaces,
+  greedyView,
+  shiftWin,
+  module W) where
+
+import Prelude hiding (head, tail)
+import Data.List.Safe (head, tail)
+import Data.List (find)
+import XMonad.StackSet as W hiding (greedyView, shiftWin)
+import qualified XMonad.StackSet
+import Data.Default
+import Data.Maybe (fromMaybe)
+
+masterWindow :: StackSet i l a s sd -> Maybe a
+masterWindow = head . integrate' . stack . workspace . current
+
+findWorkspace :: (Eq i) =>
+  i -> StackSet i l a s sd -> Maybe (Workspace i l a)
+findWorkspace wid = find ((==wid) . tag) . workspaces
+
+ensureWorkspace :: (Eq i) =>
+  i -> StackSet i l a s sd -> (StackSet i l a s sd, Workspace i l a)
+ensureWorkspace t ss =
+  case findWorkspace t ss of
+    Nothing ->
+      let ws = Workspace t (layout . workspace . current $ ss) Nothing in
+        (ss { hidden = ws : hidden ss }, ws)
+    Just ws -> (ss, ws)
+
+swapWorkspaces ::
+  (Eq i) =>
+    i -> i -> StackSet i l a s sd -> StackSet i l a s sd
+swapWorkspaces wid1 wid2 ss =
+  let (ss', workspace1) = ensureWorkspace wid1 ss
+      (ss'', workspace2) = ensureWorkspace wid2 ss'
+      in
+  mapWorkspace (\w ->
+    case () of
+      _ | tag w == wid1 -> workspace2
+      _ | tag w == wid2 -> workspace1
+      _ -> w) ss''
+      
+greedyView :: (Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
+greedyView wid ss = swapWorkspaces (tag . workspace . current $ ss) wid ss
+
+shiftWin :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
+shiftWin wid a = XMonad.StackSet.shiftWin wid a . fst . ensureWorkspace wid
diff --git a/src/Rahm/Desktop/SwapMaster.hs b/src/Rahm/Desktop/SwapMaster.hs
index b039fdb..fd61a50 100644
--- a/src/Rahm/Desktop/SwapMaster.hs
+++ b/src/Rahm/Desktop/SwapMaster.hs
@@ -1,7 +1,7 @@
 {- Swap window with the master, but save it. -}
 module Rahm.Desktop.SwapMaster (swapMaster) where
 
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 
 import Rahm.Desktop.Windows (mapWindows, getMaster, swapWindows)
 import Control.Monad.Trans.Maybe
diff --git a/src/Rahm/Desktop/Windows.hs b/src/Rahm/Desktop/Windows.hs
index d525aac..2aa5995 100644
--- a/src/Rahm/Desktop/Windows.hs
+++ b/src/Rahm/Desktop/Windows.hs
@@ -3,7 +3,7 @@ module Rahm.Desktop.Windows where
 import XMonad (windowset, X, Window, get)
 
 import Control.Applicative ((<|>))
-import XMonad.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), peek, integrate, integrate', allWindows)
+import Rahm.Desktop.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), peek, integrate, integrate', allWindows)
 import Data.Maybe (listToMaybe, catMaybes)
 import qualified Data.Map as Map
 
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index f11520a..6c52f01 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -6,14 +6,13 @@ import Prelude hiding ((!!))
 
 import Control.Monad.Trans.Maybe
 import Control.Arrow (second, (&&&))
-import qualified XMonad.StackSet as W
+import qualified Rahm.Desktop.StackSet as W
 import XMonad
 
 import Data.List.Safe ((!!))
 
 import Rahm.Desktop.Common
 import Rahm.Desktop.History
-import XMonad.Actions.DynamicWorkspaces
 import Data.List (sortOn, sort, sortBy, find)
 import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Char (isUpper, toUpper, toLower, isAlphaNum)
@@ -75,12 +74,6 @@ getHorizontallyOrderedScreens windowSet =
     where
       screens = (True, W.current windowSet) : map (False,) (W.visible windowSet)
 
-shiftToWorkspace :: WorkspaceId -> X ()
-shiftToWorkspace t = do
-  addHiddenWorkspace t
-  windows . W.shift $ t
-
-
 accompaningWorkspace :: WorkspaceId -> WorkspaceId
 accompaningWorkspace [s] = return $
     if isUpper s
@@ -88,24 +81,6 @@ accompaningWorkspace [s] = return $
       else toUpper s
 accompaningWorkspace s = s
 
-swapWorkspace :: WorkspaceId -> X ()
-swapWorkspace toWorkspace = do
-  addHiddenWorkspace toWorkspace
-  windows $ \ss -> do
-    let fromWorkspace = W.tag $ W.workspace $ W.current ss in
-      W.StackSet (swapSc fromWorkspace toWorkspace $ W.current ss)
-                (map (swapSc fromWorkspace toWorkspace) $ W.visible ss)
-                (map (swapWs fromWorkspace toWorkspace) $ W.hidden ss)
-                (W.floating ss)
-  where
-    swapSc fromWorkspace toWorkspace (W.Screen ws a b) =
-        W.Screen (swapWs fromWorkspace toWorkspace ws) a b
-
-    swapWs fromWorkspace toWorkspace ws@(W.Workspace t' l s)
-        | t' == fromWorkspace = W.Workspace toWorkspace l s
-        | t' == toWorkspace = W.Workspace fromWorkspace l s
-        | otherwise = ws
-
 adjacentWorkspaceNotVisible :: Selector -> WorkspaceId -> X WorkspaceId
 adjacentWorkspaceNotVisible (Selector selector) from =
   withWindowSet $ \ss ->
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index 629e021..af0a1a1 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -17,7 +17,7 @@ import Text.Printf
 import Rahm.Desktop.Logger
 
 import qualified XMonad as X
-import qualified XMonad.StackSet as S
+import qualified Rahm.Desktop.StackSet as S
 
 data XMobarLog = XMobarLog Handle
 
@@ -48,7 +48,7 @@ xMobarLogHook (XMobarLog xmproc) = do
 
   let log = trunc 80 $ execWriter $ do
               tell " "
-              tell layoutXpm
+              tell (toChangeLayoutAction layoutXpm)
               tell "   "
               tell $ logLevelToXMobar loglevel
 
@@ -69,12 +69,17 @@ xMobarLogHook (XMobarLog xmproc) = do
   X.io $ hPutStrLn xmproc log
 
   where
-    toAction [ch] | (isAsciiUpper ch) ||
-                    (isAsciiLower ch) ||
-                    (isDigit ch) =
+    toAction [ch] | isAsciiUpper ch ||
+                    isAsciiLower ch ||
+                    isDigit ch =
                       printf "<action=`xdotool key 'Hyper_L+g' '%s'` button=1><action=`xdotool key 'Hyper_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
     toAction ch = ch
 
+    toChangeLayoutAction :: String -> String
+    toChangeLayoutAction =
+      printf "<action=`xdotool key Hyper_L+space n` button=1>\
+        \<action=`xdotool key p` button=3>%s</action></action>"
+
     logLevelToXMobar Trace = "<fn=3><fc=#88ffff>[Trace]</fc></fn>   "
     logLevelToXMobar Debug = "<fn=3><fc=#ff88ff>[Debug]</fc></fn>   "
     logLevelToXMobar Warn  = "<fn=3><fc=#ffff88>[Warn] </fc></fn>   "
-- 
cgit 


From 1ff9a98f85df0c3df4e3f1c3f332100922d18317 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 24 Apr 2022 20:47:40 -0600
Subject: Roll ScreenRotate into StackSet

---
 src/Rahm/Desktop/Keys.hs         |  5 ++---
 src/Rahm/Desktop/ScreenRotate.hs | 19 -------------------
 src/Rahm/Desktop/StackSet.hs     | 22 ++++++++++++++++++++--
 3 files changed, 22 insertions(+), 24 deletions(-)
 delete mode 100644 src/Rahm/Desktop/ScreenRotate.hs

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index a8b05a4..0f61018 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -58,7 +58,6 @@ import Rahm.Desktop.MouseMotion
 import Rahm.Desktop.PassMenu
 import Rahm.Desktop.PromptConfig
 import Rahm.Desktop.RebindKeys
-import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
 import Rahm.Desktop.Submap
 import Rahm.Desktop.Swallow
 import Rahm.Desktop.SwapMaster (swapMaster)
@@ -771,8 +770,8 @@ mouseMap = runButtons $ do
             (button4, windows W.focusUp),
             (button5, windows W.focusDown),
 
-            (button7, windows screenRotateForward),
-            (button6, windows screenRotateBackward)
+            (button7, windows W.screenRotateForward),
+            (button6, windows W.screenRotateBackward)
             ]
 
       forM_ (map fst workspaceButtons) $ \b ->
diff --git a/src/Rahm/Desktop/ScreenRotate.hs b/src/Rahm/Desktop/ScreenRotate.hs
deleted file mode 100644
index 718976d..0000000
--- a/src/Rahm/Desktop/ScreenRotate.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module Rahm.Desktop.ScreenRotate where
-
-import Rahm.Desktop.StackSet as W
-
-screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
-screenRotateBackward (W.StackSet current visible others floating) = do
-  let screens = current : visible
-      workspaces = tail $ cycle $ map W.workspace screens
-      (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
-      in W.StackSet current' visible' others floating
-
-screenRotateForward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
-screenRotateForward (W.StackSet current visible others floating) = do
-  let screens = current : visible
-      workspaces = rcycle $ map W.workspace screens
-      (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
-      in W.StackSet current' visible' others floating
-
-  where rcycle l = last l : l
diff --git a/src/Rahm/Desktop/StackSet.hs b/src/Rahm/Desktop/StackSet.hs
index 251bee3..8db16c1 100644
--- a/src/Rahm/Desktop/StackSet.hs
+++ b/src/Rahm/Desktop/StackSet.hs
@@ -5,10 +5,12 @@ module Rahm.Desktop.StackSet (
   swapWorkspaces,
   greedyView,
   shiftWin,
+  screenRotateBackward,
+  screenRotateForward,
   module W) where
 
-import Prelude hiding (head, tail)
-import Data.List.Safe (head, tail)
+import Prelude hiding (head)
+import Data.List.Safe (head)
 import Data.List (find)
 import XMonad.StackSet as W hiding (greedyView, shiftWin)
 import qualified XMonad.StackSet
@@ -49,3 +51,19 @@ greedyView wid ss = swapWorkspaces (tag . workspace . current $ ss) wid ss
 
 shiftWin :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
 shiftWin wid a = XMonad.StackSet.shiftWin wid a . fst . ensureWorkspace wid
+
+screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
+screenRotateBackward (W.StackSet current visible others floating) = do
+  let screens = current : visible
+      workspaces = tail $ cycle $ map W.workspace screens
+      (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
+      in W.StackSet current' visible' others floating
+
+screenRotateForward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd
+screenRotateForward (W.StackSet current visible others floating) = do
+  let screens = current : visible
+      workspaces = rcycle $ map W.workspace screens
+      (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces
+      in W.StackSet current' visible' others floating
+
+  where rcycle l = last l : l
-- 
cgit 


From 07252ce0461d8746481881dbcc6ca07b71fd8553 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 24 Apr 2022 21:06:10 -0600
Subject: Roll Windows.hs into R.D.StackSet

---
 src/Main.hs                                 |  3 +-
 src/Rahm/Desktop/Common.hs                  |  1 -
 src/Rahm/Desktop/Keys.hs                    |  7 +--
 src/Rahm/Desktop/Layout.hs                  |  1 -
 src/Rahm/Desktop/Layout/ConsistentMosaic.hs |  3 +-
 src/Rahm/Desktop/Layout/Hole.hs             |  3 +-
 src/Rahm/Desktop/Marking.hs                 |  1 -
 src/Rahm/Desktop/StackSet.hs                | 70 ++++++++++++++++++++++-
 src/Rahm/Desktop/SwapMaster.hs              |  7 +--
 src/Rahm/Desktop/Windows.hs                 | 86 -----------------------------
 10 files changed, 78 insertions(+), 104 deletions(-)
 delete mode 100644 src/Rahm/Desktop/Windows.hs

diff --git a/src/Main.hs b/src/Main.hs
index bb39e14..25403d4 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -15,7 +15,6 @@ import Text.Printf
 
 import Rahm.Desktop.Swallow
 import Rahm.Desktop.Common
-import Rahm.Desktop.Windows
 import Rahm.Desktop.XMobarLog
 import Rahm.Desktop.Keys
 import Rahm.Desktop.Layout
@@ -98,7 +97,7 @@ windowHooks (Query readerT) config = do
 
   config {
     startupHook = do
-      forAllWindows $ \w -> runReaderT readerT w
+      withWindowSet $ mapM_ (runReaderT readerT) . W.allWindows
       startupHook config,
 
     manageHook = mappend (Query readerT >> return (Endo id)) (manageHook config)
diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index 273984e..8790d84 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -23,7 +23,6 @@ import Rahm.Desktop.DMenu
 import Data.Ord (comparing)
 
 import qualified Rahm.Desktop.StackSet as S
-import Rahm.Desktop.Windows
 
 -- A location is a workspace and maybe a window with that workspace.
 data Location = Location {
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 0f61018..8cb2b76 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -61,7 +61,6 @@ import Rahm.Desktop.RebindKeys
 import Rahm.Desktop.Submap
 import Rahm.Desktop.Swallow
 import Rahm.Desktop.SwapMaster (swapMaster)
-import Rahm.Desktop.Windows
 import Rahm.Desktop.Workspaces
 import qualified Rahm.Desktop.StackSet as W
 import Rahm.Desktop.History
@@ -174,9 +173,9 @@ keymap = runKeys $ do
     -- focused. It's pretty annoying because it keeps me from doing some cool
     -- things all for BS security theater, but I guess there might be some way
     -- to do this via XTest?
-    shiftMod $ forAllWindows  $ \w -> do
+    shiftMod $ withWindowSet $ mapM_  (\w -> do
       logs Info "Try send to %s" (show w)
-      sendKey (0, xK_a) w
+      sendKey (0, xK_a) w) . W.allWindows
 
     justMod $
       doc "Print this documentation"
@@ -888,7 +887,7 @@ windowBindings :: XConfig l -> XConfig l
 windowBindings xconfig =
   xconfig {
     startupHook = do
-      forAllWindows (runQuery doQuery)
+      withWindowSet $ mapM_ (runQuery doQuery) . W.allWindows
       startupHook xconfig,
 
     manageHook = (doQuery >> return (Endo id)) <> manageHook xconfig
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index ea80ba9..ad54d4a 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -26,7 +26,6 @@ import XMonad.Layout.NoBorders (smartBorders, noBorders)
 
 import Rahm.Desktop.Layout.CornerLayout (Corner(..))
 import Rahm.Desktop.Layout.List
-import Rahm.Desktop.Windows
 import Rahm.Desktop.Layout.ReinterpretMessage
 import Rahm.Desktop.Layout.Pop
 import Rahm.Desktop.Layout.Flip
diff --git a/src/Rahm/Desktop/Layout/ConsistentMosaic.hs b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
index 0a6215a..3dbc44c 100644
--- a/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
+++ b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
@@ -13,7 +13,6 @@ import Data.Maybe (mapMaybe)
 
 import XMonad.Layout.MosaicAlt
 
-import Rahm.Desktop.Windows
 import Rahm.Desktop.Logger
 
 
@@ -40,7 +39,7 @@ instance (LayoutClass l a, Show a, Ord a, Enum a, Num a) => LayoutClass (MosaicW
 
   runLayout (W.Workspace t (MosaicWrap l) (id -> Just s)) rect = do
     let zs = zipStack [100..] s
-        s' = mapStack fst zs
+        s' = fmap fst zs
         m = Map.fromList (W.integrate zs)
 
     (rects, maybeNewLayout) <- runLayout (W.Workspace t l (Just s')) rect
diff --git a/src/Rahm/Desktop/Layout/Hole.hs b/src/Rahm/Desktop/Layout/Hole.hs
index f6632d5..fe48340 100644
--- a/src/Rahm/Desktop/Layout/Hole.hs
+++ b/src/Rahm/Desktop/Layout/Hole.hs
@@ -3,11 +3,10 @@
 -- Delegates to a lower layout, but leaves a hole where the next window will go.
 module Rahm.Desktop.Layout.Hole (hole, toggleHole) where
 
-import qualified Rahm.Desktop.StackSet as W
 import XMonad
 import Data.Maybe (mapMaybe)
 
-import Rahm.Desktop.Windows
+import qualified Rahm.Desktop.StackSet as W
 
 data Hole (l :: * -> *) (a :: *) = Hole Bool (l a)
 
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 9bc2cb6..4da2a46 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -29,7 +29,6 @@ import Data.Sequence (Seq(..))
 import Rahm.Desktop.Common
 import Rahm.Desktop.History
 import Rahm.Desktop.Hooks.WindowChange
-import Rahm.Desktop.Windows (mapWindows, findWindow, getLocationWorkspace)
 import Rahm.Desktop.Workspaces
 import System.Environment
 import System.FilePath
diff --git a/src/Rahm/Desktop/StackSet.hs b/src/Rahm/Desktop/StackSet.hs
index 8db16c1..652dafe 100644
--- a/src/Rahm/Desktop/StackSet.hs
+++ b/src/Rahm/Desktop/StackSet.hs
@@ -7,6 +7,12 @@ module Rahm.Desktop.StackSet (
   shiftWin,
   screenRotateBackward,
   screenRotateForward,
+  mapWindows,
+  swapWindows,
+  getLocationWorkspace,
+  WindowLocation(..),
+  windowMemberOfWorkspace,
+  findWindow,
   module W) where
 
 import Prelude hiding (head)
@@ -15,7 +21,37 @@ import Data.List (find)
 import XMonad.StackSet as W hiding (greedyView, shiftWin)
 import qualified XMonad.StackSet
 import Data.Default
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, catMaybes, listToMaybe)
+import qualified Data.Map as Map
+
+data WindowLocation i l a s sd =
+  OnScreen (Screen i l a s sd) |
+  OnHiddenWorkspace (Workspace i l a) |
+  Floating
+
+getLocationWorkspace :: WindowLocation i l a s sd -> Maybe (Workspace i l a)
+getLocationWorkspace (OnScreen (Screen w _ _)) = Just w
+getLocationWorkspace (OnHiddenWorkspace w) = Just w
+getLocationWorkspace _ = 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
+    (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 (fmap fn) stack)
+
+swapWindows :: (Ord a) => a -> a -> StackSet i l a s d -> StackSet i l a s d
+swapWindows wa wb = mapWindows $ \w ->
+  case w of
+    _ | w == wa -> wb
+    _ | w == wb -> wa
+    _ -> w
 
 masterWindow :: StackSet i l a s sd -> Maybe a
 masterWindow = head . integrate' . stack . workspace . current
@@ -67,3 +103,35 @@ screenRotateForward (W.StackSet current visible others floating) = do
       in W.StackSet current' visible' others floating
 
   where rcycle l = last l : l
+
+{- Finds a Window and returns the screen its on and the workspace its on.
+ - Returns nothing if the window doesn't exist.
+ -
+ - If the window is not a screen Just (Nothing, workspace) is returned.
+ - If the window is a floating window Just (Nothing, Nothing) is returned. -}
+findWindow ::
+    (Eq a) => StackSet i l a s sd -> a -> Maybe (WindowLocation i l a s sd)
+findWindow (StackSet cur vis hid float) win =
+    listToMaybe . catMaybes $
+      map findWindowScreen (cur : vis) ++
+        map findWindowWorkspace hid ++
+          [findWindowFloat]
+
+  where
+    findWindowScreen s@(Screen ws _ _) =
+      if windowMemberOfWorkspace ws win
+        then Just (OnScreen s)
+        else Nothing
+
+    findWindowWorkspace w =
+      if windowMemberOfWorkspace w win
+        then Just (OnHiddenWorkspace w)
+        else Nothing
+
+    findWindowFloat =
+      if win `elem` Map.keys float
+        then Just Floating
+        else Nothing
+
+windowMemberOfWorkspace :: (Eq a) => Workspace i l a -> a -> Bool
+windowMemberOfWorkspace (Workspace _ _ s) w = w `elem` integrate' s
diff --git a/src/Rahm/Desktop/SwapMaster.hs b/src/Rahm/Desktop/SwapMaster.hs
index fd61a50..96417ed 100644
--- a/src/Rahm/Desktop/SwapMaster.hs
+++ b/src/Rahm/Desktop/SwapMaster.hs
@@ -3,7 +3,6 @@ module Rahm.Desktop.SwapMaster (swapMaster) where
 
 import qualified Rahm.Desktop.StackSet as W
 
-import Rahm.Desktop.Windows (mapWindows, getMaster, swapWindows)
 import Control.Monad.Trans.Maybe
 import XMonad (Window, ExtensionClass(..), X(..), windows, windowset)
 import Control.Monad (void)
@@ -28,13 +27,13 @@ swapMaster = void $ runMaybeT $ do
     ss <- gets windowset
 
     focused <- hoist $ W.peek ss
-    master <- hoist $ getMaster ss
+    master <- hoist $ W.masterWindow ss
 
     if focused == master
         then do
           lw <- MaybeT $ lastWindow <$> XS.get
-          lift $ windows (swapWindows focused lw)
-        else lift $ windows (swapWindows focused master)
+          lift $ windows (W.swapWindows focused lw)
+        else lift $ windows (W.swapWindows focused master)
 
     lift $ do
       XS.put (LastWindow $ Just master)
diff --git a/src/Rahm/Desktop/Windows.hs b/src/Rahm/Desktop/Windows.hs
deleted file mode 100644
index 2aa5995..0000000
--- a/src/Rahm/Desktop/Windows.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-module Rahm.Desktop.Windows where
-
-import XMonad (windowset, X, Window, get)
-
-import Control.Applicative ((<|>))
-import Rahm.Desktop.StackSet (Stack(..), StackSet(..), Screen(..), Workspace(..), peek, integrate, integrate', allWindows)
-import Data.Maybe (listToMaybe, catMaybes)
-import qualified Data.Map as Map
-
-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)
-
-getMaster :: StackSet i l a s sd -> Maybe a
-getMaster (StackSet (Screen (Workspace _ _ ss) _ _) _ _ _) =
-  head . integrate <$> ss
-
-swapWindows :: (Ord a) => a -> a -> StackSet i l a s d -> StackSet i l a s d
-swapWindows wa wb = mapWindows $ \w ->
-  case w of
-    _ | w == wa -> wb
-    _ | w == wb -> wa
-    _ -> w
-
-data WindowLocation i l a s sd =
-  OnScreen (Screen i l a s sd) |
-  OnHiddenWorkspace (Workspace i l a) |
-  Floating
-
-getLocationWorkspace :: WindowLocation i l a s sd -> Maybe (Workspace i l a)
-getLocationWorkspace (OnScreen (Screen w _ _)) = Just w
-getLocationWorkspace (OnHiddenWorkspace w) = Just w
-getLocationWorkspace _ = Nothing
-
-workspaceMember :: (Eq a) => Workspace i l a -> a -> Bool
-workspaceMember (Workspace _ _ s) w = w `elem` integrate' s
-
-forAllWindows :: (Window -> X ()) -> X ()
-forAllWindows fn = do
-  stackSet <- windowset <$> get
-  mapM_ fn (allWindows stackSet)
-
-getFocusedWindow :: X (Maybe Window)
-getFocusedWindow = do
-  peek . windowset <$> get
-
-{- Finds a Window and returns the screen its on and the workspace its on.
- - Returns nothing if the window doesn't exist.
- -
- - If the window is not a screen Just (Nothing, workspace) is returned.
- - If the window is a floating window Just (Nothing, Nothing) is returned. -}
-findWindow ::
-    (Eq a) => StackSet i l a s sd -> a -> Maybe (WindowLocation i l a s sd)
-findWindow (StackSet cur vis hid float) win =
-    listToMaybe . catMaybes $
-      map findWindowScreen (cur : vis) ++
-        map findWindowWorkspace hid ++
-          [findWindowFloat]
-
-  where
-    findWindowScreen s@(Screen ws _ _) =
-      if workspaceMember ws win
-        then Just (OnScreen s)
-        else Nothing
-
-    findWindowWorkspace w =
-      if workspaceMember w win
-        then Just (OnHiddenWorkspace w)
-        else Nothing
-
-    findWindowFloat =
-      if win `elem` Map.keys float
-        then Just Floating
-        else Nothing
-- 
cgit 


From 9b60476c272d5a9dd8cce4b811c2da6ee4a203aa Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 24 Apr 2022 21:37:30 -0600
Subject: Add M-S-s to swap windows with eachother

---
 src/Rahm/Desktop/Keys.hs       | 44 +++++++++++++++++++++++++++---------------
 src/Rahm/Desktop/StackSet.hs   | 11 +++++------
 src/Rahm/Desktop/SwapMaster.hs |  4 ++--
 3 files changed, 35 insertions(+), 24 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 8cb2b76..50b7104 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -404,22 +404,34 @@ keymap = runKeys $ do
       sendMessage rotateLayout
 
   bind xK_s $ do
-    justMod $ do
-      locations <- fromMaybe [] <$> runMaybeT readNextLocationSet
-      let locationWindows = mapMaybe locationWindow locations
-
-      withBorderWidth 4 locationWindows $
-        withBorderColor "#00ffff" locationWindows $ do
-          runMaybeT_ $ do
-            workspace <- readNextWorkspace
-            mapM_ (lift . moveLocationToWorkspaceFn workspace) locations
-
-            lift $ setAlternateWindows locationWindows
-            forM_ locations $ \loc ->
-              case locationWindow loc of
-                Nothing -> return ()
-                Just win -> do
-                  lift $ setAlternateWorkspace win (locationWorkspace loc)
+    forM_ [(False, justMod), (True, shiftMod)] $ \(doSwap, f) ->
+      f $ 
+        doc (if doSwap
+          then "Swap a windowset with another windowset."
+          else "Shift a windowset to a workspace") $ do
+        locations <- fromMaybe [] <$> runMaybeT readNextLocationSet
+        let locationWindows = mapMaybe locationWindow locations
+
+        withBorderWidth 4 locationWindows $
+          withBorderColor "#00ffff" locationWindows $ do
+            runMaybeT_ $ do
+              if doSwap
+                then do
+                  otherWindows <-
+                    lift $ mapMaybe locationWindow . fromMaybe [] <$>
+                      runMaybeT readNextLocationSet
+                  lift $ windows $
+                    W.swapWindows (zip locationWindows otherWindows)
+                else do
+                  workspace <- readNextWorkspace
+                  mapM_ (lift . moveLocationToWorkspaceFn workspace) locations
+
+              lift $ setAlternateWindows locationWindows
+              forM_ locations $ \loc ->
+                case locationWindow loc of
+                  Nothing -> return ()
+                  Just win -> do
+                    lift $ setAlternateWorkspace win (locationWorkspace loc)
 
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
diff --git a/src/Rahm/Desktop/StackSet.hs b/src/Rahm/Desktop/StackSet.hs
index 652dafe..6b90fab 100644
--- a/src/Rahm/Desktop/StackSet.hs
+++ b/src/Rahm/Desktop/StackSet.hs
@@ -46,12 +46,11 @@ mapWindows fn (StackSet cur vis hid float) =
     mapWindowsWorkspace (Workspace t l stack) =
       Workspace t l (fmap (fmap fn) stack)
 
-swapWindows :: (Ord a) => a -> a -> StackSet i l a s d -> StackSet i l a s d
-swapWindows wa wb = mapWindows $ \w ->
-  case w of
-    _ | w == wa -> wb
-    _ | w == wb -> wa
-    _ -> w
+swapWindows :: (Ord a) => [(a, a)] -> StackSet i l a s d -> StackSet i l a s d
+swapWindows toSwap = mapWindows $ \w ->
+  fromMaybe w (Map.lookup w toSwapM)
+  where
+    toSwapM = Map.fromList (toSwap ++ map (\(a, b) -> (b, a)) toSwap)
 
 masterWindow :: StackSet i l a s sd -> Maybe a
 masterWindow = head . integrate' . stack . workspace . current
diff --git a/src/Rahm/Desktop/SwapMaster.hs b/src/Rahm/Desktop/SwapMaster.hs
index 96417ed..cd47c01 100644
--- a/src/Rahm/Desktop/SwapMaster.hs
+++ b/src/Rahm/Desktop/SwapMaster.hs
@@ -32,8 +32,8 @@ swapMaster = void $ runMaybeT $ do
     if focused == master
         then do
           lw <- MaybeT $ lastWindow <$> XS.get
-          lift $ windows (W.swapWindows focused lw)
-        else lift $ windows (W.swapWindows focused master)
+          lift $ windows (W.swapWindows [(focused, lw)])
+        else lift $ windows (W.swapWindows [(focused, master)])
 
     lift $ do
       XS.put (LastWindow $ Just master)
-- 
cgit 


From fcea6ce1371de988deb2dd719263cb2c9c59dfd7 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Thu, 28 Apr 2022 18:15:34 -0600
Subject: Add Bordering layout.

The bordering layout can add windows along the border of the screen,
that way something like videos or something can be shown in the corner
of the screen.
---
 src/Rahm/Desktop/Common.hs           |   2 +
 src/Rahm/Desktop/Keys.hs             |  40 ++++++++
 src/Rahm/Desktop/Layout.hs           |   3 +-
 src/Rahm/Desktop/Layout/Bordering.hs | 194 +++++++++++++++++++++++++++++++++++
 4 files changed, 238 insertions(+), 1 deletion(-)
 create mode 100644 src/Rahm/Desktop/Layout/Bordering.hs

diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index 8790d84..3e6d54c 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -112,6 +112,8 @@ withBorderWidth width ws fn = do
   forM_ ws $ \window ->
     io $ setWindowBorderWidth d window 2
 
+  refresh
+
   return ret
 
 gotoWorkspace :: WorkspaceId -> X ()
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 50b7104..26021bb 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -14,6 +14,7 @@ import Data.List.Safe ((!!))
 import Data.Map (Map)
 import Data.Maybe (isJust, fromMaybe, mapMaybe)
 import Data.Monoid (Endo(..))
+import Data.Proxy
 import Debug.Trace
 import Graphics.X11.ExtraTypes.XF86;
 import Graphics.X11.ExtraTypes.XorgDefault
@@ -44,6 +45,7 @@ import qualified Data.Map as Map
 import Rahm.Desktop.DMenu
 import Rahm.Desktop.Keys.Dsl
 import Rahm.Desktop.Layout
+import Rahm.Desktop.Layout.Bordering
 import Rahm.Desktop.Layout.ConsistentMosaic
 import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
 import Rahm.Desktop.Layout.Hole (toggleHole)
@@ -294,6 +296,44 @@ keymap = runKeys $ do
           moveLocationToWorkspaceFn ws loc
           gotoWorkspaceFn ws
 
+  bind xK_n $ do
+    justMod $
+      doc "Banish the current window to the border" $
+        withFocused $ sendMessage . toggleBanish
+
+    shiftMod $
+      doc "Rotate border windows" $ repeatable $ do
+       
+        bind xK_h $ do
+          
+          (justMod -|- noMod) $ 
+            withFocused $ sendMessage . moveForward
+
+          shiftMod $
+            sendMessage (rotateBorderForward (Proxy :: Proxy Window))
+       
+        bind xK_l $ do
+          
+          (justMod -|- noMod) $ 
+            withFocused $ sendMessage . moveBackward
+
+          shiftMod $
+            sendMessage (rotateBorderBackward (Proxy :: Proxy Window))
+
+        bind xK_plus $ do
+          
+          (justMod -|- noMod) $
+            sendMessage $
+              changeWidth Proxy (1/24) <>
+              changeHeight (Proxy :: Proxy Window) (1/24)
+
+        bind xK_minus $ do
+          
+          (justMod -|- noMod) $
+            sendMessage $
+              changeWidth Proxy (-1/24) <>
+              changeHeight (Proxy :: Proxy Window) (-1/24)
+
   bind xK_d $
     justMod $
     doc "Record (define) macros." $
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index ad54d4a..08bd8d1 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -33,6 +33,7 @@ import Rahm.Desktop.Layout.Rotate
 import Rahm.Desktop.Layout.Redescribe
 import Rahm.Desktop.Layout.Hole
 import Rahm.Desktop.Layout.ConsistentMosaic
+import Rahm.Desktop.Layout.Bordering
 
 import qualified Data.Map as M
 import qualified Rahm.Desktop.StackSet as W
@@ -45,7 +46,7 @@ mySpacing = spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True
 
 
 mods =
-  mySpacing . poppable . flippable . rotateable . hole
+  bordering . mySpacing . poppable . flippable . rotateable . hole
 
 myLayoutList =
         layoutList $
diff --git a/src/Rahm/Desktop/Layout/Bordering.hs b/src/Rahm/Desktop/Layout/Bordering.hs
new file mode 100644
index 0000000..0a06319
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Bordering.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE DeriveAnyClass #-}
+module Rahm.Desktop.Layout.Bordering
+  (Bordering(..), banishToBorder, unbanish, rotateBorderForward,
+    rotateBorderBackward, bordering, toggleBanish,
+    changeWidth, changeHeight, moveForward, moveBackward) where
+
+import XMonad
+
+import Control.Monad
+import Data.Tuple (swap)
+import Control.Arrow
+import Data.Map (Map)
+import Data.Maybe (fromMaybe)
+import qualified Data.Map as Map
+import Data.List (partition, find)
+import qualified Data.Set as Set
+import Data.Typeable (cast)
+import Data.Proxy (Proxy)
+
+import Rahm.Desktop.Logger
+import qualified Rahm.Desktop.StackSet as W
+
+data BorderPosition =
+  North | NorthEast | East | SouthEast | South | SouthWest | West | NorthWest
+  deriving (Eq, Show, Read, Ord, Enum, Bounded)
+
+data BorderingData a =
+  BorderingData {
+    extraWindows :: Map BorderPosition a
+  , borderingWidth :: Rational
+  , borderingHeight :: Rational
+  , borderingPadding :: Int
+  } deriving (Eq, Ord, Show, Read)
+
+data Bordering (l :: * -> *) (a :: *) =
+  Bordering {
+    borderingData :: BorderingData a,
+    wrappedLayout :: l a
+  } deriving (Eq, Ord, Show, Read)
+
+data ModifyBordering a =
+  ModifyBordering (BorderingData a -> BorderingData a)
+  deriving (Message)
+
+enumNext :: (Eq a, Enum a, Bounded a) => a -> a
+enumNext a
+  | a == maxBound = minBound
+  | otherwise = succ a
+
+enumPrev :: (Eq a, Enum a, Bounded a) => a -> a
+enumPrev a
+  | a == minBound = maxBound
+  | otherwise = pred a
+
+bordering :: l a -> Bordering l a
+bordering = Bordering (BorderingData mempty (1/6) (1/6) 10) 
+
+banishToBorder :: a -> ModifyBordering a
+banishToBorder win =
+  let allPositions =
+        (\(a, b) -> b ++ a) $ break (==SouthEast) [minBound .. maxBound]
+      in
+      ModifyBordering $ \dat ->
+        maybe
+          dat
+          (\pos ->
+            dat { extraWindows = Map.insert pos win (extraWindows dat)}) $
+              find (not . (`Map.member`extraWindows dat)) allPositions
+
+toggleBanish :: (Eq a) => a -> ModifyBordering a
+toggleBanish win = ModifyBordering $ \dat ->
+  let (ModifyBordering fn) = 
+        if elem win $ Map.elems $ extraWindows dat
+          then unbanish win
+          else banishToBorder win
+     in fn dat
+  
+
+unbanish :: (Eq a) => a -> ModifyBordering a
+unbanish win =
+  ModifyBordering $ \dat ->
+    maybe
+      dat
+      (\pos -> dat { extraWindows = Map.delete pos (extraWindows dat) }) $
+      (fst <$> find ((==win) . snd) (Map.toList $ extraWindows dat))
+
+rotateBorder :: (BorderPosition -> BorderPosition) -> ModifyBordering a
+rotateBorder next = ModifyBordering $ \dat ->
+  dat { extraWindows = Map.mapKeys next (extraWindows dat) }
+
+rotateBorderForward :: Proxy a -> ModifyBordering a
+rotateBorderForward _ = rotateBorder enumNext
+
+rotateBorderBackward :: Proxy a -> ModifyBordering a
+rotateBorderBackward _ = rotateBorder enumPrev
+
+changeWidth :: Proxy a -> Rational -> ModifyBordering a
+changeWidth _ amt = ModifyBordering $ \dat ->
+  dat { borderingWidth = guard $ borderingWidth dat + amt }
+  where guard x | x < 1/12 = 1/12
+                | x > 4/12 = 4/12
+                | otherwise = x
+
+changeHeight :: Proxy a -> Rational -> ModifyBordering a
+changeHeight _ amt = ModifyBordering $ \dat ->
+  dat { borderingHeight = guard $ borderingHeight dat + amt }
+  where guard x | x < 1/12 = 1/12
+                | x > 4/12 = 4/12
+                | otherwise = x
+
+instance Semigroup (ModifyBordering a) where
+  (<>) = mappend
+
+instance Monoid (ModifyBordering a) where
+  
+  mempty = ModifyBordering id
+  mappend (ModifyBordering f1) (ModifyBordering f2) = ModifyBordering (f2 . f1)
+    
+
+move :: (Eq a) => (BorderPosition -> BorderPosition) -> a -> ModifyBordering a
+move fn win = ModifyBordering $ \dat ->
+  let mKey = fst <$> find ((==win) . snd) (Map.toList $ extraWindows dat) in
+  case mKey of
+    Nothing -> dat
+    Just key ->
+      let newKey = until (\k -> not (Map.member k (extraWindows dat) && k /= key))
+                      fn (fn key)
+          wins' = Map.insert newKey win $ Map.delete key $ extraWindows dat
+          in 
+          dat { extraWindows = wins' }
+
+moveForward :: (Eq a) => a -> ModifyBordering a
+moveForward = move enumNext
+
+moveBackward :: (Eq a) => a -> ModifyBordering a
+moveBackward = move enumPrev
+    
+
+instance (Show a, Ord a, LayoutClass l a, Typeable a) => LayoutClass (Bordering l) a where
+  runLayout (W.Workspace t (Bordering dat l) as) rect = do
+    let (out, rest) = filterStack as
+    (rects, maybeNewLayout) <- runLayout (W.Workspace t l rest) rect
+    return (layoutRest out ++ rects, Bordering dat <$> maybeNewLayout)
+    where
+      filterStack Nothing = ([], Nothing)
+      filterStack (Just (W.Stack f h t)) = do
+        let elSet = Set.fromList (Map.elems $ extraWindows dat)
+            ((hp, h'), (tp, t')) = dbl (partition (`Set.member`elSet)) (h, t)
+            in case (Set.member f elSet, h', t', hp ++ tp) of
+                 (False, _, _, r) -> (r, Just $ W.Stack f h' t')
+                 (True, (a:h''), _, r) ->  (f:r, Just $ W.Stack a h'' t')
+                 (True, [], (a:t''), r) ->  (f:r, Just $ W.Stack a [] t'')
+                 (True, [], [], r) ->  (f:r, Nothing)
+
+      layoutRest windows =
+        map (second (scaleRationalRect (padRect rect) . loc2Rect) . swap) $
+          filter ((`elem`windows) . snd) $
+            Map.toList (extraWindows dat)
+
+      padRect (Rectangle x y w h) =
+        let p :: (Integral a) => a
+            p = fromIntegral (borderingPadding dat) in
+            Rectangle (x + p) (y + p) (w - p*2) (h - p*2)
+
+      loc2Rect loc = case loc of
+        North -> W.RationalRect (1/2 - (bw / 2)) 0 bw bh
+        NorthEast -> W.RationalRect (1 - bw) 0 bw bh
+        East -> W.RationalRect (1 - bw) (1/2 - (bh / 2)) bw bh
+        SouthEast -> W.RationalRect (1 - bw) (1 - bh) bw bh
+        South -> W.RationalRect (1/2 - (bw / 2)) (1 - bh) bw bh
+        SouthWest -> W.RationalRect 0 (1 - bh) bw bh
+        West -> W.RationalRect 0 (1/2 - (bh / 2)) bw bh
+        NorthWest -> W.RationalRect 0 0 bw bh
+
+        where
+
+          bw = borderingWidth dat
+          bh = borderingHeight dat
+
+      dbl f = f *** f
+
+  handleMessage (Bordering d l) m@(fromMessage -> Just e@DestroyWindowEvent {ev_window = w}) = do
+    maybeNewLayout <- handleMessage l m
+    return $ Just $ Bordering (f d) (fromMaybe l maybeNewLayout)
+    where
+      f e@BorderingData{ extraWindows = ws } =
+        e { extraWindows = Map.filter (maybe True (/=w) . cast) ws }
+    
+  handleMessage (Bordering d l) (fromMessage -> Just (ModifyBordering fn)) =
+    return (Just $ Bordering (fn d) l)
+
+  handleMessage (Bordering d l) a = do
+    maybeNewLayout <- handleMessage l a
+    return (Bordering d <$> maybeNewLayout)
-- 
cgit 


From 13f2c99387be8217fd48a252057957f6bf6ac230 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 1 May 2022 15:49:35 -0600
Subject: Change WML workspaces to have a Maybe name.

---
 src/Rahm/Desktop/Keys.hs     |  7 +++----
 src/Rahm/Desktop/Keys/Wml.hs | 40 +++++++++++++++++++++++++---------------
 2 files changed, 28 insertions(+), 19 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 26021bb..ab72645 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -282,10 +282,9 @@ keymap = runKeys $ do
 
     shiftMod $
       doc "Swap a workspace with another workspace." $
-      runMaybeT_ $ do
-        ws1 <- readNextWorkspace
-        ws2 <- readNextWorkspace
-        lift $ windows $ W.swapWorkspaces (workspaceName ws1) (workspaceName ws2)
+      runMaybeT_ $
+        lift . windows . uncurry W.swapWorkspaces =<<
+          (,) <$> readNextWorkspaceName <*> readNextWorkspaceName
 
     controlMod $
       doc "Move the current focused window to another workspace and view that workspace" $
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 5ce455c..af04e44 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -60,7 +60,7 @@ data Workspace =
   forall a. (Typeable a) => Workspace {
     moveLocationToWorkspaceFn :: Location -> X ()
   , gotoWorkspaceFn :: X ()
-  , workspaceName :: String
+  , workspaceName :: Maybe String
   , extraWorkspaceData :: a
   }
 
@@ -90,7 +90,7 @@ justWorkspace s =
   Workspace {
     moveLocationToWorkspaceFn = flip moveLocationToWorkspace s
   , gotoWorkspaceFn = gotoWorkspace s
-  , workspaceName = s
+  , workspaceName = Just s
   , extraWorkspaceData = ()
   }
 
@@ -99,7 +99,7 @@ blackHoleWorkspace =
   Workspace {
     moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow
   , gotoWorkspaceFn = return () -- can't navigate to black hole
-  , workspaceName = "blackhole"
+  , workspaceName = Nothing
   , extraWorkspaceData = ()
   }
 
@@ -122,7 +122,7 @@ alternateWorkspace =
         Just win -> do
           mapM_ gotoWorkspace =<<  getAlternateWorkspace win
 
-  , workspaceName = "@"
+  , workspaceName = Nothing
   , extraWorkspaceData = ()
   }
 
@@ -203,24 +203,32 @@ locationSetForKeysT s = feedKeysT s readNextLocationSet
 locationSetForKeys :: KeyString -> X [Location]
 locationSetForKeys s = fromMaybe [] <$> runMaybeT (locationSetForKeysT s)
 
+lift1 :: (KeyFeeder m) => (a -> X b) -> (a -> MaybeT m b)
+lift1 = fmap (lift . fromX)
+
+readNextWorkspaceName :: (KeyFeeder m) => MaybeT m WorkspaceId
+readNextWorkspaceName = joinMaybe $ workspaceName <$> readNextWorkspace
+
 -- Returns the next workspaces associated with the next set of keystrokes.
 readNextWorkspace :: (KeyFeeder m) => MaybeT m Workspace
 readNextWorkspace =
   readNextKey $ \mask sym str ->
     case (mask, sym, str) of
       (_, _, [ch]) | isAlphaNum ch || ch == '*' -> return $ justWorkspace [ch]
-      (_, _, "[") -> mt $ 
+      (_, _, "[") ->
         justWorkspace <$>
-           (adjacentWorkspaceNotVisible prev =<< getCurrentWorkspace)
-      (_, _, "]") -> mt $
+           (lift1 (adjacentWorkspaceNotVisible prev) =<<
+              readNextWorkspaceName)
+      (_, _, "]") ->
         justWorkspace <$>
-          (adjacentWorkspaceNotVisible next =<< getCurrentWorkspace)
-      (_, _, "(") -> mt $ 
+           (lift1 (adjacentWorkspaceNotVisible next) =<<
+              readNextWorkspaceName)
+      (_, _, "(") ->
         justWorkspace <$>
-          (adjacentWorkspace prev =<< getCurrentWorkspace)
-      (_, _, ")") -> mt $
+          (lift1 (adjacentWorkspace prev) =<< readNextWorkspaceName)
+      (_, _, ")") ->
         justWorkspace <$>
-          (adjacentWorkspace next =<< getCurrentWorkspace)
+          (lift1 (adjacentWorkspace next) =<< readNextWorkspaceName)
       (_, _, "^") -> mapMaybeT fromX $ MaybeT $
         withWindowSet $ \ws -> return $
           (fmap (justWorkspace . W.tag . W.workspace . snd) . head)
@@ -239,7 +247,7 @@ readNextWorkspace =
             map (W.tag . W.workspace . snd)
               <$> withWindowSet (return . getHorizontallyOrderedScreens)
 
-        let (_, rest) = break (==workspaceName ws) (screens ++ screens)
+        let (_, rest) = break ((==workspaceName ws) . Just) (screens ++ screens)
 
         justWorkspace <$> MaybeT (return $ head $ tail rest)
 
@@ -250,7 +258,7 @@ readNextWorkspace =
             map (W.tag . W.workspace . snd)
               <$> withWindowSet (return . getHorizontallyOrderedScreens)
 
-        let (front, _) = break (==workspaceName ws) (screens ++ screens)
+        let (front, _) = break ((==workspaceName ws) . Just) (screens ++ screens)
 
         justWorkspace <$> MaybeT (return $ last front)
 
@@ -261,6 +269,8 @@ readNextWorkspace =
         loc <- readNextLocationSet
         MaybeT (return $ justWorkspace . locationWorkspace <$> head loc)
 
+      (_, _, "~") ->
+        justWorkspace . accompaningWorkspace <$> readNextWorkspaceName
       (_, _, " ") -> mt $
         justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
       (_, _, "_") -> return blackHoleWorkspace
@@ -300,7 +310,7 @@ readNextLocationSet =
         lift $ logs Info "allWindows %s" (intercalate "\n"  (map show ret))
         return ret
       (_, _, s) | s == "\t" || s == "@" || s == "\n" ->
-        (mt . windowsInWorkspace . workspaceName) =<< readNextWorkspace
+        (mt . windowsInWorkspace) =<< readNextWorkspaceName
       (_, _, "!") -> (:[]) <$> joinMaybe (head <$> readNextLocationSet)
       (_, _, ",") -> tail <$> readNextLocationSet
       (_, _, "~") -> reverse <$> readNextLocationSet
-- 
cgit 


From 54c15ea7918b88dc9c0bab5e01fc26086cddfef1 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 13 May 2022 10:42:18 -0600
Subject: Remove taking the screen count from the workspaces. It breaks docking
 the laptop

---
 src/Main.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 25403d4..81a874b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -38,7 +38,6 @@ main = do
   setEnv "ROFI" menuCommandString
 
   xmobar <- spawnXMobar
-  count <- fromIntegral . screenCount <$> openDisplay ""
 
   (=<<) X.xmonad $ 
     applyKeys $ withLocationChangeHook historyHook $ ewmh $ docks $  def
@@ -68,7 +67,7 @@ main = do
          -- with something. However, this configuration only supports 36
          -- monitors on boot. If you need more than 36 monitors, you'll have to
          -- configure those ones after starting XMonad.
-       , workspaces = map return (take count $ ['0'..'9'] ++ ['a'..'z'])
+       , workspaces = map return (['0'..'9'] ++ ['a'..'z'])
        , handleEventHook =
            composeAll [
              fullscreenEventHook,
-- 
cgit 


From 69be48b87dbad3fec795236592fdd90f15cbb396 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 8 Jun 2022 10:29:04 -0600
Subject: Change up the override keys for browsers

---
 src/Rahm/Desktop/Keys.hs | 55 +++++++++++++++++++++++++-----------------------
 1 file changed, 29 insertions(+), 26 deletions(-)

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index ab72645..b57d310 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -839,9 +839,29 @@ windowSpecificBindings config = do
 
   w <- lift ask
 
+  let mods = permuteMods [shiftMask, controlMask, 0]
   let configureIf b k = tell =<< lift (b --> return (keyBindingToKeymap (runKeys k) config))
       emitKey = flip sendKey w
 
+  configureIf (flip elem (browsers ++ spotify) <$> className) $ do
+
+    bind xK_h $ do
+      rawMask controlMask $ emitKey (0, xK_BackSpace)
+      forM_ mods $ \mask ->
+        rawMask (altMask .|. mask) $ emitKey (mask, xK_Left)
+
+    bind xK_t $
+      forM_ mods $ \mask ->
+        rawMask (altMask .|. mask) $ emitKey (mask, xK_Down)
+
+    bind xK_c $
+      forM_ mods $ \mask ->
+        rawMask (altMask .|.mask) $ emitKey (mask, xK_Up)
+
+    bind xK_n $
+      forM_ mods $ \mask ->
+        rawMask (altMask .|. mask) $ emitKey (mask, xK_Right)
+
   configureIf (flip elem browsers <$> className) $ do
 
     -- if the window is a browser, configure these bindings. Lots of browsers
@@ -865,25 +885,6 @@ windowSpecificBindings config = do
     --   Ctrl+d -> Delete current tab.
 
 
-    let mods = permuteMods [shiftMask, controlMask, 0]
-
-    bind xK_h $ do
-      rawMask controlMask $ emitKey (0, xK_BackSpace)
-      forM_ mods $ \mask ->
-        rawMask (altMask .|. mask) $ emitKey (mask, xK_Left)
-
-    bind xK_j $
-      forM_ mods $ \mask ->
-        rawMask (altMask .|. mask) $ emitKey (mask, xK_Down)
-
-    bind xK_k $
-      forM_ mods $ \mask ->
-        rawMask (altMask .|.mask) $ emitKey (mask, xK_Up)
-
-    bind xK_l $
-      forM_ mods $ \mask ->
-        rawMask (altMask .|. mask) $ emitKey (mask, xK_Right)
-
     bind xK_u $
       rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_BackSpace)
 
@@ -891,20 +892,21 @@ windowSpecificBindings config = do
       rawMask controlMask $ emitKey (controlMask, xK_BackSpace)
 
     bind xK_b $ do
-      rawMask controlMask $ emitKey (controlMask, xK_Left)
-      rawMask (controlMask .|. shiftMask) $
+      rawMask altMask $ emitKey (controlMask, xK_Left)
+      rawMask (altMask .|. shiftMask) $
         emitKey (controlMask .|. shiftMask, xK_Left)
 
     bind xK_e $ do
-      rawMask controlMask $ emitKey (controlMask, xK_Right)
-      rawMask (controlMask .|. shiftMask) $
+      rawMask altMask $ emitKey (controlMask, xK_Right)
+      rawMask (altMask .|. shiftMask) $
         emitKey (controlMask .|. shiftMask, xK_Right)
 
     bind xK_dollar $
-      rawMask controlMask $ emitKey (0, xK_End)
+      rawMask altMask $ emitKey (0, xK_End)
 
-    bind xK_at $
-      rawMask (controlMask .|. shiftMask) $ emitKey (0, xK_Home)
+    bind xK_at $ do
+      rawMask (altMask .|. shiftMask) $ emitKey (shiftMask, xK_Home)
+      rawMask altMask $ emitKey (0, xK_Home)
 
     bind xK_d $
       rawMask controlMask $ emitKey (controlMask, xK_Tab)
@@ -926,6 +928,7 @@ windowSpecificBindings config = do
 
   where
     browsers = ["Google-chrome", "Brave-browser", "firefox-default"]
+    spotify = ["Spotify"]
 
     -- Create a permutation from a list of modifiers.
     --
-- 
cgit 


From 7b91c18a7b6b16fb3f18eafb4ce2657bd155d55d Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Tue, 2 Aug 2022 12:23:45 -0600
Subject: Add more Wml adjectives.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

These are:

  '~ws' - Associated workspace, which is the workspace of the toggled
  case. I.e. workspace ~w == W, or ~. is the toggled case of the current
  workspace.

  '=ws₀ws₁ws₂ws₃' ws₂ if name(ws₀) == name(ws₁) otherwise ws₃

while not _that_ helpful for interactive usage, it is useful for
programming macros. I.e.

to jump to Spotify, unless I'm already on spotify, in which case go back
to where I was, I can record this macro on my keyboard:

<Hyper-g>=.s's

or a macro to jump back and forth between the current workspace and the
associated workspace on the next monitor:

<Hyper-g>=.~,.'~,.
---
 src/Rahm/Desktop/Keys/Wml.hs | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index af04e44..adb1d9f 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -273,8 +273,27 @@ readNextWorkspace =
         justWorkspace . accompaningWorkspace <$> readNextWorkspaceName
       (_, _, " ") -> mt $
         justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
+      (_, _, "~") -> do
+          ws <- readNextWorkspace
+          case workspaceName ws of
+            Just [a] | isAlphaNum a ->
+              return (justWorkspace $ accompaningWorkspace [a])
+            _ -> MaybeT (return Nothing)
+
       (_, _, "_") -> return blackHoleWorkspace
       (_, _, "-") -> return alternateWorkspace
+      (_, _, "=") -> do
+        ws1 <- readNextWorkspace
+        ws2 <- readNextWorkspace
+
+        ws3 <- readNextWorkspace
+        ws4 <- readNextWorkspace
+
+        return $
+          if workspaceName ws1 == workspaceName ws2
+            then ws3
+            else ws4
+
       (mask, keysym, _) -> do
         macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . workspaceMacros <$> XS.get)
         fromMaybeTX $ workspaceForKeysT macro
-- 
cgit 


From b67dbf6462187a9a8346a8d312b46b33e8d74fa3 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 3 Aug 2022 14:00:30 -0600
Subject: Add new conditional description for workspaces.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This adds the "<" condition, it used as "in"

i.e. "<l₀l₁w₀w₁" reads as "if l₀ is a subset of l₁, then w₀ else w₁"

Useful for macro programming like, if Spotify is on the current
workspace, then go back to where I came from, otherwise jump to Spotify.
This can be achieved with the following (assuming Spotify is marked with
"s"):

"<H-g><s@.'@s"

"if spotify (s) is in the set of the windows on the current screen (@.), jump
back to where I came from (workspace '), otherwise goto the workspace
spotify is on (@s)."
---
 src/Main.hs                  | 21 ++++++++++++++++++++-
 src/Rahm/Desktop/Keys/Wml.hs | 33 ++++++++++++++++++++++++++-------
 src/Rahm/Desktop/Marking.hs  | 26 +++++++++++++++++---------
 3 files changed, 63 insertions(+), 17 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 81a874b..a98e568 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,5 +1,6 @@
 import XMonad
 
+import XMonad.Hooks.DynamicProperty
 import Control.Monad.Trans.Class
 import Control.Monad.Reader
 import XMonad.Hooks.ManageDocks (docks)
@@ -14,6 +15,7 @@ import qualified Data.Map as Map
 import Text.Printf
 
 import Rahm.Desktop.Swallow
+import Rahm.Desktop.Marking
 import Rahm.Desktop.Common
 import Rahm.Desktop.XMobarLog
 import Rahm.Desktop.Keys
@@ -51,6 +53,7 @@ main = do
        , startupHook = spawn fp
        , manageHook = composeAll [
            isFullscreen --> doFullFloat
+         , doLogWindow
          , className =? "Tilda" --> doFloat
          , className =? "yakuake" --> doFloat
          , className =? "MPlayer" --> doFloat
@@ -72,7 +75,10 @@ main = do
            composeAll [
              fullscreenEventHook,
              remapHook,
-             swallowHook]
+             swallowHook,
+             dynamicTitle (composeAll [
+              title =? "Spotify" --> doMarkWindow "s"
+              ])]
        , focusFollowsMouse = False
        , clickJustFocuses = False
        , logHook = xMobarLogHook xmobar
@@ -83,6 +89,19 @@ changeHook :: Location -> Location -> X ()
 changeHook l1 l2 =
   logs Info "Change %s -> %s" (show l1) (show l2)
 
+doLogWindow :: ManageHook
+doLogWindow = do
+  t <- title
+  c <- className
+  a <- appName
+  liftX $ logs Debug "New Window {title: \"%s\", class: \"%s\", appName: \"%s\"}" t c a
+  return (Endo id)
+
+doMarkWindow :: Mark -> ManageHook
+doMarkWindow m = ask >>= (\w -> liftX (do
+  ws <- getCurrentWorkspace
+  markAllLocations m [Location ws (Just w)]) >> return (Endo id))
+
 doCenterFloat :: ManageHook
 doCenterFloat =
   ask >>= \w -> doF . W.float w . centerRect . snd =<< liftX (floatLocation w)
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index adb1d9f..647234c 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -267,18 +267,15 @@ readNextWorkspace =
 
       (_, _, "@") -> do
         loc <- readNextLocationSet
-        MaybeT (return $ justWorkspace . locationWorkspace <$> head loc)
+        MaybeT $ fromX $ withWindowSet $ \ws -> return $ do
+          win <- locationWindow =<< head loc
+          winLocation <- W.findWindow ws win
+          (justWorkspace . W.tag) <$> W.getLocationWorkspace winLocation
 
       (_, _, "~") ->
         justWorkspace . accompaningWorkspace <$> readNextWorkspaceName
       (_, _, " ") -> mt $
         justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
-      (_, _, "~") -> do
-          ws <- readNextWorkspace
-          case workspaceName ws of
-            Just [a] | isAlphaNum a ->
-              return (justWorkspace $ accompaningWorkspace [a])
-            _ -> MaybeT (return Nothing)
 
       (_, _, "_") -> return blackHoleWorkspace
       (_, _, "-") -> return alternateWorkspace
@@ -294,6 +291,28 @@ readNextWorkspace =
             then ws3
             else ws4
 
+      (_, _, "<") -> do
+        lift . fromX $
+          logs Trace "Doing thing"
+
+        l1 <- map locationWindow <$> readNextLocationSet
+
+        lift . fromX $
+          logs Trace "%s" (show l1)
+
+        l2 <- map locationWindow <$> readNextLocationSet
+
+        ws1 <- readNextWorkspace
+        ws2 <- readNextWorkspace
+
+        (lift . fromX) $ (logs Trace "%s < %s? %s" (show l1) (show l2) (show $ all (`elem`l2) l1) :: X ())
+        (lift . fromX) $ (logs Trace "%s %s" (show $ workspaceName ws1) (show $ workspaceName ws2))
+
+        return $
+          if all (`elem`l2) l1
+            then ws1
+            else ws2
+
       (mask, keysym, _) -> do
         macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . workspaceMacros <$> XS.get)
         fromMaybeTX $ workspaceForKeysT macro
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 4da2a46..f239399 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -9,7 +9,9 @@ module Rahm.Desktop.Marking (
   markAllLocations,
   farLeftWindow,
   farRightWindow,
-  windowLocation
+  windowLocation,
+  markWindow,
+  Mark
   ) where
 
 import Prelude hiding (head)
@@ -27,6 +29,7 @@ import Data.List.Safe (head)
 import Data.Map (Map)
 import Data.Sequence (Seq(..))
 import Rahm.Desktop.Common
+import Rahm.Desktop.Logger
 import Rahm.Desktop.History
 import Rahm.Desktop.Hooks.WindowChange
 import Rahm.Desktop.Workspaces
@@ -83,21 +86,26 @@ withMaybeFocused :: (Maybe Window -> X a) -> X a
 withMaybeFocused f = withWindowSet $ f . peek
 
 markAllLocations :: Mark -> [Location]  -> X ()
-markAllLocations mark locs =
+markAllLocations mark locs = do
+  logs Debug "Marking locations %s as \"%s\"" (show locs) (show mark)
+
   XS.modify $ \m ->
     m {
       markStateMap = Map.insert mark locs (markStateMap m)
     }
 
-markCurrentWindow :: Mark -> X ()
-markCurrentWindow mark = do
+markWindow :: Mark -> Window -> X ()
+markWindow mark window = do
+  logs Debug "Marking window %s as \"%s\"" (show window) (show mark)
+
   ws <- getCurrentWorkspace
+  XS.modify $ \state@MarkState {markStateMap = ms} ->
+      state {
+        markStateMap = Map.insertWith (++) mark [Location ws $ Just window] ms
+      }
 
-  withFocused $ \win ->
-    XS.modify $ \state@MarkState {markStateMap = ms} ->
-        state {
-          markStateMap = Map.insertWith (++) mark [Location ws $ Just win] ms
-        }
+markCurrentWindow :: Mark -> X ()
+markCurrentWindow = withFocused . markWindow
 
 jumpToMark :: Mark -> X ()
 jumpToMark mark = do
-- 
cgit 


From c9159878868bea1fcc7d40d85f09cb29428ba0d5 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 3 Aug 2022 15:27:34 -0600
Subject: Actually, change the workspace conditional operator.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

It was <l₀l₁w₀w₁ to condition on if l₀ is a subset of l₁, but this is
redundant, instead add "?" that conditions of if l₀ is empty.

So the new syntax is

?lw₀w₁ which is read, if the windowset l is not empty, then workspace w₀
else w₁.

This is the same use-case as before. Handy for defining macros to, say,
jump to Spotify if it's not on the current workspace, otherwise jump
to the prior window.

This is now accomplished with (assuming Spotify is marked 's'):

<H-g>?&s@.'@s

This reads as, if (?) the intersection between the Spotify window and the
windows on the current workspace (&s@.) is not empty (if spotify is on
the current window), go to the last workspace ('), otherwise go to the
workspace Spotify is on (@s).
---
 src/Rahm/Desktop/Keys/Wml.hs | 21 ++++++---------------
 1 file changed, 6 insertions(+), 15 deletions(-)

diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 647234c..9074b66 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -291,27 +291,18 @@ readNextWorkspace =
             then ws3
             else ws4
 
-      (_, _, "<") -> do
-        lift . fromX $
-          logs Trace "Doing thing"
+      -- ?&s@.'@s
 
-        l1 <- map locationWindow <$> readNextLocationSet
-
-        lift . fromX $
-          logs Trace "%s" (show l1)
-
-        l2 <- map locationWindow <$> readNextLocationSet
+      (_, _, "?") -> do
+        l1 <- readNextLocationSet
 
         ws1 <- readNextWorkspace
         ws2 <- readNextWorkspace
 
-        (lift . fromX) $ (logs Trace "%s < %s? %s" (show l1) (show l2) (show $ all (`elem`l2) l1) :: X ())
-        (lift . fromX) $ (logs Trace "%s %s" (show $ workspaceName ws1) (show $ workspaceName ws2))
-
         return $
-          if all (`elem`l2) l1
-            then ws1
-            else ws2
+          if null l1
+            then ws2
+            else ws1
 
       (mask, keysym, _) -> do
         macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . workspaceMacros <$> XS.get)
-- 
cgit 


From 6122cd030e03945382dad927c32a259c077bd468 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 3 Aug 2022 15:49:24 -0600
Subject: Add check for xK_Escape to end trynig ot type a Wml object.

---
 src/Rahm/Desktop/Keys/Wml.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 9074b66..34dabd2 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -214,6 +214,8 @@ readNextWorkspace :: (KeyFeeder m) => MaybeT m Workspace
 readNextWorkspace =
   readNextKey $ \mask sym str ->
     case (mask, sym, str) of
+      (_, e, _) | e == xK_Escape -> MaybeT $ return Nothing
+
       (_, _, [ch]) | isAlphaNum ch || ch == '*' -> return $ justWorkspace [ch]
       (_, _, "[") ->
         justWorkspace <$>
@@ -291,14 +293,14 @@ readNextWorkspace =
             then ws3
             else ws4
 
-      -- ?&s@.'@s
-
       (_, _, "?") -> do
         l1 <- readNextLocationSet
 
         ws1 <- readNextWorkspace
         ws2 <- readNextWorkspace
 
+        mt $ logs Trace "If not empty %s then %s else %s" (show l1) (show $ workspaceName ws1) (show $ workspaceName ws2)
+
         return $
           if null l1
             then ws2
@@ -315,6 +317,8 @@ readNextLocationSet :: (KeyFeeder m) => MaybeT m [Location]
 readNextLocationSet =
   readNextKey $ \mask sym str ->
     case (mask, sym, str) of
+      (_, e, _) | e == xK_Escape -> MaybeT $ return Nothing
+
       (_, _, [ch]) | isAlpha ch -> mt $ getMarkedLocations [ch]
       (_, _, "0") -> (:[]) <$> MaybeT (fromX getMostRecentLocationInHistory)
       (_, _, [ch]) | isDigit ch ->
-- 
cgit 


From 539bbd4045c010bedc785f5859e29b03814b5796 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 3 Aug 2022 16:04:48 -0600
Subject: Add preferred window for some Workspace jumps.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The wml workspace @w refers to the workspace that contains the window
marked 'w', however when jumping to that workspace, an arbitrary window
is focused. It's more intuitive to set focus to the window 'w'. This
means that <H-g>@• is the same as <H-w>•.
---
 src/Rahm/Desktop/Keys/Wml.hs | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 34dabd2..d6289bd 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -94,6 +94,22 @@ justWorkspace s =
   , extraWorkspaceData = ()
   }
 
+justWorkspaceWithPreferredWindow :: Window -> String -> Workspace
+justWorkspaceWithPreferredWindow w s =
+  Workspace {
+    moveLocationToWorkspaceFn = flip moveLocationToWorkspace s
+  , gotoWorkspaceFn = do
+      windows $ \ws' ->
+        let ws = W.greedyView s ws'
+            l = W.integrate' $ W.stack $ W.workspace $ W.current ws in
+          if w `elem` l
+            then W.focusWindow w ws
+            else ws
+
+  , workspaceName = Just s
+  , extraWorkspaceData = ()
+  }
+
 blackHoleWorkspace :: Workspace
 blackHoleWorkspace =
   Workspace {
@@ -272,7 +288,7 @@ readNextWorkspace =
         MaybeT $ fromX $ withWindowSet $ \ws -> return $ do
           win <- locationWindow =<< head loc
           winLocation <- W.findWindow ws win
-          (justWorkspace . W.tag) <$> W.getLocationWorkspace winLocation
+          (justWorkspaceWithPreferredWindow win . W.tag) <$> W.getLocationWorkspace winLocation
 
       (_, _, "~") ->
         justWorkspace . accompaningWorkspace <$> readNextWorkspaceName
-- 
cgit 


From ad4024b1c688531fca783736cefcdc79d0a1b411 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 3 Aug 2022 16:18:53 -0600
Subject: Jumping to the black hole workspace will exit Xmonad (with
 confirmation).

---
 src/Rahm/Desktop/Keys/Wml.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index d6289bd..7cff173 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -22,6 +22,8 @@ import Control.Monad (join, forM_, unless)
 import Data.List (sortOn, intercalate)
 import Data.Ord (Down(..))
 import Data.Typeable (cast)
+import XMonad.Prompt.ConfirmPrompt (confirmPrompt)
+import System.Exit (exitWith, ExitCode(..))
 
 import qualified Data.Map as Map
 import Data.Map (Map)
@@ -114,7 +116,8 @@ blackHoleWorkspace :: Workspace
 blackHoleWorkspace =
   Workspace {
     moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow
-  , gotoWorkspaceFn = return () -- can't navigate to black hole
+  , gotoWorkspaceFn =
+      confirmPrompt def "Do you want to exit xmonad" $ io (exitWith ExitSuccess)
   , workspaceName = Nothing
   , extraWorkspaceData = ()
   }
-- 
cgit 


From 9bd7b8fd7e15ff0a1b1114fb459066ebf90616c0 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 12 Aug 2022 10:08:27 -0600
Subject: Disable swallow by default

---
 src/Rahm/Desktop/Swallow.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Rahm/Desktop/Swallow.hs b/src/Rahm/Desktop/Swallow.hs
index 1939c58..a411b3f 100644
--- a/src/Rahm/Desktop/Swallow.hs
+++ b/src/Rahm/Desktop/Swallow.hs
@@ -26,4 +26,4 @@ toggleSwallowEnabled :: X ()
 toggleSwallowEnabled = (setSwallowEnabled . not) =<< isSwallowEnabled
 
 instance ExtensionClass DisableSwallow where
-  initialValue = DisableSwallow False
+  initialValue = DisableSwallow True
-- 
cgit 


From 6bacfc0e22a0a3e5917f75b5af6d1a33b575356a Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Fri, 19 Aug 2022 09:56:41 -0600
Subject: Fix problem with bluetooth-select where the power options were not
 working

---
 extras/HOME/.local/bin/bluetooth-select.sh | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/extras/HOME/.local/bin/bluetooth-select.sh b/extras/HOME/.local/bin/bluetooth-select.sh
index 3a25387..4bc416b 100755
--- a/extras/HOME/.local/bin/bluetooth-select.sh
+++ b/extras/HOME/.local/bin/bluetooth-select.sh
@@ -6,14 +6,21 @@ fi
 
 devices="$(bluetoothctl -- devices | sed 's#^Device ##')"
 selection="$(
-  echo -e "$devices\nDisconnect" | $ROFI -i -p "Connect Bluetooth" \
+  echo -e "$devices\nDisconnect\nPower On\nPower Off" | $ROFI -i -p "Connect Bluetooth" \
     -theme-str '* {theme-color: #8888ff;}' \
     -dmenu)"
 
 macaddr="${selection%% *}"
 
 if [[ "$macaddr" == "Disconnect" ]] ; then
+  echo "Disconnecting"
   exec bluetoothctl -- disconnect
+elif [[ "$selection" == "Power On" ]] ; then
+  echo "Turning Power On"
+  exec bluetoothctl -- power on
+elif [[ "$selection" == "Power Off" ]] ; then
+  echo "Turning Power Off"
+  exec bluetoothctl -- power off
 fi
 
 exec bluetoothctl -- connect "$macaddr"
-- 
cgit 


From 3c49e047d920c8662b61726460df3eb31df0b146 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 18 Nov 2022 12:17:19 -0700
Subject: Add "Theater" concept.

This is the set of the current set of screens and workspaces. It can be
saved and restored. In a sense it works like how most other tiling
managers handle "workspaces" where one can change all screens at once.
Not that it's a superior system to XMonad (it's not), but it's sometimes helpful.
---
 src/Rahm/Desktop/Keys.hs    | 30 ++++++++++++++++++-----
 src/Rahm/Desktop/Theater.hs | 60 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 84 insertions(+), 6 deletions(-)
 create mode 100644 src/Rahm/Desktop/Theater.hs

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index b57d310..fb49394 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -64,6 +64,8 @@ import Rahm.Desktop.Submap
 import Rahm.Desktop.Swallow
 import Rahm.Desktop.SwapMaster (swapMaster)
 import Rahm.Desktop.Workspaces
+import Rahm.Desktop.Theater
+
 import qualified Rahm.Desktop.StackSet as W
 import Rahm.Desktop.History
 
@@ -281,10 +283,18 @@ keymap = runKeys $ do
       runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace
 
     shiftMod $
-      doc "Swap a workspace with another workspace." $
-      runMaybeT_ $
-        lift . windows . uncurry W.swapWorkspaces =<<
-          (,) <$> readNextWorkspaceName <*> readNextWorkspaceName
+      doc "Restore the theater marked with the next typed character." $
+      runMaybeT_ $ do
+        mapNextString $ \_ str -> lift $
+          case str of
+            [ch] | isAlpha ch -> restoreTheater [ch]
+            _ -> return ()
+
+    -- shiftMod $
+    --   doc "Swap a workspace with another workspace." $
+    --   runMaybeT_ $
+    --     lift . windows . uncurry W.swapWorkspaces =<<
+    --       (,) <$> readNextWorkspaceName <*> readNextWorkspaceName
 
     controlMod $
       doc "Move the current focused window to another workspace and view that workspace" $
@@ -400,12 +410,12 @@ keymap = runKeys $ do
       doc "For mosaic layout, shrink the size-share of the current window" $
       sendMessage =<< shrinkPositionAlt
 
-  bind xK_m $
+  bind xK_m $ do
     justMod $
       doc "Mark the current window with the next typed character." $ do
       locs <- fromMaybe [] <$> runMaybeT readNextLocationSet
       let wins = mapMaybe locationWindow locs
-      withBorderWidth 4 wins $
+      withBorderWidth 2 wins $
         withBorderColor "#00ffff" wins $ do
           runMaybeT_ $ do
            mapNextString $ \_ str -> lift $
@@ -413,6 +423,14 @@ keymap = runKeys $ do
               [ch] | isAlpha ch -> markAllLocations str locs
               _ -> return ()
 
+    shiftMod $
+      doc "Mark the current theater with the next typed character." $
+      runMaybeT_ $ do
+        mapNextString $ \_ str -> lift $
+          case str of
+            [ch] | isAlpha ch -> saveCurrentTheater str
+            _ -> return ()
+
   bind xK_plus $ do
     justMod $
       doc "Increase the number of windows in the master region." $
diff --git a/src/Rahm/Desktop/Theater.hs b/src/Rahm/Desktop/Theater.hs
new file mode 100644
index 0000000..b0404b7
--- /dev/null
+++ b/src/Rahm/Desktop/Theater.hs
@@ -0,0 +1,60 @@
+module Rahm.Desktop.Theater where
+
+-- A "Theater" is a mapping from screen -> workspace. This is used to save the
+-- state of the current screen -> workspace and thus restore it.
+
+-- import XMonad.Operations
+import Data.Maybe (fromMaybe)
+import Control.Monad (forM_)
+import XMonad (X(..))
+import qualified XMonad.StackSet as W
+import qualified XMonad as X
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Default
+import qualified XMonad.Util.ExtensibleState as XS
+
+newtype Theater si wi = Theater (Map si wi)
+  deriving (Read, Show)
+
+newtype Theaters = Theaters {
+  theaters :: Map String (Theater X.ScreenId X.WorkspaceId)
+} deriving (Read, Show)
+
+instance Default Theaters where
+  def = Theaters mempty
+
+instance X.ExtensionClass Theaters where
+  initialValue = def
+  extensionType = X.PersistentExtension
+
+saveCurrentTheater :: String -> X ()
+saveCurrentTheater name =
+  X.withWindowSet $ \windowSet ->
+    XS.modify $ \(Theaters m) ->
+      Theaters $ flip (Map.insert name) m $
+        Theater $ Map.fromList $
+          map (\(W.Screen ws sid _) -> (sid, W.tag ws)) $ W.screens windowSet  
+
+restoreTheater :: String -> X ()
+restoreTheater name = do
+  (Theaters theaters) <- XS.get
+  forM_ (Map.lookup name theaters) $ \(Theater screenToWorkspace) ->
+    X.windows $ \ws@(W.StackSet cur vis hidden float) ->
+      let workspacesById = Map.fromList $ map (\ws -> (W.tag ws, ws)) (W.workspaces ws)
+
+          newScreenWorkspace scr =
+            fromMaybe scr $ do
+              wid <- Map.lookup (W.screen scr) screenToWorkspace
+              workspace <- Map.lookup wid workspacesById
+              return $ scr { W.workspace = workspace }
+
+          newScreens = map newScreenWorkspace (cur : vis)
+          newVisibleWorkspaces = map (W.tag . W.workspace) newScreens
+          newHiddenWorkspaces =
+            filter (\ws -> not (W.tag ws `elem` newVisibleWorkspaces)) $
+              W.workspaces ws
+
+          (newCur:newVisible) = newScreens
+        in
+          W.StackSet newCur newVisible newHiddenWorkspaces float
-- 
cgit