path: root/src/Rahm/Desktop/Keys.hs

module Rahm.Desktop.Keys (applyKeys) where

import Control.Monad.Trans.Maybe
import Control.Applicative
import Control.Monad
import Control.Monad.Fix (fix)
import Control.Monad.Loops (iterateWhile)
import Control.Monad.Reader
import Control.Monad.Trans.Class
import Control.Monad.Writer
import Data.Char
import Data.List hiding ((!!))
import Data.List.Safe ((!!))
import Data.Map (Map)
import Data.Maybe (isJust, fromMaybe, mapMaybe)
import Data.Monoid (Endo(..))
import Debug.Trace
import Graphics.X11.ExtraTypes.XF86;
import Graphics.X11.ExtraTypes.XorgDefault
import Prelude hiding ((!!))
import System.IO
import System.Process
import Text.Printf
import XMonad
import XMonad.Actions.CopyWindow as CopyWindow
import XMonad.Actions.RotSlaves
import XMonad.Actions.SpawnOn as SpawnOn
import XMonad.Actions.WindowNavigation
import XMonad.Hooks.ManageDocks
import XMonad.Layout.MosaicAlt
import XMonad.Layout.Spacing
import XMonad.Prompt
import XMonad.Prompt.Input
import XMonad.Prompt.Shell
import XMonad.Util.XUtils
import XMonad.Util.CustomKeys
import XMonad.Util.Run (safeSpawn)
import XMonad.Util.Scratchpad
import XMonad.Util.Ungrab

import qualified Data.Map as Map
import qualified XMonad.StackSet as W

import Rahm.Desktop.DMenu
import Rahm.Desktop.Keys.Dsl
import Rahm.Desktop.Layout
import Rahm.Desktop.Layout.ConsistentMosaic
import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically)
import Rahm.Desktop.Layout.Hole (toggleHole)
import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout, toIndexedLayout)
import Rahm.Desktop.Layout.Pop (togglePop)
import Rahm.Desktop.Layout.Rotate (rotateLayout)
import Rahm.Desktop.Common
import Rahm.Desktop.Logger
import Rahm.Desktop.Marking
import Rahm.Desktop.Keys.Wml
import Rahm.Desktop.MouseMotion
import Rahm.Desktop.PassMenu
import Rahm.Desktop.PromptConfig
import Rahm.Desktop.RebindKeys
import Rahm.Desktop.ScreenRotate (screenRotateForward, screenRotateBackward)
import Rahm.Desktop.Submap
import Rahm.Desktop.Swallow
import Rahm.Desktop.SwapMaster (swapMaster)
import Rahm.Desktop.Windows
import Rahm.Desktop.Workspaces
import Rahm.Desktop.History

type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())


spawnX :: String -> X ()
spawnX = spawn

safeSpawnX :: String -> [String] -> X ()
safeSpawnX = safeSpawn

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 = Map.mapWithKey bindingToX (bindings config)

  where
    bindingToX :: (KeyMask, KeySym) -> Documented KeyBinding -> X ()
    bindingToX key b =
      case b of
        Documented _ (Action x) -> x
        Documented _ (Submap mapping) ->
          submap (Map.mapWithKey bindingToX mapping)
        Documented _ (Repeat mapping) -> do
          mapM_ (bindingToX key) (Map.lookup key mapping)
          fix $ \recur ->
            submap (Map.mapWithKey (\k b -> bindingToX k 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)

  forM_ [xK_apostrophe, xK_w] $ \k -> bind k $ do
    justMod $
      doc "Jumps between marks." $
      runMaybeT_ $ do
        l <- readNextLocationSet
        case l of
          (h:_) -> lift (focusLocation h)
          _ -> return ()

  bind xK_BackSpace $ do
    -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
    -- 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 Info "Try send to %s" (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 Info "%s" (documentation (keymap config)) :: X ())

  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 Info "Test altgr" :: X ())

  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 flipVertically
    shiftMod $
      doc "Flip the current layout horizontally" $
      sendMessage flipHorizontally

  bind xK_g $ do

    justMod $
      doc "Goto/Send/Etc To a workspace\n\n\t\

      \Workspaces are alphanumeric characters. So if the next key typed is an\n\t\
      \alphanumeric character, that's the workspace to operate on\n\n\

      \\tThe following special characters can also reference workspaces:\n\t\t\
         \]: The next workspace, skipping those already visible.\n\t\t\
         \[: The previous workspace, skipping those already visible.\n\t\t\
         \): The next workspace.\n\t\t\
         \(: The previous workspace.\n\t\t\
         \}: The workspace on the screen to the right\n\t\t\
         \{: The workspace on the screen to the left\n\t\t\
         \<space>: The accompaningWorkspace (toggled case)\n\t\t\
         \/: Prompt to select a window, and reference that workspace\n\t\t\
         \^: The first populated workspace\n\t\t\
         \$: The last populated workspace\n\t\t\
         \*: The hidden workspace.\n\t\t\
         \_: Black hole. Sending a window here closes it.\n\n\t\
      \Other keybindings starting with H-g\n\t\t\
         \F1: display this help.\n\n\t" $
      runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace

    shiftMod $
      doc "Move the currently focused window to another workspace" $
      runMaybeT_ $ do
        ws <- readNextWorkspace
        loc <- lift getCurrentLocation
        lift $ moveLocationToWorkspaceFn ws loc

    controlMod $
      doc "Move the current focused window to another workspace and view that workspace" $
      runMaybeT_ $ do
        ws <- readNextWorkspace
        loc <- lift getCurrentLocation
        lift $ do
          moveLocationToWorkspaceFn ws loc
          gotoWorkspaceFn ws

  bind xK_d $
    justMod $
    doc "Record (define) macros." $
      subkeys $ do
      bind xK_w $ noMod $
        doc "Record a windowset macro" $
        runMaybeT_ readWindowsetMacro

      bind xK_t $ noMod $
        doc "Record a workspace macro" $
        runMaybeT_ readWorkspaceMacro

  bind xK_h $ do
    justMod $
      doc "Focus on the next window down in the stack" $
      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 master region" $
      sendMessage Shrink

    shiftMod $
      doc "Go to the previous window in history." historyBack

  bind xK_k $ do
    justMod $
      doc "Expand the size of the master region" $
      sendMessage Expand

    shiftMod $
      doc "Go to the next window in history." historyForward

  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" $
      sendMessage =<< shrinkPositionAlt

  bind xK_m $
    justMod $
      doc "Mark the current window with the next typed character." $ do
      locs <- fromMaybe [] <$> runMaybeT readNextLocationSet
      withBorderColor "#00ffff" (mapMaybe locationWindow locs) $ do
        runMaybeT_ $ do
         mapNextString $ \_ str -> lift $
          case str of
            [ch] | isAlpha ch -> markAllLocations str locs
            _ -> return ()

  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." $
      sendMessage =<< expandPositionAlt

  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 Info "CW") (logs Info "CCW")

  bind xK_r $ do
    justMod $ doc "Run a command via Rofi" runDMenu
    shiftMod $
      doc "Rotate the current layout. (flips x, y coordinates)" $
      sendMessage rotateLayout

  bind xK_s $ do
    justMod $ do
      locations <- fromMaybe [] <$> runMaybeT readNextLocationSet
      let locationWindows = mapMaybe locationWindow locations

      withBorderColor "#00ffff" locationWindows $ do
        runMaybeT_ $ do
          workspace <- readNextWorkspace
          mapM_ (lift . moveLocationToWorkspaceFn workspace) locations

          lift $ setAlternateWindows locationWindows
          forM_ locations $ \loc ->
            case locationWindow loc of
              Nothing -> return ()
              Just win -> do
                lift $ setAlternateWorkspace win (locationWorkspace loc)

    altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"

  bind xK_space $ do
    justMod $ doc "Layout-related bindings" $ subkeys $ do

      bind xK_n $
        (noMod -|- justMod) $ doc "Use the next layout in the layout list." $
          sendMessage toNextLayout

      bind xK_p $
        (noMod -|- justMod) $ doc "Use the previous layout in the layout list." $
          sendMessage toPreviousLayout

      bind xK_b $
        (noMod -|- justMod) $ doc "Go back to the first layout in the layout list." $
          sendMessage toFirstLayout

      bind xK_h $
        (noMod -|- justMod) $ doc "Flip the layout across the horizontal axis" $
          sendMessage flipVertically

      bind xK_v $
        (noMod -|- justMod) $ doc "Flip the layout across the vertical axis" $
          sendMessage flipHorizontally

      bind xK_r $
        (noMod -|- justMod) $ doc "Rotate the layout 90 degrees" $
          sendMessage rotateLayout

      bind xK_c $
        (noMod -|- justMod) $ doc "Toggle the pop window" $
          sendMessage togglePop

      bind xK_t $
        (noMod -|- justMod) $ doc "Jump to the middle layout." $
          sendMessage (toIndexedLayout (nLayouts `div` 2))

      bind xK_x $
        (noMod -|- justMod) $ doc "Toggle the hole" $
          sendMessage toggleHole

      let spaceResize = repeatable $ do
            bind xK_bracketright $ do
              noMod $
                doc "Increase the gaps between windows." $
                sendMessage $ modifyWindowBorder 5

            bind xK_bracketleft $ do
              noMod $
                doc "Decrease the gaps between windows." $
                sendMessage $ modifyWindowBorder (-5)

      bind xK_bracketleft $ noMod spaceResize
      bind xK_bracketright $ noMod spaceResize

  bind xK_t $ do
    justMod  $
      doc "Spawn a terminal." $ spawnX (terminal config)

    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_x $ do
    justMod $
      doc "Toggles respect for struts." $
      sendMessage ToggleStruts

  bind xK_z $ do

    justMod $
      doc "Less often used keybindings." $
      subkeys $ do

        bind xK_p $ do
          (justMod -|- noMod) $
            doc "Go to the prior window in the history" historyBack

        bind xK_t $ do
          (justMod -|- noMod) $ (logs Info "Test Log" :: X ())

        -- 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" historyForward

        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"

        let navigateHistory = repeatable $ do
              bind xK_bracketright $ do
                noMod $
                  doc "Move forward in location history" historyForward

              bind xK_bracketleft $ do
                noMod $
                  doc "Move backward in location history" historyBack

        bind xK_bracketleft $ noMod $
          doc "Move forward in location history" navigateHistory
        bind xK_bracketright $ noMod $
          doc "Move backward in location history" navigateHistory

        -- Double-tap Z to toggle zoom.
        bind xK_z $ do
          noMod -|- justMod $
            doc "Toggle zoom on the current window." $
            sendMessage togglePop

        -- 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 togglePop

  bind xK_F8 $ do
    justMod $ do
      ll <- getLogLevel
      let next = if minBound == ll then maxBound else pred ll

      safeSpawnX "notify-send"
        ["-t", "2000", printf "LogLevel set to %s" (show next)]
      setLogLevel next
      logs next "LogLevel set to %s." (show next)
      

  bind xF86XK_Calculator $ do
    noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"

  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 (viewAdjacent prev)

  bind button7 $
    justMod $
      noWindow (viewAdjacent next)

  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 togglePop

      bind button15 $ do
        noMod $ noWindow $ spawnX "pavucontrol"

      let mediaButtons = [
            (button4, increaseVolume),
            (button5, decreaseVolume),
            (button2, playPause),
            (button9, historyForward),
            (button8, historyBack),
            (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

    let swapButtons = [
          (button6, windows W.swapDown),
          (button7, windows W.swapUp)
          ]

    forM_ (map fst swapButtons) $ \b ->
      bind b $ noMod $ \w -> click >> continuous swapButtons b w

    bind button13 $ noMod $ subMouse $ do
      bind button13 $ noMod $ subMouse $ do
        bind button13 $ noMod $ noWindow $ spawnX "xsecurelock"
        bind button1 $ noMod $ noWindow $
          spawnX "sudo -A systemctl suspend && xsecurelock"

  bind button15 $ do

    noMod $ subMouse $ do
      bind button13 $
        noMod $
          noWindow $
            gotoWorkspace . accompaningWorkspace =<< getCurrentWorkspace

      bind button15 $ do
        noMod $ noWindow jumpToLastLocation


      let workspaceButtons = [
            (button2, swapMaster),

            (button9, viewAdjacent next),
            (button8, viewAdjacent prev),

            (button4, windows W.focusUp),
            (button5, windows W.focusDown),

            (button7, windows screenRotateForward),
            (button6, windows screenRotateBackward)
            ]

      forM_ (map fst workspaceButtons) $ \b ->
        bind b $ noMod $ continuous workspaceButtons b

-- 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_Tab)

    bind xK_Escape $
      rawMask controlMask $ emitKey (controlMask, xK_w)

    bind xK_i $ do
      rawMask controlMask $ emitKey (controlMask .|. shiftMask, xK_Tab)

    bind xK_F2 $
      -- Experimental.
      noMod $ (logs Info "This is a test" :: X ())

  -- 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 Info "For Window: %s" (show w)
      forM_ (Map.toList map) $ \(key, action) -> do
        liftX $ logs Info "   -- 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