Merge pull request #935 from xmonad/haskell-ci-update

ci: Regenerate haskell-ci
ci/nix: Drop weird magic URLs
2025-05-19 03:20:21 -07:00 · 2025-05-12 18:28:30 +02:00 · 2025-05-12 17:21:36 +01:00 · 2025-05-12 17:17:26 +01:00 · 2025-05-10 03:30:43 +00:00 · 2025-05-10 03:30:43 +00:00
54 changed files with 3215 additions and 571 deletions
--- a/.github/workflows/haskell-ci-hackage.patch
+++ b/.github/workflows/haskell-ci-hackage.patch
@ -38,13 +38,13 @@ set in GitHub repository secrets.
   linux:
     name: Haskell-CI - Linux - ${{ matrix.compiler }}
@@ -33,6 +40,7 @@
-             compilerVersion: 9.8.1
+             compilerVersion: 9.8.4
             setup-method: ghcup
             allow-failure: false
 +            upload: true
-           - compiler: ghc-9.6.4
+           - compiler: ghc-9.6.7
             compilerKind: ghc
-             compilerVersion: 9.6.4
+             compilerVersion: 9.6.7
@@ -257,6 +265,10 @@
       - name: haddock
         run: |
@ -56,19 +56,24 @@ set in GitHub repository secrets.
       - name: unconstrained build
         run: |
           rm -f cabal.project.local
-@@ -267,3 +279,75 @@
+@@ -267,3 +279,80 @@
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
           path: ~/.cabal/store
-+      - name: upload artifacts (sdist)
+      # must be separate artifacts because GitHub Actions are still broken:
 +      # https://github.com/actions/upload-artifact/issues/441
 +      # https://github.com/actions/upload-artifact/issues/457
 +      - name: upload artifact (sdist)
 +        if: matrix.upload
-+        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
 +        with:
 +          name: sdist
 +          path: ${{ github.workspace }}/sdist/*.tar.gz
-+      - name: upload artifacts (haddock)
+      - name: upload artifact (haddock)
 +        if: matrix.upload
-+        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
 +        with:
 +          name: haddock
 +          path: ${{ github.workspace }}/haddock/*-docs.tar.gz
 +      - name: hackage upload (candidate)
 +        if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''
--- a/.github/workflows/haskell-ci.yml
+++ b/.github/workflows/haskell-ci.yml
@ -8,9 +8,9 @@
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.17.20240109
+# version: 0.19.20250506
 #
-# REGENDATA ("0.17.20240109",["github","cabal.project"])
+# REGENDATA ("0.19.20250506",["github","cabal.project"])
 #
 name: Haskell-CI
 on:
@ -26,24 +26,34 @@ on:
 jobs:
  linux:
    name: Haskell-CI - Linux - ${{ matrix.compiler }}
-    runs-on: ubuntu-20.04
+    runs-on: ubuntu-24.04
    timeout-minutes:
      60
    container:
-      image: buildpack-deps:bionic
+      image: buildpack-deps:jammy
    continue-on-error: ${{ matrix.allow-failure }}
    strategy:
      matrix:
        include:
-          - compiler: ghc-9.8.1
+          - compiler: ghc-9.12.2
            compilerKind: ghc
-            compilerVersion: 9.8.1
+            compilerVersion: 9.12.2
            setup-method: ghcup
            allow-failure: false
          - compiler: ghc-9.10.2
            compilerKind: ghc
            compilerVersion: 9.10.2
            setup-method: ghcup
            allow-failure: false
          - compiler: ghc-9.8.4
            compilerKind: ghc
            compilerVersion: 9.8.4
            setup-method: ghcup
            allow-failure: false
            upload: true
-          - compiler: ghc-9.6.4
+          - compiler: ghc-9.6.7
            compilerKind: ghc
-            compilerVersion: 9.6.4
+            compilerVersion: 9.6.7
            setup-method: ghcup
            allow-failure: false
          - compiler: ghc-9.4.8
@ -69,36 +79,34 @@ jobs:
          - compiler: ghc-8.8.4
            compilerKind: ghc
            compilerVersion: 8.8.4
-            setup-method: hvr-ppa
+            setup-method: ghcup
            allow-failure: false
          - compiler: ghc-8.6.5
            compilerKind: ghc
            compilerVersion: 8.6.5
            setup-method: hvr-ppa
            allow-failure: false
      fail-fast: false
    steps:
-      - name: apt
+      - name: apt-get install
        run: |
          apt-get update
          apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
-          if [ "${{ matrix.setup-method }}" = ghcup ]; then
+          apt-get install -y libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
-            mkdir -p "$HOME/.ghcup/bin"
+      - name: Install GHCup
-            curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
+        run: |
-            chmod a+x "$HOME/.ghcup/bin/ghcup"
+          mkdir -p "$HOME/.ghcup/bin"
-            "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
+          curl -sL https://downloads.haskell.org/ghcup/0.1.50.1/x86_64-linux-ghcup-0.1.50.1 > "$HOME/.ghcup/bin/ghcup"
-            "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
+          chmod a+x "$HOME/.ghcup/bin/ghcup"
-            apt-get update
+      - name: Install cabal-install
-            apt-get install -y libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
+        run: |
-          else
+          "$HOME/.ghcup/bin/ghcup" install cabal 3.14.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
-            apt-add-repository -y 'ppa:hvr/ghc'
+          echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
-            apt-get update
+      - name: Install GHC (GHCup)
-            apt-get install -y "$HCNAME" libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
+        if: matrix.setup-method == 'ghcup'
-            mkdir -p "$HOME/.ghcup/bin"
+        run: |
-            curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
+          "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
-            chmod a+x "$HOME/.ghcup/bin/ghcup"
+          HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
-            "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
+          HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
-          fi
+          HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
          echo "HC=$HC" >> "$GITHUB_ENV"
          echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
          echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
        env:
          HCKIND: ${{ matrix.compilerKind }}
          HCNAME: ${{ matrix.compiler }}
@ -109,30 +117,12 @@ jobs:
          echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
          echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
          echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
          HCDIR=/opt/$HCKIND/$HCVER
          if [ "${{ matrix.setup-method }}" = ghcup ]; then
            HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
            HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
            HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
            echo "HC=$HC" >> "$GITHUB_ENV"
            echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
            echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
            echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
          else
            HC=$HCDIR/bin/$HCKIND
            echo "HC=$HC" >> "$GITHUB_ENV"
            echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
            echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
            echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
          fi
          HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
          echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
          echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
          echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
          echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
          echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
          echo "GHCJSARITH=0" >> "$GITHUB_ENV"
        env:
          HCKIND: ${{ matrix.compilerKind }}
          HCNAME: ${{ matrix.compiler }}
@ -182,7 +172,7 @@ jobs:
          chmod a+x $HOME/.cabal/bin/cabal-plan
          cabal-plan --version
      - name: checkout
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
        with:
          path: source
      - name: initial cabal.project for sdist
@ -220,7 +210,7 @@ jobs:
            flags:       +pedantic
            ghc-options: -j
          EOF
-          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(xmonad-contrib)$/; }' >> cabal.project.local
+          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(xmonad-contrib)$/; }' >> cabal.project.local
          cat cabal.project
          cat cabal.project.local
      - name: dump install plan
@ -228,7 +218,7 @@ jobs:
          $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
          cabal-plan
      - name: restore cache
-        uses: actions/cache/restore@v3
+        uses: actions/cache/restore@v4
        with:
          key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
          path: ~/.cabal/store
@ -262,20 +252,25 @@ jobs:
          rm -f cabal.project.local
          $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
      - name: save cache
        uses: actions/cache/save@v3
        if: always()
        uses: actions/cache/save@v4
        with:
          key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
          path: ~/.cabal/store
-      - name: upload artifacts (sdist)
+      # must be separate artifacts because GitHub Actions are still broken:
      # https://github.com/actions/upload-artifact/issues/441
      # https://github.com/actions/upload-artifact/issues/457
      - name: upload artifact (sdist)
        if: matrix.upload
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
        with:
          name: sdist
          path: ${{ github.workspace }}/sdist/*.tar.gz
-      - name: upload artifacts (haddock)
+      - name: upload artifact (haddock)
        if: matrix.upload
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
        with:
          name: haddock
          path: ${{ github.workspace }}/haddock/*-docs.tar.gz
      - name: hackage upload (candidate)
        if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''
--- a/.github/workflows/nix.yml
+++ b/.github/workflows/nix.yml
@ -6,23 +6,21 @@ on:
 jobs:
  build:
-    runs-on: ubuntu-20.04  # FIXME
+    runs-on: ubuntu-latest
    name: Nix Flake - Linux
    permissions:
      contents: read
    steps:
      - name: Install Nix
-        uses: cachix/install-nix-action@v25
+        uses: cachix/install-nix-action@v31
        with:
-          install_url: https://nixos-nix-install-tests.cachix.org/serve/i6laym9jw3wg9mw6ncyrk6gjx4l34vvx/install
+          github_access_token: ${{ secrets.GITHUB_TOKEN }}
          install_options: '--tarball-url-prefix https://nixos-nix-install-tests.cachix.org/serve'
          extra_nix_config: |
            experimental-features = nix-command flakes
            access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
      - name: Clone project
        uses: actions/checkout@v4
      - name: Build
        # "nix build" builds with full optimization and includes a profiling
        # build, so just the build of xmonad-contrib itself takes 3 minutes.
        # As a workaround, we invoke cabal manually here.
-        run: nix develop -c cabal v2-build -O0 -j
+        run: |
          nix develop -c cabal v2-update -O0 -j
          nix develop -c cabal v2-build -O0 -j
--- a/.github/workflows/packdeps.yml
+++ b/.github/workflows/packdeps.yml
@ -42,10 +42,9 @@ jobs:
            *.cabal
  workflow-keepalive:
    if: github.event_name == 'schedule'
    runs-on: ubuntu-latest
    permissions:
      actions: write
    steps:
-      - name: Re-enable workflow
+      - uses: liskin/gh-workflow-keepalive@v1
        env:
          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
        run: |
          gh api -X PUT repos/${{ github.repository }}/actions/workflows/packdeps.yml/enable
--- a/.github/workflows/stack.yml
+++ b/.github/workflows/stack.yml
@ -12,10 +12,8 @@ jobs:
      fail-fast: false
      matrix:
        include:
-          - resolver: lts-14  # GHC 8.6
+          - resolver: lts-16  # GHC 8.8
            yaml: stack.yaml
          - resolver: lts-14  # GHC 8.6
            yaml: stack-master.yaml
          - resolver: lts-16  # GHC 8.8
            yaml: stack-master.yaml
          - resolver: lts-18  # GHC 8.10
@ -25,8 +23,12 @@ jobs:
          - resolver: lts-20  # GHC 9.2
            yaml: stack-master.yaml
          - resolver: lts-21  # GHC 9.4
            yaml: stack-master.yaml
          - resolver: lts-22  # GHC 9.6
            yaml: stack-master.yaml
          - resolver: lts-23  # GHC 9.8
            yaml: stack.yaml
-          - resolver: lts-21  # GHC 9.4
+          - resolver: lts-23  # GHC 9.8
            yaml: stack-master.yaml
    steps:
--- a/.mailmap
+++ b/.mailmap
@ -103,6 +103,7 @@ hexago.nl <xmonad-contrib@hexago.nl>
 lithis <xmonad@selg.hethrael.org>
 lithis <xmonad@selg.hethrael.org> <xmonad@s001.hethrael.com>
 sam-barr <mail@samf.bar> <samfbarr@outlook.com>
-slotThe <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
+Tony Zorman <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
-slotThe <soliditsallgood@mailbox.org> <soliditsallgood@tuta.io>
+Tony Zorman <soliditsallgood@mailbox.org> <soliditsallgood@tuta.io>
 Tony Zorman <soliditsallgood@mailbox.org>
 spoonm <spoonm@spoonm.org>
--- a/CHANGES.md
+++ b/CHANGES.md
@ -1,5 +1,165 @@
 # Change Log / Release Notes
 ## _unreleased_
 ### Breaking Changes
  * Drop support for GHC 8.6
 ### Bug Fixes and Minor Changes
  * `XMonad.Util.EZConfig`
    - Added `XF86WLAN` and `Menu` to the list of supported special keys.
  * `XMonad.Actions.DynamicProjects`
    - No longer autodelete projects when `switchProject` is called from
      an empty workspace. This also fixes a bug where static workspaces
      would be deleted when switching to a dynamic project.
    - Improved documentation on how to close a project.
  * `XMonad.Hooks.Rescreen`
    - Allow overriding the `rescreen` operation itself. Additionally, the
      `XMonad.Actions.PhysicalScreens` module now provides an alternative
      implementation of `rescreen` that avoids reshuffling the workspaces if
      the number of screens doesn't change and only their locations do (which
      is especially common if one uses `xrandr --setmonitor` to split an
      ultra-wide display in two).
    - Added an optional delay when waiting for events to settle. This may be
      used to avoid flicker and unnecessary workspace reshuffling if multiple
      `xrandr` commands are used to reconfigure the display layout.
  * `XMonad.Layout.NoBorders`
    - It's no longer necessary to use `borderEventHook` to garbage collect
      `alwaysHidden`/`neverHidden` lists. The layout listens to
      `DestroyWindowEvent` messages instead, which are broadcast to layouts
      since xmonad v0.17.0.
  * `XMonad.Hooks.EwmhDesktops`
    - Added a customization option for the action that gets executed when
      a client sends a **_NET_CURRENT_DESKTOP** request. It is now possible
      to change it using the `setEwmhSwitchDesktopHook`.
    - Added a customization option for mapping hidden workspaces to screens
      when setting the **_NET_DESKTOP_VIEWPORT**. This can be done using
      the `setEwmhHiddenWorkspaceToScreenMapping`.
  * `XMonad.Layout.IndependentScreens`
    - Added `focusWorkspace` for focusing workspaces on the screen that they
      belong to.
    - Added `doFocus'` hook as an alternative for `doFocus` when using
      IndependentScreens.
    - Added `screenOnMonitor` for getting the active screen for a monitor.
  * `XMonad.Util.NamedScratchPad`
    - Fix unintended window hiding in `nsSingleScratchpadPerWorkspace`.
      Only hide the previously active scratchpad.
 ## 0.18.1 (August 20, 2024)
 ### Breaking Changes
  * `XMonad.Hooks.StatusBars`
    - Move status bar functions from the `IO` to the `X` monad to
      allow them to look up information from `X`, like the screen
      width. Existing configurations may need to use `io` from
      `XMonad.Core` or `liftIO` from `Control.Monad.IO.Class` in
      order to lift any existing `IO StatusBarConfig` values into
      `X StatusBarConfig` values.
  * `XMonad.Prompt`
    - Added an additional `XPConfig` argument to `historyCompletion` and
      `historyCompletionP`. Calls along the lines of `historyCompletionP
      myFunc` should be changed to `historyCompletionP myConf myFunc`.
      If not `myConf` is lying around, `def` can be used instead.
  * `XMonad.Actions.GridSelect`
    - Added the `gs_cancelOnEmptyClick` field to `GSConfig`, which makes
      mouse clicks into "empty space" cancel the current grid-select.
      Users explicitly defining their own `GSConfig` record will have to
      add this to their definitions. Additionally, the field defaults to
      `True`—to retain the old behaviour, set it to `False`.
 ### New Modules
  * `XMonad.Actions.Profiles`
    - Group workspaces by similarity. Useful when one has lots
      of workspaces and uses only a couple per unit of work.
  * `XMonad.Hooks.FloatConfigureReq`
    - Customize handling of floating windows' move/resize/restack requests
      (ConfigureRequest). Useful as a workaround for some misbehaving client
      applications (Steam, rxvt-unicode, anything that tries to restore
      absolute position of floats).
  * `XMonad.Layout.Columns`
    - Organize windows in columns. This layout allows to move/resize windows in
      every directions.
  * `XMonad.Prompt.WindowBringer`
    - Added `copyMenu`, a convenient way to copy a window to the current workspace.
 ### Bug Fixes and Minor Changes
  * Fix build-with-cabal.sh when XDG_CONFIG_HOME is defined.
  * `XMonad.Util.EZConfig`
    - Fixed `checkKeymap` warning that all keybindings are duplicates.
  * `XMonad.Hooks.ManageHelpers`
    - Added `isNotification` predicate to check for windows with
      `_NET_WM_WINDOW_TYPE` property of `_NET_WM_WINDOW_TYPE_NOTIFICATION`.
  * `XMonad.Prompt.OrgMode`
    - Added `HH:MM-HH:MM` and `HH:MM+HH` syntax to specify time spans.
  * `XMonad.Prompt`
    - The history file is not extraneously read and written anymore if
      the `historySize` is set to 0.
  * `XMonad.Hooks.EwmhDesktops`
    - Requests for unmanaged windows no longer cause a refresh. This avoids
      flicker and also fixes disappearing menus in the Steam client and
      possibly a few other client applications.
      (See also `XMonad.Hooks.FloatConfigureReq` and/or `XMonad.Util.Hacks`
      for additional Steam client workarounds.)
  * `XMonad.Actions.Submap`
    - Added `visualSubmapSorted` to enable sorting of the keymap
      descriptions.
  * `XMonad.Hooks.ScreenCorners`
    - Added screen edge support with `SCTop`, `SCBottom`, `SCLeft` and
      `SCRight`. Now both corners and edges are supported.
  * `XMonad.Actions.WindowNavigation`
    - Improve navigation in presence of floating windows.
    - Handle window switching when in `Full` layout.
 ### Other changes
 ## 0.18.0 (February 3, 2024)
 ### Breaking Changes
@ -307,8 +467,6 @@
    - Added `zipperFocusedAtFirstOf` to differentiate two lists into a
      zipper.
 ### Other changes
 ## 0.17.1 (September 3, 2022)
 ### Breaking Changes
@ -322,7 +480,8 @@
  * `XMonad.Config.{Arossato,Dmwit,Droundy,Monad,Prime,Saegesser,Sjanssen}`
    - Deprecated all of these modules.  The user-specific configuration
-      modules may still be found [on the website].
+      modules may still be found [on the
      website](https://xmonad.org/configurations.html)
  * `XMonad.Util.NamedScratchpad`
@ -343,8 +502,6 @@
    - Deprecated `urgencyConfig`; use `def` from the new `Default`
      instance of `UrgencyConfig` instead.
 [on the website]: https://xmonad.org/configurations.html
 ### New Modules
  * `XMonad.Actions.PerLayoutKeys`
@ -419,7 +576,8 @@
      `todo +d 12 02 2024` work.
    - Added the ability to specify alphabetic (`#A`, `#B`, and `#C`)
-      [priorities] at the end of the input note.
+      [priorities](https://orgmode.org/manual/Priorities.html) at the end of
      the input note.
  * `XMonad.Prompt.Unicode`
@ -513,7 +671,8 @@
    - Modified `mkAbsolutePath` to support a leading environment variable, so
      things like `$HOME/NOTES` work. If you want more general environment
-      variable support, comment on [this PR].
+      variable support, comment on [this
      PR](https://github.com/xmonad/xmonad-contrib/pull/744)
  * `XMonad.Util.XUtils`
@ -552,9 +711,6 @@
    - Added a `Default` instance for `UrgencyConfig` and `DzenUrgencyHook`.
 [this PR]: https://github.com/xmonad/xmonad-contrib/pull/744
 [priorities]: https://orgmode.org/manual/Priorities.html
 ### Other changes
  * Migrated the sample build scripts from the deprecated `xmonad-testing` repo to
@ -2080,8 +2236,8 @@
  * `XMonad.Prompt.Pass`
-    This module provides 3 `XMonad.Prompt`s to ease passwords
+    This module provides 3 `XMonad.Prompt`s to ease passwords manipulation
-    manipulation (generate, read, remove) via [pass][].
+    (generate, read, remove) via [pass](http://www.passwordstore.org/).
  * `XMonad.Util.RemoteWindows`
@ -2157,5 +2313,3 @@
 ## See Also
 <https://wiki.haskell.org/Xmonad/Notable_changes_since_0.8>
 [pass]: http://www.passwordstore.org/
--- a/XMonad/Actions/DynamicProjects.hs
+++ b/XMonad/Actions/DynamicProjects.hs
@ -69,7 +69,9 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- the working directory to the one configured for the matching
 -- project.  If the workspace doesn't have any windows, the project's
 -- start-up hook is executed.  This allows you to launch applications
-- or further configure the workspace/project.
+-- or further configure the workspace/project. To close a project,
 -- you can use the functions provided by "XMonad.Actions.DynamicWorkspaces",
 -- such as @removeWorkspace@ or @removeWorkspaceByTag@.
 --
 -- When using the @switchProjectPrompt@ function, workspaces are
 -- created as needed.  This means you can create new project spaces
@ -230,7 +232,9 @@ lookupProject name = Map.lookup name <$> XS.gets projects
 --------------------------------------------------------------------------------
 -- | Fetch the current project (the one being used for the currently
-- active workspace).
+-- active workspace). If the workspace doesn't have a project, a
 -- default project is returned, using the workspace name as the
 -- project name.
 currentProject :: X Project
 currentProject = do
  name <- gets (W.tag . W.workspace . W.current . windowset)
@ -255,20 +259,7 @@ modifyProject f = do
 --------------------------------------------------------------------------------
 -- | Switch to the given project.
 switchProject :: Project -> X ()
-switchProject p = do
+switchProject p = appendWorkspace (projectName p)
  oldws <- gets (W.workspace . W.current . windowset)
  oldp <- currentProject
  let name = W.tag oldws
      ws   = W.integrate' (W.stack oldws)
  -- If the project we are switching away from has no windows, and
  -- it's a dynamic project, remove it from the configuration.
  when (null ws && isNothing (projectStartHook oldp)) $ do
    removeWorkspaceByTag name -- also remove the old workspace
    XS.modify (\s -> s {projects = Map.delete name $ projects s})
  appendWorkspace (projectName p)
 --------------------------------------------------------------------------------
 -- | Prompt for a project name and then switch to it.  Automatically
--- a/XMonad/Actions/GridSelect.hs
+++ b/XMonad/Actions/GridSelect.hs
@ -203,10 +203,13 @@ data GSConfig a = GSConfig {
      gs_colorizer :: a -> Bool -> X (String, String),
      gs_font :: String,
      gs_navigate :: TwoD a (Maybe a),
      -- ^ Customize key bindings for a GridSelect
      gs_rearranger :: Rearranger a,
      gs_originFractX :: Double,
      gs_originFractY :: Double,
-      gs_bordercolor :: String
+      gs_bordercolor :: String,
      gs_cancelOnEmptyClick :: Bool
      -- ^ When True, click on empty space will cancel GridSelect
 }
 -- | That is 'fromClassName' if you are selecting a 'Window', or
@ -386,13 +389,20 @@ updateElementsWithColorizer colorizer elementmap = do
 stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
 stdHandle ButtonEvent{ ev_event_type = t, ev_x = x, ev_y = y } contEventloop
    | t == buttonRelease = do
-        s@TwoDState { td_paneX = px, td_paneY = py,
+        s@TwoDState{ td_paneX = px
-                         td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get
+                   , td_paneY = py
                   , td_gsconfig = GSConfig{ gs_cellheight = ch
                                           , gs_cellwidth = cw
                                           , gs_cancelOnEmptyClick = cancelOnEmptyClick
                                           }
                   } <- get
        let gridX = (fi x - (px - cw) `div` 2) `div` cw
            gridY = (fi y - (py - ch) `div` 2) `div` ch
        case lookup (gridX,gridY) (td_elementmap s) of
             Just (_,el) -> return (Just el)
-             Nothing -> contEventloop
+             Nothing     -> if cancelOnEmptyClick
                            then return Nothing
                            else contEventloop
    | otherwise = contEventloop
 stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop
@ -648,7 +658,7 @@ gridselect gsconfig elements =
    liftIO $ mapWindow dpy win
    liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask)
    status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime
-    io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime
+    void $ io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime
    font <- initXMF (gs_font gsconfig)
    let screenWidth = toInteger $ rect_width scr
        screenHeight = toInteger $ rect_height scr
@ -706,7 +716,7 @@ decorateName' w = do
 -- | Builds a default gs config from a colorizer function.
 buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
-buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white"
+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white" True
 -- | Brings selected window to the current workspace.
 bringSelected :: GSConfig Window -> X ()
--- a/XMonad/Actions/OnScreen.hs
+++ b/XMonad/Actions/OnScreen.hs
@ -1,148 +1,181 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.OnScreen
 -- Description :  Control workspaces on different screens (in xinerama mode).
-- Copyright   :  (c) 2009 Nils Schweinsberg
+-- Copyright   :  (c) 2009-2025 Nils Schweinsberg
 -- License     :  BSD3-style (see LICENSE)
 --
-- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>
+-- Maintainer  :  Nils Schweinsberg <mail@nils.cc>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
 -- Control workspaces on different screens (in xinerama mode).
--
+module XMonad.Actions.OnScreen
-----------------------------------------------------------------------------
+  ( -- * Usage
 module XMonad.Actions.OnScreen (
    -- * Usage
    -- $usage
-      onScreen
+    onScreen,
-    , onScreen'
+    onScreen',
-    , Focus(..)
+    Focus (..),
-    , viewOnScreen
+    viewOnScreen,
-    , greedyViewOnScreen
+    greedyViewOnScreen,
-    , onlyOnScreen
+    onlyOnScreen,
-    , toggleOnScreen
+    toggleOnScreen,
-    , toggleGreedyOnScreen
+    toggleGreedyOnScreen,
-    ) where
+  )
 where
 import XMonad
-import XMonad.Prelude (fromMaybe, guard, empty)
+import XMonad.Prelude (empty, fromMaybe, guard)
 import XMonad.StackSet hiding (new)
 -- | Focus data definitions
-data Focus = FocusNew                       -- ^ always focus the new screen
+data Focus
-           | FocusCurrent                   -- ^ always keep the focus on the current screen
+  = -- | always focus the new screen
-           | FocusTag WorkspaceId           -- ^ always focus tag i on the new stack
+    FocusNew
-           | FocusTagVisible WorkspaceId    -- ^ focus tag i only if workspace with tag i is visible on the old stack
+  | -- | always keep the focus on the current screen
-
+    FocusCurrent
  | -- | always focus tag i on the new stack
    FocusTag WorkspaceId
  | -- | focus tag i only if workspace with tag i is visible on the old stack
    FocusTagVisible WorkspaceId
 -- | Run any function that modifies the stack on a given screen. This function
 -- will also need to know which Screen to focus after the function has been
 -- run.
-onScreen :: (WindowSet -> WindowSet) -- ^ function to run
+onScreen ::
-         -> Focus                    -- ^ what to do with the focus
+  -- | function to run
-         -> ScreenId                 -- ^ screen id
+  (WindowSet -> WindowSet) ->
-         -> WindowSet                -- ^ current stack
+  -- | what to do with the focus
-         -> WindowSet
+  Focus ->
  -- | screen id
  ScreenId ->
  -- | current stack
  WindowSet ->
  WindowSet
 onScreen f foc sc st = fromMaybe st $ do
-    ws <- lookupWorkspace sc st
+  ws <- lookupWorkspace sc st
-    let fStack      = f $ view ws st
+  let fStack = f $ view ws st
    return $ setFocus foc st fStack
  return $ setFocus foc st fStack
 -- set focus for new stack
-setFocus :: Focus
+setFocus ::
-         -> WindowSet -- ^ old stack
+  Focus ->
-         -> WindowSet -- ^ new stack
+  -- | old stack
-         -> WindowSet
+  WindowSet ->
-setFocus FocusNew _ new             = new
+  -- | new stack
-setFocus FocusCurrent old new        =
+  WindowSet ->
-    case lookupWorkspace (screen $ current old) new of
+  WindowSet
-         Nothing -> new
+setFocus FocusNew _ new = new
-         Just i -> view i new
+setFocus FocusCurrent old new =
-setFocus (FocusTag i) _ new         = view i new
+  case lookupWorkspace (screen $ current old) new of
    Nothing -> new
    Just i -> view i new
 setFocus (FocusTag i) _ new = view i new
 setFocus (FocusTagVisible i) old new =
-    if i `elem` map (tag . workspace) (visible old)
+  if i `elem` map (tag . workspace) (visible old)
-       then setFocus (FocusTag i) old new
+    then setFocus (FocusTag i) old new
-       else setFocus FocusCurrent old new
+    else setFocus FocusCurrent old new
 -- | A variation of @onScreen@ which will take any @X ()@ function and run it
 -- on the given screen.
 -- Warning: This function will change focus even if the function it's supposed
 -- to run doesn't succeed.
-onScreen' :: X ()       -- ^ X function to run
+onScreen' ::
-          -> Focus      -- ^ focus
+  -- | X function to run
-          -> ScreenId   -- ^ screen id
+  X () ->
-          -> X ()
+  -- | focus
  Focus ->
  -- | screen id
  ScreenId ->
  X ()
 onScreen' x foc sc = do
-    st <- gets windowset
+  st <- gets windowset
-    case lookupWorkspace sc st of
+  case lookupWorkspace sc st of
-         Nothing -> return ()
+    Nothing -> return ()
-         Just ws -> do
+    Just ws -> do
-             windows $ view ws
+      windows $ view ws
-             x
+      x
-             windows $ setFocus foc st
+      windows $ setFocus foc st
 -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to
 -- switch focus to the workspace @i@.
-viewOnScreen :: ScreenId    -- ^ screen id
+viewOnScreen ::
-             -> WorkspaceId -- ^ index of the workspace
+  -- | screen id
-             -> WindowSet   -- ^ current stack
+  ScreenId ->
-             -> WindowSet
+  -- | index of the workspace
  WorkspaceId ->
  -- | current stack
  WindowSet ->
  WindowSet
 viewOnScreen sid i =
-    onScreen (view i) (FocusTag i) sid
+  onScreen (view i) (FocusTag i) sid
 -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @greedyView@
 -- to switch the current workspace with workspace @i@.
-greedyViewOnScreen :: ScreenId    -- ^ screen id
+greedyViewOnScreen ::
-                   -> WorkspaceId -- ^ index of the workspace
+  -- | screen id
-                   -> WindowSet   -- ^ current stack
+  ScreenId ->
-                   -> WindowSet
+  -- | index of the workspace
  WorkspaceId ->
  -- | current stack
  WindowSet ->
  WindowSet
 greedyViewOnScreen sid i =
-    onScreen (greedyView i) (FocusTagVisible i) sid
+  onScreen (greedyView i) (FocusTagVisible i) sid
 -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing.
-onlyOnScreen :: ScreenId    -- ^ screen id
+onlyOnScreen ::
-             -> WorkspaceId -- ^ index of the workspace
+  -- | screen id
-             -> WindowSet   -- ^ current stack
+  ScreenId ->
-             -> WindowSet
+  -- | index of the workspace
  WorkspaceId ->
  -- | current stack
  WindowSet ->
  WindowSet
 onlyOnScreen sid i =
-    onScreen (view i) FocusCurrent sid
+  onScreen (view i) FocusCurrent sid
 -- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view
-toggleOnScreen :: ScreenId    -- ^ screen id
+toggleOnScreen ::
-               -> WorkspaceId -- ^ index of the workspace
+  -- | screen id
-               -> WindowSet   -- ^ current stack
+  ScreenId ->
-               -> WindowSet
+  -- | index of the workspace
  WorkspaceId ->
  -- | current stack
  WindowSet ->
  WindowSet
 toggleOnScreen sid i =
-    onScreen (toggleOrView' view i) FocusCurrent sid
+  onScreen (toggleOrView' view i) FocusCurrent sid
 -- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView
-toggleGreedyOnScreen :: ScreenId    -- ^ screen id
+toggleGreedyOnScreen ::
-                     -> WorkspaceId -- ^ index of the workspace
+  -- | screen id
-                     -> WindowSet   -- ^ current stack
+  ScreenId ->
-                     -> WindowSet
+  -- | index of the workspace
  WorkspaceId ->
  -- | current stack
  WindowSet ->
  WindowSet
 toggleGreedyOnScreen sid i =
-    onScreen (toggleOrView' greedyView i) FocusCurrent sid
+  onScreen (toggleOrView' greedyView i) FocusCurrent sid
 -- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip
-toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet)   -- ^ function to run
+toggleOrView' ::
-              -> WorkspaceId                               -- ^ tag to look for
+  -- | function to run
-              -> WindowSet                                 -- ^ current stackset
+  (WorkspaceId -> WindowSet -> WindowSet) ->
-              -> WindowSet
+  -- | tag to look for
  WorkspaceId ->
  -- | current stackset
  WindowSet ->
  WindowSet
 toggleOrView' f i st = fromMaybe (f i st) $ do
-    let st' = hidden st
+  let st' = hidden st
-    -- make sure we actually have to do something
+  -- make sure we actually have to do something
-    guard $ i == (tag . workspace $ current st)
+  guard $ i == (tag . workspace $ current st)
-    case st' of
+  case st' of
-      []      -> empty
+    [] -> empty
-      (h : _) -> return $ f (tag h) st  -- finally, toggle!
+    (h : _) -> return $ f (tag h) st -- finally, toggle!
 -- $usage
 --
--- a/XMonad/Actions/PhysicalScreens.hs
+++ b/XMonad/Actions/PhysicalScreens.hs
@ -1,4 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ParallelListComp #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.PhysicalScreens
@ -28,10 +30,13 @@ module XMonad.Actions.PhysicalScreens (
                                      , getScreenIdAndRectangle
                                      , screenComparatorById
                                      , screenComparatorByRectangle
                                      , rescreen
                                      ) where
-import XMonad
+import Data.List.NonEmpty (nonEmpty)
-import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy)
+import XMonad hiding (rescreen)
 import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy, NonEmpty((:|)))
 import qualified Data.List.NonEmpty as NE
 import qualified XMonad.StackSet as W
 {- $usage
@ -146,3 +151,53 @@ onNextNeighbour sc = neighbourWindows sc 1
 -- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
 onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
 onPrevNeighbour sc = neighbourWindows sc (-1)
 -- | An alternative to 'XMonad.Operations.rescreen' that avoids reshuffling
 -- the workspaces if the number of screens doesn't change and only their
 -- locations do. Useful for users of @xrandr --setmonitor@.
 --
 -- See 'XMonad.Hooks.Rescreen.setRescreenWorkspacesHook', which lets you
 -- replace the builtin rescreen handler.
 rescreen :: ScreenComparator -> X ()
 rescreen (ScreenComparator cmpScreen) = withDisplay (fmap nonEmpty . getCleanedScreenInfo) >>= \case
    Nothing -> trace "getCleanedScreenInfo returned []"
    Just xinescs -> windows $ rescreen' xinescs
  where
    rescreen' :: NonEmpty Rectangle -> WindowSet -> WindowSet
    rescreen' xinescs ws
      | NE.length xinescs == length (W.visible ws) + 1 = rescreenSameLength xinescs ws
      | otherwise = rescreenCore xinescs ws
    -- the 'XMonad.Operations.rescreen' implementation from core as a fallback
    rescreenCore :: NonEmpty Rectangle -> WindowSet -> WindowSet
    rescreenCore (xinesc :| xinescs) ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } =
        let (xs, ys) = splitAt (length xinescs) (map W.workspace vs ++ hs)
            a = W.Screen (W.workspace v) 0 (SD xinesc)
            as = zipWith3 W.Screen xs [1..] $ map SD xinescs
        in  ws{ W.current = a
              , W.visible = as
              , W.hidden  = ys }
    -- sort both existing screens and the screens we just got from xinerama
    -- using cmpScreen, and then replace the rectangles in the WindowSet,
    -- keeping the order of current/visible workspaces intact
    rescreenSameLength :: NonEmpty Rectangle -> WindowSet -> WindowSet
    rescreenSameLength xinescs ws =
        ws{ W.current = (W.current ws){ W.screenDetail = SD newCurrentRect }
          , W.visible = [ w{ W.screenDetail = SD r } | w <- W.visible ws | r <- newVisibleRects ]
          }
      where
        undoSort =
            NE.map fst $
            NE.sortBy (cmpScreen `on` (getScreenIdAndRectangle . snd)) $
            NE.zip ((0 :: Int) :| [1..]) $ -- add indices to undo the sort later
            W.current ws :| W.visible ws
        newCurrentRect :| newVisibleRects =
            NE.map snd $ NE.sortWith fst $ NE.zip undoSort $ -- sort back into current:visible order
            NE.map snd $ NE.sortBy cmpScreen $ NE.zip (0 :| [1..]) xinescs
    -- TODO:
    -- If number of screens before and after isn't the same, we might still
    -- try to match locations and avoid changing the workspace for those that
    -- didn't move, while making sure that the current workspace is still
    -- visible somewhere.
--- a/XMonad/Actions/Profiles.hs
+++ b/XMonad/Actions/Profiles.hs
@ -0,0 +1,545 @@
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE DerivingVia   #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.Profiles
 -- Description :  Group your workspaces by similarity.
 -- Copyright   :  (c) Mislav Zanic
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  Mislav Zanic <mislavzanic3@gmail.com>
 -- Stability   :  experimental
 -- Portability :  unportable
 --
 --------------------------------------------------------------------------------
 module XMonad.Actions.Profiles
  ( -- * Overview
    -- $overview
    -- * Usage
    -- $usage
    -- * Types
    ProfileId
  , Profile(..)
  , ProfileConfig(..)
  -- * Hooks
  , addProfiles
  , addProfilesWithHistory
  -- * Switching profiles
  , switchToProfile
  -- * Workspace navigation and keybindings
  , wsFilter
  , bindOn
  -- * Loggers and pretty printers
  , excludeWSPP
  , profileLogger
  -- * Prompts
  , switchProfilePrompt
  , addWSToProfilePrompt
  , removeWSFromProfilePrompt
  , switchProfileWSPrompt
  , shiftProfileWSPrompt
  -- * Utilities
  , currentProfile
  , profileIds
  , previousProfile
  , profileHistory
  , allProfileWindows
  , profileWorkspaces
  )where
 --------------------------------------------------------------------------------
 import Data.Map.Strict (Map)
 import Data.List
 import qualified Data.Map.Strict as Map
 import Control.DeepSeq
 import XMonad
 import XMonad.Prelude
 import qualified XMonad.StackSet as W
 import XMonad.Actions.CycleWS
 import qualified XMonad.Util.ExtensibleState as XS
 import XMonad.Util.Loggers (Logger)
 import XMonad.Prompt.Window (XWindowMap)
 import XMonad.Actions.WindowBringer (WindowBringerConfig(..))
 import XMonad.Actions.OnScreen (greedyViewOnScreen)
 import XMonad.Hooks.Rescreen (addAfterRescreenHook)
 import XMonad.Hooks.DynamicLog (PP(ppRename))
 import XMonad.Prompt 
 --------------------------------------------------------------------------------
 -- $overview
 -- This module allows you to group your workspaces into 'Profile's based on certain similarities.
 -- The idea is to expand upon the philosophy set by "XMonad.Actions.TopicSpace"
 -- which states that you can look at a topic/workspace as a
 -- single unit of work instead of multiple related units of work.
 -- This comes in handy if you have lots of workspaces with windows open and need only to
 -- work with a few of them at a time. With 'Profile's, you can focus on those few workspaces that
 -- require your attention by not displaying, or allowing you to switch to the rest of the workspaces.
 -- The best example is having a profile for development and a profile for leisure activities.
 --------------------------------------------------------------------------------
 -- $usage
 -- To use @Profiles@ you need to add it to your XMonad configuration
 -- and configure your profiles.
 --  
 -- First you'll need to handle the imports.
 --  
 -- > import XMonad.Actions.Profiles 
 -- > import XMonad.Util.EZConfig -- for keybindings
 -- > import qualified XMonad.StackSet as W
 -- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO -- for workspace navigation
 --
 -- Next you'll need to define your profiles.
 --
 -- > myStartingProfile :: ProfileId
 -- > myStartingProfile = "Work"
 -- >
 -- > myProfiles :: [Profile]
 -- > myProfiles =
 -- >  [ Profile { profileId = "Home"
 -- >            , profileWS = [ "www"
 -- >                          , "rss"
 -- >                          , "vid"
 -- >                          , "vms"
 -- >                          , "writing"
 -- >                          , "notes"
 -- >                          ]
 -- >            }
 -- >  , Profile { profileId = "Work"
 -- >            , profileWS = [ "www"
 -- >                          , "slack"
 -- >                          , "dev"
 -- >                          , "k8s"
 -- >                          , "notes"
 -- >                          ]
 -- >            }
 -- >  ]
 -- 
 -- So, while using @Home@ 'Profile', you'll only be able to see, navigate to and 
 -- do actions with @["www", "rss", "vid", "vms", "writing", "notes"]@ workspaces.
 --
 -- You may also need to define some keybindings. Since @M-1@ .. @M-9@ are
 -- sensible keybindings for switching workspaces, you'll need to use
 -- 'bindOn' to have different keybindings per profile.
 -- Here, we'll use "XMonad.Util.EZConfig" syntax:
 -- 
 -- > myKeys :: [(String, X())]
 -- > myKeys = 
 -- >   [ ("M-p",  switchProfilePrompt   xpConfig)
 -- >   , ("M-g",  switchProfileWSPrompt xpConfig)
 -- >   , ("M1-j", DO.moveTo Next wsFilter)
 -- >   , ("M1-k", DO.moveTo Prev wsFilter)
 -- >   ]
 -- >   <>
 -- >   [ ("M-" ++ m ++ k, bindOn $ map (\x -> (fst x, f $ snd x)) i)
 -- >   | (i, k) <- map (\(x:xs) -> (map fst (x:xs), snd x)) $ sortGroupBy snd tupleList
 -- >   , (f, m) <- [(mby $ windows . W.greedyView, ""), (mby $ windows . W.shift, "S-")]
 -- >   ]
 -- >   where
 -- >     mby f wid = if wid == "" then return () else f wid
 -- >     sortGroupBy f = groupBy (\ x y -> f x == f y) . sortBy (\x y -> compare (f x) (f y))
 -- >     tupleList = concatMap (\p -> zip (map (\wid -> (profileId p, wid)) (profileWS p <> repeat "")) (map show [1..9 :: Int])) myProfiles
 -- 
 -- After that, you'll need to hook @Profiles@ into your XMonad config:
 -- 
 -- > main = xmonad $ addProfiles def { profiles        = myProfiles
 -- >                                 , startingProfile = myStartingProfile
 -- >                                 }
 -- >               $ def `additionalKeysP` myKeys
 -- 
 --------------------------------------------------------------------------------
 type ProfileId  = String
 type ProfileMap = Map ProfileId Profile
 --------------------------------------------------------------------------------
 -- | Profile representation.
 data Profile = Profile
  { profileId :: !ProfileId     -- ^ Profile name.
  , profileWS :: ![WorkspaceId] -- ^ A list of workspaces contained within a profile.
  }
 --------------------------------------------------------------------------------
 -- | Internal profile state.
 data ProfileState = ProfileState
  { profilesMap :: !ProfileMap
  , current     :: !(Maybe Profile)
  , previous    :: !(Maybe ProfileId)
  }
 --------------------------------------------------------------------------------
 -- | User config for profiles.
 data ProfileConfig = ProfileConfig
  { workspaceExcludes :: ![WorkspaceId] -- ^ A list of workspaces to exclude from the @profileHistoryHook@.
  , profiles          :: ![Profile]     -- ^ A list of user-defined profiles.
  , startingProfile   :: !ProfileId     -- ^ Profile shown on startup.
  }
 --------------------------------------------------------------------------------
 instance Default ProfileConfig where
  def            = ProfileConfig { workspaceExcludes = []
                                 , profiles          = []
                                 , startingProfile   = ""
                                 }
 --------------------------------------------------------------------------------
 instance ExtensionClass ProfileState where
  initialValue = ProfileState Map.empty Nothing Nothing
 --------------------------------------------------------------------------------
 -- Internal type for history tracking.
 -- Main problem with @XMonad.Hooks.HistoryHook@ is that it isn't profile aware.
 -- Because of that, when switching to a previous workspace, you might switch to
 -- a workspace
 newtype ProfileHistory = ProfileHistory
  { history :: Map ProfileId [(ScreenId, WorkspaceId)]
  }
  deriving (Read, Show)
  deriving NFData via Map ProfileId [(Int, WorkspaceId)]
 --------------------------------------------------------------------------------
 instance ExtensionClass ProfileHistory where
  extensionType = PersistentExtension
  initialValue = ProfileHistory Map.empty
 --------------------------------------------------------------------------------
 newtype ProfilePrompt = ProfilePrompt String
 --------------------------------------------------------------------------------
 instance XPrompt ProfilePrompt where
  showXPrompt (ProfilePrompt x) = x
 --------------------------------------------------------------------------------
 defaultProfile :: Profile
 defaultProfile = defaultProfile
 --------------------------------------------------------------------------------
 -- | Returns current profile.
 currentProfile :: X ProfileId
 currentProfile = profileId . fromMaybe defaultProfile . current <$> XS.get
 --------------------------------------------------------------------------------
 -- | Returns previous profile.
 previousProfile :: X (Maybe ProfileId)
 previousProfile = XS.gets previous
 --------------------------------------------------------------------------------
 -- | Returns the history of viewed workspaces per profile.
 profileHistory :: X (Map ProfileId [(ScreenId, WorkspaceId)])
 profileHistory = XS.gets history
 --------------------------------------------------------------------------------
 profileMap :: X ProfileMap
 profileMap = XS.gets profilesMap
 --------------------------------------------------------------------------------
 -- | Returns ids of all profiles.
 profileIds :: X [ProfileId]
 profileIds = Map.keys <$> XS.gets profilesMap
 --------------------------------------------------------------------------------
 currentProfileWorkspaces :: X [WorkspaceId]
 currentProfileWorkspaces = XS.gets current <&> profileWS . fromMaybe defaultProfile
 --------------------------------------------------------------------------------
 -- | Hook profiles into XMonad. This function adds a startup hook that
 -- sets up ProfileState. Also adds an afterRescreenHook for viewing correct
 -- workspaces when adding new screens.
 addProfiles :: ProfileConfig -> XConfig a -> XConfig a
 addProfiles profConf conf = addAfterRescreenHook hook $ conf
  { startupHook = profileStartupHook' <> startupHook conf
  }
 where
   profileStartupHook' :: X()
   profileStartupHook' = profilesStartupHook (profiles profConf) (startingProfile profConf)
   hook = currentProfile >>= switchWSOnScreens
 --------------------------------------------------------------------------------
 -- | Hooks profiles into XMonad and enables Profile history logging.
 addProfilesWithHistory :: ProfileConfig -> XConfig a -> XConfig a
 addProfilesWithHistory profConf conf = conf'
  { logHook = profileHistoryHookExclude (workspaceExcludes profConf) <> logHook conf
  }
  where
   conf' = addProfiles profConf conf
 --------------------------------------------------------------------------------
 profileHistoryHookExclude :: [WorkspaceId] -> X()
 profileHistoryHookExclude ews = do
  cur <- gets $ W.current . windowset
  vis <- gets $ W.visible . windowset
  pws <- currentProfileWorkspaces
  p <- currentProfile
  updateHist p $ workspaceScreenPairs $ filterWS pws $ cur:vis
  where
    workspaceScreenPairs wins = zip (W.screen <$> wins) (W.tag . W.workspace <$> wins)
    filterWS pws = filter ((\wid -> (wid `elem` pws) && (wid `notElem` ews)) . W.tag . W.workspace)
 --------------------------------------------------------------------------------
 updateHist :: ProfileId -> [(ScreenId, WorkspaceId)] -> X()
 updateHist pid xs = profileWorkspaces pid >>= XS.modify' . update
  where
    update pws hs = force $ hs { history = doUpdate pws $ history hs }
    doUpdate pws hist = foldl (\acc (sid, wid) -> Map.alter (f pws sid wid) pid acc) hist xs
    f pws sid wid val = case val of
      Nothing -> pure [(sid, wid)]
      Just hs -> pure $ let new = (sid, wid) in new:filterWS pws new hs
    filterWS :: [WorkspaceId] -> (ScreenId, WorkspaceId) -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
    filterWS pws new = filter (\x -> snd x `elem` pws && x /= new)
 --------------------------------------------------------------------------------
 -- | Adds profiles to ProfileState and sets current profile using .
 profilesStartupHook :: [Profile] -> ProfileId -> X ()
 profilesStartupHook ps pid = XS.modify go >> switchWSOnScreens pid
  where
    go :: ProfileState -> ProfileState
    go s = s {profilesMap = update $ profilesMap s, current = setCurrentProfile $ Map.fromList $ map entry ps}
    update :: ProfileMap -> ProfileMap
    update = Map.union (Map.fromList $ map entry ps)
    entry :: Profile -> (ProfileId, Profile)
    entry p = (profileId p, p)
    setCurrentProfile :: ProfileMap -> Maybe Profile
    setCurrentProfile s = case Map.lookup pid s of
      Nothing -> Just $ Profile pid []
      Just pn -> Just pn
 --------------------------------------------------------------------------------
 setPrevious :: ProfileId -> X()
 setPrevious name = XS.modify update
  where
    update ps = ps { previous = doUpdate ps }
    doUpdate ps = case Map.lookup name $ profilesMap ps of
      Nothing -> previous ps
      Just p -> Just $ profileId p
 --------------------------------------------------------------------------------
 setProfile :: ProfileId -> X ()
 setProfile p = currentProfile >>= setPrevious >> setProfile' p
 --------------------------------------------------------------------------------
 setProfile' :: ProfileId -> X ()
 setProfile' name = XS.modify update
  where
    update ps = ps { current = doUpdate ps }
    doUpdate ps = case Map.lookup name $ profilesMap ps of
      Nothing -> current ps
      Just p -> Just p
 --------------------------------------------------------------------------------
 -- | Switch to a profile.
 switchToProfile :: ProfileId -> X()
 switchToProfile pid = setProfile pid >> switchWSOnScreens pid
 --------------------------------------------------------------------------------
 -- | Returns the workspace ids associated with a profile id.
 profileWorkspaces :: ProfileId -> X [WorkspaceId]
 profileWorkspaces pid = profileMap >>= findPWs
  where
    findPWs pm = return . profileWS . fromMaybe defaultProfile $ Map.lookup pid pm
 --------------------------------------------------------------------------------
 -- | Prompt for adding a workspace id to a profile.
 addWSToProfilePrompt :: XPConfig -> X()
 addWSToProfilePrompt c = do
  ps <- profileIds
  mkXPrompt (ProfilePrompt "Add ws to profile:") c (mkComplFunFromList' c ps) f
  where
   f :: String -> X()
   f p = do
     vis <- gets $ fmap (W.tag . W.workspace) . W.visible . windowset
     cur <- gets $ W.tag . W.workspace . W.current . windowset
     hid <- gets $ fmap W.tag . W.hidden . windowset
     let
       arr = cur:(vis <> hid)
       in mkXPrompt (ProfilePrompt "Ws to add to profile:") c (mkComplFunFromList' c arr) (`addWSToProfile` p)
 --------------------------------------------------------------------------------
 -- | Prompt for switching profiles.
 switchProfilePrompt :: XPConfig -> X()
 switchProfilePrompt c = do
  ps <- profileIds
  mkXPrompt (ProfilePrompt "Profile: ") c (mkComplFunFromList' c ps) switchToProfile
 --------------------------------------------------------------------------------
 -- | Prompt for switching workspaces.
 switchProfileWSPrompt :: XPConfig -> X ()
 switchProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces
  where
    mkPrompt pws = mkXPrompt (ProfilePrompt "Switch to workspace:") c (mkComplFunFromList' c pws) mbygoto 
    mbygoto wid = do
      pw <- profileWorkspaces =<< currentProfile
      unless (wid `notElem` pw) (windows . W.greedyView $ wid)
 --------------------------------------------------------------------------------
 -- | Prompt for shifting windows to a different workspace.
 shiftProfileWSPrompt :: XPConfig -> X ()
 shiftProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces
  where
    mkPrompt pws = mkXPrompt (ProfilePrompt "Send window to workspace:") c (mkComplFunFromList' c pws) mbyshift
    mbyshift wid = do
      pw <- profileWorkspaces =<< currentProfile
      unless (wid `notElem` pw) (windows . W.shift $ wid)
 --------------------------------------------------------------------------------
 addWSToProfile :: WorkspaceId -> ProfileId -> X()
 addWSToProfile wid pid = XS.modify go
  where
   go :: ProfileState -> ProfileState
   go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}
   update :: ProfileMap -> ProfileMap
   update mp = case Map.lookup pid mp of
     Nothing -> mp
     Just p  -> if wid `elem` profileWS p then mp else Map.adjust f pid mp
   f :: Profile -> Profile
   f p = Profile pid (wid : profileWS p)
   update' :: Profile -> Maybe Profile
   update' cp = if profileId cp == pid && wid `notElem` profileWS cp then Just (Profile pid $ wid:profileWS cp) else Just cp
 --------------------------------------------------------------------------------
 -- | Prompt for removing a workspace from a profile.
 removeWSFromProfilePrompt :: XPConfig -> X()
 removeWSFromProfilePrompt c = do
  ps <- profileIds
  mkXPrompt (ProfilePrompt "Remove ws from profile:") c (mkComplFunFromList' c ps) f
  where
   f :: String -> X()
   f p = do
     arr <- profileWorkspaces p
     mkXPrompt (ProfilePrompt "Ws to remove from profile:") c (mkComplFunFromList' c arr) $
       \ws -> do
         cp <- currentProfile
         ws `removeWSFromProfile` p 
         when (cp == p) $ currentProfile >>= switchWSOnScreens
 --------------------------------------------------------------------------------
 removeWSFromProfile :: WorkspaceId -> ProfileId -> X()
 removeWSFromProfile wid pid = XS.modify go
  where
   go :: ProfileState -> ProfileState
   go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}
   update :: ProfileMap -> ProfileMap
   update mp = case Map.lookup pid mp of
     Nothing -> mp
     Just p  -> if wid `elem` profileWS p then Map.adjust f pid mp else mp
   f :: Profile -> Profile
   f p = Profile pid (delete wid $ profileWS p)
   update' :: Profile -> Maybe Profile
   update' cp = if profileId cp == pid && wid `elem` profileWS cp then Just (Profile pid $ delete wid $ profileWS cp) else Just cp
 --------------------------------------------------------------------------------
 -- | Pretty printer for a bar. Prints workspace ids of current profile.
 excludeWSPP :: PP -> X PP
 excludeWSPP pp = modifyPP <$> currentProfileWorkspaces
  where
    modifyPP pws = pp { ppRename = ppRename pp . printTag pws }
    printTag pws tag = if tag `elem` pws then tag else ""
 --------------------------------------------------------------------------------
 -- | For cycling through workspaces associated with the current.
 wsFilter :: WSType
 wsFilter = WSIs $ currentProfileWorkspaces >>= (\ws -> return $ (`elem` ws) . W.tag)
 --------------------------------------------------------------------------------
 -- Takes care of placing correct workspaces on their respective screens.
 -- It does this by reducing the history of a Profile until it gets an array of length
 -- equal to the number of screens with pairs that have unique workspace ids.
 switchWSOnScreens :: ProfileId -> X()
 switchWSOnScreens pid = do
  hist <- profileHistory
  vis <- gets $ W.visible . windowset
  cur <- gets $ W.current . windowset
  pws <- profileMap <&> (profileWS . fromMaybe (Profile pid []) . Map.lookup pid)
  case Map.lookup pid hist of
    Nothing -> switchScreens $ zip (W.screen <$> (cur:vis)) pws
    Just xs -> compareAndSwitch (f (W.screen <$> cur:vis) xs) (cur:vis) pws
  where
    f :: [ScreenId] -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
    f sids = reorderUniq . reorderUniq . reverse . filter ((`elem` sids) . fst)
    reorderUniq :: (Ord k, Ord v) => [(k,v)] -> [(v,k)]
    reorderUniq = map (\(x,y) -> (y,x)) . uniq
    uniq :: (Ord k, Ord v) => [(k,v)] -> [(k,v)]
    uniq = Map.toList . Map.fromList
    viewWS fview sid wid = windows $ fview sid wid
    switchScreens = mapM_ (uncurry $ viewWS greedyViewOnScreen)
    compareAndSwitch hist wins pws | length hist < length wins = switchScreens $ hist <> populateScreens hist wins pws
                                   | otherwise                 = switchScreens hist
    populateScreens hist wins pws = zip (filter (`notElem` map fst hist) $ W.screen <$> wins) (filter (`notElem` map snd hist) pws)
 --------------------------------------------------------------------------------
 chooseAction :: (String -> X ()) -> X ()
 chooseAction f = XS.gets current <&> (profileId . fromMaybe defaultProfile) >>= f
 --------------------------------------------------------------------------------
 -- | Create keybindings per profile.
 bindOn :: [(String, X ())] -> X ()
 bindOn bindings = chooseAction chooser
  where
    chooser profile = case lookup profile bindings of
        Just action -> action
        Nothing -> case lookup "" bindings of
            Just action -> action
            Nothing -> return ()
 --------------------------------------------------------------------------------
 -- | Loggs currentProfile and all profiles with hidden workspaces
 --   (workspaces that aren't shown on a screen but have windows).
 profileLogger :: (String -> String) -> (String -> String) -> Logger
 profileLogger formatFocused formatUnfocused = do
  hws <- gets $ W.hidden . windowset
  p <- currentProfile
  hm <- map fst
      . filter (\(p', xs) -> any ((`elem` htags hws) . snd) xs || p' == p)
      . Map.toList <$> profileHistory
  return $ Just $ foldl (\a b -> a ++ " " ++ b) "" $ format p <$> hm
  where
    format p a = if a == p then formatFocused a else formatUnfocused a
    htags wins = W.tag <$> filter (isJust . W.stack) wins
 --------------------------------------------------------------------------------
 -- | @XWindowMap@ of all windows contained in a profile.
 allProfileWindows :: XWindowMap
 allProfileWindows = allProfileWindows' def
 --------------------------------------------------------------------------------
 allProfileWindows' :: WindowBringerConfig -> XWindowMap
 allProfileWindows' WindowBringerConfig{ windowTitler = titler, windowFilter = include } = do
  pws <- currentProfileWorkspaces
  windowSet <- gets windowset
  Map.fromList . concat <$> mapM keyValuePairs (filter ((`elem` pws) . W.tag) $ W.workspaces windowSet)
   where keyValuePairs ws = let wins = W.integrate' (W.stack ws)
                           in mapM (keyValuePair ws) =<< filterM include wins
         keyValuePair ws w = (, w) <$> titler ws w
--- a/XMonad/Actions/Search.hs
+++ b/XMonad/Actions/Search.hs
@ -437,14 +437,14 @@ namedEngine name (SearchEngine _ site) = searchEngineF name site
   browser. -}
 promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
 promptSearchBrowser config browser (SearchEngine name site) = do
-    hc <- historyCompletionP ("Search [" `isPrefixOf`)
+    hc <- historyCompletionP config ("Search [" `isPrefixOf`)
    mkXPrompt (Search name) config hc $ search browser site
 {- | Like 'promptSearchBrowser', but only suggest previous searches for the
   given 'SearchEngine' in the prompt. -}
 promptSearchBrowser' :: XPConfig -> Browser -> SearchEngine -> X ()
 promptSearchBrowser' config browser (SearchEngine name site) = do
-    hc <- historyCompletionP (searchName `isPrefixOf`)
+    hc <- historyCompletionP config (searchName `isPrefixOf`)
    mkXPrompt (Search name) config hc $ search browser site
  where
    searchName = showXPrompt (Search name)
--- a/XMonad/Actions/Submap.hs
+++ b/XMonad/Actions/Submap.hs
@ -18,6 +18,7 @@ module XMonad.Actions.Submap (
                             -- $usage
                             submap,
                             visualSubmap,
                             visualSubmapSorted,
                             submapDefault,
                             submapDefaultWithKey,
@ -88,15 +89,32 @@ visualSubmap :: WindowConfig -- ^ The config for the spawned window.
             -> M.Map (KeyMask, KeySym) (String, X ())
                             -- ^ A map @keybinding -> (description, action)@.
             -> X ()
-visualSubmap wc keys =
+visualSubmap = visualSubmapSorted id
 -- | Like 'visualSubmap', but is able to sort the descriptions.
 -- For example,
 --
 -- > import Data.Ord (comparing, Down)
 -- >
 -- > visualSubmapSorted (sortBy (comparing Down)) def
 --
 -- would sort the @(key, description)@ pairs by their keys in descending
 -- order.
 visualSubmapSorted :: ([((KeyMask, KeySym), String)] -> [((KeyMask, KeySym), String)])
                             -- ^ A function to resort the descriptions
             -> WindowConfig -- ^ The config for the spawned window.
             -> M.Map (KeyMask, KeySym) (String, X ())
                             -- ^ A map @keybinding -> (description, action)@.
             -> X ()
 visualSubmapSorted sorted wc keys =
    withSimpleWindow wc descriptions waitForKeyPress >>= \(m', s) ->
        maybe (pure ()) snd (M.lookup (m', s) keys)
  where
    descriptions :: [String]
    descriptions =
-        zipWith (\key desc -> keyToString key <> ": " <> desc)
+        map (\(key, desc) -> keyToString key <> ": " <> desc)
-                (M.keys keys)
+            . sorted
-                (map fst (M.elems keys))
+            $ zip (M.keys keys) (map fst (M.elems keys))
 -- | Give a name to an action.
 subName :: String -> X () -> (String, X ())
--- a/XMonad/Actions/UpKeys.hs
+++ b/XMonad/Actions/UpKeys.hs
@ -0,0 +1,169 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TypeApplications #-}
 {- |
   Module      : XMonad.Actions.UpKeys
   Description : Bind an action to the release of a key
   Copyright   : (c) Tony Zorman, 2024
   License     : BSD-3
   Maintainer  : Tony Zorman <soliditsallgood@mailbox.org>
 A combinator for binding an action to the release of a key. This can be
 useful for hold-type buttons, where the press of a key engages some
 functionality, and its release… releases it again.
 -}
 module XMonad.Actions.UpKeys
  ( -- * Usage
    -- $usage
    useUpKeys,
    UpKeysConfig (..),
    ezUpKeys,
  )
 where
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import XMonad
 import XMonad.Prelude
 import XMonad.Util.EZConfig (mkKeymap)
 import qualified XMonad.Util.ExtensibleConf as XC
 {- $usage
 You can use this module with the following in your @xmonad.hs@:
 > import XMonad.Actions.UpKeys
 Next, define the keys and actions you want to have happen on the release
 of a key:
 > myUpKeys = ezUpKeys $
 >   [ ("M-z", myAction)
 >   , ("M-a", myAction2)
 >   ]
 All that's left is to plug this definition into the 'useUpKeys'
 combinator that this module provides:
 > main :: IO ()
 > main = xmonad
 >      . useUpKeys (def{ grabKeys = True, upKeys = myUpKeys })
 >      $ myConfig
 Note the presence of @'grabKeys' = True@; this is for situations where
 you don't have any of these keys bound to do something upon pressing
 them; i.e., you use them solely for their release actions. If you want
 something to happen in both cases, remove that part (@'grabKeys' =
 False@ is the default) and bind the keys to actions as you normally
 would.
 ==== __Examples__
 As an extended example, consider the case where you want all of your
 docks (e.g., status bar) to "pop up" when you press the super key, and
 then vanish again once that keys is released.
 Since docks are not generally part of XMonad's window-set—otherwise, we
 would have to manage them—we first need a way to access and manipulate
 all docks.
 > onAllDocks :: (Display -> Window -> IO ()) -> X ()
 > onAllDocks act = withDisplay \dpy -> do
 >   rootw <- asks theRoot
 >   (_, _, wins) <- io $ queryTree dpy rootw
 >   traverse_ (io . act dpy) =<< filterM (runQuery checkDock) wins
 This is also the place where one could filter for just status bar,
 trayer, and so on.
 Now we have to decide what kinds of keys we want to watch out for. Since
 you most likely use left super as your modifier key, this is a little
 bit more complicated than for other keys, as you will most likely see
 the key both as a @KeyMask@, as well as a @KeySym@. One could think a
 bit and probably come up with an elegant solution for this—or one could
 grab all possible key combinations by brute-force!
 > dockKeys :: X () -> [((KeyMask, KeySym), X ())]
 > dockKeys act = map (actKey . foldr1 (.|.)) . combinations $ keyMasks
 >  where
 >   actKey :: KeyMask -> ((KeyMask, KeySym), X ())
 >   actKey mask = ((mask, xK_Super_L), act)
 >
 >   keyMasks :: [KeyMask]
 >   keyMasks = [ noModMask, shiftMask, lockMask, controlMask, mod1Mask, mod2Mask, mod3Mask, mod4Mask, mod5Mask ]
 >
 >   -- Return all combinations of a sequence of values.
 >   combinations :: [a] -> [[a]]
 >   combinations xs = concat [combs i xs | i <- [1 .. length xs]]
 >    where
 >     combs 0 _      = [[]]
 >     combs _ []     = []
 >     combs n (x:xs) = map (x:) (combs (n-1) xs) <> combs n xs
 Given some action, like lowering or raising the window, we generate all
 possible combinations of modifiers that may be pressed with the super
 key. This is a good time to say that this is just for demonstrative
 purposes, btw—please don't actually do this.
 All that's left is to plug everything into the machinery of this module,
 and we're done!
 > import qualified Data.Map.Strict as Map
 >
 > main :: IO ()
 > main = xmonad
 >      . … -- other combinators
 >      . useUpKeys (def { upKeys = Map.fromList $ dockKeys (onAllDocks lowerWindow) })
 >      $ myConfig `additionalKeys` dockKeys (onAllDocks raiseWindow)
 >
 > myConfig = …
 -}
 data UpKeysConfig = UpKeysConfig
  { -- | Whether to grab all keys that are not already grabbed.
    grabKeys :: !Bool
    -- | The keys themselves.
  , upKeys :: !(Map (KeyMask, KeySym) (X ()))
  }
 -- | The default 'UpKeysConfig'; keys are not grabbed, and no upkeys are
 -- specified.
 instance Default UpKeysConfig where
  def :: UpKeysConfig
  def = UpKeysConfig { grabKeys = False, upKeys = mempty }
 instance Semigroup UpKeysConfig where
  (<>) :: UpKeysConfig -> UpKeysConfig -> UpKeysConfig
  UpKeysConfig g u <> UpKeysConfig g' u' = UpKeysConfig (g && g') (u <> u')
 -- | Bind actions to keys upon their release.
 useUpKeys :: UpKeysConfig -> (XConfig l -> XConfig l)
 useUpKeys upKeysConf = flip XC.once upKeysConf \conf -> conf
  { handleEventHook = handleEventHook conf <> (\e -> handleKeyUp e $> All True)
  , startupHook     = startupHook     conf <> when (grabKeys upKeysConf) grabUpKeys
  }
 where
  grabUpKeys :: X ()
  grabUpKeys = do
    XConf{ display = dpy, theRoot = rootw } <- ask
    realKeys <- maybe mempty upKeys <$> XC.ask @X @UpKeysConfig
    let grab :: (KeyMask, KeyCode) -> X ()
        grab (km, kc) = io $ grabKey dpy kc km rootw True grabModeAsync grabModeAsync
    traverse_ grab =<< mkGrabs (Map.keys realKeys)
 -- | Parse the given EZConfig-style keys into the internal keymap
 -- representation.
 --
 -- This is just 'mkKeymap' with a better name.
 ezUpKeys :: XConfig l -> [(String, X ())] -> Map (KeyMask, KeySym) (X ())
 ezUpKeys = mkKeymap
 -- | A handler for key-up events.
 handleKeyUp :: Event -> X ()
 handleKeyUp KeyEvent{ ev_event_type, ev_state, ev_keycode }
  | ev_event_type == keyRelease = withDisplay \dpy -> do
      s   <- io $ keycodeToKeysym dpy ev_keycode 0
      cln <- cleanMask ev_state
      ks  <- maybe mempty upKeys <$> XC.ask @X @UpKeysConfig
      userCodeDef () $ whenJust (ks Map.!? (cln, s)) id
 handleKeyUp _ = pure ()
--- a/XMonad/Actions/WindowBringer.hs
+++ b/XMonad/Actions/WindowBringer.hs
@ -22,6 +22,7 @@ module XMonad.Actions.WindowBringer (
                    WindowBringerConfig(..),
                    gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
                    bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
                    copyMenu, copyMenuConfig, copyMenu', copyMenuArgs, copyMenuArgs',
                    windowMap, windowAppMap, windowMap', bringWindow, actionMenu
                   ) where
@ -33,6 +34,7 @@ import XMonad
 import qualified XMonad as X
 import XMonad.Util.Dmenu (menuMapArgs)
 import XMonad.Util.NamedWindows (getName, getNameWMClass)
 import XMonad.Actions.CopyWindow (copyWindow)
 -- $usage
 --
@ -44,6 +46,7 @@ import XMonad.Util.NamedWindows (getName, getNameWMClass)
 --
 -- > , ((modm .|. shiftMask, xK_g     ), gotoMenu)
 -- > , ((modm .|. shiftMask, xK_b     ), bringMenu)
 -- > , ((modm .|. shiftMask, xK_y     ), copyMenu)
 --
 -- For detailed instructions on editing your key bindings, see
 -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
@ -90,6 +93,37 @@ gotoMenu' cmd = gotoMenuConfig def { menuArgs = [], menuCommand = cmd }
 gotoMenuArgs' :: String -> [String] -> X ()
 gotoMenuArgs' cmd args = gotoMenuConfig def { menuCommand = cmd, menuArgs = args }
 -- | Pops open a dmenu with window titles. Choose one, and it will be copied into your current workspace.
 copyMenu :: X ()
 copyMenu = copyMenuArgs def
 -- | Pops open a dmenu with window titles. Choose one, and it will be
 --   copied into your current workspace. This version
 --   accepts a configuration object.
 copyMenuConfig :: WindowBringerConfig -> X ()
 copyMenuConfig wbConfig = actionMenu wbConfig copyBringWindow
 -- | Pops open a dmenu with window titles. Choose one, and it will be
 --   copied into your current workspace. This version
 --   takes a list of arguments to pass to dmenu.
 copyMenuArgs :: [String] -> X ()
 copyMenuArgs args = copyMenuConfig def { menuArgs = args }
 -- | Pops open an application with window titles given over stdin. Choose one,
 --   and it will be copied into your current workspace.
 copyMenu' :: String -> X ()
 copyMenu' cmd = copyMenuConfig def { menuArgs = [], menuCommand = cmd }
 -- | Pops open an application with window titles given over stdin. Choose one,
 --   and it will be copied into your current
 --   workspace. This version allows arguments to the chooser to be specified.
 copyMenuArgs' :: String -> [String] -> X ()
 copyMenuArgs' cmd args = copyMenuConfig def { menuArgs = args, menuCommand = cmd }
 -- | Brings a copy of the specified window into the current workspace.
 copyBringWindow :: Window -> X.WindowSet -> X.WindowSet
 copyBringWindow w ws = copyWindow w (W.currentTag ws) ws
 -- | Pops open a dmenu with window titles. Choose one, and it will be
 --   dragged, kicking and screaming, into your current workspace.
 bringMenu :: X ()
@ -159,7 +193,7 @@ decorateName ws w = do
  return $ name ++ " [" ++ W.tag ws ++ "]"
 -- | Returns the window name as will be listed in dmenu.  This will
-- return the executable name of the window along with it's workspace
+-- return the executable name of the window along with its workspace
 -- ID.
 decorateAppName :: X.WindowSpace -> Window -> X String
 decorateAppName ws w = do
--- a/XMonad/Actions/WindowNavigation.hs
+++ b/XMonad/Actions/WindowNavigation.hs
@ -1,10 +1,12 @@
 {-# LANGUAGE TupleSections #-} -- I didn't want this, it's hlint's "suggestion" and it's apparently non-negotiable
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.WindowNavigation
 -- Description :  Experimental rewrite of "XMonad.Layout.WindowNavigation".
 -- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>,
 --                          Devin Mullins <me@twifkak.com>
-- Maintainer  :  Devin Mullins <me@twifkak.com>
+-- Maintainer  :  Devin Mullins <me@twifkak.com>,
 --                Platon Pronko <platon7pronko@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 -- Stability   :  unstable
 -- Portability :  unportable
@ -37,17 +39,19 @@ module XMonad.Actions.WindowNavigation (
                                       withWindowNavigationKeys,
                                       WNAction(..),
                                       go, swap,
                                       goPure, swapPure,
                                       Direction2D(..), WNState,
                                       ) where
-import XMonad
+import XMonad hiding (state)
-import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn)
+import XMonad.Prelude (catMaybes, fromMaybe, sortOn)
 import XMonad.Util.Types (Direction2D(..))
 import qualified XMonad.StackSet as W
 import Control.Arrow (second)
 import Data.IORef
 import Data.Map (Map())
 import Data.List (partition, find)
 import qualified Data.Map as M
 import qualified Data.Set as S
@ -101,27 +105,60 @@ withWindowNavigation (u,l,d,r) conf@XConfig{modMask=modm} =
 withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
 withWindowNavigationKeys wnKeys conf = do
-    posRef <- newIORef M.empty
+    stateRef <- newIORef M.empty
-    return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys)
+    return conf { keys = \cnf -> M.fromList (map (second (fromWNAction stateRef)) wnKeys)
                                 `M.union` keys conf cnf,
-                  logHook = logHook conf >> trackMovement posRef }
+                  logHook = logHook conf >> trackMovement stateRef }
-  where fromWNAction posRef (WNGo dir)   = go   posRef dir
+  where fromWNAction stateRef (WNGo dir)   = go   stateRef dir
-        fromWNAction posRef (WNSwap dir) = swap posRef dir
+        fromWNAction stateRef (WNSwap dir) = swap stateRef dir
 data WNAction = WNGo Direction2D | WNSwap Direction2D
 type WNState = Map WorkspaceId Point
-- go:
+-- | Focus window in the given direction.
 -- 1. get current position, verifying it matches the current window
 -- 2. get target windowrect
 -- 3. focus window
 -- 4. set new position
 go :: IORef WNState -> Direction2D -> X ()
-go = withTargetWindow W.focusWindow
+go stateRef dir = runPureAction stateRef (goPure dir)
 -- | Swap current window with the window in the given direction.
 -- Note: doesn't work with floating windows (don't think it makes much sense to swap floating windows).
 swap :: IORef WNState -> Direction2D -> X ()
-swap = withTargetWindow swapWithFocused
+swap stateRef dir = runPureAction stateRef (swapPure dir)
 type WindowRectFn x = (Window -> x (Maybe Rectangle))
 -- | (state, oldWindowSet, mappedWindows, windowRect)
 type WNInput x = (WNState, WindowSet, S.Set Window, WindowRectFn x)
 type WNOutput = (WNState, WindowSet)
 -- | Run the pure action inside X monad.
 runPureAction :: IORef WNState -> (WNInput X -> X WNOutput) -> X ()
 runPureAction stateRef action = do
  oldState <- io (readIORef stateRef)
  oldWindowSet <- gets windowset
  mappedWindows <- gets mapped
  (newState, newWindowSet) <- action (oldState, oldWindowSet, mappedWindows, windowRectX)
  windows (const newWindowSet)
  io $ writeIORef stateRef newState
 -- | Version of `go` not dependent on X monad (needed for testing).
 goPure :: Monad x => Direction2D -> WNInput x -> x WNOutput
 goPure dir input@(oldState, oldWindowSet, mappedWindows, _) =
  if length (filter (`S.member` mappedWindows) $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet) == 1
  then
    -- Handle the special case of Full layout, when there's only one mapped window on a screen.
    return ( oldState
           , case dir of
               U -> W.focusUp oldWindowSet
               L -> W.focusDown oldWindowSet
               D -> W.focusDown oldWindowSet
               R -> W.focusUp oldWindowSet
           )
  else
    withTargetWindow W.focusWindow dir input
 -- | Version of `swap` not dependent on X monad (needed for testing).
 swapPure :: Monad x => Direction2D -> WNInput x -> x WNOutput
 swapPure = withTargetWindow swapWithFocused
  where swapWithFocused targetWin winSet =
            case W.peek winSet of
                Just currentWin -> W.focusWindow currentWin $
@ -135,87 +172,249 @@ swap = withTargetWindow swapWithFocused
          | win == win2 = win1
          | otherwise = win
-withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
+-- | Select a target window in the given direction and modify the WindowSet.
-withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
+-- 1. Get current position, verifying it matches the current window (exit if no focused window).
-    targets <- filter ((/= win) . fst) <$> navigableTargets pos dir
+-- 2. Get the target window.
-    whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do
+-- 3. Execute an action on the target window and windowset.
-      windows (adj targetWin)
+-- 4. Set the new position.
-      setPosition posRef pos targetRect
+withTargetWindow :: Monad x => (Window -> WindowSet -> WindowSet) -> Direction2D -> WNInput x -> x WNOutput
 withTargetWindow adj dir input@(oldState, oldWindowSet, _, _) = do
  whenJust' (getCurrentWindow input) (oldState, oldWindowSet) $ \(win, winRect, pos) -> do
    targetMaybe <- find ((/= win) . fst) <$> navigableTargets input dir winRect pos
    whenJust' (pure targetMaybe) (oldState, oldWindowSet) $ \(targetWin, newPos) ->
      let newWindowSet = adj targetWin oldWindowSet
      in return (modifyState newWindowSet newPos oldState, newWindowSet)
 -- | Update position on outside changes in windows.
 trackMovement :: IORef WNState -> X ()
-trackMovement posRef = fromCurrentPoint posRef $ \win pos ->
+trackMovement stateRef = do
-                           windowRect win >>= flip whenJust (setPosition posRef pos . snd)
+  oldState <- io (readIORef stateRef)
  oldWindowSet <- gets windowset
  mappedWindows <- gets mapped
  whenJust' (getCurrentWindow (oldState, oldWindowSet, mappedWindows, windowRectX)) () $ \(_, _, pos) -> do
      io $ writeIORef stateRef $ modifyState oldWindowSet pos oldState
-fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
+-- | Get focused window and current position.
-fromCurrentPoint posRef f = withFocused $ \win ->
+getCurrentWindow :: Monad x => WNInput x -> x (Maybe (Window, Rectangle, Point))
-                                currentPosition posRef >>= f win
+getCurrentWindow input@(_, oldWindowSet, _, _) =
  whenJust' (pure $ W.peek oldWindowSet) Nothing $ \window -> do
    (pos, rect) <- currentPosition input
    return $ Just (window, rect, pos)
-- Gets the current position from the IORef passed in, or if nothing (say, from
+-- | Gets the current position from the state passed in, or if nothing
-- a restart), derives the current position from the current window. Also,
+-- (say, from a restart), derives the current position from the current window.
-- verifies that the position is congruent with the current window (say, if you
+-- Also, verifies that the position is congruent with the current window
-- used mod-j/k or mouse or something).
+-- (say, if you moved focus using mouse or something).
-currentPosition :: IORef WNState -> X Point
+-- Returns the window rectangle for convenience, since we'll need it later anyway.
-currentPosition posRef = do
+currentPosition :: Monad x => WNInput x -> x (Point, Rectangle)
-    root <- asks theRoot
+currentPosition (state, oldWindowSet, _, windowRect) = do
-    currentWindow <- gets (W.peek . windowset)
+  currentRect <- fromMaybe (Rectangle 0 0 0 0) <$> maybe (pure Nothing) windowRect (W.peek oldWindowSet)
-    currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow)
+  let posMaybe = M.lookup (W.currentTag oldWindowSet) state
      middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)
  return $ case posMaybe of
    Nothing -> (middleOf currentRect, currentRect)
    Just pos -> (centerPosition currentRect pos, currentRect)
-    wsid <- gets (W.currentTag . windowset)
+-- | Inserts new position into the state.
-    mp <- M.lookup wsid <$> io (readIORef posRef)
+modifyState :: WindowSet -> Point -> WNState -> WNState
 modifyState oldWindowSet =
  M.insert (W.currentTag oldWindowSet)
-    return $ maybe (middleOf currentRect) (`inside` currentRect) mp
+-- | "Jumps" the current position into the middle of target rectangle.
-
+-- (keeps the position as-is if it is already inside the target rectangle)
-  where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)
+centerPosition :: Rectangle -> Point -> Point
-
+centerPosition r@(Rectangle rx ry rw rh) pos@(Point x y) = do
-setPosition :: IORef WNState -> Point -> Rectangle -> X ()
+  if pointWithin x y r
-setPosition posRef oldPos newRect = do
+  then pos
-    wsid <- gets (W.currentTag . windowset)
+  else Point (midPoint rx rw) (midPoint ry rh)
    io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect)
 inside :: Point -> Rectangle -> Point
 Point x y `inside` Rectangle rx ry rw rh =
    Point (x `within` (rx, rw)) (y `within` (ry, rh))
  where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim
                                    then pos
                                    else midPoint lower dim
 midPoint :: Position -> Dimension -> Position
 midPoint pos dim = pos + fromIntegral dim `div` 2
-navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
+-- | Make a list of target windows we can navigate to,
-navigableTargets point dir = navigable dir point <$> windowRects
+-- sorted by desirability of navigation.
 navigableTargets :: Monad x => WNInput x -> Direction2D -> Rectangle -> Point -> x [(Window, Point)]
 navigableTargets input@(_, oldWindowSet, _, _) dir currentRect currentPos = do
  allScreensWindowsAndRectangles <- mapSnd (rectTransform dir) <$> windowRects input
  let
    screenWindows = S.fromList $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet
    (thisScreenWindowsAndRectangles, otherScreensWindowsAndRectangles) = partition (\(w, _) -> S.member w screenWindows) allScreensWindowsAndRectangles
-- Filters and sorts the windows in terms of what is closest from the Point in
+    pos = pointTransform dir currentPos
-- the Direction2D.
+    wr = rectTransform dir currentRect
 navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
 navigable d pt = sortby d . filter (inr d pt . snd)
-- Produces a list of normal-state windows, on any screen. Rectangles are
+    rectInside r = (rect_p1 r >= rect_p1 wr && rect_p1 r < rect_p2 wr && rect_p2 r > rect_p1 wr && rect_p2 r <= rect_p2 wr) &&
-- adjusted based on screen position relative to the current screen, because I'm
+                   ((rect_o1 r >= rect_o1 wr && rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr && rect_o2 r <= rect_o2 wr) ||
-- bad like that.
+                    (rect_o1 r <= rect_o1 wr && rect_o2 r >= rect_o2 wr)) -- include windows that fully overlaps current on the orthogonal axis
-windowRects :: X [(Window, Rectangle)]
+    sortByP2 = sortOn (rect_p2 . snd)
-windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped
+    posBeforeEdge r = point_p pos < rect_p2 r
-windowRect :: Window -> X (Maybe (Window, Rectangle))
+    rectOverlapsEdge r = rect_p1 r <= rect_p2 wr && rect_p2 r > rect_p2 wr &&
-windowRect win = withDisplay $ \dpy -> do
+                         rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr
    rectOverlapsOneEdge r = rectOverlapsEdge r && rect_p1 r > rect_p1 wr
    rectOverlapsBothEdges r = rectOverlapsEdge r &&
                              rect_o1 r > rect_o1 wr && rect_o2 r < rect_o2 wr && point_o pos >= rect_o1 r && point_o pos < rect_o2 r
    distanceToRectEdge r = max (max 0 (rect_o1 r - point_o pos)) (max 0 (point_o pos + 1 - rect_o2 r))
    distanceToRectCenter r =
      let distance = (rect_o1 r + rect_o2 r) `div` 2 - point_o pos
      in if distance <= 0
         then distance + 1
         else distance
    sortByPosDistance = sortOn ((\r -> (rect_p1 r, distanceToRectEdge r, distanceToRectCenter r)) . snd)
    rectOutside r = rect_p1 r < rect_p1 wr && rect_p2 r > rect_p2 wr &&
                    rect_o1 r < rect_o1 wr && rect_o2 r > rect_o2 wr
    sortByLength = sortOn (rect_psize . snd)
    rectAfterEdge r = rect_p1 r > rect_p2 wr
    -- Modified from David Roundy and Devin Mullins original implementation of WindowNavigation:
    inr r = point_p pos < rect_p2 r && point_o pos >= rect_o1 r && point_o pos < rect_o2 r
    clamp v v1 v2 | v < v1 = v1
                  | v >= v2 = v2 - 1
                  | otherwise = v
    dragPos r = DirPoint (max (point_p pos) (rect_p1 r)) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))
  return $ mapSnd (inversePointTransform dir) $ concat
    [
      -- First, navigate to windows that are fully inside current window
      -- and have higher coordinate bigger than current position.
      -- ┌──────────────────┐
      -- │   current        │  (all examples assume direction=R)
      -- │    ┌──────────┐  │
      -- │  ──┼─► inside │  │
      -- │    └──────────┘  │
      -- └──────────────────┘
      -- Also include windows fully overlapping current on the orthogonal axis:
      --             ┌──────────────┐
      --             │ overlapping  │
      -- ┌───────────┤              ├────┐
      -- │ current ──┼─►            │    │
      -- └───────────┤              ├────┘
      --             └──────────────┘
      mapSnd dragPos $ sortByP2 $ filterSnd posBeforeEdge $ filterSnd rectInside thisScreenWindowsAndRectangles
      -- Then navigate to windows that touch or overlap the edge of current window in the chosen direction.
      -- ┌──────────────┬─────────────┐   ┌───────────┐                   ┌─────────────┐
      -- │ current      │ adjacent    │   │ current   │                   │ current     │
      -- │            ──┼─►           │   │       ┌───┴───────────────┐   │         ┌───┴─────────────┐
      -- │              │             │   │     ──┼─► │   overlapping │   │       ──┼─►               │
      -- │              ├─────────────┘   │       └───┬───────────────┘   └─────────┤     overlapping │
      -- │              │                 │           │                             │                 │
      -- └──────────────┘                 └───────────┘                             └─────────────────┘
    , mapSnd dragPos $ sortByPosDistance $ filterSnd rectOverlapsOneEdge thisScreenWindowsAndRectangles
      -- Windows fully overlapping current window "in the middle" on the parallel axis are also included,
      -- if position is inside them:
      --     ┌───────────┐
      --     │  current  │
      -- ┌───┤-----------├────────────────┐
      -- │   │     *   ──┼─►  overlapping │
      -- └───┤-----------├────────────────┘
      --     └───────────┘
    , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByPosDistance $ filterSnd rectOverlapsBothEdges thisScreenWindowsAndRectangles
      -- Then navigate to windows that fully encompass the current window.
      -- ┌─────────────────────┐
      -- │    outer            │
      -- │  ┌─────────────┐    │
      -- │  │  current  ──┼─►  │
      -- │  └─────────────┘    │
      -- └─────────────────────┘
    , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByLength $ filterSnd rectOutside thisScreenWindowsAndRectangles
      -- Then navigate to windows that are fully after current window in the chosen direction.
      -- ┌──────────────┐
      -- │ current      │  ┌────────────────┐
      -- │              │  │                │
      -- │            ──┼──┼─► not adjacent │
      -- │              │  │                │
      -- │              │  └────────────────┘
      -- └──────────────┘
    , mapSnd dragPos $ sortByPosDistance $ filterSnd rectAfterEdge thisScreenWindowsAndRectangles
      -- Cast a ray from the current position, jump to the first window (on another screen) that intersects this ray.
    , mapSnd dragPos $ sortByPosDistance $ filterSnd inr otherScreensWindowsAndRectangles
      -- If everything else fails, then navigate to the window that is fully inside current window,
      -- but is before the current position.
      -- This can happen when we are at the last window on a screen, and attempt to navigate even further.
      -- In this case it seems okay to jump to the remaining inner windows, since we don't have any other choice anyway,
      -- and user is probably not so fully aware of the precise position anyway.
    , mapSnd (\r -> DirPoint (rect_p2 r - 1) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))) $
      sortByP2 $ filterSnd (not . posBeforeEdge) $ filterSnd rectInside thisScreenWindowsAndRectangles
    ]
 -- Structs for direction-independent space - equivalent to rotating points and rectangles such that
 -- navigation direction points to the right.
 -- Allows us to abstract over direction in the navigation functions.
 data DirPoint = DirPoint
  { point_p :: Position -- coordinate parallel to the direction
  , point_o :: Position -- coordinate orthogonal to the direction
  }
 data DirRectangle = DirRectangle
  { rect_p1 :: Position -- lower rectangle coordinate parallel to the direction
  , rect_p2 :: Position -- higher rectangle coordinate parallel to the direction
  , rect_o1 :: Position -- lower rectangle coordinate orthogonal to the direction
  , rect_o2 :: Position -- higher rectangle coordinate orthogonal to the direction
  }
 {- HLINT ignore "Use camelCase" -}
 rect_psize :: DirRectangle -> Dimension
 rect_psize r = fromIntegral (rect_p2 r - rect_p1 r)
 -- | Transform a point from screen space into direction-independent space.
 pointTransform :: Direction2D -> Point -> DirPoint
 pointTransform dir (Point x y) = case dir of
  U -> DirPoint (negate y - 1) x
  L -> DirPoint (negate x - 1) (negate y - 1)
  D -> DirPoint y (negate x - 1)
  R -> DirPoint x y
 -- | Transform a point from direction-independent space back into screen space.
 inversePointTransform :: Direction2D -> DirPoint -> Point
 inversePointTransform dir p = case dir of
  U -> Point (point_o p) (negate $ point_p p + 1)
  L -> Point (negate $ point_p p + 1) (negate $ point_o p + 1)
  D -> Point (negate $ point_o p + 1) (point_p p)
  R -> Point (point_p p) (point_o p)
 -- | Transform a rectangle from screen space into direction-independent space.
 rectTransform :: Direction2D -> Rectangle -> DirRectangle
 rectTransform dir (Rectangle x y w h) = case dir of
  U -> DirRectangle (negate $ y + fromIntegral h) (negate y) x (x + fromIntegral w)
  L -> DirRectangle (negate $ x + fromIntegral w) (negate x) (negate $ y + fromIntegral h) (negate y)
  D -> DirRectangle y (y + fromIntegral h) (negate $ x + fromIntegral w) (negate x)
  R -> DirRectangle x (x + fromIntegral w) y (y + fromIntegral h)
 -- | Produces a list of normal-state windows on all screens, excluding currently focused window.
 windowRects :: Monad x => WNInput x -> x [(Window, Rectangle)]
 windowRects (_, oldWindowSet, mappedWindows, windowRect) =
  let
    allWindows = filter (\w -> w `notElem` W.peek oldWindowSet) $ S.toList mappedWindows
    windowRect2 w = fmap (w,) <$> windowRect w
  in catMaybes <$> mapM windowRect2 allWindows
 windowRectX :: Window -> X (Maybe Rectangle)
 windowRectX win = withDisplay $ \dpy -> do
    (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
-    return $ Just (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
+    return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw)
    `catchX` return Nothing
-- Modified from droundy's implementation of WindowNavigation:
+-- Maybe below functions can be replaced with some standard helper functions?
-inr :: Direction2D -> Point -> Rectangle -> Bool
+-- | Execute a monadic action on the contents if Just, otherwise wrap default value and return it.
-inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w &&
+whenJust' :: Monad x => x (Maybe a) -> b -> (a -> x b) -> x b
-                                                        py < ry + fromIntegral h
+whenJust' monadMaybeValue deflt f = do
-inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w &&
+  maybeValue <- monadMaybeValue
-                                            py >  ry
+  case maybeValue of
-inr R (Point px py) (Rectangle rx ry w h) =             px < rx + fromIntegral w &&
+    Nothing -> return deflt
-                                            py >= ry && py < ry + fromIntegral h
+    Just value -> f value
 inr L (Point px py) (Rectangle rx ry _ h) = px >  rx &&
                                            py >= ry && py < ry + fromIntegral h
-sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
+-- | Filter a list of tuples on the second tuple member.
-sortby D = sortOn (rect_y . snd)
+filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)]
-sortby R = sortOn (rect_x . snd)
+filterSnd f = filter (f . snd)
-sortby U = reverse . sortby D
+
-sortby L = reverse . sortby R
+-- | Map a second tuple member in a list of tuples.
 mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')]
 mapSnd f = map (second f)
--- a/XMonad/Actions/WorkspaceNames.hs
+++ b/XMonad/Actions/WorkspaceNames.hs
@ -138,7 +138,7 @@ setCurrentWorkspaceName name = do
 -- | Prompt for a new name for the current workspace and set it.
 renameWorkspace :: XPConfig -> X ()
 renameWorkspace conf = do
-    completion <- historyCompletionP (prompt ==)
+    completion <- historyCompletionP conf (prompt ==)
    mkXPrompt (Wor prompt) conf completion setCurrentWorkspaceName
  where
    prompt = "Workspace name: "
--- a/XMonad/Config/Prime.hs
+++ b/XMonad/Config/Prime.hs
@ -1,3 +1,4 @@
 {-# OPTIONS_HADDOCK hide #-}
 {-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-}
 -----------------------------------------------------------------------------
--- a/XMonad/Hooks/DebugEvents.hs
+++ b/XMonad/Hooks/DebugEvents.hs
@ -33,7 +33,6 @@ import           XMonad.Util.DebugWindow                     (debugWindow)
 -- import           Graphics.X11.Xlib.Extras.GetAtomName        (getAtomName)
 import           Control.Exception                    as E
 import           Control.Monad.Fail
 import           Control.Monad.State
 import           Control.Monad.Reader
 import           Codec.Binary.UTF8.String
--- a/XMonad/Hooks/EwmhDesktops.hs
+++ b/XMonad/Hooks/EwmhDesktops.hs
@ -42,6 +42,10 @@ module XMonad.Hooks.EwmhDesktops (
    -- $customActivate
    setEwmhActivateHook,
    -- ** Workspace switching
    -- $customWorkspaceSwitch
    setEwmhSwitchDesktopHook,
    -- ** Fullscreen
    -- $customFullscreen
    setEwmhFullscreenHooks,
@ -50,6 +54,9 @@ module XMonad.Hooks.EwmhDesktops (
    -- $customManageDesktopViewport
    disableEwmhManageDesktopViewport,
    -- $customHiddenWorkspaceMapper
    setEwmhHiddenWorkspaceToScreenMapping,
    -- * Standalone hooks (deprecated)
    ewmhDesktopsStartup,
    ewmhDesktopsLogHook,
@ -114,8 +121,12 @@ data EwmhDesktopsConfig =
            -- ^ configurable handling of window activation requests
        , fullscreenHooks :: (ManageHook, ManageHook)
            -- ^ configurable handling of fullscreen state requests
        , switchDesktopHook :: WorkspaceId -> WindowSet -> WindowSet
            -- ^ configurable action for handling _NET_CURRENT_DESKTOP
        , manageDesktopViewport :: Bool
            -- ^ manage @_NET_DESKTOP_VIEWPORT@?
        , hiddenWorkspaceToScreen :: WindowSet -> WindowSpace -> WindowScreen
            -- ^ map hidden workspaces to screens for @_NET_DESKTOP_VIEWPORT@
        }
 instance Default EwmhDesktopsConfig where
@ -124,7 +135,10 @@ instance Default EwmhDesktopsConfig where
        , workspaceRename = pure pure
        , activateHook = doFocus
        , fullscreenHooks = (doFullFloat, doSink)
        , switchDesktopHook = W.view
        , manageDesktopViewport = True
        -- Hidden workspaces are mapped to the current screen by default.
        , hiddenWorkspaceToScreen = \winset _ -> W.current winset
        }
@ -231,8 +245,8 @@ setEwmhWorkspaceRename f = XC.modifyDef $ \c -> c{ workspaceRename = f }
 -- >   [ className =? "Google-chrome" <||> className =? "google-chrome" -?> doAskUrgent
 -- >   , pure True -?> doFocus ]
 --
-- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers" and "XMonad.Hooks.Focus"
+-- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers", "XMonad.Hooks.Focus" and
-- for functions that can be useful here.
+-- "XMonad.Layout.IndependentScreens" for functions that can be useful here.
 -- | Set (replace) the hook which is invoked when a client sends a
 -- @_NET_ACTIVE_WINDOW@ request to activate a window. The default is 'doFocus'
@ -245,6 +259,31 @@ setEwmhActivateHook :: ManageHook -> XConfig l -> XConfig l
 setEwmhActivateHook h = XC.modifyDef $ \c -> c{ activateHook = h }
 -- $customWorkspaceSwitch
 -- When a client sends a @_NET_CURRENT_DESKTOP@ request to switch to a workspace,
 -- the default action used to do that is the 'W.view' function.
 -- This may not be the desired behaviour in all configurations.
 --
 -- For example if using the "XMonad.Layout.IndependentScreens" the default action
 -- might move a workspace to a screen that it isn't supposed to be on.
 -- This behaviour can be fixed using the following:
 --
 -- > import XMonad.Actions.OnScreen
 -- > import XMonad.Layout.IndependentScreens
 -- >
 -- > main = xmonad $ ... . setEwmhSwitchDesktopHook focusWorkspace . ewmh . ... $
 -- >  def{
 -- >    ...
 -- >      workspaces = withScreens 2 (workspaces def)
 -- >    ...
 -- >  }
 -- | Set (replace) the action which is invoked when a client sends a
 -- @_NET_CURRENT_DESKTOP@ request to switch workspace.
 setEwmhSwitchDesktopHook :: (WorkspaceId -> WindowSet -> WindowSet) -> XConfig l -> XConfig l
 setEwmhSwitchDesktopHook action = XC.modifyDef $ \c -> c{ switchDesktopHook = action }
 -- $customFullscreen
 -- When a client sends a @_NET_WM_STATE@ request to add\/remove\/toggle the
 -- @_NET_WM_STATE_FULLSCREEN@ state, 'ewmhFullscreen' uses a pair of hooks to
@ -284,6 +323,34 @@ disableEwmhManageDesktopViewport :: XConfig l -> XConfig l
 disableEwmhManageDesktopViewport = XC.modifyDef $ \c -> c{ manageDesktopViewport = False }
 -- $customHiddenWorkspaceMapper
 --
 -- Mapping the hidden workspaces to the current screen is a good default behavior,
 -- but it makes the assumption that workspaces don't belong to a sepcific screen.
 -- If the default behaviour is undesired, for example when using "XMonad.Layout.IndependentScreens",
 -- it can be customized.
 --
 -- The following example demonstrates a way to configure the mapping when using "XMonad.Layout.IndependentScreens":
 --
 -- > import XMonad.Layout.IndependentScreens
 -- >
 -- > customMapper :: WindowSet -> (WindowSpace -> WindowScreen)
 -- > customMapper winset (Workspace wsid _ _) = fromMaybe (W.current winset) maybeMappedScreen
 -- >  where
 -- >    screenId = unmarshallS wsid
 -- >    maybeMappedScreen = screenOnMonitor screenId winset
 -- >
 -- >
 -- > main = xmonad $ ... . setEwmhHiddenWorkspaceToScreenMapping customMapper . ewmh . ... $ def{...}
 -- | Set (replace) the function responsible for mapping the hidden workspaces to screens.
 setEwmhHiddenWorkspaceToScreenMapping :: (WindowSet -> (WindowSpace -> WindowScreen))
                                        -- ^ Function that given the current WindowSet
                                        -- produces a function to maps a (hidden) workspace to a screen.
                                        -> XConfig l -> XConfig l
 setEwmhHiddenWorkspaceToScreenMapping mapper = XC.modifyDef $ \c -> c{ hiddenWorkspaceToScreen = mapper }
 -- | Initializes EwmhDesktops and advertises EWMH support to the X server.
 {-# DEPRECATED ewmhDesktopsStartup "Use ewmh instead." #-}
 ewmhDesktopsStartup :: X ()
@ -358,7 +425,7 @@ whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()
 whenChanged = whenX . XS.modified . const
 ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X ()
-ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDesktopViewport} = withWindowSet $ \s -> do
+ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDesktopViewport, hiddenWorkspaceToScreen} = withWindowSet $ \s -> do
    sort' <- workspaceSort
    let ws = sort' $ W.workspaces s
@ -423,18 +490,20 @@ ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDe
    when manageDesktopViewport $ do
        let visibleScreens = W.current s : W.visible s
            currentTags    = map (W.tag . W.workspace) visibleScreens
-        whenChanged (MonitorTags currentTags) $ mkViewPorts s (map W.tag ws)
+        whenChanged (MonitorTags currentTags) $ mkViewPorts s hiddenWorkspaceToScreen (map W.tag ws)
 -- | Create the viewports from the current 'WindowSet' and a list of
 -- already sorted workspace IDs.
-mkViewPorts :: WindowSet -> [WorkspaceId] -> X ()
+mkViewPorts :: WindowSet -> (WindowSet -> WindowSpace -> WindowScreen) -> [WorkspaceId] -> X ()
-mkViewPorts winset = setDesktopViewport . concat . mapMaybe (viewPorts M.!?)
+mkViewPorts winset hiddenWorkspaceMapper = setDesktopViewport . concat . mapMaybe (viewPorts M.!?)
  where
    foc = W.current winset
    -- Hidden workspaces are mapped to the current screen's viewport.
    viewPorts :: M.Map WorkspaceId [Position]
    viewPorts = M.fromList $ map mkVisibleViewPort (foc : W.visible winset)
-                          ++ map (mkViewPort foc)  (W.hidden winset)
+                          ++ map (uncurry mkViewPort) hiddenWorkspacesWithScreens
    hiddenWorkspacesWithScreens :: [(WindowScreen,WindowSpace)]
    hiddenWorkspacesWithScreens = map (\x -> (hiddenWorkspaceMapper winset x, x)) (W.hidden winset)
    mkViewPort :: WindowScreen -> WindowSpace -> (WorkspaceId, [Position])
    mkViewPort scr w = (W.tag w, mkPos scr)
@ -449,7 +518,7 @@ mkViewPorts winset = setDesktopViewport . concat . mapMaybe (viewPorts M.!?)
 ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All
 ewmhDesktopsEventHook'
        ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d}
-        EwmhDesktopsConfig{workspaceSort, activateHook} =
+        EwmhDesktopsConfig{workspaceSort, activateHook, switchDesktopHook} =
    withWindowSet $ \s -> do
        sort' <- workspaceSort
        let ws = sort' $ W.workspaces s
@ -459,10 +528,17 @@ ewmhDesktopsEventHook'
        a_aw <- getAtom "_NET_ACTIVE_WINDOW"
        a_cw <- getAtom "_NET_CLOSE_WINDOW"
-        if  | mt == a_cd, n : _ <- d, Just ww <- ws !? fi n ->
+        if  | mt == a_cw ->
-                if W.currentTag s == W.tag ww then mempty else windows $ W.view (W.tag ww)
+                killWindow w
            | mt == a_cd, n : _ <- d, Just ww <- ws !? fi n ->
                if W.currentTag s == W.tag ww then mempty else windows $ switchDesktopHook (W.tag ww)
            | mt == a_cd ->
                trace $ "Bad _NET_CURRENT_DESKTOP with data=" ++ show d
            | not (w `W.member` s) ->
                -- do nothing for unmanaged windows; it'd be just a useless
                -- refresh which breaks menus/popups of misbehaving apps that
                -- send _NET_ACTIVE_WINDOW requests for override-redirect wins
                mempty
            | mt == a_d, n : _ <- d, Just ww <- ws !? fi n ->
                if W.findTag w s == Just (W.tag ww) then mempty else windows $ W.shiftWin (W.tag ww) w
            | mt == a_d ->
@ -473,8 +549,6 @@ ewmhDesktopsEventHook'
                if W.peek s == Just w then mempty else windows $ W.focusWindow w
            | mt == a_aw -> do
                if W.peek s == Just w then mempty else windows . appEndo =<< runQuery activateHook w
            | mt == a_cw ->
                killWindow w
            | otherwise ->
                -- The Message is unknown to us, but that is ok, not all are meant
                -- to be handled by the window manager
--- a/XMonad/Hooks/FloatConfigureReq.hs
+++ b/XMonad/Hooks/FloatConfigureReq.hs
@ -0,0 +1,126 @@
 {-# LANGUAGE LambdaCase #-}
 -- |
 -- Module      :  XMonad.Hooks.FloatConfigureReq
 -- Description :  Customize handling of floating windows' move\/resize\/restack requests (ConfigureRequest).
 -- Copyright   :  (c) 2024 Tomáš Janoušek <tomi@nomi.cz>
 -- License     :  BSD3
 -- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>
 --
 -- xmonad normally honours those requests by doing exactly what the client
 -- application asked, and refreshing. There are some misbehaving clients,
 -- however, that:
 --
 -- * try to move their window to the last known absolute position regardless
 --   of the current xrandr/xinerama layout
 --
 -- * move their window to 0, 0 for no particular reason (e.g. rxvt-unicode)
 --
 -- * issue lots of no-op requests causing flickering (e.g. Steam)
 --
 -- This module provides a replacement handler for 'ConfigureRequestEvent' to
 -- work around such misbehaviours.
 --
 module XMonad.Hooks.FloatConfigureReq (
    -- * Usage
    -- $usage
    MaybeMaybeManageHook,
    floatConfReqHook,
    -- * Known workarounds
    fixSteamFlicker,
    fixSteamFlickerMMMH,
    ) where
 import qualified Data.Map.Strict as M
 import XMonad
 import XMonad.Hooks.ManageHelpers
 import XMonad.Prelude
 import qualified XMonad.StackSet as W
 -- $usage
 -- To use this, include the following in your @xmonad.hs@:
 --
 -- > import XMonad.Hooks.FloatConfigureReq
 -- > import XMonad.Hooks.ManageHelpers
 --
 -- > myFloatConfReqHook :: MaybeMaybeManageHook
 -- > myFloatConfReqHook = composeAll
 -- >     [ … ]
 --
 -- > myEventHook :: Event -> X All
 -- > myEventHook = mconcat
 -- >     [ …
 -- >     , floatConfReqHook myFloatConfReqHook
 -- >     , … ]
 --
 -- > main = xmonad $ …
 -- >               $ def{ handleEventHook = myEventHook
 -- >                    , … }
 --
 -- Then fill the @myFloatConfReqHook@ with whatever custom rules you need.
 --
 -- As an example, the following will prevent rxvt-unicode from moving its
 -- (floating) window to 0, 0 after a font change but still ensure its size
 -- increment hints are respected:
 --
 -- > className =? "URxvt" -?> pure <$> doFloat
 --
 -- Another example that avoids flickering and xmonad slowdowns caused by the
 -- Steam client (completely ignore all its requests, none of which are
 -- meaningful in the context of a tiling WM):
 --
 -- > map toLower `fmap` className =? "steam" -?> mempty
 --
 -- (this example is also available as 'fixSteamFlickerMMMH' to be added to
 -- one's @myFloatConfReqHook@ and also 'fixSteamFlicker' to be added directly
 -- to one's 'handleEventHook')
 -- | A variant of 'MaybeManageHook' that additionally may or may not make
 -- changes to the 'WindowSet'.
 type MaybeMaybeManageHook = Query (Maybe (Maybe (Endo WindowSet)))
 -- | Customizable handler for a 'ConfigureRequestEvent'. If the event's
 -- 'ev_window' is a managed floating window, the provided
 -- 'MaybeMaybeManageHook' is consulted and its result interpreted as follows:
 --
 --  * @Nothing@ - no match, fall back to the default handler
 --
 --  * @Just Nothing@ - match but ignore, no refresh, just send ConfigureNotify
 --
 --  * @Just (Just a)@ - match, modify 'WindowSet', refresh, send ConfigureNotify
 floatConfReqHook :: MaybeMaybeManageHook -> Event -> X All
 floatConfReqHook mh ConfigureRequestEvent{ev_window = w} =
    runQuery (join <$> (isFloatQ -?> mh)) w >>= \case
        Nothing -> mempty
        Just e -> do
            whenJust e (windows . appEndo)
            sendConfEvent
            pure (All False)
  where
    sendConfEvent = withDisplay $ \dpy ->
        withWindowAttributes dpy w $ \wa -> do
            io . allocaXEvent $ \ev -> do
                -- We may have made no changes to the window size/position
                -- and thus the X server didn't emit any ConfigureNotify,
                -- so we need to send the ConfigureNotify ourselves to make
                -- sure there is a reply to this ConfigureRequestEvent and the
                -- window knows we (possibly) ignored its request.
                setEventType ev configureNotify
                setConfigureEvent ev w w
                    (wa_x wa) (wa_y wa) (wa_width wa)
                    (wa_height wa) (wa_border_width wa) none (wa_override_redirect wa)
                sendEvent dpy w False 0 ev
 floatConfReqHook _ _ = mempty
 -- | A 'Query' to determine if a window is floating.
 isFloatQ :: Query Bool
 isFloatQ = ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset
 -- | A pre-packaged 'floatConfReqHook' that fixes flickering of the Steam client by ignoring 'ConfigureRequestEvent's on any of its floating windows.
 --
 -- To use this, add 'fixSteamFlicker' to your 'handleEventHook'.
 fixSteamFlicker :: Event -> X All
 fixSteamFlicker = floatConfReqHook fixSteamFlickerMMMH
 fixSteamFlickerMMMH :: MaybeMaybeManageHook
 fixSteamFlickerMMMH = map toLower `fmap` className =? "steam" -?> mempty
--- a/XMonad/Hooks/ManageHelpers.hs
+++ b/XMonad/Hooks/ManageHelpers.hs
@ -51,6 +51,7 @@ module XMonad.Hooks.ManageHelpers (
    isFullscreen,
    isMinimized,
    isDialog,
    isNotification,
    pid,
    desktop,
    transientTo,
@ -191,9 +192,18 @@ isMinimized :: Query Bool
 isMinimized = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN"
 -- | A predicate to check whether a window is a dialog.
 --
 -- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>.
 isDialog :: Query Bool
 isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG"
 -- | A predicate to check whether a window is a notification.
 --
 -- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>.
 isNotification :: Query Bool
 isNotification =
  isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_NOTIFICATION"
 -- | This function returns 'Just' the @_NET_WM_PID@ property for a
 -- particular window if set, 'Nothing' otherwise.
 --
--- a/XMonad/Hooks/OnPropertyChange.hs
+++ b/XMonad/Hooks/OnPropertyChange.hs
@ -41,13 +41,13 @@ import XMonad.Prelude
 -- $usage
 -- You can use this module with the following in your @xmonad.hs@:
 --
-- > import XMonad.Hooks.DynamicProperty
+-- > import XMonad.Hooks.OnPropertyChange
 --
 -- Enable it by including in you handleEventHook definition:
 --
 -- >  main = xmonad $ def
 -- >      { ...
-- >      , handleEventHook = onXPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5"))
+-- >      , handleEventHook = onXPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5")
 -- >      , ...
 -- >      }
 --
--- a/XMonad/Hooks/Rescreen.hs
+++ b/XMonad/Hooks/Rescreen.hs
@ -15,10 +15,13 @@ module XMonad.Hooks.Rescreen (
    -- $usage
    addAfterRescreenHook,
    addRandrChangeHook,
    setRescreenWorkspacesHook,
    setRescreenDelay,
    RescreenConfig(..),
    rescreenHook,
    ) where
 import Control.Concurrent (threadDelay)
 import Graphics.X11.Xrandr
 import XMonad
 import XMonad.Prelude
@ -59,16 +62,21 @@ import qualified XMonad.Util.ExtensibleConf as XC
 data RescreenConfig = RescreenConfig
    { afterRescreenHook :: X () -- ^ hook to invoke after 'rescreen'
    , randrChangeHook :: X () -- ^ hook for other randr changes, e.g. (dis)connects
    , rescreenWorkspacesHook :: Last (X ()) -- ^ hook to invoke instead of 'rescreen'
    , rescreenDelay :: Last Int -- ^ delay (in microseconds) to wait for events to settle
    }
 instance Default RescreenConfig where
    def = RescreenConfig
        { afterRescreenHook = mempty
        , randrChangeHook = mempty
        , rescreenWorkspacesHook = mempty
        , rescreenDelay = mempty
        }
 instance Semigroup RescreenConfig where
-    RescreenConfig arh rch <> RescreenConfig arh' rch' = RescreenConfig (arh <> arh') (rch <> rch')
+    RescreenConfig arh rch rwh rd <> RescreenConfig arh' rch' rwh' rd' =
        RescreenConfig (arh <> arh') (rch <> rch') (rwh <> rwh') (rd <> rd')
 instance Monoid RescreenConfig where
    mempty = def
@ -89,20 +97,45 @@ instance Monoid RescreenConfig where
 -- 'randrChangeHook' may be used to automatically trigger xrandr (or perhaps
 -- autorandr) when outputs are (dis)connected.
 --
 -- 'rescreenWorkspacesHook' allows tweaking the 'rescreen' implementation,
 -- to change the order workspaces are assigned to physical screens for
 -- example.
 --
 -- 'rescreenDelay' makes xmonad wait a bit for events to settle (after the
 -- first event is received) — useful when multiple @xrandr@ invocations are
 -- being used to change the screen layout.
 --
 -- Note that 'rescreenHook' is safe to use several times, 'rescreen' is still
-- done just once and hooks are invoked in sequence, also just once.
+-- done just once and hooks are invoked in sequence (except
 -- 'rescreenWorkspacesHook', which has a replace rather than sequence
 -- semantics), also just once.
 rescreenHook :: RescreenConfig -> XConfig l -> XConfig l
-rescreenHook = XC.once $ \c -> c
+rescreenHook = XC.once hook . catchUserCode
-    { startupHook = startupHook c <> rescreenStartupHook
+  where
-    , handleEventHook = handleEventHook c <> rescreenEventHook }
+    hook c = c
        { startupHook = startupHook c <> rescreenStartupHook
        , handleEventHook = handleEventHook c <> rescreenEventHook }
    catchUserCode rc@RescreenConfig{..} = rc
        { afterRescreenHook = userCodeDef () afterRescreenHook
        , randrChangeHook = userCodeDef () randrChangeHook
        , rescreenWorkspacesHook = flip catchX rescreen <$> rescreenWorkspacesHook
        }
 -- | Shortcut for 'rescreenHook'.
 addAfterRescreenHook :: X () -> XConfig l -> XConfig l
-addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = userCodeDef () h }
+addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = h }
 -- | Shortcut for 'rescreenHook'.
 addRandrChangeHook :: X () -> XConfig l -> XConfig l
-addRandrChangeHook h = rescreenHook def{ randrChangeHook = userCodeDef () h }
+addRandrChangeHook h = rescreenHook def{ randrChangeHook = h }
 -- | Shortcut for 'rescreenHook'.
 setRescreenWorkspacesHook :: X () -> XConfig l -> XConfig l
 setRescreenWorkspacesHook h = rescreenHook def{ rescreenWorkspacesHook = pure h }
 -- | Shortcut for 'rescreenHook'.
 setRescreenDelay :: Int -> XConfig l -> XConfig l
 setRescreenDelay d = rescreenHook def{ rescreenDelay = pure d }
 -- | Startup hook to listen for @RRScreenChangeNotify@ events.
 rescreenStartupHook :: X ()
@ -126,13 +159,14 @@ handleEvent :: Event -> X ()
 handleEvent e = XC.with $ \RescreenConfig{..} -> do
    -- Xorg emits several events after every change, clear them to prevent
    -- triggering the hook multiple times.
    whenJust (getLast rescreenDelay) (io . threadDelay)
    moreConfigureEvents <- clearTypedWindowEvents (ev_window e) configureNotify
    _ <- clearTypedWindowRREvents (ev_window e) rrScreenChangeNotify
    -- If there were any ConfigureEvents, this is an actual screen
    -- configuration change, so rescreen and fire rescreenHook. Otherwise,
    -- this is just a connect/disconnect, fire randrChangeHook.
    if ev_event_type e == configureNotify || moreConfigureEvents
-        then rescreen >> afterRescreenHook
+        then fromMaybe rescreen (getLast rescreenWorkspacesHook) >> afterRescreenHook
        else randrChangeHook
 -- | Remove all X events of a given window and type from the event queue,
--- a/XMonad/Hooks/ScreenCorners.hs
+++ b/XMonad/Hooks/ScreenCorners.hs
@ -1,48 +1,51 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}
+{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TupleSections #-}
 -- |
 -- Module      :  XMonad.Hooks.ScreenCorners
 -- Description :  Run X () actions by touching the edge of your screen with your mouse.
-- Copyright   :  (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky
+-- Copyright   :  (c) 2009-2025 Nils Schweinsberg, 2015 Evgeny Kurnevsky, 2024 Yuanle Song
 -- License     :  BSD3-style (see LICENSE)
 --
-- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>
+-- Maintainer  :  Nils Schweinsberg <mail@nils.cc>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
 -- Run @X ()@ actions by touching the edge of your screen with your mouse.
 --
 -----------------------------------------------------------------------------
 module XMonad.Hooks.ScreenCorners
-    (
+  ( -- * Usage
    -- * Usage
    -- $usage
    -- * Adding screen corners
-      ScreenCorner (..)
+    ScreenCorner (..),
-    , addScreenCorner
+    addScreenCorner,
-    , addScreenCorners
+    addScreenCorners,
    -- * Event hook
-    , screenCornerEventHook
+    screenCornerEventHook,
    -- * Layout hook
-    , screenCornerLayoutHook
+    screenCornerLayoutHook,
-    ) where
+  )
-
+where
 import XMonad.Prelude
 import XMonad
 import XMonad.Layout.LayoutModifier
 import qualified Data.Map as M
 import XMonad
 import XMonad.Layout.LayoutModifier
 import XMonad.Prelude
 import qualified XMonad.Util.ExtensibleState as XS
-data ScreenCorner = SCUpperLeft
+data ScreenCorner
-                  | SCUpperRight
+  = SCUpperLeft
-                  | SCLowerLeft
+  | SCUpperRight
-                  | SCLowerRight
+  | SCLowerLeft
-                  deriving (Eq, Ord, Show)
+  | SCLowerRight
  | SCTop
  | SCBottom
  | SCLeft
  | SCRight
  deriving (Eq, Ord, Show)
 --------------------------------------------------------------------------------
 -- ExtensibleState modifications
@ -51,77 +54,89 @@ data ScreenCorner = SCUpperLeft
 newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ()))
 instance ExtensionClass ScreenCornerState where
-    initialValue = ScreenCornerState M.empty
+  initialValue = ScreenCornerState M.empty
 -- | Add one single @X ()@ action to a screen corner
 addScreenCorner :: ScreenCorner -> X () -> X ()
 addScreenCorner corner xF = do
  ScreenCornerState m <- XS.get
  (win, xFunc) <- case find (\(_, (sc, _)) -> sc == corner) (M.toList m) of
    Just (w, (_, xF')) -> return (w, xF' >> xF) -- chain X actions
    Nothing -> (,xF) <$> createWindowAt corner
-    ScreenCornerState m <- XS.get
+  XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner, xFunc) m'
    (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of
                        Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions
                        Nothing           -> (, xF) <$> createWindowAt corner
    XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'
 -- | Add a list of @(ScreenCorner, X ())@ tuples
-addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()
+addScreenCorners :: [(ScreenCorner, X ())] -> X ()
 addScreenCorners = mapM_ (uncurry addScreenCorner)
 --------------------------------------------------------------------------------
 -- Xlib functions
 --------------------------------------------------------------------------------
-- "Translate" a ScreenCorner to real (x,y) Positions
+-- "Translate" a ScreenCorner to real (x,y) Positions with proper width and
 -- height.
 createWindowAt :: ScreenCorner -> X Window
-createWindowAt SCUpperLeft = createWindowAt' 0 0
+createWindowAt SCUpperLeft = createWindowAt' 0 0 1 1
 createWindowAt SCUpperRight = withDisplay $ \dpy ->
-    let w = displayWidth  dpy (defaultScreen dpy) - 1
+  let w = displayWidth dpy (defaultScreen dpy) - 1
-    in createWindowAt' (fi w) 0
+   in createWindowAt' (fi w) 0 1 1
 createWindowAt SCLowerLeft = withDisplay $ \dpy ->
-    let h = displayHeight dpy (defaultScreen dpy) - 1
+  let h = displayHeight dpy (defaultScreen dpy) - 1
-    in createWindowAt' 0 (fi h)
+   in createWindowAt' 0 (fi h) 1 1
 createWindowAt SCLowerRight = withDisplay $ \dpy ->
-    let w = displayWidth  dpy (defaultScreen dpy) - 1
+  let w = displayWidth dpy (defaultScreen dpy) - 1
-        h = displayHeight dpy (defaultScreen dpy) - 1
+      h = displayHeight dpy (defaultScreen dpy) - 1
-    in createWindowAt' (fi w) (fi h)
+   in createWindowAt' (fi w) (fi h) 1 1
 createWindowAt SCTop = withDisplay $ \dpy ->
  let w = displayWidth dpy (defaultScreen dpy) - 1
      -- leave some gap so corner and edge can work nicely when they overlap
      threshold = 150
   in createWindowAt' threshold 0 (fi $ fi w - threshold * 2) 1
 createWindowAt SCBottom = withDisplay $ \dpy ->
  let w = displayWidth dpy (defaultScreen dpy) - 1
      h = displayHeight dpy (defaultScreen dpy) - 1
      threshold = 150
   in createWindowAt' threshold (fi h) (fi $ fi w - threshold * 2) 1
 createWindowAt SCLeft = withDisplay $ \dpy ->
  let h = displayHeight dpy (defaultScreen dpy) - 1
      threshold = 150
   in createWindowAt' 0 threshold 1 (fi $ fi h - threshold * 2)
 createWindowAt SCRight = withDisplay $ \dpy ->
  let w = displayWidth dpy (defaultScreen dpy) - 1
      h = displayHeight dpy (defaultScreen dpy) - 1
      threshold = 150
   in createWindowAt' (fi w) threshold 1 (fi $ fi h - threshold * 2)
-- Create a new X window at a (x,y) Position
+-- Create a new X window at a (x,y) Position, with given width and height.
-createWindowAt' :: Position -> Position -> X Window
+createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window
-createWindowAt' x y = withDisplay $ \dpy -> io $ do
+createWindowAt' x y width height = withDisplay $ \dpy -> io $ do
  rootw <- rootWindow dpy (defaultScreen dpy)
-    rootw <- rootWindow dpy (defaultScreen dpy)
+  let visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
      attrmask = cWOverrideRedirect
-    let
+  w <- allocaSetWindowAttributes $ \attributes -> do
-        visual   = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
+    set_override_redirect attributes True
-        attrmask = cWOverrideRedirect
+    createWindow
-
+      dpy -- display
-    w <- allocaSetWindowAttributes $ \attributes -> do
+      rootw -- parent window
-
+      x -- x
-        set_override_redirect attributes True
+      y -- y
-        createWindow dpy        -- display
+      width -- width
-                     rootw      -- parent window
+      height -- height
-                     x          -- x
+      0 -- border width
-                     y          -- y
+      0 -- depth
-                     1          -- width
+      inputOnly -- class
-                     1          -- height
+      visual -- visual
-                     0          -- border width
+      attrmask -- valuemask
-                     0          -- depth
+      attributes -- attributes
                     inputOnly  -- class
                     visual     -- visual
                     attrmask   -- valuemask
                     attributes -- attributes
    -- we only need mouse entry events
    selectInput dpy w enterWindowMask
    mapWindow dpy w
    sync dpy False
    return w
  -- we only need mouse entry events
  selectInput dpy w enterWindowMask
  mapWindow dpy w
  sync dpy False
  return w
 --------------------------------------------------------------------------------
 -- Event hook
@ -129,42 +144,40 @@ createWindowAt' x y = withDisplay $ \dpy -> io $ do
 -- | Handle screen corner events
 screenCornerEventHook :: Event -> X All
-screenCornerEventHook CrossingEvent { ev_window = win } = do
+screenCornerEventHook CrossingEvent {ev_window = win} = do
  ScreenCornerState m <- XS.get
-    ScreenCornerState m <- XS.get
+  case M.lookup win m of
-
+    Just (_, xF) -> xF
-    case M.lookup win m of
+    Nothing -> return ()
         Just (_, xF) -> xF
         Nothing      -> return ()
    return (All True)
  return (All True)
 screenCornerEventHook _ = return (All True)
 --------------------------------------------------------------------------------
 -- Layout hook
 --------------------------------------------------------------------------------
 data ScreenCornerLayout a = ScreenCornerLayout
-    deriving ( Read, Show )
+  deriving (Read, Show)
 instance LayoutModifier ScreenCornerLayout a where
-    hook ScreenCornerLayout = withDisplay $ \dpy -> do
+  hook ScreenCornerLayout = withDisplay $ \dpy -> do
-        ScreenCornerState m <- XS.get
+    ScreenCornerState m <- XS.get
-        io $ mapM_ (raiseWindow dpy) $ M.keys m
+    io $ mapM_ (raiseWindow dpy) $ M.keys m
-    unhook = hook
+  unhook = hook
 screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a
 screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
 --------------------------------------------------------------------------------
 -- $usage
 --
-- This extension adds KDE-like screen corners to XMonad. By moving your cursor
+-- This extension adds KDE-like screen corners and GNOME Hot Edge like
-- into one of your screen corners you can trigger an @X ()@ action, for
+-- features to XMonad. By moving your cursor into one of your screen corners
-- example @"XMonad.Actions.GridSelect".goToSelected@ or
+-- or edges, you can trigger an @X ()@ action, for example
 -- @"XMonad.Actions.GridSelect".goToSelected@ or
 -- @"XMonad.Actions.CycleWS".nextWS@ etc.
 --
 -- To use it, import it on top of your @xmonad.hs@:
@ -176,6 +189,7 @@ screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
 -- > myStartupHook = do
 -- >     ...
 -- >     addScreenCorner SCUpperRight (goToSelected def { gs_cellwidth = 200})
 -- >     addScreenCorner SCBottom (goToSelected def)
 -- >     addScreenCorners [ (SCLowerRight, nextWS)
 -- >                      , (SCLowerLeft,  prevWS)
 -- >                      ]
--- a/XMonad/Hooks/StatusBar.hs
+++ b/XMonad/Hooks/StatusBar.hs
@ -426,12 +426,12 @@ statusBarPipe cmd xpp = do
 -- > xmobarBottom = statusBarPropTo "_XMONAD_LOG_2" "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom)
 -- > xmobar1      = statusBarPropTo "_XMONAD_LOG_3" "xmobar -x 1 ~/.config/xmobar/xmobarrc1"       (pure pp1)
 -- >
-- > barSpawner :: ScreenId -> IO StatusBarConfig
+-- > barSpawner :: ScreenId -> StatusBarConfig
-- > barSpawner 0 = pure $ xmobarTop <> xmobarBottom -- two bars on the main screen
+-- > barSpawner 0 = xmobarTop <> xmobarBottom -- two bars on the main screen
-- > barSpawner 1 = pure $ xmobar1
+-- > barSpawner 1 = xmobar1
 -- > barSpawner _ = mempty -- nothing on the rest of the screens
 -- >
-- > main = xmonad $ dynamicSBs barSpawner (def { ... })
+-- > main = xmonad $ dynamicSBs (pure . barSpawner) (def { ... })
 --
 -- Make sure you specify which screen to place the status bar on (in xmobar,
 -- this is achieved by the @-x@ argument). In addition to making sure that your
@ -452,7 +452,7 @@ instance ExtensionClass ActiveSBs where
 -- 'avoidStruts', check 'dynamicEasySBs'.
 --
 -- Heavily inspired by "XMonad.Hooks.DynamicBars"
-dynamicSBs :: (ScreenId -> IO StatusBarConfig) -> XConfig l -> XConfig l
+dynamicSBs :: (ScreenId -> X StatusBarConfig) -> XConfig l -> XConfig l
 dynamicSBs f conf = addAfterRescreenHook (updateSBs f) $ conf
  { startupHook = startupHook conf >> killAllStatusBars >> updateSBs f
  , logHook     = logHook conf >> logSBs
@ -462,7 +462,7 @@ dynamicSBs f conf = addAfterRescreenHook (updateSBs f) $ conf
 -- resulting config and adds 'avoidStruts' to the
 -- layout.
 dynamicEasySBs :: LayoutClass l Window
-               => (ScreenId -> IO StatusBarConfig)
+               => (ScreenId -> X StatusBarConfig)
               -> XConfig l
               -> XConfig (ModifiedLayout AvoidStruts l)
 dynamicEasySBs f conf =
@ -471,7 +471,7 @@ dynamicEasySBs f conf =
 -- | Given the function to create status bars, update
 -- the status bars by killing those that shouldn't be
 -- visible anymore and creates any missing status bars
-updateSBs :: (ScreenId -> IO StatusBarConfig) -> X ()
+updateSBs :: (ScreenId -> X StatusBarConfig) -> X ()
 updateSBs f = do
  actualScreens    <- withWindowSet $ return . map W.screen . W.screens
  (toKeep, toKill) <-
@ -480,7 +480,7 @@ updateSBs f = do
  cleanSBs (map snd toKill)
  -- Create new status bars if needed
  let missing = actualScreens \\ map fst toKeep
-  added <- io $ traverse (\s -> (s,) <$> f s) missing
+  added <- traverse (\s -> (s,) <$> f s) missing
  traverse_ (sbStartupHook . snd) added
  XS.put (ASB (toKeep ++ added))
--- a/XMonad/Layout/AutoMaster.hs
+++ b/XMonad/Layout/AutoMaster.hs
@ -35,7 +35,7 @@ import Control.Arrow (first)
 -- in one row, in slave area underlying layout is run. Size of slave area
 -- automatically increases when number of slave windows is increasing.
 --
-- You can use this module by adding folowing in your @xmonad.hs@:
+-- You can use this module by adding following in your @xmonad.hs@:
 --
 -- > import XMonad.Layout.AutoMaster
 --
--- a/XMonad/Layout/CenteredMaster.hs
+++ b/XMonad/Layout/CenteredMaster.hs
@ -38,7 +38,7 @@ import Control.Arrow (first)
 -- All other windows in background are managed by base layout.
 -- topRightMaster is like centerMaster, but places master window in top right corner instead of center.
 --
-- Yo can use this module by adding folowing in your @xmonad.hs@:
+-- You can use this module by adding following in your @xmonad.hs@:
 --
 -- > import XMonad.Layout.CenteredMaster
 --
--- a/XMonad/Layout/CircleEx.hs
+++ b/XMonad/Layout/CircleEx.hs
@ -116,7 +116,7 @@ data CircleExMsg
  = Rotate !Double            -- ^ Rotate secondary windows by specific angle
  | IncStackRatio !Rational   -- ^ Increase (or decrease, with negative value) sizes of secondary windows
  | IncMultiplier !Rational   -- ^ Increase 'cMultiplier'.
-  deriving (Eq, Show, Typeable)
+  deriving (Eq, Show)
 instance Message CircleExMsg
--- a/XMonad/Layout/Column.hs
+++ b/XMonad/Layout/Column.hs
@ -11,7 +11,7 @@
 -- Portability :  unportable
 --
 -- Provides Column layout that places all windows in one column. Windows
-- heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is
+-- heights are calculated from the equation: H1/H2 = H2/H3 = ... = q, where q is
 -- given. With Shrink/Expand messages you can change the q value.
 --
 -----------------------------------------------------------------------------
@ -25,12 +25,12 @@ import XMonad
 import qualified XMonad.StackSet as W
 -- $usage
-- This module defines layot named Column. It places all windows in one
+-- This module defines layout named Column. It places all windows in one
-- column. Windows heights are calculated from equation: H1/H2 = H2/H3 = ... =
+-- column. Windows heights are calculated from the equation: H1/H2 = H2/H3 = ... =
 -- q, where `q' is given (thus, windows heights are members of geometric
 -- progression). With Shrink/Expand messages one can change the `q' value.
 --
-- You can use this module by adding folowing in your @xmonad.hs@:
+-- You can use this module by adding following in your @xmonad.hs@:
 --
 -- > import XMonad.Layout.Column
 --
--- a/XMonad/Layout/Columns.hs
+++ b/XMonad/Layout/Columns.hs
@ -0,0 +1,480 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 -- |
 -- Module: XMonad.Layout.Columns
 -- Description: A layout which tiles the windows in columns.
 -- Copyright: Jean-Charles Quillet
 -- License: BSD-style (see LICENSE)
 --
 -- Maintainer: none
 -- Stability: unstable
 -- Portability: unportable
 --
 -- A layout which tiles the windows in columns. The windows can be moved and
 -- resized in every directions.
 --
 -- The first window appears in a single column in the center of the screen. Its
 -- width is configurable (See 'coOneWindowWidth').
 --
 -- The second window appears in a second column. Starting with two columns, they
 -- fill up the screen.
 --
 -- Subsequent windows appear on the bottom of the last columns.
 module XMonad.Layout.Columns
  ( -- * Usage
    -- $usage
    ColumnsLayout (..),
    -- * Messages
    Focus (..),
    Move (..),
    Resize (..),
    -- * Tools
    focusDown,
    focusUp,
  )
 where
 import Control.Applicative ((<|>))
 import Control.Arrow (Arrow (first), second)
 import Control.Monad (guard)
 import Control.Monad.State (modify)
 import Control.Monad.Trans.Maybe (MaybeT (..))
 import Data.Foldable (Foldable (..))
 import Data.List (scanl')
 import Data.Maybe (listToMaybe)
 import Data.Ratio ((%))
 import XMonad
  ( LayoutClass (..),
    Message,
    Rectangle (..),
    SomeMessage,
    Window,
    WindowSet,
    X,
    XState (..),
    fromMessage,
    gets,
    scaleRationalRect,
    sendMessage,
  )
 import qualified XMonad.Operations as O
 import XMonad.StackSet
  ( RationalRect (..),
    Screen (..),
    Stack (..),
    StackSet (..),
    integrate,
    peek,
  )
 import qualified XMonad.StackSet as StackSet
 -- $usage
 -- Add 'Columns' to your @layoutHook@ with an initial empty state:
 --
 -- > myLayout = Full ||| Columns 1 []
 --
 -- Here is an example of keybindings:
 --
 -- > -- Focus up/down
 -- > ((modm, xK_Tab), focusDown),
 -- > ((modm .|. shiftMask, xK_Tab), focusUp),
 -- > -- Move windows around
 -- > ((modm .|. shiftMask, xK_l), sendMessage MoveRight),
 -- > ((modm .|. shiftMask, xK_h), sendMessage MoveLeft),
 -- > ((modm .|. shiftMask, xK_k), sendMessage MoveUp),
 -- > ((modm .|. shiftMask, xK_j), sendMessage MoveDown),
 -- > -- Resize them
 -- > ((modm .|. controlMask, xK_l), sendMessage HorizontalExpand),
 -- > ((modm .|. controlMask, xK_h), sendMessage HorizontalShrink),
 -- > ((modm .|. controlMask, xK_k), sendMessage VerticalExpand),
 -- > ((modm .|. controlMask, xK_j), sendMessage VerticalShrink),
 --
 -- This layout is known to work with:
 --
 -- * "XMonad.Layout.WindowNavigation" for changing focus with a direction using
 -- 'XMonad.Layout.WindowNavigation.Go' messages.
 -- * 'XMonad.Layout.SubLayouts.subTabbed' for docking windows together with
 -- tabs. Note that sometimes when undocking windows, the layout is reset. This is
 -- a minor annoyance caused by the difficulty to track windows in the sublayout.
 -- | The windows can be moved in every directions.
 --
 -- Horizontally, a window alone in its column cannot be moved before the first
 -- or after the last column. If not alone, moving the window outside those
 -- limits will create a new column.
 -- The windows can also be moved vertically in their column.
 data Move = MoveLeft | MoveRight | MoveUp | MoveDown deriving (Show, Read)
 instance Message Move
 -- | The windows can be resized in every directions.
 --
 -- When resizing horizontally:
 --
 -- * if the window to be resized is not in the last column
 --
 --      * then the right side of the window will be moved
 --      * the last column will compensate the size change
 --
 -- * if the window is in the last column
 --
 --      * then the left side of the window will be moved
 --      * the column on the left of the current one will compensate the size change
 --
 -- The same applies when resizing vertically using the bottom side of the
 -- window unless it is the last window in the column in which case we use the
 -- top side.
 data Resize
  = VerticalShrink
  | VerticalExpand
  | HorizontalShrink
  | HorizontalExpand
  deriving (Show, Read)
 instance Message Resize
 -- | The layout handles focus change messages.
 --
 -- Built-in focus cannot be used here because @XMonad@ does not make it easy to
 -- change the order of windows in the focus list. See also 'focusUp' and
 -- 'focusDown' functions.
 data Focus = FocusUp | FocusDown
  deriving (Show, Read)
 instance Message Focus
 -- | A column is a list of windows with their relative vertical dimensions.
 type Column = [(Rational, Window)]
 -- | The layout is a list of 'Column' with their relative horizontal dimensions.
 type Columns = [(Rational, Column)]
 data ColumnsLayout a = Columns
  { -- | With of the first column when there is only one window. Usefull on wide
    -- screens.
    coOneWindowWidth :: Rational,
    -- | The current state
    coColumns :: Columns
  }
  deriving (Show, Read)
 instance LayoutClass ColumnsLayout Window where
  description _ = layoutDescription
  doLayout (Columns oneWindowWidth columns) rectangle stack =
    pure (rectangles, Just (Columns oneWindowWidth columns'))
    where
      hackedColumns = hackForTabs columns stack
      columns' = updateWindowList hackedColumns stack
      rectangles = toRectangles rectangle' columns'
      -- If there is only one window, we set the destination rectangle according
      -- to the width in the layout setting.
      rectangle'
        | (length . toList $ stack) == 1 =
            scaleRationalRect rectangle singleColumnRR
        | otherwise = rectangle
      singleColumnOffset = (1 - oneWindowWidth) / 2
      singleColumnRR = RationalRect singleColumnOffset 0 oneWindowWidth 1
  handleMessage layout@(Columns oneWindowWidth columns) message = do
    mbStack <- runMaybeT $ handleFocus' =<< getStack
    changedFocus <- traverse updateStack' mbStack
    movedOrResized <-
      runMaybeT $
        Columns oneWindowWidth
          <$> (handleMoveOrResize' =<< peekFocus)
    pure $ movedOrResized <|> changedFocus
    where
      getStack = MaybeT . gets $ StackSet.stack . workspace . current . windowset
      handleFocus' = hoistMaybe . handleFocus columns message
      -- A 'Just' needs to be return for the new stack to be taken into account
      updateStack' s = modify (setStack s) >> pure layout
      peekFocus = MaybeT . gets $ peek . windowset
      handleMoveOrResize' = hoistMaybe . handleMoveOrResize columns message
      hoistMaybe = MaybeT . pure
 layoutDescription :: String
 layoutDescription = "Columns"
 -- | Change the keyboard focus to the previous window
 focusUp :: X ()
 focusUp =
  sendMsgOrOnWindowsSet FocusUp StackSet.focusUp
    =<< getCurrentLayoutDescription
 -- | Change the keyboard focus to the next window
 focusDown :: X ()
 focusDown =
  sendMsgOrOnWindowsSet FocusDown StackSet.focusDown
    =<< getCurrentLayoutDescription
 sendMsgOrOnWindowsSet :: (Message a) => a -> (WindowSet -> WindowSet) -> String -> X ()
 sendMsgOrOnWindowsSet message f description'
  | description' == layoutDescription = sendMessage message
  | otherwise = O.windows f
 getCurrentLayoutDescription :: X String
 getCurrentLayoutDescription =
  gets
    ( description
        . StackSet.layout
        . workspace
        . current
        . windowset
    )
 setStack :: Stack Window -> XState -> XState
 setStack stack state =
  state
    { windowset =
        (windowset state)
          { current =
              (current $ windowset state)
                { workspace =
                    (workspace . current $ windowset state)
                      { StackSet.stack = Just stack
                      }
                }
          }
    }
 handleFocus :: Columns -> SomeMessage -> Stack Window -> Maybe (Stack Window)
 handleFocus columns message stack
  | Just FocusDown <- fromMessage message = setFocus' stack <$> mbNext
  | Just FocusUp <- fromMessage message = setFocus' stack <$> mbPrevious
  | otherwise = Nothing
  where
    focused = focus stack
    windows = columnsToWindows columns
    exists = focused `elem` windows
    mbNext = guard exists >> next focused windows
    mbPrevious = guard exists >> previous focused windows
    setFocus' = flip setFocus
    previous a = next a . reverse
    setFocus w = until ((==) w . focus) StackSet.focusDown'
    next _ [] = Nothing
    next a (x : xs)
      | a == x = listToMaybe xs
      | otherwise = next a (xs <> [x])
 oldNewWindows :: Columns -> Stack Window -> ([Window], [Window])
 oldNewWindows columns stack = (old, new)
  where
    old = filter (`notElem` stackList) windows
    new = filter (`notElem` windows) stackList
    stackList = toList stack
    windows = columnsToWindows columns
 -- | Add the new windows to the layout and remove the old ones.
 updateWindowList :: Columns -> Stack Window -> Columns
 updateWindowList columns stack = addWindows newWindows (removeWindows oldWindows columns)
  where
    (oldWindows, newWindows) = oldNewWindows columns stack
 -- | If one window disappeared and another appeared, we assume that the sublayout
 -- tabs just changed focused.
 hackForTabs :: Columns -> Stack Window -> Columns
 hackForTabs columns stack = mapWindow replace columns
  where
    replace window
      | (w1 : _, [w2]) <- oldNewWindows columns stack =
          if window == w1
            then w2
            else window
      | otherwise = window
 toRectangles :: Rectangle -> [(Rational, [(Rational, a)])] -> [(a, Rectangle)]
 toRectangles rectangle columns =
  second (scaleRationalRect rectangle) <$> windowsAndRectangles
  where
    offsetsAndRatios = toOffsetRatio (second toOffsetRatio <$> columns)
    windowsAndRectangles = foldMap toWindowAndRectangle offsetsAndRatios
    toWindowAndRectangle (x, w, cs) = (\(y, h, ws) -> (ws, RationalRect x y w h)) <$> cs
 onFocused :: (a -> a) -> Stack a -> Stack a
 onFocused f (Stack a before after) = Stack (f a) before after
 onFocusedM :: (Monad m) => (a -> m a) -> Stack a -> m (Stack a)
 onFocusedM f (Stack a before after) = Stack <$> f a <*> pure before <*> pure after
 onFocusedOrPrevious :: (a -> a) -> Stack a -> Stack a
 onFocusedOrPrevious f (Stack a (a' : others) []) = Stack a (f a' : others) []
 onFocusedOrPrevious f stack = onFocused f stack
 handleMoveOrResize :: Columns -> SomeMessage -> Window -> Maybe Columns
 handleMoveOrResize columns message window
  | Just msg <- fromMessage message = move msg window columns
  | Just HorizontalShrink <- fromMessage message =
      onFocusedOrPrevious' shrink <$> findInColumns window columns
  | Just HorizontalExpand <- fromMessage message =
      onFocusedOrPrevious' expand <$> findInColumns window columns
  | Just VerticalExpand <- fromMessage message =
      onFocusedM'
        (fmap (onFocusedOrPrevious' shrink) . findInColumn window)
        =<< findInColumns window columns
  | Just VerticalShrink <- fromMessage message =
      onFocusedM'
        (fmap (onFocusedOrPrevious' expand) . findInColumn window)
        =<< findInColumns window columns
  | otherwise = Nothing
  where
    expand = first $ flip (+) (3 / 100)
    shrink = first $ flip (-) (3 / 100)
    onFocusedM' f = fmap integrate . onFocusedM (sequence . second f)
    onFocusedOrPrevious' f = sanitize . integrate . onFocusedOrPrevious f
 move :: Move -> Window -> Columns -> Maybe Columns
 move direction window columns =
  case (direction, findInColumns window columns) of
    (MoveRight, Just (Stack (_, [(_, _)]) _ [])) -> Nothing
    (MoveLeft, Just (Stack (_, [(_, _)]) [] _)) -> Nothing
    (MoveRight, Just (Stack column@(_, [(_, _)]) before (next : others))) ->
      let (column', next') = swapWindowBetween window column next
       in Just . integrate $ Stack column' before (next' : others)
    (MoveLeft, Just (Stack column@(_, [(_, _)]) (previous : others) after)) ->
      let (column', previous') = swapWindowBetween window column previous
       in Just . integrate $ Stack column' (previous' : others) after
    (MoveRight, Just stack) ->
      let (newColumns', Stack column before after) = rationalize newColumns stack
          windows = removeWindow window column
       in Just . integrate $ Stack windows before (newColumns' <> after)
    (MoveLeft, Just stack) ->
      let (newColumns', Stack column before after) = rationalize newColumns stack
          windows = removeWindow window column
       in Just . integrate $ Stack windows (newColumns' <> before) after
    (MoveUp, Just stack) -> integrate <$> onFocusedM (swapWindowUp window) stack
    (MoveDown, Just stack) -> integrate <$> onFocusedM (swapWindowDown window) stack
    _ -> Nothing
  where
    newColumns = [[(1, window)]]
 mapWindow :: (Window -> Window) -> Columns -> Columns
 mapWindow = fmap . fmap . fmap . fmap
 columnsToWindows :: Columns -> [Window]
 columnsToWindows = foldMap ((: []) . snd) . foldMap snd
 swapWindowBetween ::
  Window ->
  (Rational, Column) ->
  (Rational, Column) ->
  ((Rational, Column), (Rational, Column))
 swapWindowBetween window from to = (removed, added)
  where
    removed = removeWindow window from
    added = appendWindows [window] to
 swapWindowUp :: Window -> (Rational, Column) -> Maybe (Rational, Column)
 swapWindowUp window (width, column)
  | Just (Stack (height, _) (previous : before') after) <- findInColumn window column =
      Just (width, integrate $ Stack previous ((height, window) : before') after)
  | otherwise = Nothing
 swapWindowDown :: Window -> (Rational, Column) -> Maybe (Rational, Column)
 swapWindowDown window (width, column)
  | Just (Stack (height, _) before (next : others)) <- findInColumn window column =
      Just (width, integrate $ Stack next before ((height, window) : others))
  | otherwise = Nothing
 -- | Adjust the ratio of a list or a stack of elts so that when adding new
 --  elements:
 -- - the new elements are distributed according to the total number of elements
 -- - the existing elements keep their proportion in the remaining space
 rationalize ::
  (Functor f, Foldable f) =>
  [a] ->
  f (Rational, a) ->
  ([(Rational, a)], f (Rational, a))
 rationalize new existing = (new', existing')
  where
    nbNew = fromIntegral $ length new
    nbInColumn = fromIntegral $ length existing
    newRatio = nbNew % (nbNew + nbInColumn)
    existingRatio = 1 - newRatio
    new' = fitElements newRatio new
    existing' = first (* existingRatio) <$> existing
 append :: [a] -> [(Rational, a)] -> [(Rational, a)]
 append new existing = uncurry (flip mappend) (rationalize new existing)
 appendWindows ::
  [Window] ->
  (Rational, [(Rational, Window)]) ->
  (Rational, [(Rational, Window)])
 appendWindows windows = second (append windows)
 fitElements :: Rational -> [a] -> [(Rational, a)]
 fitElements dimension elts = (dimension',) <$> elts
  where
    dimension' = dimension / fromIntegral (length elts)
 singleColumn :: Rational -> Rational -> [Window] -> Columns
 singleColumn width height windows = [(width, fitElements height windows)]
 findElement' :: (a -> Bool) -> [(Rational, a)] -> Maybe (Stack (Rational, a))
 findElement' predicate list
  | (before, c : after) <- break (predicate . snd) list =
      Just $ Stack c (reverse before) after
  | otherwise = Nothing
 findInColumns :: Window -> Columns -> Maybe (Stack (Rational, Column))
 findInColumns window = findElement' (any ((== window) . snd))
 findInColumn :: Window -> Column -> Maybe (Stack (Rational, Window))
 findInColumn window = findElement' (== window)
 removeWindows :: [Window] -> Columns -> Columns
 removeWindows windows = removeEmptyColumns . fmap (second removeWindows')
  where
    inWindows (_, window) = window `notElem` windows
    removeWindows' = normalize . filter inWindows
    removeEmptyColumns = normalize . filter (not . null . snd)
 removeWindow :: Window -> (Rational, Column) -> (Rational, Column)
 removeWindow window = second (normalize . filter ((/= window) . snd))
 addWindows :: [Window] -> Columns -> Columns
 addWindows [] columns = columns
 -- When there is only one column, create a new one on the right
 addWindows windows [(_, windows')] = (1 % 2, windows') : singleColumn (1 % 2) 1 windows
 -- When there is more, append the windows to the last column
 addWindows windows columns
  | Just (columns', column) <- unsnoc columns =
      sanitizeColumns $ columns' <> [appendWindows windows column]
  | otherwise = singleColumn 1 1 windows
 -- | Make sure the sum of all dimensions is 1
 normalize :: [(Rational, a)] -> [(Rational, a)]
 normalize elts = fmap (first (/ total)) elts
  where
    total = sum (fst <$> elts)
 -- | Update the last dimension so that the sum of all dimensions is 1
 sanitize :: [(Rational, a)] -> [(Rational, a)]
 sanitize list
  | Just (elts, (_, a)) <- unsnoc list = elts <> [(1 - sum (fst <$> elts), a)]
  | otherwise = []
 -- | Same on the whole layout
 sanitizeColumns :: Columns -> Columns
 sanitizeColumns = sanitize . fmap (second sanitize)
 toOffsetRatio :: [(Rational, a)] -> [(Rational, Rational, a)]
 toOffsetRatio ra = zipWith toTruple ra positions
  where
    toTruple (dimension, a) position = (position, dimension, a)
    positions = scanl' (\position (dimension, _) -> position + dimension) 0 ra
 unsnoc :: [a] -> Maybe ([a], a)
 unsnoc [] = Nothing
 unsnoc (x : xs)
  | Just (is, l) <- unsnoc xs = Just (x : is, l)
  | otherwise = Just ([], x)
--- a/XMonad/Layout/FixedAspectRatio.hs
+++ b/XMonad/Layout/FixedAspectRatio.hs
@ -158,6 +158,5 @@ data ManageAspectRatio =
    FixRatio Rational Window    -- ^ Set the aspect ratio for the window
  | ResetRatio Window           -- ^ Remove the aspect ratio for the window
  | ToggleRatio Rational Window -- ^ Toggle the reatio
  deriving Typeable
 instance Message ManageAspectRatio
--- a/XMonad/Layout/Hidden.hs
+++ b/XMonad/Layout/Hidden.hs
@ -118,7 +118,7 @@ popHiddenWindow = sendMessage . PopSpecificHiddenWindow
 --------------------------------------------------------------------------------
 hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a))
 hideWindowMsg (HiddenWindows hidden) win = do
-  modify (\s -> s { windowset = W.delete' win $ windowset s })
+  modifyWindowSet $ W.delete' win
  return . Just . HiddenWindows $ hidden ++ [win]
 --------------------------------------------------------------------------------
--- a/XMonad/Layout/IfMax.hs
+++ b/XMonad/Layout/IfMax.hs
@ -36,7 +36,7 @@ import qualified XMonad.StackSet as W
 -- IfMax layout will run one layout if number of windows on workspace is as
 -- maximum N, and else will run another layout.
 --
-- You can use this module by adding folowing in your @xmonad.hs@:
+-- You can use this module by adding following in your @xmonad.hs@:
 --
 -- > import XMonad.Layout.IfMax
 --
--- a/XMonad/Layout/IndependentScreens.hs
+++ b/XMonad/Layout/IndependentScreens.hs
@ -26,8 +26,8 @@ module XMonad.Layout.IndependentScreens (
    marshallPP,
    whenCurrentOn,
    countScreens,
-    workspacesOn,
+    workspacesOn, screenOnMonitor,
-    workspaceOnScreen, focusWindow', focusScreen, nthWorkspace, withWspOnScreen,
+    workspaceOnScreen, focusWindow', doFocus', focusScreen, focusWorkspace, nthWorkspace, withWspOnScreen,
    -- * Converting between virtual and physical workspaces
    -- $converting
    marshall, unmarshall, unmarshallS, unmarshallW,
@ -40,6 +40,7 @@ import XMonad
 import XMonad.Hooks.StatusBar.PP
 import XMonad.Prelude
 import qualified XMonad.StackSet as W
 import XMonad.Actions.OnScreen (viewOnScreen)
 -- $usage
 -- You can use this module with the following in your @xmonad.hs@:
@ -147,7 +148,7 @@ withWspOnScreen screenId operation ws = case workspaceOnScreen screenId ws of
    Just wsp -> operation wsp ws
    Nothing -> ws
-- | Get the workspace that is active on a given screen.
+-- | Get the screen that is active on a given monitor.
 screenOnMonitor :: ScreenId -> WindowSet -> Maybe WindowScreen
 screenOnMonitor screenId ws = find ((screenId ==) . W.screen) (W.current ws : W.visible ws)
@ -159,10 +160,20 @@ focusWindow' window ws
      Just tag -> W.focusWindow window $ focusScreen (unmarshallS tag) ws
      Nothing -> ws
 -- | ManageHook to focus a window, switching workspace on the correct Xinerama screen if neccessary.
 -- Useful in 'XMonad.Hooks.EwmhDesktops.setActivateHook' when using this module.
 doFocus' :: ManageHook
 doFocus' = doF . focusWindow' =<< ask
 -- | Focus a given screen.
 focusScreen :: ScreenId -> WindowSet -> WindowSet
 focusScreen screenId = withWspOnScreen screenId W.view
 -- | Focus the given workspace on the correct Xinerama screen.
 -- An example usage can be found at `XMonad.Hooks.EwmhDesktops.setEwmhSwitchDesktopHook`
 focusWorkspace :: WorkspaceId -> WindowSet -> WindowSet
 focusWorkspace workspaceId = viewOnScreen (unmarshallS workspaceId) workspaceId
 -- | Get the nth virtual workspace
 nthWorkspace :: Int -> X (Maybe VirtualWorkspace)
 nthWorkspace n = (!? n) . workspaces' <$> asks config
--- a/XMonad/Layout/NoBorders.hs
+++ b/XMonad/Layout/NoBorders.hs
@ -143,10 +143,8 @@ data ConfigurableBorder p w = ConfigurableBorder
 -- | Only necessary with 'BorderMessage' - remove non-existent windows from the
 -- 'alwaysHidden' or 'neverHidden' lists.
 {-# DEPRECATED borderEventHook "No longer needed." #-}
 borderEventHook :: Event -> X All
 borderEventHook DestroyWindowEvent{ ev_window = w } = do
    broadcastMessage $ ResetBorder w
    return $ All True
 borderEventHook _ = return $ All True
 instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where
@ -167,14 +165,17 @@ instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder
            in  ConfigurableBorder gh <$> consNewIf ah (not b)
                                        <*> consNewIf nh b
                                        <*> pure ch
-        | Just (ResetBorder w) <- fromMessage m =
+        | Just (ResetBorder w) <- fromMessage m = resetBorder w
        | Just DestroyWindowEvent { ev_window = w } <- fromMessage m = resetBorder w
        | otherwise = Nothing
      where
        resetBorder w =
            let delete' e l = if e `elem` l then (True,delete e l) else (False,l)
                (da,ah') = delete' w ah
                (dn,nh') = delete' w nh
            in  if da || dn
                then Just cb { alwaysHidden = ah', neverHidden = nh' }
                else Nothing
        | otherwise = Nothing
 -- | SetsAmbiguous allows custom actions to generate lists of windows that
 -- should not have borders drawn through 'ConfigurableBorder'
--- a/XMonad/Layout/OnHost.hs
+++ b/XMonad/Layout/OnHost.hs
@ -1,5 +1,6 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
-
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.OnHost
@ -27,10 +28,12 @@ module XMonad.Layout.OnHost (-- * Usage
 import           XMonad
 import qualified XMonad.StackSet              as W
 import           XMonad.Prelude
 import           XMonad.Layout.LayoutModifier
-import           Data.Maybe                        (fromMaybe)
+import           Foreign                           (allocaArray0)
 import           Foreign.C
 import           System.Posix.Env                  (getEnv)
 -- $usage
@ -56,11 +59,13 @@ import           System.Posix.Env                  (getEnv)
 --
 -- > layoutHook = A ||| B ||| onHost "foo" D C
 --
-- Note that we rely on '$HOST' being set in the environment, as is true on most
+-- Note that we rely on either @$HOST@ being set in the environment, or
-- modern systems; if it's not, you may want to use a wrapper around xmonad or
+-- <https://linux.die.net/man/2/gethostname gethostname> returning something
-- perhaps use 'System.Posix.Env.setEnv' (or 'putEnv') to set it in 'main'.
+-- useful, as is true on most modern systems; if this is not the case for you,
-- This is to avoid dragging in the network package as an xmonad dependency.
+-- you may want to use a wrapper around xmonad or perhaps use
-- If '$HOST' is not defined, it will behave as if the host name never matches.
+-- 'System.Posix.Env.setEnv' (or 'putEnv') to set @$HOST@ in 'main'. If
 -- neither of the two methods work, the module will behave as if the host name
 -- never matches.
 --
 -- Also note that '$HOST' is usually a fully qualified domain name, not a short name.
 -- If you use a short name, this code will try to truncate $HOST to match; this may
@ -116,16 +121,16 @@ data OnHost l1 l2 a = OnHost [String]
 instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnHost l1 l2) a where
    runLayout (W.Workspace i p@(OnHost hosts _ lt lf) ms) r = do
-      h <- io $ getEnv "HOST"
+      h <- io $ getEnv "HOST" <|> getHostName
      if maybe False (`elemFQDN` hosts) h
        then do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r
                return (wrs, Just $ mkNewOnHostT p mlt')
        else do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r
                return (wrs, Just $ mkNewOnHostF p mlt')
-    handleMessage (OnHost hosts bool lt lf) m
+    handleMessage (OnHost hosts choice lt lf) m
-        | bool      = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts bool nt lf)
+        | choice    = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts choice nt lf)
-        | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . OnHost hosts bool lt)
+        | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . OnHost hosts choice lt)
    description (OnHost _ True  l1 _) = description l1
    description (OnHost _ _     _ l2) = description l2
@ -154,3 +159,17 @@ eqFQDN a b
  | '.' `elem` a                 = takeWhile (/= '.') a ==                    b
  |                 '.' `elem` b =                    a == takeWhile (/= '.') b
  | otherwise                    =                    a ==                    b
 -----------------------------------------------------------------------
 -- cbits
 foreign import ccall "gethostname" gethostname :: CString -> CSize -> IO CInt
 getHostName :: IO (Maybe String)
 getHostName = allocaArray0 size $ \cstr -> do
  throwErrnoIfMinus1_ "getHostName" $ gethostname cstr (fromIntegral size)
  peekCString cstr <&> \case
    "" -> Nothing
    s  -> Just s
 where
  size = 256
--- a/XMonad/Layout/TabBarDecoration.hs
+++ b/XMonad/Layout/TabBarDecoration.hs
@ -46,8 +46,8 @@ import XMonad.Prompt ( XPPosition (..) )
 -- 'tabBar' will give you the possibility of setting a custom shrinker
 -- and a custom theme.
 --
-- The deafult theme can be dynamically change with the xmonad theme
+-- The default theme can be dynamically changed with the xmonad theme
-- selector. See "XMonad.Prompt.Theme". For more themse, look at
+-- selector. See "XMonad.Prompt.Theme". For more themes, look at
 -- "XMonad.Util.Themes"
 -- | Add, on the top of the screen, a simple bar of tabs to a given
--- a/XMonad/Prelude.hs
+++ b/XMonad/Prelude.hs
@ -313,6 +313,7 @@ specialKeys =
  , ("KP_7"       , xK_KP_7)
  , ("KP_8"       , xK_KP_8)
  , ("KP_9"       , xK_KP_9)
  , ("Menu"       , xK_Menu)
  ]
 -- | List of multimedia keys. If Xlib does not know about some keysym
@ -472,6 +473,7 @@ multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $
  , "XF86_Next_VMode"
  , "XF86_Prev_VMode"
  , "XF86Bluetooth"
  , "XF86WLAN"
  ]
 -- | The specialized 'W.Screen' derived from 'WindowSet'.
--- a/XMonad/Prompt.hs
+++ b/XMonad/Prompt.hs
@ -562,7 +562,7 @@ mkXPromptImplementation historyKey conf om = do
  s <- gets $ screenRect . W.screenDetail . W.current . windowset
  cleanMask <- cleanKeyMask
  cachedir <- asks (cacheDir . directories)
-  hist <- io $ readHistory cachedir
+  hist <- io $ readHistory conf cachedir
  fs <- initXMF (font conf)
  let width = getWinWidth s (position conf)
  st' <- io $
@ -582,7 +582,7 @@ mkXPromptImplementation historyKey conf om = do
  releaseXMF fs
  when (successful st') $ do
    let prune = take (historySize conf)
-    io $ writeHistory cachedir $
+    io $ writeHistory conf cachedir $
      M.insertWith
      (\xs ys -> prune . historyFilter conf $ xs ++ ys)
      historyKey
@ -1690,16 +1690,18 @@ emptyHistory = M.empty
 getHistoryFile :: FilePath -> FilePath
 getHistoryFile cachedir = cachedir ++ "/prompt-history"
-readHistory :: FilePath -> IO History
+readHistory :: XPConfig -> FilePath -> IO History
-readHistory cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory
+readHistory (XPC { historySize = 0 }) _ = return emptyHistory
 readHistory _ cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory
 where
    readHist = do
        let path = getHistoryFile cachedir
        xs <- withFile path ReadMode hGetLine
        readIO xs
-writeHistory :: FilePath -> History -> IO ()
+writeHistory :: XPConfig -> FilePath -> History -> IO ()
-writeHistory cachedir hist = do
+writeHistory (XPC { historySize = 0 }) _ _ = return ()
 writeHistory _ cachedir hist = do
  let path = getHistoryFile cachedir
      filtered = M.filter (not . null) hist
  writeFile path (show filtered) `E.catch` \(SomeException e) ->
@ -1793,17 +1795,17 @@ breakAtSpace s
 -- | 'historyCompletion' provides a canned completion function much like
 --   'getShellCompl'; you pass it to mkXPrompt, and it will make completions work
 --   from the query history stored in the XMonad cache directory.
-historyCompletion :: X ComplFunction
+historyCompletion :: XPConfig -> X ComplFunction
-historyCompletion = historyCompletionP (const True)
+historyCompletion conf = historyCompletionP conf (const True)
 -- | Like 'historyCompletion' but only uses history data from Prompts whose
 -- name satisfies the given predicate.
-historyCompletionP :: (String -> Bool) -> X ComplFunction
+historyCompletionP :: XPConfig -> (String -> Bool) -> X ComplFunction
-historyCompletionP p = do
+historyCompletionP conf p = do
    cd <- asks (cacheDir . directories)
    pure $ \x ->
        let toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []
-         in toComplList . M.filterWithKey (const . p) <$> readHistory cd
+         in toComplList . M.filterWithKey (const . p) <$> readHistory conf cd
 -- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off
 --   laziness and stability for efficiency.
--- a/XMonad/Prompt/OrgMode.hs
+++ b/XMonad/Prompt/OrgMode.hs
@ -53,6 +53,7 @@ module XMonad.Prompt.OrgMode (
    Date (..),
    Time (..),
    TimeOfDay (..),
    OrgTime (..),
    DayOfWeek (..),
 #endif
@ -122,7 +123,9 @@ Monday and you schedule something for Monday, you will actually schedule
 it for the /next/ Monday (the one in seven days).
 The time is specified in the @HH:MM@ or @HHMM@ format.  The minutes may
-be omitted, in which case we assume a full hour is specified.
+be omitted, in which case we assume a full hour is specified.  It is also
 possible to enter a time span using the syntax @HH:MM-HH:MM@ or @HH:MM+HH@.
 In the former case, minutes may be omitted.
 A few examples are probably in order.  Suppose we have bound the key
 above, pressed it, and are now confronted with a prompt:
@ -137,6 +140,10 @@ above, pressed it, and are now confronted with a prompt:
  - @hello +d today 12:30@ works just like above, but creates a
    deadline.
  - @hello +d today 12:30-14:30@ works like the above, but gives the
    event a duration of two hours.  An alternative way to specify
    this would be @hello +d today 12:30+2@.
  - @hello +s thu@ would schedule the note for next thursday.
  - @hello +s 11@ would schedule it for the 11th of this month and this
@ -356,21 +363,30 @@ refile (asString -> parent) (asString -> fp) =
 -- @HH:MM@ time.
 data Time = Time
  { date :: Date
-  , tod  :: Maybe TimeOfDay
+  , tod  :: Maybe OrgTime
  }
  deriving (Eq, Show)
 -- | The time in HH:MM.
-data TimeOfDay = TimeOfDay Int Int
+data TimeOfDay = HHMM Int Int
  deriving (Eq)
 instance Show TimeOfDay where
  show :: TimeOfDay -> String
-  show (TimeOfDay h m) = pad h <> ":" <> pad m
+  show (HHMM h m) = pad h <> ":" <> pad m
   where
    pad :: Int -> String
    pad n = (if n <= 9 then "0" else "") <> show n
 -- | The time—possibly as a span—in HH:MM format.
 data OrgTime = MomentInTime TimeOfDay | TimeSpan TimeOfDay TimeOfDay
  deriving (Eq)
 instance Show OrgTime where
  show :: OrgTime -> String
  show (MomentInTime tod)  = show tod
  show (TimeSpan tod tod') = show tod <> "-" <> show tod'
 -- | Type for specifying exactly which day one wants.
 data Date
  = Today
@ -383,7 +399,7 @@ data Date
    -- ^ Manual date entry in the format DD [MM] [YYYY]
  deriving (Eq, Ord, Show)
-toOrgFmt :: Maybe TimeOfDay -> Day -> String
+toOrgFmt :: Maybe OrgTime -> Day -> String
 toOrgFmt tod day =
  mconcat ["<", isoDay, " ", take 3 $ show (dayOfWeek day), time, ">"]
 where
@ -498,8 +514,8 @@ ppNote clp todo = \case
 -- | Parse the given string into a 'Note'.
 pInput :: String -> Maybe Note
 pInput inp = (`runParser` inp) . choice $
-  [ Scheduled <$> getLast "+s" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority
+  [ Scheduled <$> (getLast "+s" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority
-  , Deadline  <$> getLast "+d" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority
+  , Deadline  <$> (getLast "+d" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority
  , do s <- munch1 (pure True)
       let (s', p) = splitAt (length s - 3) s
       pure $ case tryPrio p of
@ -507,6 +523,12 @@ pInput inp = (`runParser` inp) . choice $
         Nothing   -> NormalMsg s                   NoPriority
  ]
 where
  fixTime :: Maybe Date -> Maybe OrgTime -> Parser Time
  fixTime d tod = case (d, tod) of
    (Nothing, Nothing) -> mempty                -- no day and no time
    (Nothing, Just{})  -> pure (Time Today tod) -- no day, but a time
    (Just d', _)       -> pure (Time d'    tod) -- day given
  tryPrio :: String -> Maybe Priority
  tryPrio [' ', '#', x]
    | x `elem` ("Aa" :: String) = Just A
@ -533,21 +555,33 @@ pInput inp = (`runParser` inp) . choice $
 -- | Parse a 'Priority'.
 pPriority :: Parser Priority
 pPriority = option NoPriority $
-  " " *> skipSpaces *> choice
+  skipSpaces *> choice
    [ "#" *> foldCase "a" $> A
    , "#" *> foldCase "b" $> B
    , "#" *> foldCase "c" $> C
    ]
 -- | Try to parse a 'Time'.
-pTimeOfDay :: Parser (Maybe TimeOfDay)
+pOrgTime :: Parser (Maybe OrgTime)
-pTimeOfDay = option Nothing $
+pOrgTime = option Nothing $
-  skipSpaces >> Just <$> choice
+  between skipSpaces (void " " <|> eof) $
-    [ TimeOfDay <$> pHour <* ":" <*> pMinute -- HH:MM
+    Just <$> choice
-    , pHHMM                                  -- HHMM
+      [ TimeSpan <$> (pTimeOfDay <* ("--" <|> "-" <|> "–")) <*> pTimeOfDay
-    , TimeOfDay <$> pHour        <*> pure 0  -- HH
+      -- Org is not super smart around times with this syntax, so
-    ]
+      -- we pretend not to be as well.
      , do from@(HHMM h m) <- pTimeOfDay <* "+"
           off <- pHour
           pure $ TimeSpan from (HHMM (h + off) m)
      , MomentInTime <$> pTimeOfDay
      ]
 where
  pTimeOfDay :: Parser TimeOfDay
  pTimeOfDay = choice
    [ HHMM <$> pHour <* ":" <*> pMinute -- HH:MM
    , pHHMM                             -- HHMM
    , HHMM <$> pHour        <*> pure 0  -- HH
    ]
  pHHMM :: Parser TimeOfDay
  pHHMM = do
    let getTwo = count 2 (satisfy isDigit)
@ -555,18 +589,19 @@ pTimeOfDay = option Nothing $
    guard (hh >= 0 && hh <= 23)
    mm <- read <$> getTwo
    guard (mm >= 0 && mm <= 59)
-    pure $ TimeOfDay hh mm
+    pure $ HHMM hh mm
  pHour   :: Parser Int = pNumBetween 0 23
  pMinute :: Parser Int = pNumBetween 0 59
-- | Parse a 'Date'.
+-- | Try to parse a 'Date'.
-pDate :: Parser Date
+pDate :: Parser (Maybe Date)
-pDate = skipSpaces *> choice
+pDate = skipSpaces *> optional (choice
  [ pPrefix "tod" "ay"    Today
  , pPrefix "tom" "orrow" Tomorrow
  , Next <$> pNext
  , Date <$> pDate'
-  ]
+  ])
 where
  pNext :: Parser DayOfWeek = choice
    [ pPrefix "m"  "onday"    Monday   , pPrefix "tu" "esday"  Tuesday
@ -585,7 +620,7 @@ pDate = skipSpaces *> choice
  pDate' :: Parser (Int, Maybe Int, Maybe Integer)
  pDate' =
-    (,,) <$> pNumBetween 1 31               -- day
+    (,,) <$> (pNumBetween 1 31 <* (void " " <|> eof))  -- day
         <*> optional (skipSpaces *> choice
               [ pPrefix "ja"  "nuary"    1 , pPrefix "f"   "ebruary" 2
               , pPrefix "mar" "ch"       3 , pPrefix "ap"  "ril"     4
--- a/XMonad/Util/EZConfig.hs
+++ b/XMonad/Util/EZConfig.hs
@ -419,6 +419,7 @@ infixl 4 `removeMouseBindings`
 -- > <XF86_Next_VMode>
 -- > <XF86_Prev_VMode>
 -- > <XF86Bluetooth>
 -- > <XF86WLAN>
 mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ())
 mkKeymap c = M.fromList . mkSubmaps . readKeymap c
@ -552,8 +553,8 @@ doKeymapCheck :: XConfig l -> [(String,a)] -> ([String], [String])
 doKeymapCheck conf km = (bad,dups)
  where ks = map ((readKeySequence conf &&& id) . fst) km
        bad = nub . map snd . filter (isNothing . fst) $ ks
-        dups = map (snd . NE.head)
+        dups = map (snd . NE.head . notEmpty)
-             . mapMaybe nonEmpty
+             . filter ((>1) . length)
             . groupBy ((==) `on` fst)
             . sortBy (comparing fst)
             . map (first fromJust)
--- a/XMonad/Util/Grab.hs
+++ b/XMonad/Util/Grab.hs
@ -29,15 +29,12 @@ module XMonad.Util.Grab
  ) where
 -- core
-import           XMonad                         hiding (mkGrabs)
+import           XMonad
 import           Control.Monad                  ( when )
 import           Data.Bits                      ( setBit )
 import           Data.Foldable                  ( traverse_ )
 -- base
 import qualified Data.Map.Strict               as M
 import           Data.Semigroup                 ( All(..) )
 import           Data.Traversable               ( for )
 -- }}}
@ -70,9 +67,8 @@ grabUngrab
  -> [(KeyMask, KeySym)] -- ^ Keys to ungrab
  -> X ()
 grabUngrab gr ugr = do
-  f <- mkGrabs
+  traverse_ (uncurry ungrabKP) =<< mkGrabs ugr
-  traverse_ (uncurry ungrabKP) (f ugr)
+  traverse_ (uncurry grabKP)   =<< mkGrabs gr
  traverse_ (uncurry grabKP)   (f gr)
 -- | A convenience function to grab keys. This also ungrabs all
 -- previously grabbed keys.
@ -88,49 +84,9 @@ customRegrabEvHook regr = \case
  e@MappingNotifyEvent{} -> do
    io (refreshKeyboardMapping e)
    when (ev_request e `elem` [mappingKeyboard, mappingModifier])
-      $  setNumlockMask
+      $  cacheNumlockMask
      >> regr
    pure (All False)
  _ -> pure (All True)
 -- }}}
 -- --< Private Utils >-- {{{
 -- | Private action shamelessly copied and restyled from XMonad.Main source.
 setNumlockMask :: X ()
 setNumlockMask = withDisplay $ \dpy -> do
  ms <- io (getModifierMapping dpy)
  xs <- sequence
    [ do
        ks <- io (keycodeToKeysym dpy kc 0)
        pure $ if ks == xK_Num_Lock
          then setBit 0 (fromIntegral m)
          else 0 :: KeyMask
    | (m, kcs) <- ms
    , kc       <- kcs
    , kc /= 0
    ]
  modify $ \s -> s { numberlockMask = foldr (.|.) 0 xs }
 -- | Private function shamelessly copied and refactored from XMonad.Main source.
 mkGrabs :: X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
 mkGrabs = withDisplay $ \dpy -> do
  let (minCode, maxCode) = displayKeycodes dpy
      allCodes           = [fromIntegral minCode .. fromIntegral maxCode]
  syms <- io . for allCodes $ \code -> keycodeToKeysym dpy code 0
  let keysymMap = M.fromListWith (++) (zip syms $ pure <$> allCodes)
      keysymToKeycodes sym = M.findWithDefault [] sym keysymMap
  extraMods <- extraModifiers
  pure $ \ks -> do
    (mask, sym) <- ks
    keycode     <- keysymToKeycodes sym
    extraMod    <- extraMods
    pure (mask .|. extraMod, keycode)
 -- }}}
 -- NOTE: there is some duplication between this module and core. The
 -- latter probably will never change, but this needs to be kept in sync
 -- with any potential bugs that might arise.
--- a/XMonad/Util/Hacks.hs
+++ b/XMonad/Util/Hacks.hs
@ -40,10 +40,14 @@ module XMonad.Util.Hacks (
  trayerPaddingXmobarEventHook,
  trayPaddingXmobarEventHook,
  trayPaddingEventHook,
  -- * Steam flickering fix
  fixSteamFlicker,
  ) where
 import XMonad
 import XMonad.Hooks.FloatConfigureReq (fixSteamFlicker)
 import XMonad.Hooks.StatusBar (xmonadPropLog')
 import XMonad.Prelude (All (All), fi, filterM, when)
 import System.Posix.Env (putEnv)
--- a/XMonad/Util/NamedScratchpad.hs
+++ b/XMonad/Util/NamedScratchpad.hs
@ -309,7 +309,7 @@ nsSingleScratchpadPerWorkspace :: NamedScratchpads -> X ()
 nsSingleScratchpadPerWorkspace scratches =
    nsHideOnCondition $ \ _lastFocus curFocus winSet hideScratch -> do
        allScratchesButCurrent <-
-            filterM (liftA2 (<||>) (pure . (/= curFocus)) (`isNSP` scratches))
+            filterM (liftA2 (<&&>) (pure . (/= curFocus)) (`isNSP` scratches))
                    (W.index winSet)
        whenX (isNSP curFocus scratches) $
            for_ allScratchesButCurrent hideScratch
--- a/XMonad/Util/Rectangle.hs
+++ b/XMonad/Util/Rectangle.hs
@ -67,7 +67,7 @@ data PointRectangle a = PointRectangle
 -- @[N,N+1]@, as though each real-valued coordinate had been rounded (either
 -- down or up) to the nearest integers. So each pixel, from zero, is listed as:
 -- @[0,0]@, @[1,1]@, @[2,2]@, and so on. Rather than a coordinate system, this
-- considers pixels as row/colum indices.  While easiest to reason with,
+-- considers pixels as row/column indices.  While easiest to reason with,
 -- indices are unable to represent zero-dimension rectangles.
 --
 -- Consider pixels as indices. Do not use this on empty rectangles.
--- a/flake.nix
+++ b/flake.nix
@ -2,9 +2,9 @@
 # See NIX.md for an overview of module usage.
 {
  inputs = {
-    flake-utils.url = github:numtide/flake-utils;
+    flake-utils.url = "github:numtide/flake-utils";
-    git-ignore-nix.url = github:hercules-ci/gitignore.nix/master;
+    git-ignore-nix.url = "github:hercules-ci/gitignore.nix/master";
-    xmonad.url = github:xmonad/xmonad;
+    xmonad.url = "github:xmonad/xmonad";
  };
  outputs = { self, flake-utils, nixpkgs, git-ignore-nix, xmonad }:
  with xmonad.lib;
--- a/scripts/build/build-with-cabal.sh
+++ b/scripts/build/build-with-cabal.sh
@ -15,7 +15,7 @@ output="$1"
 if [ "$SRC_DIR" = "" ]; then
    # look for the config directory, fall back to the old one
-    SRC_DIR="${XMONAD_CONFIG_DIR:-${XDG_CONFIG_HOME:-$HOME/.config/xmonad}}"
+    SRC_DIR="${XMONAD_CONFIG_DIR:-${XDG_CONFIG_HOME:-$HOME/.config}/xmonad}"
    if test -f "$SRC_DIR/build"; then
 	:
    else
--- a/stack.yaml
+++ b/stack.yaml
@ -8,7 +8,7 @@ packages:
 extra-deps:
 - X11-1.10.2
- xmonad-0.17.0
+- xmonad-0.18.0
 nix:
  packages:
--- a/tests/Main.hs
+++ b/tests/Main.hs
@ -14,6 +14,7 @@ import qualified CycleRecentWS
 import qualified OrgMode
 import qualified GridSelect
 import qualified EZConfig
 import qualified WindowNavigation
 main :: IO ()
 main = hspec $ do
@ -53,3 +54,4 @@ main = hspec $ do
    context "OrgMode"        OrgMode.spec
    context "GridSelect"     GridSelect.spec
    context "EZConfig"       EZConfig.spec
    context "WindowNavigation" WindowNavigation.spec
--- a/tests/OrgMode.hs
+++ b/tests/OrgMode.hs
@ -45,7 +45,7 @@ spec = do
        `shouldBe` Just
          ( Deadline
              "todo"
-              (Time {date = Date (1, Nothing, Nothing), tod = Just $ TimeOfDay 1 1})
+              (Time {date = Date (1, Nothing, Nothing), tod = Just $ MomentInTime(HHMM 1 1)})
              NoPriority
          )
    it "works with todo +d 22 jan 2021 01:01 #b" $ do
@ -53,9 +53,23 @@ spec = do
        `shouldBe` Just
          ( Deadline
                "todo"
-                (Time {date = Date (22, Just 1, Just 2021), tod = Just $ TimeOfDay 1 1})
+                (Time {date = Date (22, Just 1, Just 2021), tod = Just $ MomentInTime(HHMM 1 1)})
                B
          )
    it "parses no day as today when given a time" $ do
      pInput "todo +s 12:00"
        `shouldBe` Just (Scheduled "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 12 0)}) NoPriority)
      pInput "todo +d 14:05 #B"
        `shouldBe` Just (Deadline "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 14 5)}) B)
    it "parses `blah+d`, `blah +d`, `blah +d `, and `blah +d #B` as normal messages" $ do
      pInput "blah+d"
        `shouldBe` Just (NormalMsg "blah+d" NoPriority)
      pInput "blah +d"
        `shouldBe` Just (NormalMsg "blah +d" NoPriority)
      pInput "blah +d "
        `shouldBe` Just (NormalMsg "blah +d " NoPriority)
      pInput "blah +d #B"
        `shouldBe` Just (NormalMsg "blah +d" B)
  context "no priority#b" $ do
    it "parses to the correct thing" $
@ -100,10 +114,10 @@ ppPrio = \case
  prio       -> " #" <> show prio
 ppTime :: Time -> String
-ppTime (Time d t) = ppDate d <> ppTOD t
+ppTime (Time d t) = ppDate d <> ppOrgTime t
 where
-  ppTOD :: Maybe TimeOfDay -> String
+  ppOrgTime :: Maybe OrgTime -> String
-  ppTOD = maybe "" ((' ' :) . show)
+  ppOrgTime = maybe "" ((' ' :) . show)
  ppDate :: Date -> String
  ppDate dte = case days !? dte of
@ -179,7 +193,7 @@ instance Arbitrary Date where
    [ pure Today
    , pure Tomorrow
    , Next . toEnum <$> choose (0, 6)
-    , do d <- posInt
+    , do d <- posInt `suchThat` (<= 31)
         m <- mbPos `suchThat` (<= Just 12)
         Date . (d, m, ) <$> if   isNothing m
                             then pure Nothing
@ -188,7 +202,14 @@ instance Arbitrary Date where
 instance Arbitrary TimeOfDay where
  arbitrary :: Gen TimeOfDay
-  arbitrary = TimeOfDay <$> hourInt <*> minuteInt
+  arbitrary = HHMM <$> hourInt <*> minuteInt
 instance Arbitrary OrgTime where
  arbitrary :: Gen OrgTime
  arbitrary = oneof
    [ MomentInTime <$> arbitrary
    , TimeSpan <$> arbitrary <*> arbitrary
    ]
 ------------------------------------------------------------------------
 -- Util
--- a/tests/WindowNavigation.hs
+++ b/tests/WindowNavigation.hs
@ -0,0 +1,635 @@
 {-# OPTIONS_GHC -Wall #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 module WindowNavigation where
 import Test.Hspec
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Functor.Identity
 import XMonad
 import XMonad.Util.Types (Direction2D(..))
 import XMonad.Actions.WindowNavigation (goPure, swapPure, WNState)
 import qualified XMonad.StackSet as W
 spec :: Spec
 spec = do
  it "two-window adjacent go right (empty state)" $ do
    -- Simplest case - just move the focus once.
    -- ┌─────┬──────┐
    -- │ 1 ──┼─►  2 │
    -- └─────┴──────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 1280)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
    runNav R M.empty (mkws 1 [] [2])
      `shouldBe` (mkstate 960 640, mkws 2 [1] [])
  it "two-window adjacent go right (populated state)" $ do
    -- Like the previous test, but this time internal stat is already populated with a position.
    -- ┌─────┬──────┐
    -- │ 1 ──┼─►  2 │
    -- └─────┴──────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 1280)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
    runNav R (mkstate 100 100) (mkws 1 [] [2])
      `shouldBe` (mkstate 960 100, mkws 2 [1] [])
  it "two-window adjacent go right (incorrectly-populated state)" $ do
    -- This time we set the position incorrectly, testing if it will be reset to the center of focused window.
    -- ┌─────┬──────┐
    -- │ 1 ──┼─►  2 │
    -- └─────┴──────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 1280)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
    runNav R (mkstate 1000 100) (mkws 1 [] [2])
      `shouldBe` (mkstate 960 640, mkws 2 [1] [])
  it "swap windows" $ do
    -- Swap windows around.
    -- ┌─────┬──────┐
    -- │ 1 ◄─┼─►  2 │
    -- └─────┴──────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 1280)
          ]
    runIdentity (swapPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))
      `shouldBe` (mkstate 960 640, mkws 1 [2] [])
  it "tall layout, go up" $ do
    -- ┌─────┬─────┐
    -- │     │ 2 ▲ │
    -- │  1  ├───┼─┤
    -- │     │ 3 │ │
    -- └─────┴─────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 640)
          , (3, Rectangle 960 640 960 640)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2, 3], windowRect)
    runNav U M.empty (mkws 3 [] [1, 2])
      `shouldBe` (mkstate 1440 639, mkws 2 [1, 3] [])
  it "tall layout, go down" $ do
    -- ┌─────┬─────┐
    -- │     │ 2   │
    -- │     ├─────┤
    -- │  1  │ 3 │ │
    -- │     ├───┼─┤
    -- │     │ 4 ▼ │
    -- └─────┴─────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 400)
          , (3, Rectangle 960 400 960 400)
          , (4, Rectangle 960 800 960 480)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
    runNav D M.empty (mkws 3 [] [1, 2, 4])
      `shouldBe` (mkstate 1440 800, mkws 4 [2, 1, 3] [])
  it "tall layout, go left" $ do
    -- ┌─────┬─────┐
    -- │   ◄─┼── 2 │
    -- │     ├─────┤
    -- │ 1   │   3 │
    -- │     ├─────┤
    -- │     │   4 │
    -- └─────┴─────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 400)
          , (3, Rectangle 960 400 960 400)
          , (4, Rectangle 960 800 960 480)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
    runNav L M.empty (mkws 2 [] [1, 3, 4])
      `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])
  it "tall layout, go left and then right (window 2)" $ do
    -- ┌─────┬─────┐
    -- │   ◄─┼── 2 │
    -- │   ──┼─►   │
    -- │     ├─────┤
    -- │ 1   │   3 │
    -- │     ├─────┤
    -- │     │   4 │
    -- └─────┴─────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 400)
          , (3, Rectangle 960 400 960 400)
          , (4, Rectangle 960 800 960 480)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
    let (st2, ws2) = runNav L M.empty (mkws 2 [] [1, 3, 4])
    (st2, ws2) `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])
    let (st3, ws3) = runNav R st2 ws2
    (st3, ws3) `shouldBe` (mkstate 960 200, mkws 2 [] [1, 3, 4])
  it "tall layout, go left and then right (window 3)" $ do
    -- ┌─────┬─────┐
    -- │     │   2 │
    -- │     ├─────┤
    -- │ 1 ◄─┼── 3 │
    -- │   ──┼─►   │
    -- │     ├─────┤
    -- │     │   4 │
    -- └─────┴─────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 400)
          , (3, Rectangle 960 400 960 400)
          , (4, Rectangle 960 800 960 480)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
    let (st2, ws2) = runNav L M.empty (mkws 3 [] [1, 2, 4])
    (st2, ws2) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4])
    let (st3, ws3) = runNav R st2 ws2
    (st3, ws3) `shouldBe` (mkstate 960 600, mkws 3 [] [1, 2, 4])
  it "tall layout, go left and then right (window 4)" $ do
    -- ┌─────┬─────┐
    -- │     │   2 │
    -- │     ├─────┤
    -- │ 1   │   3 │
    -- │     ├─────┤
    -- │   ◄─┼── 4 │
    -- │   ──┼─►   │
    -- └─────┴─────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 400)
          , (3, Rectangle 960 400 960 400)
          , (4, Rectangle 960 800 960 480)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
    let (st2, ws2) = runNav L M.empty (mkws 4 [] [1, 2, 3])
    (st2, ws2) `shouldBe` (mkstate 959 1040, mkws 1 [4] [2, 3])
    let (st3, ws3) = runNav R st2 ws2
    (st3, ws3) `shouldBe` (mkstate 960 1040, mkws 4 [] [1, 2, 3])
  it "grid layout, go in a circle" $ do
    -- ┌─────┬─────┐
    -- │ 1 ──┼─► 2 │
    -- │     │     │
    -- │ ▲   │   │ │
    -- ├─┼───┼───┼─┤
    -- │ │   │   ▼ │
    -- │     │     │
    -- │ 3 ◄─┼── 4 │
    -- └─────┴─────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 640)
          , (2, Rectangle 960 0 960 640)
          , (3, Rectangle 0 640 960 640)
          , (4, Rectangle 960 640 960 640)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
    let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3, 4])
    (st2, ws2) `shouldBe` (mkstate 960 320, mkws 2 [1] [3, 4])
    let (st3, ws3) = runNav D st2 ws2
    (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [3, 2, 1] [])
    let (st4, ws4) = runNav L st3 ws3
    (st4, ws4) `shouldBe` (mkstate 959 640, mkws 3 [2, 1] [4])
    let (st5, ws5) = runNav U st4 ws4
    (st5, ws5) `shouldBe` (mkstate 959 639, mkws 1 [] [2, 3, 4])
  it "ignore window that fully overlaps the current window in parallel direction when pos is outside it" $ do
    -- ┌─────┬──────┬──────┐
    -- │ ┌───┴──────┴────┐ │
    -- │ │   |  4   |    │ │
    -- │ └───┬──────┬────┘ │
    -- │  1  │  2 ──┼─► 3  │
    -- └─────┴──────┴──────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 600 1280)
          , (2, Rectangle 600 0 600 1280)
          , (3, Rectangle 1200 0 720 1280)
          , (4, Rectangle 200 200 1520 400)
          ]
    runIdentity (goPure R (mkstate 900 900, mkws 2 [] [1, 3, 4], S.fromList [1..4], windowRect))
      `shouldBe` (mkstate 1200 900, mkws 3 [1,2] [4])
  it "go to window that fully overlaps the current window in parallel direction when pos is inside it" $ do
    -- ┌─────────────────┐
    -- │     ┌──────┐    │
    -- │  1  │      │    │
    -- ├─────┤------├────┤
    -- │     │      │    │
    -- │  2  │  4 ──┼─►  │
    -- │     │      │    │
    -- ├─────┤------├────┤
    -- │  3  │      │    │
    -- │     └──────┘    │
    -- └─────────────────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 1920 400)
          , (2, Rectangle 0 400 1920 400)
          , (3, Rectangle 0 800 1920 480)
          , (4, Rectangle 800 200 400 880)
          ]
    runIdentity (goPure R (mkstate 1000 600, mkws 4 [] [1, 2, 3], S.fromList [1..4], windowRect))
      `shouldBe` (mkstate 1200 600, mkws 2 [1,4] [3])
  it "go from inner window to outer" $ do
    -- ┌───────────────┐
    -- │      ┌──────┐ │
    -- │  1 ◄─┼── 2  │ │
    -- │      └──────┘ │
    -- └───────────────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 1920 1280)
          , (2, Rectangle 600 600 600 600)
          ]
    runIdentity (goPure L (M.empty, mkws 2 [] [1], S.fromList [1, 2], windowRect))
      `shouldBe` (mkstate 599 900, mkws 1 [2] [])
  it "if there are multiple outer windows, go to the smaller one" $ do
    -- ┌────────────────────────┐
    -- │  ┌───────────────┐     │
    -- │  │      ┌──────┐ │     │
    -- │  │  2 ◄─┼── 3  │ │  1  │
    -- │  │      └──────┘ │     │
    -- │  └───────────────┘     │
    -- └────────────────────────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 1920 1280)
          , (2, Rectangle 200 200 1520 880)
          , (3, Rectangle 400 400 400 400)
          ]
    runIdentity (goPure L (M.empty, mkws 3 [] [1, 2], S.fromList [1..3], windowRect))
      `shouldBe` (mkstate 399 600, mkws 2 [1, 3] [])
  it "two tiled and one floating, floating fully inside" $ do
    -- ┌───────────────────┬─────┐
    -- │   ┌───────┐       │     │
    -- │ ──┼─►   ──┼─►   ──┼─►   │
    -- │   │   3   │   1   │   2 │
    -- │   │     ◄─┼──   ◄─┼──   │
    -- │   └───────┘       │     │
    -- └───────────────────┴─────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 1280)
          , (3, Rectangle 400 400 400 400)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
    let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3])
    (st2, ws2) `shouldBe` (mkstate 400 400, mkws 3 [2, 1] [])
    let (st3, ws3) = runNav R st2 ws2
    (st3, ws3) `shouldBe` (mkstate 800 400, mkws 1 [] [2, 3])
    let (st4, ws4) = runNav R st3 ws3
    (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1] [3])
    let (st5, ws5) = runNav L st4 ws4
    (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [] [2, 3])
    let (st6, ws6) = runNav L st5 ws5
    (st6, ws6) `shouldBe` (mkstate 799 400, mkws 3 [2, 1] [])
  it "two floating windows inside one big tiled one" $ do
    -- ┌─────────┐
    -- │    │    │
    -- │ ┌──┼──┐ │
    -- │ │  ▼  │ │
    -- │ │  3  │ │
    -- │ └──┼──┘ │
    -- │    ▼    │
    -- │    1    │
    -- │ ┌──┼──┐ │
    -- │ │  ▼  │ │
    -- │ │  4  │ │
    -- │ └──┼──┘ │
    -- │    ▼    │
    -- ├────┼────┤
    -- │    ▼    │
    -- │    2    │
    -- └─────────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 1920 640)
          , (2, Rectangle 0 640 1920 640)
          , (3, Rectangle 200 200 100 100)
          , (4, Rectangle 1000 400 100 100)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
    let (st2, ws2) = runNav D (mkstate 1000 250) (mkws 1 [] [2, 3, 4])
    (st2, ws2) `shouldBe` (mkstate 299 250, mkws 3 [2, 1] [4])
    let (st3, ws3) = runNav D st2 ws2
    (st3, ws3) `shouldBe` (mkstate 299 300, mkws 1 [] [2, 3, 4])
    let (st4, ws4) = runNav D st3 ws3
    (st4, ws4) `shouldBe` (mkstate 1000 400, mkws 4 [3, 2, 1] [])
    let (st5, ws5) = runNav D st4 ws4
    (st5, ws5) `shouldBe` (mkstate 1000 500, mkws 1 [] [2, 3, 4])
    let (st6, ws6) = runNav D st5 ws5
    (st6, ws6) `shouldBe` (mkstate 1000 640, mkws 2 [1] [3, 4])
  it "floating window between two tiled ones" $ do
    -- ┌───────┬────────┐
    -- │ 1 ┌───┴───┐  2 │
    -- │ ──┼─► 3 ──┼─►  │
    -- │   └───┬───┘    │
    -- └───────┴────────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 1280)
          , (3, Rectangle 860 540 200 200)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
    let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3])
    (st2, ws2) `shouldBe` (mkstate 860 640, mkws 3 [2, 1] [])
    let (st3, ws3) = runNav R st2 ws2
    (st3, ws3) `shouldBe` (mkstate 960 640, mkws 2 [1] [3])
  it "floating window overlapping four tiled ones" $ do
    -- ┌───────┬───────┐
    -- │   ┌───┴───┐   │
    -- │ 1 │       │ 2 │
    -- ├───┤       ├───┤
    -- │ ──┼─► 5 ──┼─► │
    -- │ 3 └───┬───┘ 4 │
    -- └───────┴───────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 640)
          , (2, Rectangle 960 0 960 640)
          , (3, Rectangle 0 640 960 640)
          , (4, Rectangle 960 640 960 640)
          , (5, Rectangle 760 440 400 400)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)
    let (st2, ws2) = runNav R (mkstate 480 640) (mkws 3 [] [1, 2, 4, 5])
    (st2, ws2) `shouldBe` (mkstate 760 640, mkws 5 [4, 2, 1, 3] [])
    let (st3, ws3) = runNav R st2 ws2
    (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [2, 1, 3] [5])
  it "sequential inner floating windows" $ do
    -- ┌───────────────────────────────────┬──────┐
    -- │   ┌───────┐                       │      │
    -- │   │       │       ┌───────┐       │      │
    -- │ ──┼─► 3 ──┼─► 1 ──┼─► 4 ──┼─►   ──┼─► 2  │
    -- │ ◄─┼──   ◄─┼──   ◄─┼──   ◄─┼──   ◄─┼──    │
    -- │   └───────┘       │       │       │      │
    -- │                   └───────┘       │      │
    -- └───────────────────────────────────┴──────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 1280)
          , (3, Rectangle 200 200 200 200)
          , (4, Rectangle 600 600 200 200)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
    let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3, 4])
    (st2, ws2) `shouldBe` (mkstate 200 200, mkws 3 [2,1] [4])
    let (st3, ws3) = runNav R st2 ws2
    (st3, ws3) `shouldBe` (mkstate 400 200, mkws 1 [] [2, 3, 4])
    let (st4, ws4) = runNav R st3 ws3
    (st4, ws4) `shouldBe` (mkstate 600 600, mkws 4 [3, 2, 1] [])
    let (st5, ws5) = runNav R st4 ws4
    (st5, ws5) `shouldBe` (mkstate 800 600, mkws 1 [] [2, 3, 4])
    let (st6, ws6) = runNav R st5 ws5
    (st6, ws6) `shouldBe` (mkstate 960 600, mkws 2 [1] [3, 4])
    let (st7, ws7) = runNav L st6 ws6
    (st7, ws7) `shouldBe` (mkstate 959 600, mkws 1 [] [2, 3, 4])
    let (st8, ws8) = runNav L st7 ws7
    (st8, ws8) `shouldBe` (mkstate 799 600, mkws 4 [3, 2, 1] [])
    let (st9, ws9) = runNav L st8 ws8
    (st9, ws9) `shouldBe` (mkstate 599 600, mkws 1 [] [2, 3, 4])
    let (st10, ws10) = runNav L st9 ws9
    (st10, ws10) `shouldBe` (mkstate 399 399, mkws 3 [2, 1] [4])
    let (st11, ws11) = runNav L st10 ws10
    (st11, ws11) `shouldBe` (mkstate 199 399, mkws 1 [] [2, 3, 4])
  it "overlapping inner floating windows" $ do
    -- ┌─────────────────────┬──────┐
    -- │ ┌─────────┐         │      │
    -- │ │  3 ┌────┴─┐       │      │
    -- │ │  ──┼─►  ──┼─► 1 ──┼─►  2 │
    -- │ │  ◄─┼──  ◄─┼──   ◄─┼──    │
    -- │ │    │  4   │       │      │
    -- │ └────┤      │       │      │
    -- │      └──────┘       │      │
    -- └─────────────────────┴──────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 1280)
          , (3, Rectangle 200 200 400 400)
          , (4, Rectangle 300 300 400 400)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
    let (st2, ws2) = runNav R M.empty (mkws 3 [] [1, 2, 4])
    (st2, ws2) `shouldBe` (mkstate 400 400, mkws 4 [2, 1, 3] [])
    let (st3, ws3) = runNav R st2 ws2
    (st3, ws3) `shouldBe` (mkstate 700 400, mkws 1 [3] [2, 4])
    let (st4, ws4) = runNav R st3 ws3
    (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1, 3] [4])
    let (st5, ws5) = runNav L st4 ws4
    (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [3] [2, 4])
    let (st6, ws6) = runNav L st5 ws5
    (st6, ws6) `shouldBe` (mkstate 699 400, mkws 4 [2, 1, 3] [])
    let (st7, ws7) = runNav L st6 ws6
    (st7, ws7) `shouldBe` (mkstate 599 400, mkws 3 [] [1, 2, 4])
  it "bounce back from the wall to the floating window" $ do
    -- ┌────────────────┬─────┐
    -- │  1   ┌──────┐  │     │
    -- │  ┌───┼─►  3 │  │  2  │
    -- │  └── │      │  │     │
    -- │      └──────┘  │     │
    -- └────────────────┴─────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 1280)
          , (3, Rectangle 400 400 200 200)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
    runNav L (mkstate 100 640) (mkws 1 [] [2, 3])
      `shouldBe` (mkstate 400 599, mkws 3 [2, 1] [])
  it "jump between screens" $ do
    -- ┌─────┬──────┐  ┌────────┐
    -- │     │  2   │  │    5   │
    -- │     ├──────┤  ├────────┤
    -- │  1  │  3 ──┼──┼─►  6   │
    -- │     ├──────┤  └────────┘
    -- │     │  4   │
    -- └─────┴──────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 400)
          , (3, Rectangle 960 400 960 400)
          , (4, Rectangle 960 800 960 480)
          , (5, Rectangle 1920 0 1280 384)
          , (6, Rectangle 1920 384 1280 384)
          ]
        initWindowSet =
          W.StackSet
          { W.current =
              W.Screen
              { W.workspace =
                  W.Workspace
                  { W.tag = "A"
                  , W.layout = Layout NullLayout
                  , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }
                  }
              , W.screen = 1
              , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
              }
          , W.visible =
              [ W.Screen
                { W.workspace =
                    W.Workspace
                    { W.tag = "B"
                    , W.layout = Layout NullLayout
                    , W.stack = Just $ W.Stack { W.focus = 5, W.up = [], W.down = [6] }
                    }
                , W.screen = 2
                , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }
                }
              ]
          , W.hidden = []
          , W.floating = M.empty
          }
        expectedWindowSet =
          W.StackSet
          { W.current =
              W.Screen
              { W.workspace =
                  W.Workspace
                  { W.tag = "B"
                  , W.layout = Layout NullLayout
                  , W.stack = Just $ W.Stack { W.focus = 6, W.up = [5], W.down = [] }
                  }
              , W.screen = 2
              , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }
              }
          , W.visible =
              [ W.Screen
                { W.workspace =
                    W.Workspace
                    { W.tag = "A"
                    , W.layout = Layout NullLayout
                    , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }
                    }
                , W.screen = 1
                , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
                }
              ]
          , W.hidden = []
          , W.floating = M.empty
          }
    runIdentity (goPure R (M.empty, initWindowSet, S.fromList [1..6], windowRect))
      `shouldBe` (M.fromList [("B", Point 1920 600)], expectedWindowSet)
  it "floating window overlapping fully in the orthogonal direction" $ do
    -- ┌─────┬──────────────────┐
    -- │     │      ┌───────┐   │
    -- │     │    2 │       │   │
    -- │     ├──────┤-------├───┤
    -- │  1  │    3 │       │ 3 │
    -- │   ◄─┼──  ◄─┼── 5 ◄─┼── │
    -- │     ├──────┤-------├───┤
    -- │     │    4 │       │   │
    -- │     │      └───────┘   │
    -- └─────┴──────────────────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 960 0 960 400)
          , (3, Rectangle 960 400 960 400)
          , (4, Rectangle 960 800 960 480)
          , (5, Rectangle 1360 200 200 800)
          ]
        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)
    let (st2, ws2) = runNav L (mkstate 1800 600) (mkws 3 [] [1, 2, 4, 5])
    (st2, ws2) `shouldBe` (mkstate 1559 600, mkws 5 [4, 2, 1, 3] [])
    let (st3, ws3) = runNav L st2 ws2
    (st3, ws3) `shouldBe` (mkstate 1359 600, mkws 3 [] [1, 2, 4, 5])
    let (st4, ws4) = runNav L st3 ws3
    (st4, ws4) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4, 5])
  it "navigation to free-floating windows on the same screen" $ do
    -- ┌──────┐
    -- │      │  ┌──────┐
    -- │      │  │      │
    -- │    ──┼──┼─►  2 │
    -- │      │  │      │
    -- │   1  │  └──────┘
    -- │      │
    -- │      │
    -- └──────┘
    let windowRect w =
          Identity $ M.lookup w $ M.fromList
          [ (1, Rectangle 0 0 960 1280)
          , (2, Rectangle 1200 400 400 400)
          ]
    runIdentity (goPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))
      `shouldBe` (mkstate 1200 640, mkws 2 [1] [])
  it "switch between windows in Full layout" $ do
    let windowRect w = Identity $ M.lookup w $ M.fromList [(1, Rectangle 0 0 1920 1280)]
    runIdentity (goPure D (M.empty, mkws 1 [] [2, 3], S.fromList [1], windowRect))
      `shouldBe` (M.empty, mkws 2 [1] [3])
 data NullLayout a = NullLayout deriving (Show, Read, Eq)
 instance LayoutClass NullLayout a
 -- to make WindowSets comparable
 instance Eq (Layout w) where
  (==) a b = show a == show b
  (/=) a b = show a /= show b
 -- make a state with a position for a single workspace
 mkstate :: Position -> Position -> WNState
 mkstate px py = M.fromList [("A", Point px py)]
 -- make a single-workspace WindowSet
 mkws :: Window -> [Window] -> [Window] -> WindowSet
 mkws focusedWindow upWindows downWindows = W.StackSet
  { W.current = W.Screen
    { W.workspace = W.Workspace
      { W.tag = "A"
      , W.layout = Layout NullLayout
      , W.stack = Just $ W.Stack { W.focus = focusedWindow, W.up = upWindows, W.down = downWindows }
      }
    , W.screen = 1
    , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
    }
  , W.visible = []
  , W.hidden = []
  , W.floating = M.empty
  }
--- a/xmonad-contrib.cabal
+++ b/xmonad-contrib.cabal
@ -1,5 +1,5 @@
 name:               xmonad-contrib
-version:            0.18.0
+version:            0.18.1.9
 -- ^ also update cpp-options: -DXMONAD_CONTRIB_VERSION_*
 homepage:           https://xmonad.org/
@ -38,7 +38,7 @@ cabal-version:      1.12
 build-type:         Simple
 bug-reports:        https://github.com/xmonad/xmonad-contrib/issues
-tested-with:        GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.4 || == 9.8.1
+tested-with:        GHC == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.7 || == 9.8.4 || == 9.10.2 || == 9.12.2
 source-repository head
  type:     git
@ -54,32 +54,33 @@ flag pedantic
  manual:      True
 library
-    build-depends: base >= 4.11 && < 5,
+    build-depends: base >= 4.12 && < 5,
                   bytestring >= 0.10 && < 0.13,
-                   containers >= 0.5 && < 0.8,
+                   containers >= 0.5 && < 0.9,
                   directory,
                   filepath,
-                   time >= 1.8 && < 1.13,
+                   time >= 1.8 && < 1.15,
                   process,
                   random,
                   mtl >= 1 && < 3,
                   transformers,
                   unix,
                   X11 >= 1.10 && < 1.11,
-                   xmonad >= 0.16.99999 && < 0.19,
+                   xmonad >= 0.18.0 && < 0.19,
                   utf8-string,
                   deepseq
    default-language: Haskell2010
    cpp-options:   -DXMONAD_CONTRIB_VERSION_MAJOR=0
                   -DXMONAD_CONTRIB_VERSION_MINOR=18
-                   -DXMONAD_CONTRIB_VERSION_PATCH=0
+                   -DXMONAD_CONTRIB_VERSION_PATCH=1
    ghc-options:   -Wall -Wno-unused-do-bind
    if flag(pedantic)
-       ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports
+       ghc-options: -Werror -Wwarn=deprecations
    -- Keep this in sync with the oldest version in 'tested-with'
-    if impl(ghc > 8.6.5)
+    if impl(ghc > 8.8.4)
       -- don't treat unused-imports warning as errors, they may be necessary
       -- for compatibility with older versions of base (or other deps)
       ghc-options: -Wwarn=unused-imports
@ -130,6 +131,7 @@ library
                        XMonad.Actions.PhysicalScreens
                        XMonad.Actions.Plane
                        XMonad.Actions.Prefix
                        XMonad.Actions.Profiles
                        XMonad.Actions.Promote
                        XMonad.Actions.RandomBackground
                        XMonad.Actions.RepeatAction
@ -152,6 +154,7 @@ library
                        XMonad.Actions.TreeSelect
                        XMonad.Actions.UpdateFocus
                        XMonad.Actions.UpdatePointer
                        XMonad.Actions.UpKeys
                        XMonad.Actions.Warp
                        XMonad.Actions.WindowBringer
                        XMonad.Actions.WindowGo
@ -191,6 +194,7 @@ library
                        XMonad.Hooks.EwmhDesktops
                        XMonad.Hooks.FadeInactive
                        XMonad.Hooks.FadeWindows
                        XMonad.Hooks.FloatConfigureReq
                        XMonad.Hooks.FloatNext
                        XMonad.Hooks.Focus
                        XMonad.Hooks.InsertPosition
@ -234,6 +238,7 @@ library
                        XMonad.Layout.Circle
                        XMonad.Layout.CircleEx
                        XMonad.Layout.Column
                        XMonad.Layout.Columns
                        XMonad.Layout.Combo
                        XMonad.Layout.ComboP
                        XMonad.Layout.Cross
@ -425,7 +430,9 @@ test-suite tests
                  RotateSome
                  Selective
                  SwapWorkspaces
                  WindowNavigation
                  Utils
                  XMonad.Actions.CopyWindow
                  XMonad.Actions.CycleRecentWS
                  XMonad.Actions.CycleWS
                  XMonad.Actions.FocusNth
@ -437,10 +444,13 @@ test-suite tests
                  XMonad.Actions.SwapWorkspaces
                  XMonad.Actions.TagWindows
                  XMonad.Actions.WindowBringer
                  XMonad.Actions.WindowGo
                  XMonad.Actions.WindowNavigation
                  XMonad.Hooks.ManageDocks
                  XMonad.Hooks.ManageHelpers
                  XMonad.Hooks.UrgencyHook
                  XMonad.Hooks.WorkspaceHistory
                  XMonad.Hooks.StatusBar.PP
                  XMonad.Layout.Decoration
                  XMonad.Layout.LayoutModifier
                  XMonad.Layout.LimitWindows
@ -474,13 +484,13 @@ test-suite tests
                  XMonad.Util.XUtils
                  XPrompt
  hs-source-dirs: tests, .
-  build-depends: base
+  build-depends: base >= 4.12 && < 5
               , QuickCheck >= 2
               , X11 >= 1.10 && < 1.11
               , bytestring >= 0.10 && < 0.13
               , containers
               , directory
-               , time >= 1.8 && < 1.13
+               , time >= 1.8 && < 1.15
               , hspec >= 2.4.0 && < 3
               , mtl
               , random
@ -494,10 +504,10 @@ test-suite tests
  default-language: Haskell2010
  if flag(pedantic)
-     ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports
+     ghc-options: -Werror -Wwarn=deprecations
  -- Keep this in sync with the oldest version in 'tested-with'
-  if impl(ghc > 8.6.5)
+  if impl(ghc > 8.8.4)
     -- don't treat unused-imports warning as errors, they may be necessary
     -- for compatibility with older versions of base (or other deps)
     ghc-options: -Wwarn=unused-imports