Rename Internal to Rahm.Desktop

22 files changed, 3226 insertions, 0 deletions

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)