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

ci: Regenerate haskell-ci

.github/ISSUE_TEMPLATE.md

@@ -1,12 +1,16 @@
 ### Problem Description
 
-Describe the problem you are having, what you expect to happen
-instead, and how to reproduce the problem.
+Describe the problem you are having and what you expect to happen
+instead.
+
+### Steps to Reproduce
+
+Give detailed step-by-step instructions on how to reproduce the problem.
 
 ### Configuration File
 
-Please include the smallest configuration file that reproduces the
-problem you are experiencing:
+Please include the smallest _full_ configuration file that reproduces
+the problem you are experiencing:
 
 ```haskell
 module Main (main) where
@@ -21,4 +25,6 @@ main = xmonad def
 
   - [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)
 
-  - [ ] I tested my configuration with [xmonad-testing](https://github.com/xmonad/xmonad-testing)
+  - I tested my configuration
+    - [ ] With `xmonad` version XXX (commit XXX if using git)
+    - [ ] With `xmonad-contrib` version XXX (commit XXX if using git)

.github/PULL_REQUEST_TEMPLATE.md

@@ -7,6 +7,7 @@ behind them.
 
   - [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)
 
-  - [ ] I tested my changes with [xmonad-testing](https://github.com/xmonad/xmonad-testing)
+  - [ ] I've considered how to best test these changes (property, unit,
+        manually, ...) and concluded: XXX
 
   - [ ] I updated the `CHANGES.md` file

.github/dependabot.yml

@@ -0,0 +1,6 @@
+version: 2
+updates:
+  - package-ecosystem: "github-actions"
+    directory: "/"
+    schedule:
+      interval: "weekly"

.github/workflows/haskell-ci-hackage.patch

@@ -0,0 +1,139 @@
+Piggy-back on the haskell-ci workflow for automatic releases to Hackage.
+
+This extends the workflow with two additional triggers:
+
+ * When the Haskell-CI workflow is triggered manually with a non-empty version
+   input (matching the version in the cabal file), a candidate release is
+   uploaded to Hackage and docs are submitted for it as Hackage can't build
+   them itself (https://github.com/haskell/hackage-server/issues/925).
+
+   Note that promoting the candidate on Hackage discards the uploaded docs
+   (https://github.com/haskell/hackage-server/issues/70). Don't do that.
+
+ * When a release is created on GitHub, a final release is uploaded to Hackage
+   and docs are submitted for it.
+
+The automation uses a special Hackage user: https://hackage.haskell.org/user/xmonad
+and each repo (X11, xmonad, xmonad-contrib) has its own HACKAGE_API_KEY token
+set in GitHub repository secrets.
+
+--- .github/workflows/haskell-ci.yml.orig
++++ .github/workflows/haskell-ci.yml
+@@ -14,8 +14,15 @@
+ #
+ name: Haskell-CI
+ on:
+-  - push
+-  - pull_request
++  push:
++  pull_request:
++  release:
++    types:
++      - published
++  workflow_dispatch:
++    inputs:
++      version:
++        description: candidate version (must match version in cabal file)
+ jobs:
+   linux:
+     name: Haskell-CI - Linux - ${{ matrix.compiler }}
+@@ -33,6 +40,7 @@
+             compilerVersion: 9.8.4
+             setup-method: ghcup
+             allow-failure: false
++            upload: true
+           - compiler: ghc-9.6.7
+             compilerKind: ghc
+             compilerVersion: 9.6.7
+@@ -257,6 +265,10 @@
+       - name: haddock
+         run: |
+           $CABAL v2-haddock --disable-documentation $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
++      - name: haddock for hackage
++        if: matrix.upload
++        run: |
++          $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH --haddock-for-hackage --builddir $GITHUB_WORKSPACE/haddock all
+       - name: unconstrained build
+         run: |
+           rm -f cabal.project.local
+@@ -267,3 +279,80 @@
+         with:
+           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
+           path: ~/.cabal/store
++      # 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@v4
++        with:
++          name: sdist
++          path: ${{ github.workspace }}/sdist/*.tar.gz
++      - name: upload artifact (haddock)
++        if: matrix.upload
++        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 != ''
++        shell: bash
++        run: |
++          set -ex
++          PACKAGE_VERSION="${PACKAGE_VERSION#v}"
++          res=$(
++            curl \
++              --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
++              --header "Accept: text/plain" \
++              --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
++              --form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
++              https://hackage.haskell.org/packages/candidates/
++          )
++          [[ $res == 2?? ]]  # TODO: --fail-with-body once curl 7.76.0 is available
++          res=$(
++            curl \
++              --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
++              -X PUT \
++              --header "Accept: text/plain" \
++              --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
++              --header "Content-Type: application/x-tar" \
++              --header "Content-Encoding: gzip" \
++              --data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
++              https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/candidate/docs
++          )
++          [[ $res == 2?? ]]
++        env:
++          HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
++          PACKAGE_NAME: ${{ github.event.repository.name }}
++          PACKAGE_VERSION: ${{ github.event.inputs.version }}
++      - name: hackage upload (release)
++        if: matrix.upload && github.event_name == 'release'
++        shell: bash
++        run: |
++          set -ex
++          PACKAGE_VERSION="${PACKAGE_VERSION#v}"
++          res=$(
++            curl \
++              --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
++              --header "Accept: text/plain" \
++              --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
++              --form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
++              https://hackage.haskell.org/packages/
++          )
++          [[ $res == 2?? ]]  # TODO: --fail-with-body once curl 7.76.0 is available
++          res=$(
++            curl \
++              --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
++              -X PUT \
++              --header "Accept: text/plain" \
++              --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
++              --header "Content-Type: application/x-tar" \
++              --header "Content-Encoding: gzip" \
++              --data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
++              https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/docs
++          )
++          [[ $res == 2?? ]]
++        env:
++          HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
++          PACKAGE_NAME: ${{ github.event.repository.name }}
++          PACKAGE_VERSION: ${{ github.event.release.tag_name }}

.github/workflows/haskell-ci.yml

@@ -0,0 +1,336 @@
+# This GitHub workflow config has been generated by a script via
+#
+#   haskell-ci 'github' 'cabal.project'
+#
+# To regenerate the script (for example after adjusting tested-with) run
+#
+#   haskell-ci regenerate
+#
+# For more information, see https://github.com/haskell-CI/haskell-ci
+#
+# version: 0.19.20250506
+#
+# REGENDATA ("0.19.20250506",["github","cabal.project"])
+#
+name: Haskell-CI
+on:
+  push:
+  pull_request:
+  release:
+    types:
+      - published
+  workflow_dispatch:
+    inputs:
+      version:
+        description: candidate version (must match version in cabal file)
+jobs:
+  linux:
+    name: Haskell-CI - Linux - ${{ matrix.compiler }}
+    runs-on: ubuntu-24.04
+    timeout-minutes:
+      60
+    container:
+      image: buildpack-deps:jammy
+    continue-on-error: ${{ matrix.allow-failure }}
+    strategy:
+      matrix:
+        include:
+          - compiler: ghc-9.12.2
+            compilerKind: ghc
+            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.7
+            compilerKind: ghc
+            compilerVersion: 9.6.7
+            setup-method: ghcup
+            allow-failure: false
+          - compiler: ghc-9.4.8
+            compilerKind: ghc
+            compilerVersion: 9.4.8
+            setup-method: ghcup
+            allow-failure: false
+          - compiler: ghc-9.2.8
+            compilerKind: ghc
+            compilerVersion: 9.2.8
+            setup-method: ghcup
+            allow-failure: false
+          - compiler: ghc-9.0.2
+            compilerKind: ghc
+            compilerVersion: 9.0.2
+            setup-method: ghcup
+            allow-failure: false
+          - compiler: ghc-8.10.7
+            compilerKind: ghc
+            compilerVersion: 8.10.7
+            setup-method: ghcup
+            allow-failure: false
+          - compiler: ghc-8.8.4
+            compilerKind: ghc
+            compilerVersion: 8.8.4
+            setup-method: ghcup
+            allow-failure: false
+      fail-fast: false
+    steps:
+      - 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
+          apt-get install -y libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
+      - name: Install GHCup
+        run: |
+          mkdir -p "$HOME/.ghcup/bin"
+          curl -sL https://downloads.haskell.org/ghcup/0.1.50.1/x86_64-linux-ghcup-0.1.50.1 > "$HOME/.ghcup/bin/ghcup"
+          chmod a+x "$HOME/.ghcup/bin/ghcup"
+      - name: Install cabal-install
+        run: |
+          "$HOME/.ghcup/bin/ghcup" install cabal 3.14.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
+          echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
+      - name: Install GHC (GHCup)
+        if: matrix.setup-method == 'ghcup'
+        run: |
+          "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
+          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"
+        env:
+          HCKIND: ${{ matrix.compilerKind }}
+          HCNAME: ${{ matrix.compiler }}
+          HCVER: ${{ matrix.compilerVersion }}
+      - name: Set PATH and environment variables
+        run: |
+          echo "$HOME/.cabal/bin" >> $GITHUB_PATH
+          echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
+          echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
+          echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
+          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"
+        env:
+          HCKIND: ${{ matrix.compilerKind }}
+          HCNAME: ${{ matrix.compiler }}
+          HCVER: ${{ matrix.compilerVersion }}
+      - name: env
+        run: |
+          env
+      - name: write cabal config
+        run: |
+          mkdir -p $CABAL_DIR
+          cat >> $CABAL_CONFIG <<EOF
+          remote-build-reporting: anonymous
+          write-ghc-environment-files: never
+          remote-repo-cache: $CABAL_DIR/packages
+          logs-dir:          $CABAL_DIR/logs
+          world-file:        $CABAL_DIR/world
+          extra-prog-path:   $CABAL_DIR/bin
+          symlink-bindir:    $CABAL_DIR/bin
+          installdir:        $CABAL_DIR/bin
+          build-summary:     $CABAL_DIR/logs/build.log
+          store-dir:         $CABAL_DIR/store
+          install-dirs user
+            prefix: $CABAL_DIR
+          repository hackage.haskell.org
+            url: http://hackage.haskell.org/
+          EOF
+          cat >> $CABAL_CONFIG <<EOF
+          program-default-options
+            ghc-options: $GHCJOBS +RTS -M3G -RTS
+          EOF
+          cat $CABAL_CONFIG
+      - name: versions
+        run: |
+          $HC --version || true
+          $HC --print-project-git-commit-id || true
+          $CABAL --version || true
+      - name: update cabal index
+        run: |
+          $CABAL v2-update -v
+      - name: install cabal-plan
+        run: |
+          mkdir -p $HOME/.cabal/bin
+          curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz
+          echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2  cabal-plan.xz' | sha256sum -c -
+          xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
+          rm -f cabal-plan.xz
+          chmod a+x $HOME/.cabal/bin/cabal-plan
+          cabal-plan --version
+      - name: checkout
+        uses: actions/checkout@v4
+        with:
+          path: source
+      - name: initial cabal.project for sdist
+        run: |
+          touch cabal.project
+          echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
+          cat cabal.project
+      - name: sdist
+        run: |
+          mkdir -p sdist
+          $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
+      - name: unpack
+        run: |
+          mkdir -p unpacked
+          find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
+      - name: generate cabal.project
+        run: |
+          PKGDIR_xmonad_contrib="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/xmonad-contrib-[0-9.]*')"
+          echo "PKGDIR_xmonad_contrib=${PKGDIR_xmonad_contrib}" >> "$GITHUB_ENV"
+          rm -f cabal.project cabal.project.local
+          touch cabal.project
+          touch cabal.project.local
+          echo "packages: ${PKGDIR_xmonad_contrib}" >> cabal.project
+          echo "package xmonad-contrib" >> cabal.project
+          echo "    ghc-options: -Werror=missing-methods" >> cabal.project
+          cat >> cabal.project <<EOF
+          source-repository-package
+            type:     git
+            location: https://github.com/xmonad/xmonad
+            branch:   master
+
+          optimization: False
+
+          package xmonad-contrib
+            flags:       +pedantic
+            ghc-options: -j
+          EOF
+          $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
+        run: |
+          $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
+          cabal-plan
+      - name: restore cache
+        uses: actions/cache/restore@v4
+        with:
+          key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
+          path: ~/.cabal/store
+          restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
+      - name: install dependencies
+        run: |
+          $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
+          $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
+      - name: build w/o tests
+        run: |
+          $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
+      - name: build
+        run: |
+          $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
+      - name: tests
+        run: |
+          $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
+      - name: cabal check
+        run: |
+          cd ${PKGDIR_xmonad_contrib} || false
+          ${CABAL} -vnormal check
+      - name: haddock
+        run: |
+          $CABAL v2-haddock --disable-documentation $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
+      - name: haddock for hackage
+        if: matrix.upload
+        run: |
+          $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH --haddock-for-hackage --builddir $GITHUB_WORKSPACE/haddock all
+      - name: unconstrained build
+        run: |
+          rm -f cabal.project.local
+          $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
+      - name: save cache
+        if: always()
+        uses: actions/cache/save@v4
+        with:
+          key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
+          path: ~/.cabal/store
+      # 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@v4
+        with:
+          name: sdist
+          path: ${{ github.workspace }}/sdist/*.tar.gz
+      - name: upload artifact (haddock)
+        if: matrix.upload
+        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 != ''
+        shell: bash
+        run: |
+          set -ex
+          PACKAGE_VERSION="${PACKAGE_VERSION#v}"
+          res=$(
+            curl \
+              --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
+              --header "Accept: text/plain" \
+              --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
+              --form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
+              https://hackage.haskell.org/packages/candidates/
+          )
+          [[ $res == 2?? ]]  # TODO: --fail-with-body once curl 7.76.0 is available
+          res=$(
+            curl \
+              --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
+              -X PUT \
+              --header "Accept: text/plain" \
+              --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
+              --header "Content-Type: application/x-tar" \
+              --header "Content-Encoding: gzip" \
+              --data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
+              https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/candidate/docs
+          )
+          [[ $res == 2?? ]]
+        env:
+          HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
+          PACKAGE_NAME: ${{ github.event.repository.name }}
+          PACKAGE_VERSION: ${{ github.event.inputs.version }}
+      - name: hackage upload (release)
+        if: matrix.upload && github.event_name == 'release'
+        shell: bash
+        run: |
+          set -ex
+          PACKAGE_VERSION="${PACKAGE_VERSION#v}"
+          res=$(
+            curl \
+              --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
+              --header "Accept: text/plain" \
+              --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
+              --form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
+              https://hackage.haskell.org/packages/
+          )
+          [[ $res == 2?? ]]  # TODO: --fail-with-body once curl 7.76.0 is available
+          res=$(
+            curl \
+              --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
+              -X PUT \
+              --header "Accept: text/plain" \
+              --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
+              --header "Content-Type: application/x-tar" \
+              --header "Content-Encoding: gzip" \
+              --data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
+              https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/docs
+          )
+          [[ $res == 2?? ]]
+        env:
+          HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
+          PACKAGE_NAME: ${{ github.event.repository.name }}
+          PACKAGE_VERSION: ${{ github.event.release.tag_name }}

.github/workflows/hlint.yaml

@@ -0,0 +1,22 @@
+name: hlint
+
+on:
+  push:
+  pull_request:
+
+jobs:
+  hlint:
+    runs-on: ubuntu-latest
+    steps:
+    - uses: actions/checkout@v4
+
+    - name: 'Set up HLint'
+      uses: haskell-actions/hlint-setup@v2
+      with:
+        version: '3.5'
+
+    - name: 'Run HLint'
+      uses: haskell-actions/hlint-run@v2
+      with:
+        path: '["XMonad/", "tests/", "scripts/"]'
+        fail-on: status

.github/workflows/nix.yml

@@ -0,0 +1,26 @@
+name: Nix
+
+on:
+  push:
+  pull_request:
+
+jobs:
+  build:
+    runs-on: ubuntu-latest
+    name: Nix Flake - Linux
+    permissions:
+      contents: read
+    steps:
+      - name: Install Nix
+        uses: cachix/install-nix-action@v31
+        with:
+          github_access_token: ${{ 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-update -O0 -j
+          nix develop -c cabal v2-build -O0 -j

.github/workflows/packdeps.yml

@@ -0,0 +1,50 @@
+name: Packdeps
+
+on:
+  workflow_dispatch:
+  schedule:
+    # Run every Saturday
+    - cron: '0 3 * * 6'
+
+jobs:
+  packdeps:
+    name: Packdeps
+    runs-on: ubuntu-latest
+
+    steps:
+      - name: Clone project
+        uses: actions/checkout@v4
+      - name: Setup Haskell
+        uses: haskell-actions/setup@v2
+        with:
+          # packdeps doesn't build with newer as of 2021-10
+          ghc-version: '8.8'
+      - name: Install packdeps
+        run: |
+          set -ex
+          cd  # go somewhere without a cabal.project
+          cabal install packdeps
+      - name: Check package bounds (all)
+        continue-on-error: true
+        run: |
+          set -ex
+          packdeps \
+            --exclude X11 \
+            --exclude xmonad \
+            *.cabal
+      - name: Check package bounds (preferred)
+        run: |
+          set -ex
+          packdeps \
+            --preferred \
+            --exclude X11 \
+            --exclude xmonad \
+            *.cabal
+
+  workflow-keepalive:
+    if: github.event_name == 'schedule'
+    runs-on: ubuntu-latest
+    permissions:
+      actions: write
+    steps:
+      - uses: liskin/gh-workflow-keepalive@v1

.github/workflows/stack.yml

@@ -0,0 +1,95 @@
+name: Stack
+
+on:
+  push:
+  pull_request:
+
+jobs:
+  build:
+    name: Stack CI - Linux - ${{ matrix.resolver }} - ${{ matrix.yaml }}
+    runs-on: ubuntu-latest
+    strategy:
+      fail-fast: false
+      matrix:
+        include:
+          - resolver: lts-16  # GHC 8.8
+            yaml: stack.yaml
+          - resolver: lts-16  # GHC 8.8
+            yaml: stack-master.yaml
+          - resolver: lts-18  # GHC 8.10
+            yaml: stack-master.yaml
+          - resolver: lts-19  # GHC 9.0
+            yaml: stack-master.yaml
+          - 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-23  # GHC 9.8
+            yaml: stack-master.yaml
+
+    steps:
+      - name: Clone project
+        uses: actions/checkout@v4
+
+      - name: Install C dependencies
+        run: |
+          set -ex
+          sudo apt update -y
+          sudo apt install -y \
+            libx11-dev \
+            libxext-dev \
+            libxft-dev \
+            libxinerama-dev \
+            libxrandr-dev \
+            libxss-dev \
+            #
+
+      - name: Refresh caches once a month
+        id: cache-date
+        # GHA writes caches on the first miss and then never updates them again;
+        # force updating the cache at least once a month. Additionally, the
+        # date is prefixed with an epoch number to let us manually refresh the
+        # cache when needed. This is a workaround for https://github.com/actions/cache/issues/2
+        run: |
+          date +date=1-%Y-%m >> $GITHUB_OUTPUT
+
+      - name: Cache Haskell package metadata
+        uses: actions/cache@v4
+        with:
+          path: ~/.stack/pantry
+          key: stack-pantry-${{ runner.os }}-${{ steps.cache-date.outputs.date }}
+
+      - name: Cache Haskell dependencies
+        uses: actions/cache@v4
+        with:
+          path: |
+            ~/.stack/*
+            !~/.stack/pantry
+            !~/.stack/programs
+          key: stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-${{ hashFiles(matrix.yaml) }}-${{ hashFiles('*.cabal') }}
+          restore-keys: |
+            stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-${{ hashFiles(matrix.yaml) }}-
+            stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-
+
+      - name: Update hackage index
+        # always update index to prevent the shared ~/.stack/pantry cache from being empty
+        run: |
+          set -ex
+          stack update
+
+      - name: Build and test
+        run: |
+          set -ex
+
+          # workaround for stack/pantry caching of github archives
+          sed -e "s/@{today}/@{$(date -u --iso-8601=seconds)}/" -i ${{ matrix.yaml }}
+
+          stack test \
+            --fast --no-terminal \
+            --stack-yaml=${{ matrix.yaml }} \
+            --resolver=${{ matrix.resolver }} --system-ghc \
+            --flag=xmonad-contrib:pedantic

.gitignore

@@ -24,3 +24,9 @@ tags
 # stack artifacts
 /.stack-work/
 /cabal.project.local
+
+stack.yaml.lock
+
+# nix artifacts
+result
+flake.lock

.hlint.yaml

@@ -0,0 +1,2 @@
+# Ignore these warnings.
+- ignore: {name: "Evaluate"}

.mailmap

@@ -13,90 +13,97 @@ Bogdan Sinitsyn <bogdan.sinitsyn@gmail.com>
 Brandon S Allbery KF8NH <allbery.b@gmail.com>
 Brandon S Allbery KF8NH <allbery.b@gmail.com> <allbery@ece.cmu.edu>
 Brent Yorgey <byorgey@gmail.com> <byorgey@cis.upenn.edu>
+Bruce Forte <fuererb@student.ethz.ch>
 Carlos Lopez-Camey <c.lopez@kmels.net>
 Carsten Otto <xmonad@c-otto.de>
+Cesar Crusius <ccrusius@google.com> <ccrusius@ccrusius-glaptop.roam.corp.google.com>
 Christian Dietrich <stettberger@dokucode.de>
 Christian Wills <cwills.dev@gmail.com>
 Daniel Neri <daniel.neri@sigicom.com> <daniel.neri@sigicom.se>
-Daniel Schoepe <daniel.schoepe@googlemail.com> <asgaroth_@gmx.de>
-Daniel Schoepe <daniel.schoepe@googlemail.com> <daniel.schoepe@gmail.com>
+Daniel Schoepe <daniel.schoepe@gmail.com> <asgaroth_@gmx.de>
+Daniel Schoepe <daniel.schoepe@gmail.com> <daniel.schoepe@googlemail.com>
 Daniel Wagner <me@dmwit.com> <daniel@wagner-home.com>
 Dave Harrison <dave@nullcube.com>
+Dave Macias <davama@gmail.com>
 David Glasser <glasser@mit.edu>
 David McLean <gopsychonauts@gmail.com>
+Devin Mullins <devin.mullins@gmail.com> <devinmullins@gmail.com>
 Devin Mullins <devin.mullins@gmail.com> <me@twifkak.com>
 Dominik Bruhn <dominik@dbruhn.de>
 Don Stewart <dons00@gmail.com> <dons@cse.unsw.edu.au>
 Don Stewart <dons00@gmail.com> <dons@galois.com>
 Edward Z. Yang <ezyang@cs.stanford.edu>
+Evgeny Kurnevsky <kurnevsky@gmail.com>
 Gwern Branwen <gwern@gwern.net>
 Gwern Branwen <gwern@gwern.net> <gwern0@gmail.com>
 Henrique Abreu <hgabreu@gmail.com>
 Ilya Portnov <portnov84@rambler.ru>
-intrigeri <intrigeri@boum.org>
+Ivan Brennen <ivan.brennan@gmail.com>
+Ivan Brennen <ivan.brennan@gmail.com> <ivanbrennan@users.noreply.github.com>
 Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
 Jan-David Quesel <quesel@informatik.uni-oldenburg.de>
 Jens Petersen <juhp@community.haskell.org> <petersen@haskell.org>
 Jeremy Apthorp <nornagon@gmail.com>
 Joachim Breitner <mail@joachim-breitner.de>
 Joachim Fasting <joachim.fasting@gmail.com>
-Joel Suovaniemi <joel.suovaniemi@iki.fi>
+Joan Milev <joantmilev@gmail.com> <51526053+exorcist365@users.noreply.github.com>
 Joe Thornber <joe.thornber@gmail.com>
+Joel Suovaniemi <joel.suovaniemi@iki.fi>
 Johann Giwer <johanngiwer@web.de>
 Jussi Maki <joamaki@gmail.com>
 Konstantin Sobolev <konstantin.sobolev@gmail.com>
+L. S. Leary <LSLeary@users.noreply.github.com>
 Lanny Ripple <lan3ny@gmail.com>
 Lei Chen <linxray@gmail.com>
+Leon Kowarschick <lkowarschick@gmail.com>
+Leon Kowarschick <lkowarschick@gmail.com> <5300871+elkowar@users.noreply.github.com>
 Leonardo Serra <leoserra@minaslivre.org>
+Luc Duzan <lduzan@linagora.com>
+Luc Duzan <lduzan@linagora.com> <stroky.l@gmail.com>
 Luis Cabellos <zhen.sydow@gmail.com>
 Lukas Mai <l.mai@web.de>
 Mario Pastorelli <pastorelli.mario@gmail.com>
 Mathias Stearn <redbeard0531@gmail.com>
 Matt Brown <deadguysfrom@gmail.com>
 Matthew Hague <matthewhague@zoho.com>
+Michael G. Sloan <mgsloan@gmail.com>
 Nathaniel Filardo <nwfilardo@gmail.com>
 Nelson Elhage <nelhage@mit.edu>
 Nicolas Dudebout <nicolas.dudebout@gatech.edu>
 Nicolas Pouillard <nicolas.pouillard@gmail.com>
 Nils Schweinsberg <mail@n-sch.de>
 Norbert Zeh <nzeh@cs.dal.ca>
+Peter J. Jones <pjones@devalot.com>
+Peter J. Jones <pjones@devalot.com> <pjones@pmade.com>
 Peter Olson <polson2@hawk.iit.edu>
 Quentin Moser <moserq@gmail.com>
-Quentin Moser <quentin.moser@unifr.ch>
+Quentin Moser <moserq@gmail.com> <quentin.moser@unifr.ch>
 Rickard Gustafsson <acura@allyourbase.se>
 Robert Marlow <bobstopper@bobturf.org>
 Robert Marlow <bobstopper@bobturf.org> <robreim@bobturf.org>
 Rohan Jain <crodjer@gmail.com>
-Sibi Prabakaran <sibi@psibi.in> <psibi2000@gmail.com>
 Sean Escriva <sean.escriva@gmail.com>
 Sean McEligot <seanmce33@gmail.com>
+Sibi Prabakaran <sibi@psibi.in>
 Spencer Janssen <spencerjanssen@gmail.com> <sjanssen@cse.unl.edu>
-Tomohiro Matsuyama <matsuyama3@ariel-networks.com>
+Timothy Hobbs <tim.thelion@gmail.com>
 Tom Rauchenwald <its.sec@gmx.net>
+Tom Smeets <tom.tsmeets@gmail.com> <Tom.TSmeets@Gmail.com>
+Tomas Janousek <tomi@nomi.cz>
+Tomohiro Matsuyama <matsuyama3@ariel-networks.com>
 Tony Morris <haskell@tmorris.net>
 Valery V. Vorotyntsev <valery.vv@gmail.com>
 Will Farrington <wcfarrington@gmail.com>
 Wirt Wolff <wirtwolff@gmail.com>
 Yaakov Nemoy <loupgaroublond@gmail.com>
+Yclept Nemo <orbisvicis@gmail.com> <pscjtwjdjtAhnbjm/dpn>
+Yecine Megdiche <yecine.megdiche@gmail.com> <megdiche@in.tum.de>
 
-brian <brian@lorf.org>
-cardboard42 <cardboard42@gmail.com>
-daedalusinfinity <daedalusinfinity@gmail.com>
 hexago.nl <xmonad-contrib@hexago.nl>
-intrigeri <intrigeri@boum.org>
-jakob <jakob@pipefour.org>
-kedals0 <kedals0@gmail.com>
 lithis <xmonad@selg.hethrael.org>
 lithis <xmonad@selg.hethrael.org> <xmonad@s001.hethrael.com>
-longpoke <longpoke@gmail.com>
-md143rbh7f <md143rbh7f@gmail.com>
-perlkat <perlkat@katspace.org>
-rupa <rupa@lrrr.us> <rupa@lrrr.us>
-timthelion <tim.thelion@gmail.com>
-
-# for core only
-Neil Mitchell <http://www.cs.york.ac.uk/~ndm/>, Neil Mitchell
-Nick Burlett <nickburlett@mac.com>
-Sam Hughes   <hughes@rpi.edu>
-Shae Erisson <shae@ScannedInAvian.com>
-Conrad Irwin <conrad.irwin@gmail.com>
+sam-barr <mail@samf.bar> <samfbarr@outlook.com>
+Tony Zorman <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
+Tony Zorman <soliditsallgood@mailbox.org> <soliditsallgood@tuta.io>
+Tony Zorman <soliditsallgood@mailbox.org>
+spoonm <spoonm@spoonm.org>

.travis.yml

@@ -1,91 +0,0 @@
-# This file has been generated -- see https://github.com/hvr/multi-ghc-travis
-language: c
-sudo: false
-
-cache:
-  directories:
-    - $HOME/.cabsnap
-    - $HOME/.cabal/packages
-
-before_cache:
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
-
-matrix:
-  include:
-    - env: CABALVER=1.16 GHCVER=7.6.3
-      compiler: ": #GHC 7.6.3"
-      addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
-    - env: CABALVER=1.18 GHCVER=7.8.4
-      compiler: ": #GHC 7.8.4"
-      addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
-    - env: CABALVER=1.22 GHCVER=7.10.3
-      compiler: ": #GHC 7.10.3"
-      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
-    - env: CABALVER=1.24 GHCVER=8.0.1
-      compiler: ": #GHC 8.0.1"
-      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
-
-before_install:
- - unset CC
- - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
-
-install:
- # build xmonad from HEAD
- - git clone https://github.com/xmonad/xmonad.git
-
- - cabal --version
- - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
- - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
-   then
-     zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
-          $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
-   fi
- - travis_retry cabal update -v
- - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
- - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
- - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
-
-# check whether current requested install-plan matches cached package-db snapshot
- - if diff -u $HOME/.cabsnap/installplan.txt installplan.txt;
-   then
-     echo "cabal build-cache HIT";
-     rm -rfv .ghc;
-     cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
-     cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
-   else
-     echo "cabal build-cache MISS";
-     rm -rf $HOME/.cabsnap;
-     mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
-     cabal install --only-dependencies --enable-tests --enable-benchmarks;
-   fi
-
-# snapshot package-db on cache miss
- - if [ ! -d $HOME/.cabsnap ];
-   then
-      echo "snapshotting package-db to build-cache";
-      mkdir $HOME/.cabsnap;
-      cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
-      cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
-   fi
-
- - cabal install xmonad/
-
-# Here starts the actual work to be performed for the package under test;
-# any command which exits with a non-zero exit code causes the build to fail.
-script:
- - if [ -f configure.ac ]; then autoreconf -i; fi
- - cabal configure --enable-tests --enable-benchmarks -v2  # -v2 provides useful information for debugging
- - cabal build   # this builds all libraries and executables (including tests/benchmarks)
- - cabal test
-# - cabal check   # complains about -Werror even though it is
-                  # hidden behind a manual flag with default false
- - cabal sdist   # tests that a source-distribution can be generated
-
-# Check that the resulting source distribution can be built & installed.
-# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
-# `cabal install --force-reinstalls dist/*-*.tar.gz`
- - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
-   (cd dist && cabal install --force-reinstalls "$SRC_TGZ")
-
-# EOF

CONTRIBUTING.md

@@ -0,0 +1,5 @@
+# Contributing to xmonad and xmonad-contrib
+
+Please refer to XMonad's [CONTRIBUTING][gh:xmonad:contributing].
+
+[gh:xmonad:contributing]: https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md

LICENSE

@@ -1,27 +1,26 @@
-Copyright (c) The Xmonad Community
+Copyright (c) The Xmonad Community. All rights reserved.
 
-All rights reserved.
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
 
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
+1. Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
 
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+2. Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+3. Neither the name of the copyright holder nor the names of its contributors
+may be used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

NIX.md

@@ -0,0 +1,106 @@
+# `nix` integration for XMonad
+
+## Customizing the `nix-shell`
+
+It's possible to use a file `develop.nix` to customize the `devShell`
+provided by the flake.  This is useful if e.g. you want to have the
+`haskell-language-server` or other developer tools in the shell properly
+configured (correct GHC versions, and the like).
+
+Here is an example `develop.nix` for `haskell-language-server`:
+
+``` nix
+pkgs: devInputs: devInputs // {
+  nativeBuildInputs = with pkgs.haskellPackages;
+    [ cabal-install hlint ghcid ormolu implicit-hie haskell-language-server ];
+}
+```
+
+## Selecting a Compiler
+
+A `comp.nix` file can be used to set the compiler used for `nix build` etc. E.g.
+
+```nix
+{ compiler = "ghc924"; }
+```
+
+Note that you must `git add comp.nix`, or it will be invisible to the flake.
+
+There is also a `prefix` option (see documentation below) but it doesn't really
+work in this context, since the xmonad flakes don't see the effects of your
+system overlays. Instead try the `--override-input` flag, e.g.
+
+```sh
+$ nix develop . --override-input nixpkgs 'github:NixOS/nixpkgs/nixos-unstable'
+```
+
+## NixOS Modules
+
+The core and contrib flakes provide NixOS configuration modules.
+You can bring them into your system flake like so:
+
+```nix
+{
+  inputs = {
+    nixpkgs.url = github:NixOS/nixpkgs/nixos-<version>;
+    # The xmonad-contrib flake depends upon and re-exports from the xmonad
+    # flake. As such, you don't need to use the latter directly. If you wish to
+    # use /only/ the xmonad flake, you should beware that the version of
+    # contrib you get from nixpkgs might not build against it.
+    xmonad-contrib.url = github:xmonad/xmonad-contrib;
+  };
+
+  outputs = { self, nixpkgs, xmonad-contrib }: {
+    nixosConfigurations.<hostname> = nixpkgs.lib.nixosSystem rec {
+      system = <system>;
+      # NixOS module composition is /not/ commutative; order matters.
+      # To avoid issues, add `xmonad-contrib.nixosModules` after your standard
+      # configuration, but before `modernise` or any module overlaying in a
+      # "prefix".
+      modules = [
+        ./configuration.nix
+        ./hardware-configuration.nix
+        <myMiscConfigModule>
+      ] ++ xmonad-contrib.nixosModules ++ [
+        # `modernise` replaces the standard xmonad module and wrapper script
+        # with those from unstable. This is currently a necessary workaround to
+        # make Mod-q recompilation work.
+        xmonad-contrib.modernise.${system}
+        <myPrefixModule>
+      ];
+    };
+  };
+}
+```
+
+Note that `<thing>` should be replaced with a user-supplied `thing`.
+`<version>`, `<hostname>` and `<system>` are necessary, while
+` <myMiscConfigModule>` and `<myPrefixModule>` are entirely optional.
+
+Having brought in `xmonad-contrib.nixosModules`, you can then set the provided
+options in your `configuration.nix` under `flake`:
+
+```nix
+  services.xserver.windowManager.xmonad = {
+    enable = true;
+    enableContribAndExtras = true;
+    flake = {
+      enable = true;
+    # prefix = "unstable";
+      compiler = "ghc924";
+    };
+  };
+```
+
+This will use core and contrib from git for your system xmonad, building your
+config with the compiler of your choice.
+
+With the flake enabled, the `xmonad.haskellPackages` option is not used
+directly, and is instead set by the `flake.compiler` option. When `compiler` is
+unset, the default `pkgs.haskellPackages` is used.
+
+The `prefix` option is used if you wish to select your haskell packages from
+within, e.g., unstable overlaid into `pkgs` as `pkgs.unstable`.
+
+See the flakes themselves and nix flake documentation for full detail.
+Additionally, a semi-walkthrough is available [here](https://tony-zorman.com/posts/xmonad-on-nixos.html).

README.md

@@ -1,42 +1,82 @@
-# xmonad-contrib: Third Party Extensions to the xmonad Window Manager
+<p align="center">
+  <a href="https://xmonad.org/"><img alt="XMonad logo" src="https://xmonad.org/images/logo-wrapped.svg" height=150></a>
+</p>
+<p align="center">
+  <a href="https://hackage.haskell.org/package/xmonad-contrib"><img alt="Hackage" src="https://img.shields.io/hackage/v/xmonad-contrib?logo=haskell"></a>
+  <a href="https://github.com/xmonad/xmonad-contrib/blob/readme/LICENSE"><img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad-contrib"></a>
+  <a href="https://haskell.org/"><img alt="Made in Haskell" src="https://img.shields.io/badge/Made%20in-Haskell-%235e5086?logo=haskell"></a>
+  <br>
+  <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/stack.yml"><img alt="Stack" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad-contrib/stack.yml?label=Stack&logo=githubactions&logoColor=white"></a>
+  <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/haskell-ci.yml"><img alt="Cabal" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad-contrib/haskell-ci.yml?label=Cabal&logo=githubactions&logoColor=white"></a>
+  <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/nix.yml"><img alt="Nix" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad-contrib/nix.yml?label=Nix&logo=githubactions&logoColor=white"></a>
+  <br>
+  <a href="https://github.com/sponsors/xmonad"><img alt="GitHub Sponsors" src="https://img.shields.io/github/sponsors/xmonad?label=GitHub%20Sponsors&logo=githubsponsors"></a>
+  <a href="https://opencollective.com/xmonad"><img alt="Open Collective" src="https://img.shields.io/opencollective/all/xmonad?label=Open%20Collective&logo=opencollective"></a>
+  <br>
+  <a href="https://web.libera.chat/#xmonad"><img alt="Chat on #xmonad@irc.libera.chat" src="https://img.shields.io/badge/%23%20chat-on%20libera-brightgreen"></a>
+  <a href="https://matrix.to/#/#xmonad:matrix.org"><img alt="Chat on #xmonad:matrix.org" src="https://img.shields.io/matrix/xmonad:matrix.org?logo=matrix"></a>
+</p>
 
-[![Build Status](https://travis-ci.org/xmonad/xmonad-contrib.svg?branch=master)](https://travis-ci.org/xmonad/xmonad-contrib)
+# xmonad-contrib
 
-You need the ghc compiler and xmonad window manager installed in
-order to use these extensions.
+**Community-maintained extensions for the [XMonad][web:xmonad] window manager.**
 
-For installation and configuration instructions, please see the
-[xmonad website] [xmonad], the documents included with the
-[xmonad source distribution] [xmonad-git], and the
-[online haddock documentation] [xmonad-docs].
+[xmonad core][gh:xmonad] is minimal, stable, yet extensible.
+[xmonad-contrib][gh:xmonad-contrib] is home to hundreds of additional tiling
+algorithms and extension modules. The two combined make for a powerful X11
+window-manager with endless customization possibilities. They are, quite
+literally, libraries for creating your own window manager.
 
-## Getting or Updating XMonadContrib
+## Installation
 
-  * Latest release: <https://hackage.haskell.org/package/xmonad-contrib>
+For installation and configuration instructions, please see:
 
-  * Git version: <https://github.com/xmonad/xmonad-contrib>
+ * [downloading and installing xmonad][web:download]
+ * [installing latest xmonad snapshot from git][web:install]
+ * [configuring xmonad][web:tutorial]
 
-(To use git xmonad-contrib you must also use the
-[git version of xmonad] [xmonad-git].)
+If you run into any trouble, consult our [documentation][web:documentation] or
+ask the [community][web:community] for help.
 
 ## Contributing
 
-Haskell code contributed to this repo should live under the
-appropriate subdivision of the `XMonad` namespace (currently includes
-`Actions`, `Config`, `Hooks`, `Layout`, `Prompt`, and `Util`). For
-example, to use the Grid layout, one would import:
+We welcome all forms of contributions:
 
-    XMonad.Layout.Grid
+ * [bug reports and feature ideas][gh:xmonad-contrib:issues]
+   (also to [xmonad][gh:xmonad:issues])
+ * [bug fixes, new features, new extensions][gh:xmonad-contrib:pulls]
+   (also to [xmonad][gh:xmonad:pulls])
+ * documentation fixes and improvements: [xmonad][gh:xmonad],
+   [xmonad-contrib][gh:xmonad-contrib], [xmonad-web][gh:xmonad-web]
+ * helping others in the [community][web:community]
+ * financial support: [GitHub Sponsors][gh:xmonad:sponsors],
+   [Open Collective][opencollective:xmonad]
 
-For further details, see the [documentation] [developing] for the
-`XMonad.Doc.Developing` module and the [xmonad website] [xmonad].
+Please do read the [CONTRIBUTING][gh:xmonad:contributing] document for more
+information about bug reporting and code contributions. For a brief overview
+of the architecture and code conventions, see the [documentation for the
+`XMonad.Doc.Developing` module][doc:developing]. If in doubt, [talk to
+us][web:community].
 
 ## License
 
-Code submitted to the contrib repo is licensed under the same license as
-xmonad itself, with copyright held by the authors.
+Code submitted to the xmonad-contrib repo is licensed under the same license
+as xmonad core itself, with copyright held by the authors.
 
-[xmonad]: http://xmonad.org
-[xmonad-git]: https://github.com/xmonad/xmonad
-[xmonad-docs]: http://www.xmonad.org/xmonad-docs
-[developing]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
+[doc:developing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
+[gh:xmonad-contrib:issues]: https://github.com/xmonad/xmonad-contrib/issues
+[gh:xmonad-contrib:pulls]: https://github.com/xmonad/xmonad-contrib/pulls
+[gh:xmonad-contrib]: https://github.com/xmonad/xmonad-contrib
+[gh:xmonad-web]: https://github.com/xmonad/xmonad-web
+[gh:xmonad:contributing]: https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md
+[gh:xmonad:issues]: https://github.com/xmonad/xmonad/issues
+[gh:xmonad:pulls]: https://github.com/xmonad/xmonad/pulls
+[gh:xmonad:sponsors]: https://github.com/sponsors/xmonad
+[gh:xmonad]: https://github.com/xmonad/xmonad
+[opencollective:xmonad]: https://opencollective.com/xmonad
+[web:community]: https://xmonad.org/community.html
+[web:documentation]: https://xmonad.org/documentation.html
+[web:download]: https://xmonad.org/download.html
+[web:install]: https://xmonad.org/INSTALL.html
+[web:tutorial]: https://xmonad.org/TUTORIAL.html
+[web:xmonad]: https://xmonad.org/

XMonad/Actions/AfterDrag.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.AfterDrag
+-- Description :  Allows you to add actions dependent on the current mouse drag.
 -- Copyright   :  (c) 2014 Anders Engstrom <ankaan@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -19,10 +20,11 @@ module XMonad.Actions.AfterDrag (
                 ifClick') where
 
 import XMonad
-import System.Time
+
+import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime)
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- >    import XMonad.Actions.AfterDrag
 --
@@ -53,7 +55,7 @@ afterDrag task = do drag <- gets dragging
 --   A drag is considered a click if it is completed within 300 ms.
 ifClick
   :: X ()   -- ^ The action to take if the dragging turned out to be a click.
-  -> X () 
+  -> X ()
 ifClick action = ifClick' 300 action (return ())
 
 -- | Take an action if the current dragging is completed within a certain time (in milliseconds.)
@@ -61,11 +63,11 @@ ifClick'
   :: Int    -- ^ Maximum time of dragging for it to be considered a click (in milliseconds.)
   -> X ()   -- ^ The action to take if the dragging turned out to be a click.
   -> X ()   -- ^ The action to take if the dragging turned out to not be a click.
-  -> X () 
+  -> X ()
 ifClick' ms click drag = do
-  start <- io $ getClockTime
-  afterDrag $ do 
-    stop <- io $ getClockTime
-    if diffClockTimes stop start <= noTimeDiff { tdPicosec = fromIntegral ms * 10^(9 :: Integer) }
+  start <- io getCurrentTime
+  afterDrag $ do
+    stop <- io getCurrentTime
+    if diffUTCTime stop start <= (fromIntegral ms / 10^(3 :: Integer) :: NominalDiffTime)
       then click
       else drag

XMonad/Actions/BluetileCommands.hs

@@ -1,6 +1,7 @@
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.BluetileCommands
+-- Description :  Interface with the [Bluetile](https://hackage.haskell.org/package/bluetile) tiling window manager.
 -- Copyright   :  (c) Jan Vornberger 2009
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -24,12 +25,11 @@ module XMonad.Actions.BluetileCommands (
 
 import XMonad
 import qualified XMonad.StackSet as W
-import XMonad.Layout.LayoutCombinators
 import System.Exit
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- >    import XMonad.Hooks.ServerMode
 -- >    import XMonad.Actions.BluetileCommands
@@ -43,7 +43,7 @@ import System.Exit
 
 workspaceCommands :: Int -> X [(String, X ())]
 workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return
-                            [(("greedyView" ++ show i),
+                            [( "greedyView" ++ show i,
                                 activateScreen sid >> windows (W.greedyView i))
                                 | i <- spaces ]
 
@@ -66,7 +66,7 @@ masterAreaCommands sid = [ ("increase master n", activateScreen sid >>
                          ]
 
 quitCommands :: [(String, X ())]
-quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess))
+quitCommands = [ ("quit bluetile", io exitSuccess)
                , ("quit bluetile and start metacity", restart "metacity" False)
                ]
 

XMonad/Actions/Commands.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.Commands
+-- Description :  Run internal xmonad commands using a dmenu menu.
 -- Copyright   :  (c) David Glasser 2007
 -- License     :  BSD3
 --
@@ -19,6 +20,7 @@ module XMonad.Actions.Commands (
                              -- $usage
                              commandMap,
                              runCommand,
+                             runCommandConfig,
                              runCommand',
                              workspaceCommands,
                              screenCommands,
@@ -31,11 +33,11 @@ import XMonad.Util.Dmenu (dmenu)
 
 import qualified Data.Map as M
 import System.Exit
-import Data.Maybe
+import XMonad.Prelude
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- >    import XMonad.Actions.Commands
 --
@@ -55,23 +57,23 @@ import Data.Maybe
 -- bindings!)
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a
 --   list of pairs.
 commandMap :: [(String, X ())] -> M.Map String (X ())
-commandMap c = M.fromList c
+commandMap = M.fromList
 
 -- | Generate a list of commands to switch to\/send windows to workspaces.
 workspaceCommands :: X [(String, X ())]
 workspaceCommands = asks (workspaces . config) >>= \spaces -> return
-                            [((m ++ show i), windows $ f i)
+                            [( m ++ show i, windows $ f i)
                                 | i <- spaces
                                 , (f, m) <- [(view, "view"), (shift, "shift")] ]
 
 -- | Generate a list of commands dealing with multiple screens.
 screenCommands :: [(String, X ())]
-screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))
+screenCommands = [( m ++ show sc, screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))
                       | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes
                       , (f, m) <- [(view, "screen"), (shift, "screen-to-")]
                  ]
@@ -99,15 +101,22 @@ defaultCommands = do
         , ("swap-down"           , windows swapDown                                 )
         , ("swap-master"         , windows swapMaster                               )
         , ("sink"                , withFocused $ windows . sink                     )
-        , ("quit-wm"             , io $ exitWith ExitSuccess                        )
+        , ("quit-wm"             , io exitSuccess                                   )
         ]
 
 -- | Given a list of command\/action pairs, prompt the user to choose a
---   command and return the corresponding action.
+--   command using dmenu and return the corresponding action.
 runCommand :: [(String, X ())] -> X ()
-runCommand cl = do
+runCommand = runCommandConfig dmenu
+
+
+-- | Given a list of command\/action pairs, prompt the user to choose a
+--   command using dmenu-compatible launcher and return the corresponding action.
+--   See X.U.Dmenu for compatible launchers.
+runCommandConfig :: ([String] -> X String) -> [(String, X ())] -> X()
+runCommandConfig f cl = do
   let m = commandMap cl
-  choice <- dmenu (M.keys m)
+  choice <- f (M.keys m)
   fromMaybe (return ()) (M.lookup choice m)
 
 -- | Given the name of a command from 'defaultCommands', return the

XMonad/Actions/ConstrainedResize.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.ConstrainedResize
+-- Description :  Constrain the aspect ratio of a floating window.
 -- Copyright   :  (c) Dougal Stanton
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -25,7 +26,7 @@ import XMonad
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- > import qualified XMonad.Actions.ConstrainedResize as Sqr
 --
@@ -43,9 +44,8 @@ import XMonad
 
 -- | Resize (floating) window with optional aspect ratio constraints.
 mouseResizeWindow :: Window -> Bool -> X ()
-mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    wa <- io $ getWindowAttributes d w
+mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     sh <- io $ getWMNormalHints d w
     io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
     mouseDrag (\ex ey -> do
@@ -53,5 +53,6 @@ mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
                      y = ey - fromIntegral (wa_y wa)
                      sz = if c then (max x y, max x y) else (x,y)
                  io $ resizeWindow d w `uncurry`
-                    applySizeHintsContents sh sz)
+                    applySizeHintsContents sh sz
+                 float w)
               (float w)

XMonad/Actions/CopyWindow.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE RecordWildCards #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.CopyWindow
+-- Description :  Duplicate a window on multiple workspaces.
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>, Ivan Veselov <veselov@gmail.com>, Lanny Ripple <lan3ny@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -18,22 +20,24 @@ module XMonad.Actions.CopyWindow (
                                  -- * Usage
                                  -- $usage
                                  copy, copyToAll, copyWindow, runOrCopy
-                                 , killAllOtherCopies, kill1
+                                 , killAllOtherCopies, kill1, taggedWindows, copiesOfOn
                                  -- * Highlight workspaces containing copies in logHook
                                  -- $logHook
-                                 , wsContainingCopies
+                                 , wsContainingCopies, copiesPP
                                 ) where
 
 import XMonad
+import XMonad.Prelude
 import Control.Arrow ((&&&))
 import qualified Data.List as L
 
 import XMonad.Actions.WindowGo
+import XMonad.Hooks.StatusBar.PP (PP(..), WS(..), isHidden)
 import qualified XMonad.StackSet as W
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+-- You can use this module with the following in your @xmonad.hs@ file:
 --
 -- > import XMonad.Actions.CopyWindow
 --
@@ -73,21 +77,27 @@ import qualified XMonad.StackSet as W
 -- >  , ((modm .|. shiftMask, xK_v ),  killAllOtherCopies) -- @@ Toggle window state back
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- $logHook
--- To distinguish workspaces containing copies of the focused window use
--- something like:
 --
--- > sampleLogHook h = do
--- >    copies <- wsContainingCopies
--- >    let check ws | ws `elem` copies = pad . xmobarColor "red" "black" $ ws
--- >                 | otherwise = pad ws
--- >    dynamicLogWithPP myPP {ppHidden = check, ppOutput = hPutStrLn h}
--- >
--- > main = do
--- >    h <- spawnPipe "xmobar"
--- >    xmonad def { logHook = sampleLogHook h }
+-- To distinguish workspaces containing copies of the focused window, use 'copiesPP'.
+-- 'copiesPP' takes a pretty printer and makes it aware of copies of the focused window.
+-- It can be applied when creating a 'XMonad.Hooks.StatusBar.StatusBarConfig'.
+--
+-- A sample config looks like this:
+--
+-- > mySB = statusBarProp "xmobar" (copiesPP (pad . xmobarColor "red" "black") xmobarPP)
+-- > main = xmonad $ withEasySB mySB defToggleStrutsKey def
+
+-- | Take a pretty printer and make it aware of copies by using the provided function
+-- to show hidden workspaces that contain copies of the focused window.
+copiesPP :: (WorkspaceId -> String) -> PP -> X PP
+copiesPP wtoS pp = do
+    copies <- wsContainingCopies
+    let check WS{..} = W.tag wsWS `elem` copies
+    let printer = (asks (isHidden <&&> check) >>= guard) $> wtoS
+    return pp{ ppPrinters = printer <|> ppPrinters pp }
 
 -- | Copy the focused window to a workspace.
 copy :: (Eq s, Eq i, Eq a) => i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
@@ -96,7 +106,7 @@ copy n s | Just w <- W.peek s = copyWindow w n s
 
 -- | Copy the focused window to all workspaces.
 copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd
-copyToAll s = foldr copy s $ map W.tag (W.workspaces s)
+copyToAll s = foldr (copy . W.tag) s (W.workspaces s)
 
 -- | Copy an arbitrary window to a workspace.
 copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
@@ -104,10 +114,10 @@ copyWindow w n = copy'
     where copy' s = if n `W.tagMember` s
                     then W.view (W.currentTag s) $ insertUp' w $ W.view n s
                     else s
-          insertUp' a s = W.modify (Just $ W.Stack a [] [])
+          insertUp' a = W.modify (Just $ W.Stack a [] [])
                           (\(W.Stack t l r) -> if a `elem` t:l++r
                                              then Just $ W.Stack t l r
-                                             else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) s
+                                             else Just $ W.Stack a (L.delete a l) (L.delete a (t:r)))
 
 
 -- | runOrCopy will run the provided shell command unless it can
@@ -142,9 +152,9 @@ killAllOtherCopies = do ss <- gets windowset
                                                    W.view (W.currentTag ss) .
                                                    delFromAllButCurrent w
     where
-      delFromAllButCurrent w ss = foldr ($) ss $
-                                  map (delWinFromWorkspace w . W.tag) $
-                                  W.hidden ss ++ map W.workspace (W.visible ss)
+      delFromAllButCurrent w ss = foldr (delWinFromWorkspace w . W.tag)
+                                  ss
+                                  (W.hidden ss ++ map W.workspace (W.visible ss))
       delWinFromWorkspace w wid = viewing wid $ W.modify Nothing (W.filter (/= w))
 
       viewing wis f ss = W.view (W.currentTag ss) $ f $ W.view wis ss

XMonad/Actions/CycleRecentWS.hs

@@ -1,6 +1,11 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE MultiWayIf #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.CycleRecentWS
+-- Description :  Cycle through most recently used workspaces.
 -- Copyright   :  (c) Michal Janeczek <janeczek@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -19,21 +24,37 @@ module XMonad.Actions.CycleRecentWS (
                                 -- * Usage
                                 -- $usage
                                 cycleRecentWS,
-                                cycleWindowSets
+                                cycleRecentNonEmptyWS,
+                                cycleWindowSets,
+                                toggleRecentWS,
+                                toggleRecentNonEmptyWS,
+                                toggleWindowSets,
+                                recentWS,
+
+#ifdef TESTING
+                                unView,
+#endif
 ) where
 
+import XMonad.Actions.Repeatable (repeatableSt)
+
 import XMonad hiding (workspaces)
-import XMonad.StackSet
+import XMonad.Prelude (void, when)
+import XMonad.StackSet hiding (filter, modify)
+
+import Control.Arrow ((&&&))
+import Data.Function (on)
+import Control.Monad.State (lift)
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+-- You can use this module with the following in your @xmonad.hs@ file:
 --
 -- > import XMonad.Actions.CycleRecentWS
 -- >
 -- >   , ((modm, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave)
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Cycle through most recent workspaces with repeated presses of a key, while
 --   a modifier key is held down. The recency of workspaces previewed while browsing
@@ -47,39 +68,91 @@ cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this a
               -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.
                           --   If it's the same as the nextWorkspace key, it is effectively ignored.
               -> X ()
-cycleRecentWS = cycleWindowSets options
- where options w = map (view `flip` w) (recentTags w)
-       recentTags w = map tag $ tail (workspaces w) ++ [head (workspaces w)]
+cycleRecentWS = cycleWindowSets $ recentWS (const True)
 
 
-cycref :: [a] -> Int -> a
-cycref l i = l !! (i `mod` length l)
+-- | Like 'cycleRecentWS', but restricted to non-empty workspaces.
+cycleRecentNonEmptyWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
+                                  --   As soon as one of them is released, the final switch is made.
+                      -> KeySym   -- ^ Key used to switch to next (less recent) workspace.
+                      -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.
+                                  --   If it's the same as the nextWorkspace key, it is effectively ignored.
+                      -> X ()
+cycleRecentNonEmptyWS = cycleWindowSets $ recentWS (not . null . stack)
 
--- | Cycle through a finite list of WindowSets with repeated presses of a key, while
+
+-- | Switch to the most recent workspace. The stack of most recently used workspaces
+-- is updated, so repeated use toggles between a pair of workspaces.
+toggleRecentWS :: X ()
+toggleRecentWS = toggleWindowSets $ recentWS (const True)
+
+
+-- | Like 'toggleRecentWS', but restricted to non-empty workspaces.
+toggleRecentNonEmptyWS :: X ()
+toggleRecentNonEmptyWS = toggleWindowSets $ recentWS (not . null . stack)
+
+
+-- | Given a predicate @p@ and the current 'WindowSet' @w@, create a
+-- list of workspaces to choose from. They are ordered by recency and
+-- have to satisfy @p@.
+recentWS :: (WindowSpace -> Bool) -- ^ A workspace predicate.
+         -> WindowSet             -- ^ The current WindowSet
+         -> [WorkspaceId]
+recentWS p w = map tag
+             $ filter p
+             $ map workspace (visible w)
+               ++ hidden w
+               ++ [workspace (current w)]
+
+-- | Cycle through a finite list of workspaces with repeated presses of a key, while
 --   a modifier key is held down. For best effects use the same modkey+key combination
 --   as the one used to invoke this action.
-cycleWindowSets :: (WindowSet -> [WindowSet]) -- ^ A function used to create a list of WindowSets to choose from
-                -> [KeySym]                   -- ^ A list of modifier keys used when invoking this action.
-                                              --   As soon as one of them is released, the final WindowSet is chosen and the action exits.
-                -> KeySym                     -- ^ Key used to preview next WindowSet from the list of generated options
-                -> KeySym                     -- ^ Key used to preview previous WindowSet from the list of generated options.
-                                              --   If it's the same as nextOption key, it is effectively ignored.
+cycleWindowSets :: (WindowSet -> [WorkspaceId]) -- ^ A function used to create a list of workspaces to choose from
+                -> [KeySym]                     -- ^ A list of modifier keys used when invoking this action.
+                                                --   As soon as one of them is released, the final workspace is chosen and the action exits.
+                -> KeySym                       -- ^ Key used to preview next workspace from the list of generated options
+                -> KeySym                       -- ^ Key used to preview previous workspace from the list of generated options.
+                                                --   If it's the same as nextOption key, it is effectively ignored.
                 -> X ()
 cycleWindowSets genOptions mods keyNext keyPrev = do
+  (options, unView') <- gets $ (genOptions &&& unView) . windowset
+  let
+    preview = do
+      i <- get
+      lift $ windows (view (options !! (i `mod` n)) . unView')
+      where n = length options
+  void . repeatableSt (-1) mods keyNext $ \t s -> when (t == keyPress) $ if
+    | s == keyNext -> modify succ >> preview
+    | s == keyPrev -> modify pred >> preview
+    | otherwise    -> pure ()
+
+-- | Given an old and a new 'WindowSet', which is __exactly__ one
+-- 'view' away from the old one, restore the workspace order of the
+-- former inside of the latter.  This respects any new state that the
+-- new 'WindowSet' may have accumulated.
+unView :: forall i l a s sd. (Eq i, Eq s)
+       => StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd
+unView w0 w1 = fixOrderH . fixOrderV . view' (currentTag w0) $ w1
+ where
+  view' = if screen (current w0) == screen (current w1) then greedyView else view
+  fixOrderV w | v : vs <- visible w = w{ visible = insertAt (pfxV (visible w0) vs) v vs }
+              | otherwise = w
+  fixOrderH w | h : hs <- hidden w = w{ hidden = insertAt (pfxH (hidden w0) hs) h hs }
+              | otherwise = w
+  pfxV = commonPrefix `on` fmap (tag . workspace)
+  pfxH = commonPrefix `on` fmap tag
+
+  insertAt :: Int -> x -> [x] -> [x]
+  insertAt n x xs = let (l, r) = splitAt n xs in l ++ [x] ++ r
+
+  commonPrefix :: Eq x => [x] -> [x] -> Int
+  commonPrefix a b = length $ takeWhile id $ zipWith (==) a b
+
+-- | Given some function that generates a list of workspaces from a
+-- given 'WindowSet', switch to the first generated workspace.
+toggleWindowSets :: (WindowSet -> [WorkspaceId]) -> X ()
+toggleWindowSets genOptions = do
   options <- gets $ genOptions . windowset
-  XConf {theRoot = root, display = d} <- ask
-  let event = allocaXEvent $ \p -> do
-                maskEvent d (keyPressMask .|. keyReleaseMask) p
-                KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
-                s <- keycodeToKeysym d c 0
-                return (t, s)
-  let setOption n = do windows $ const $ options `cycref` n
-                       (t, s) <- io event
-                       case () of
-                         () | t == keyPress   && s == keyNext  -> setOption (n+1)
-                            | t == keyPress   && s == keyPrev  -> setOption (n-1)
-                            | t == keyRelease && s `elem` mods -> return ()
-                            | otherwise                        -> setOption n
-  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
-  setOption 0
-  io $ ungrabKeyboard d currentTime
+  case options of
+    []  -> return ()
+    o:_ -> windows (view o)

XMonad/Actions/CycleSelectedLayouts.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.CycleSelectedLayouts
+-- Description :  Cycle through the given subset of layouts.
 -- Copyright   :  (c) Roman Cheplyaka
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -18,34 +19,29 @@ module XMonad.Actions.CycleSelectedLayouts (
     cycleThroughLayouts) where
 
 import XMonad
-import Data.List (findIndex)
-import Data.Maybe (fromMaybe)
-import XMonad.Layout.LayoutCombinators (JumpToLayout(..))
+import XMonad.Prelude (elemIndex, fromMaybe)
 import qualified XMonad.StackSet as S
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
--- > import XMonad hiding ((|||))
--- > import XMonad.Layout.LayoutCombinators ((|||))
+-- > import XMonad
 -- > import XMonad.Actions.CycleSelectedLayouts
 --
 -- >   , ((modm,  xK_t ),   cycleThroughLayouts ["Tall", "Mirror Tall"])
---
--- Make sure you are using NewSelect from XMonad.Layout.LayoutCombinators,
--- rather than the Select defined in xmonad core.
 
 cycleToNext :: (Eq a) => [a] -> a -> Maybe a
 cycleToNext lst a = do
     -- not beautiful but simple and readable
-    ind <- findIndex (a==) lst
+    ind <- elemIndex a lst
     return $ lst !! if ind == length lst - 1 then 0 else ind+1
 
 -- | If the current layout is in the list, cycle to the next layout. Otherwise,
 --   apply the first layout from list.
 cycleThroughLayouts :: [String] -> X ()
-cycleThroughLayouts lst = do
+cycleThroughLayouts []         = pure ()
+cycleThroughLayouts lst@(x: _) = do
     winset <- gets windowset
     let ld = description . S.layout . S.workspace . S.current $ winset
-    let newld = fromMaybe (head lst) (cycleToNext lst ld)
+    let newld = fromMaybe x (cycleToNext lst ld)
     sendMessage $ JumpToLayout newld

XMonad/Actions/CycleWS.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.CycleWS
+-- Description :  Cycle through workspaces.
 -- Copyright   :  (c) Joachim Breitner <mail@joachim-breitner.de>,
 --                    Nelson Elhage <nelhage@mit.edu> (`toggleWS' function)
 -- License     :  BSD3-style (see LICENSE)
@@ -18,13 +19,13 @@
 --
 -- Note that this module now subsumes the functionality of the former
 -- @XMonad.Actions.RotView@.  Former users of @rotView@ can simply replace
--- @rotView True@ with @moveTo Next NonEmptyWS@, and so on.
+-- @rotView True@ with @moveTo Next (Not emptyWS)@, and so on.
 --
 -- If you want to exactly replicate the action of @rotView@ (cycling
 -- through workspace in order lexicographically by tag, instead of in
 -- the order specified in the config), it can be implemented as:
 --
--- > rotView b  = do t <- findWorkspace getSortByTag (bToDir b) NonEmptyWS 1
+-- > rotView b  = do t <- findWorkspace getSortByTag (bToDir b) (Not emptyWS) 1
 -- >                 windows . greedyView $ t
 -- >   where bToDir True  = Next
 -- >         bToDir False = Prev
@@ -63,6 +64,11 @@ module XMonad.Actions.CycleWS (
 
                               , Direction1D(..)
                               , WSType(..)
+                              , emptyWS
+                              , hiddenWS
+                              , anyWS
+                              , wsTagGroup
+                              , ignoringWSs
 
                               , shiftTo
                               , moveTo
@@ -78,9 +84,7 @@ module XMonad.Actions.CycleWS (
 
                              ) where
 
-import Data.List ( find, findIndex )
-import Data.Maybe ( isNothing, isJust )
-
+import XMonad.Prelude (find, findIndex, isJust, isNothing, liftM2)
 import XMonad hiding (workspaces)
 import qualified XMonad.Hooks.WorkspaceHistory as WH
 import XMonad.StackSet hiding (filter)
@@ -88,7 +92,7 @@ import XMonad.Util.Types
 import XMonad.Util.WorkspaceCompare
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+-- You can use this module with the following in your @xmonad.hs@ file:
 --
 -- > import XMonad.Actions.CycleWS
 -- >
@@ -112,13 +116,13 @@ import XMonad.Util.WorkspaceCompare
 -- You can also get fancier with 'moveTo', 'shiftTo', and 'findWorkspace'.
 -- For example:
 --
--- >   , ((modm     , xK_f), moveTo Next EmptyWS)  -- find a free workspace
+-- >   , ((modm     , xK_f), moveTo Next emptyWS)  -- find a free workspace
 -- >   , ((modm .|. controlMask, xK_Right),        -- a crazy keybinding!
--- >         do t <- findWorkspace getSortByXineramaRule Next NonEmptyWS 2
+-- >         do t <- findWorkspace getSortByXineramaRule Next (Not emptyWS) 2
 -- >            windows . view $ t                                         )
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 --
 -- When using the toggle functions, in order to ensure that the workspace
 -- to which you switch is the previously viewed workspace, use the
@@ -201,8 +205,7 @@ skipTags wss ids = filter ((`notElem` ids) . tag) wss
 lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId)
 lastViewedHiddenExcept skips = do
     hs <- gets $ map tag . flip skipTags skips . hidden . windowset
-    vs <- WH.workspaceHistory
-    return $ choose hs (find (`elem` hs) vs)
+    choose hs . find (`elem` hs) <$> WH.workspaceHistory
     where choose []    _           = Nothing
           choose (h:_) Nothing     = Just h
           choose _     vh@(Just _) = vh
@@ -213,8 +216,8 @@ switchWorkspace d = wsBy d >>= windows . greedyView
 shiftBy :: Int -> X ()
 shiftBy d = wsBy d >>= windows . shift
 
-wsBy :: Int -> X (WorkspaceId)
-wsBy = findWorkspace getSortByIndex Next AnyWS
+wsBy :: Int -> X WorkspaceId
+wsBy = findWorkspace getSortByIndex Next anyWS
 
 {- $taketwo
 
@@ -223,7 +226,7 @@ through subsets of workspaces.
 
 For example,
 
->   moveTo Next EmptyWS
+>   moveTo Next emptyWS
 
 will move to the first available workspace with no windows, and
 
@@ -234,6 +237,13 @@ the letter 'p' in its name. =)
 
 -}
 
+{-# DEPRECATED EmptyWS             "Use emptyWS instead." #-}
+{-# DEPRECATED HiddenWS            "Use hiddenWS instead." #-}
+{-# DEPRECATED NonEmptyWS          "Use Not emptyWS instead." #-}
+{-# DEPRECATED HiddenNonEmptyWS    "Use hiddenWS :&: Not emptyWS instead." #-}
+{-# DEPRECATED HiddenEmptyWS       "Use hiddenWS :&: emptyWS instead." #-}
+{-# DEPRECATED AnyWS               "Use anyWS instead." #-}
+{-# DEPRECATED WSTagGroup          "Use wsTagGroup instead." #-}
 -- | What type of workspaces should be included in the cycle?
 data WSType = EmptyWS     -- ^ cycle through empty workspaces
             | NonEmptyWS  -- ^ cycle through non-empty workspaces
@@ -248,6 +258,11 @@ data WSType = EmptyWS     -- ^ cycle through empty workspaces
             | WSIs (X (WindowSpace -> Bool))
                           -- ^ cycle through workspaces satisfying
                           --   an arbitrary predicate
+            | WSType :&: WSType -- ^ cycle through workspaces satisfying both
+                                --   predicates.
+            | WSType :|: WSType -- ^ cycle through workspaces satisfying one of
+                                --   the predicates.
+            | Not WSType -- ^ cycle through workspaces not satisfying the predicate
 
 -- | Convert a WSType value to a predicate on workspaces.
 wsTypeToPred :: WSType -> X (WindowSpace -> Bool)
@@ -262,10 +277,46 @@ wsTypeToPred HiddenEmptyWS  = do ne <- wsTypeToPred EmptyWS
                                  hi <- wsTypeToPred HiddenWS
                                  return (\w -> hi w && ne w)
 wsTypeToPred AnyWS      = return (const True)
-wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset
+wsTypeToPred (WSTagGroup sep) = do cur <- groupName.workspace.current <$> gets windowset
                                    return $ (cur ==).groupName
                                    where groupName = takeWhile (/=sep).tag
-wsTypeToPred (WSIs p)   = p
+wsTypeToPred (WSIs p ) = p
+wsTypeToPred (p :&: q) = liftM2 (&&) <$> wsTypeToPred p <*> wsTypeToPred q
+wsTypeToPred (p :|: q) = liftM2 (||) <$> wsTypeToPred p <*> wsTypeToPred q
+wsTypeToPred (Not p  ) = fmap not <$> wsTypeToPred p
+
+-- | Cycle through empty workspaces
+emptyWS :: WSType
+emptyWS = WSIs . return $ isNothing . stack
+
+-- | Cycle through non-visible workspaces
+hiddenWS :: WSType
+hiddenWS = WSIs $ do
+  hs <- gets (map tag . hidden . windowset)
+  return $ (`elem` hs) . tag
+
+-- | Cycle through all workspaces
+anyWS :: WSType
+anyWS = WSIs . return $ const True
+
+-- | Cycle through workspaces that are not in the given list. This could, for
+--   example, be used for skipping the workspace reserved for
+--   "XMonad.Util.NamedScratchpad":
+--
+-- >  moveTo Next $ hiddenWS :&: Not emptyWS :&: ignoringWSs [scratchpadWorkspaceTag]
+--
+ignoringWSs :: [WorkspaceId] -> WSType
+ignoringWSs ts = WSIs . return $ (`notElem` ts) . tag
+
+-- | Cycle through workspaces in the same group, the
+--   group name is all characters up to the first
+--   separator character or the end of the tag
+wsTagGroup :: Char -> WSType
+wsTagGroup sep = WSIs $ do
+  cur <- groupName . workspace . current <$> gets windowset
+  return $ (cur ==) . groupName
+  where groupName = takeWhile (/= sep) . tag
+
 
 -- | View the next workspace in the given direction that satisfies
 --   the given condition.
@@ -299,7 +350,7 @@ findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceI
 findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n)
   where
     maybeNegate Next d = d
-    maybeNegate Prev d = (-d)
+    maybeNegate Prev d = -d
 
 findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId
 findWorkspaceGen _ _ 0 = gets (currentTag . windowset)
@@ -309,7 +360,7 @@ findWorkspaceGen sortX wsPredX d = do
     ws     <- gets windowset
     let cur     = workspace (current ws)
         sorted  = sort (workspaces ws)
-        pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a
+        pivoted = let (a,b) = span ((/= tag cur) . tag) sorted in b ++ a
         ws'     = filter wsPred pivoted
         mCurIx  = findWsIndex cur ws'
         d'      = if d > 0 then d - 1 else d
@@ -321,7 +372,7 @@ findWorkspaceGen sortX wsPredX d = do
     return $ tag next
 
 findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int
-findWsIndex ws wss = findIndex ((== tag ws) . tag) wss
+findWsIndex ws = findIndex ((== tag ws) . tag)
 
 -- | View next screen
 nextScreen :: X ()
@@ -349,7 +400,7 @@ the default screen keybindings:
 >         , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
 
 -}
-screenBy :: Int -> X (ScreenId)
+screenBy :: Int -> X ScreenId
 screenBy d = do ws <- gets windowset
                 --let ss = sortBy screen (screens ws)
                 let now = screen (current ws)

XMonad/Actions/CycleWindows.hs

@@ -1,6 +1,9 @@
+{-# LANGUAGE ViewPatterns, MultiWayIf #-}
+
 --------------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.CycleWindows
+-- Description  : Cycle windows while maintaining focus in place.
 -- Copyright    : (c) Wirt Wolff <wirtwolff@gmail.com>
 -- License      : BSD3-style (see LICENSE)
 --
@@ -47,18 +50,21 @@ module XMonad.Actions.CycleWindows (
         -- $pointer
 
         -- * Generic list rotations
-        -- $generic
         rotUp, rotDown
 ) where
 
 import XMonad
+import XMonad.Prelude
 import qualified XMonad.StackSet as W
+import qualified Data.List.NonEmpty as NE
 import XMonad.Actions.RotSlaves
+import XMonad.Actions.Repeatable (repeatableSt)
 
 import Control.Arrow (second)
+import Control.Monad.Trans (lift)
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+-- You can use this module with the following in your @xmonad.hs@ file:
 --
 -- > import XMonad.Actions.CycleWindows
 -- >    -- config
@@ -74,7 +80,7 @@ import Control.Arrow (second)
 --
 -- Also, if you use focus follows mouse, you will want to read the section
 -- on updating the mouse pointer below.  For detailed instructions on
--- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
+-- editing your key bindings, see <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 {- $pointer
 With FocusFollowsMouse == True, the focus is updated after binding
 actions, possibly focusing a window you didn't intend to focus. Most
@@ -116,7 +122,7 @@ cycleRecentWindows :: [KeySym] -- ^ A list of modifier keys used when invoking t
                                --   If it's the same as the first key, it is effectively ignored.
                     -> X ()
 cycleRecentWindows = cycleStacks' stacks where
-    stacks s = map (shiftToFocus' `flip` s) (wins s)
+    stacks s = map (`shiftToFocus'` s) (wins s)
     wins (W.Stack t l r) = t : r ++ reverse l
 
 
@@ -134,27 +140,19 @@ cycleStacks' :: (W.Stack Window -> [W.Stack Window]) -- ^ A function to a finite
                                     -> KeySym    -- ^ Key used to select a \"previous\" stack.
                                     -> X ()
 cycleStacks' filteredPerms mods keyNext keyPrev = do
-    XConf {theRoot = root, display = d} <- ask
-    stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset
-
-    let evt = allocaXEvent $
-                  \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p
-                           KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
-                           s <- keycodeToKeysym d c 0
-                           return (t, s)
-        choose n (t, s)
-              | t == keyPress   && s == keyNext  = io evt >>= choose (n+1)
-              | t == keyPress   && s == keyPrev  = io evt >>= choose (n-1)
-              | t == keyPress   && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s)
-              | t == keyRelease && s `elem` mods = return ()
-              | otherwise                        = doStack n >> io evt >>= choose n
-        doStack n = windows . W.modify' . const $ stacks `cycref` n
-
-    io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
-    io evt >>= choose 1
-    io $ ungrabKeyboard d currentTime
-  where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite
-        numKeyToN = subtract 48 . read . show
+  stacks <- gets $ maybe [] filteredPerms
+                 . W.stack . W.workspace . W.current . windowset
+  let
+    preview = do
+      i <- get
+      lift . windows . W.modify' . const $ stacks !! (i `mod` n)
+      where n = length stacks
+  void $ repeatableSt 0 mods keyNext $ \t s -> if
+    | t == keyPress && s == keyNext          -> modify succ
+    | t == keyPress && s == keyPrev          -> modify pred
+    | t == keyPress && s `elem` [xK_0..xK_9] -> put (numKeyToN s)
+    | otherwise                              -> preview
+  where numKeyToN = subtract 48 . read . show
 
 -- | Given a stack element and a stack, shift or insert the element (window)
 --   at the currently focused position.
@@ -178,7 +176,7 @@ rotOpposite' :: W.Stack a -> W.Stack a
 rotOpposite' (W.Stack t l r) = W.Stack t' l' r'
   where rrvl = r ++ reverse l
         part = (length rrvl + 1) `div` 2
-        (l',t':r') =  second reverse . splitAt (length l) $
+        (l', notEmpty -> t' :| r') = second reverse . splitAt (length l) $
                                 reverse (take part rrvl ++ t : drop part rrvl)
 
 
@@ -204,8 +202,8 @@ rotFocusedDown = windows . W.modify' $ rotFocused' rotDown
 rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
 rotFocused' _ s@(W.Stack _ [] []) = s
 rotFocused' f   (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus
-    where (t':rs') = f (t:rs)
-rotFocused' f s@(W.Stack _ _ _) = rotSlaves' f s              -- otherwise
+    where (notEmpty -> t' :| rs') = f (t:rs)
+rotFocused' f s@W.Stack{} = rotSlaves' f s                    -- otherwise
 
 
 -- $unfocused
@@ -222,14 +220,5 @@ rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
 rotUnfocused' _ s@(W.Stack _ [] []) = s
 rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s                 -- Master has focus
 rotUnfocused' f   (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise
-    where  (master:revls)  = reverse ls
+    where  (master :| revls) = NE.reverse (let l:ll = ls in l :| ll)
            (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs)
-
--- $generic
--- Generic list rotations such that @rotUp [1..4]@ is equivalent to
--- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are
--- @id@ for null or singleton lists.
-rotUp :: [a] -> [a]
-rotUp   l = drop 1 l ++ take 1 l
-rotDown :: [a] -> [a]
-rotDown = reverse . rotUp . reverse

XMonad/Actions/CycleWorkspaceByScreen.hs

@@ -0,0 +1,111 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.CycleWorkspaceByScreen
+-- Description :  Cycle workspaces in a screen-aware fashion.
+-- Copyright   :  (c) 2017 Ivan Malison
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  IvanMalison@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Cycle through previously viewed workspaces in the order they were viewed most
+-- recently on the screen where cycling is taking place.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.CycleWorkspaceByScreen (
+    -- * Usage
+    -- $usage
+    cycleWorkspaceOnScreen
+  , cycleWorkspaceOnCurrentScreen
+  , handleKeyEvent
+  , repeatableAction
+  ) where
+
+import           Data.IORef
+
+import           XMonad
+import           XMonad.Prelude
+import           XMonad.Hooks.WorkspaceHistory
+import           XMonad.Actions.Repeatable (repeatable)
+import qualified XMonad.StackSet as W
+
+-- $usage
+--
+-- To use this module, first import it as well as
+-- "XMonad.Hooks.WorkspaceHistory":
+--
+-- > import XMonad.Hooks.WorkspaceHistory (workspaceHistoryHook)
+-- > import XMonad.Actions.CycleWorkspaceByScreen
+--
+-- Then add 'workspaceHistoryHook' to your @logHook@ like this:
+--
+-- > main :: IO ()
+-- > main = xmonad $ def
+-- >    { ...
+-- >    , logHook = workspaceHistoryHook >> ...
+-- >    }
+--
+-- Finally, define a new keybinding for cycling (seen) workspaces per
+-- screen:
+--
+-- > , ((mod4Mask, xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p)
+
+{-# DEPRECATED repeatableAction "Use XMonad.Actions.Repeatable.repeatable" #-}
+repeatableAction :: [KeySym] -> KeySym -> (EventType -> KeySym -> X ()) -> X ()
+repeatableAction = repeatable
+
+handleKeyEvent :: EventType
+               -> KeySym
+               -> X ()
+               -> EventType
+               -> KeySym
+               -> Maybe (X ())
+handleKeyEvent eventType key action = helper
+  where
+  helper et k
+    | et == eventType && k == key = Just action
+    | otherwise = Nothing
+
+
+runFirst :: [EventType -> KeySym -> Maybe (X ())] -> EventType -> KeySym -> X ()
+runFirst matchers eventType key =
+  fromMaybe (return ()) $ join $ find isJust $ map (\fn -> fn eventType key) matchers
+
+-- | Like 'XMonad.Actions.CycleRecentWS.cycleRecentWS', but only cycle
+-- through the most recent workspaces on the given screen.
+cycleWorkspaceOnScreen
+  :: ScreenId -- ^ The screen to cycle on.
+  -> [KeySym] -- ^ A list of modifier keys used when invoking this
+              --   action; as soon as one of them is released, the final
+              --   switch is made.
+  -> KeySym   -- ^ Key used to switch to next workspace.
+  -> KeySym   -- ^ Key used to switch to previous workspace.
+  -> X ()
+cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransaction $ do
+  startingHistory <- workspaceHistoryByScreen
+  currentWSIndex <- io $ newIORef 1
+  let cycleWorkspaces = fromMaybe [] $ lookup screenId startingHistory
+      getAndIncrementWS increment = do
+        current <- readIORef currentWSIndex
+        modifyIORef
+          currentWSIndex
+          ((`mod` length cycleWorkspaces) . (+ increment))
+        return $ cycleWorkspaces !! current
+      focusIncrement i = io (getAndIncrementWS i) >>= (windows . W.greedyView)
+
+  repeatable mods nextKey $
+    runFirst
+      [ handleKeyEvent keyPress nextKey $ focusIncrement 1
+      , handleKeyEvent keyPress prevKey $ focusIncrement (-1)
+      ]
+  return ()
+
+-- | Like 'cycleWorkspaceOnScreen', but supply the currently focused
+-- screen as the @screenId@.
+cycleWorkspaceOnCurrentScreen
+  :: [KeySym] -> KeySym -> KeySym -> X ()
+cycleWorkspaceOnCurrentScreen mods n p =
+  withWindowSet $ \ws ->
+    cycleWorkspaceOnScreen (W.screen $ W.current ws) mods n p

XMonad/Actions/DeManage.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.DeManage
+-- Description :  Cease management of a window without unmapping it.
 -- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -38,7 +39,7 @@ import qualified XMonad.StackSet as W
 import XMonad
 
 -- $usage
--- To use demanage, add this import to your @~\/.xmonad\/xmonad.hs@:
+-- To use demanage, add this import to your @xmonad.hs@:
 --
 -- >     import XMonad.Actions.DeManage
 --
@@ -47,7 +48,7 @@ import XMonad
 -- > , ((modm,               xK_d     ), withFocused demanage)
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Stop managing the currently focused window.
 demanage :: Window -> X ()

XMonad/Actions/DwmPromote.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.DwmPromote
+-- Description :  DWM-like swap function for xmonad.
 -- Copyright   :  (c) Miikka Koskinen 2007
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -24,10 +25,13 @@ module XMonad.Actions.DwmPromote (
 
 import XMonad
 import XMonad.StackSet
+import XMonad.Prelude
+
+import qualified Data.List.NonEmpty as NE
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- >    import XMonad.Actions.DwmPromote
 --
@@ -36,7 +40,7 @@ import XMonad.StackSet
 -- >   , ((modm,               xK_Return), dwmpromote)
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Swap the focused window with the master window. If focus is in
 --   the master, swap it with the next window in the stack. Focus
@@ -44,6 +48,6 @@ import XMonad.StackSet
 dwmpromote :: X ()
 dwmpromote = windows $ modify' $
              \c -> case c of
-                   Stack _ [] []     -> c
-                   Stack t [] (x:rs) -> Stack x [] (t:rs)
-                   Stack t ls rs     -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls
+                   Stack _ []     []     -> c
+                   Stack t []     (r:rs) -> Stack r [] (t:rs)
+                   Stack t (l:ls) rs     -> Stack t [] (ys ++ y : rs) where (y :| ys) = NE.reverse (l :| ls)

XMonad/Actions/DynamicProjects.hs

@@ -1,8 +1,7 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.DynamicProjects
+-- Description :  Treat workspaces as individual project areas.
 -- Copyright   :  (c) Peter J. Jones
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -39,18 +38,14 @@ module XMonad.Actions.DynamicProjects
        , lookupProject
        , currentProject
        , activateProject
+       , modifyProject
        ) where
 
 --------------------------------------------------------------------------------
-import Control.Applicative ((<|>))
-import Control.Monad (when, unless)
-import Data.Char (isSpace)
-import Data.List (sort, union, stripPrefix)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import Data.Maybe (fromMaybe, isNothing)
-import Data.Monoid ((<>))
-import System.Directory (setCurrentDirectory, getHomeDirectory)
+import System.Directory (setCurrentDirectory, getHomeDirectory, makeAbsolute)
+import XMonad.Prelude
 import XMonad
 import XMonad.Actions.DynamicWorkspaces
 import XMonad.Prompt
@@ -74,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
@@ -114,11 +111,11 @@ import qualified XMonad.Util.ExtensibleState as XS
 --
 -- And finally, configure some optional key bindings:
 --
--- >  , ((modm, xK_space), switchProjectPrompt)
--- >  , ((modm, xK_slash), shiftToProjectPrompt)
+-- >  , ((modm, xK_space), switchProjectPrompt def)
+-- >  , ((modm, xK_slash), shiftToProjectPrompt def)
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 --------------------------------------------------------------------------------
 type ProjectName  = String
@@ -130,14 +127,14 @@ data Project = Project
   { projectName      :: !ProjectName    -- ^ Workspace name.
   , projectDirectory :: !FilePath       -- ^ Working directory.
   , projectStartHook :: !(Maybe (X ())) -- ^ Optional start-up hook.
-  } deriving Typeable
+  }
 
 --------------------------------------------------------------------------------
 -- | Internal project state.
 data ProjectState = ProjectState
   { projects        :: !ProjectTable
   , previousProject :: !(Maybe WorkspaceId)
-  } deriving Typeable
+  }
 
 --------------------------------------------------------------------------------
 instance ExtensionClass ProjectState where
@@ -145,24 +142,24 @@ instance ExtensionClass ProjectState where
 
 --------------------------------------------------------------------------------
 -- Internal types for working with XPrompt.
-data ProjectPrompt = ProjectPrompt ProjectMode [ProjectName]
+data ProjectPrompt = ProjectPrompt XPConfig ProjectMode [ProjectName]
 data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode
 
 instance XPrompt ProjectPrompt where
-  showXPrompt (ProjectPrompt submode _) =
+  showXPrompt (ProjectPrompt _ submode _) =
     case submode of
       SwitchMode -> "Switch or Create Project: "
       ShiftMode  -> "Send Window to Project: "
       RenameMode -> "New Project Name: "
       DirMode    -> "Change Project Directory: "
 
-  completionFunction (ProjectPrompt RenameMode _) = return . (:[])
-  completionFunction (ProjectPrompt DirMode _) =
-    let xpt = directoryMultipleModes "" (const $ return ())
+  completionFunction (ProjectPrompt _ RenameMode _) = return . (:[])
+  completionFunction (ProjectPrompt c DirMode _) =
+    let xpt = directoryMultipleModes' (complCaseSensitivity c) "" (const $ return ())
     in completionFunction xpt
-  completionFunction (ProjectPrompt _ ns) = mkComplFunFromList' ns
+  completionFunction (ProjectPrompt c _ ns) = mkComplFunFromList' c ns
 
-  modeAction (ProjectPrompt SwitchMode _) buf auto = do
+  modeAction (ProjectPrompt _ SwitchMode _) buf auto = do
     let name = if null auto then buf else auto
     ps <- XS.gets projects
 
@@ -171,18 +168,19 @@ instance XPrompt ProjectPrompt where
       Nothing | null name -> return ()
               | otherwise -> switchProject (defProject name)
 
-  modeAction (ProjectPrompt ShiftMode _) buf auto = do
+  modeAction (ProjectPrompt _ ShiftMode _) buf auto = do
     let name = if null auto then buf else auto
     ps <- XS.gets projects
     shiftToProject . fromMaybe (defProject name) $ Map.lookup name ps
 
-  modeAction (ProjectPrompt RenameMode _) name _ =
+  modeAction (ProjectPrompt _ RenameMode _) name _ =
     when (not (null name) && not (all isSpace name)) $ do
       renameWorkspaceByName name
       modifyProject (\p -> p { projectName = name })
 
-  modeAction (ProjectPrompt DirMode _) buf auto = do
-    let dir = if null auto then buf else auto
+  modeAction (ProjectPrompt _ DirMode _) buf auto = do
+    let dir' = if null auto then buf else auto
+    dir <- io $ makeAbsolute dir'
     modifyProject (\p -> p { projectDirectory = dir })
 
 --------------------------------------------------------------------------------
@@ -230,11 +228,13 @@ dynamicProjectsStartupHook ps = XS.modify go
 --------------------------------------------------------------------------------
 -- | Find a project based on its name.
 lookupProject :: ProjectName -> X (Maybe Project)
-lookupProject name = Map.lookup name `fmap` XS.gets projects
+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)
@@ -259,20 +259,7 @@ modifyProject f = do
 --------------------------------------------------------------------------------
 -- | Switch to the given project.
 switchProject :: Project -> X ()
-switchProject p = do
-  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)
+switchProject p = appendWorkspace (projectName p)
 
 --------------------------------------------------------------------------------
 -- | Prompt for a project name and then switch to it.  Automatically
@@ -326,11 +313,11 @@ changeProjectDirPrompt = projectPrompt [ DirMode
 -- | Prompt for a project name.
 projectPrompt :: [ProjectMode] -> XPConfig -> X ()
 projectPrompt submodes c = do
-  ws <- map W.tag `fmap` gets (W.workspaces . windowset)
+  ws <- map W.tag <$> gets (W.workspaces . windowset)
   ps <- XS.gets projects
 
   let names = sort (Map.keys ps `union` ws)
-      modes = map (\m -> XPT $ ProjectPrompt m names) submodes
+      modes = map (\m -> XPT $ ProjectPrompt c m names) submodes
 
   mkXPromptWithModes modes c
 

XMonad/Actions/DynamicWorkspaceGroups.hs

@@ -1,8 +1,7 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.DynamicWorkspaceGroups
+-- Description :  Dynamically manage workspace groups in multi-head setups.
 -- Copyright   :  (c) Brent Yorgey 2009
 -- License     :  BSD-style (see LICENSE)
 --
@@ -34,20 +33,25 @@ module XMonad.Actions.DynamicWorkspaceGroups
     , promptWSGroupForget
 
     , WSGPrompt
+     -- * TopicSpace Integration
+     -- $topics
+    , viewTopicGroup
+    , promptTopicGroupView
     ) where
 
-import Data.List (find)
 import Control.Arrow ((&&&))
 import qualified Data.Map as M
 
 import XMonad
+import XMonad.Prelude (find, for_)
 import qualified XMonad.StackSet as W
 
 import XMonad.Prompt
 import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Actions.TopicSpace
 
 -- $usage
--- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
+-- You can use this module by importing it into your @xmonad.hs@ file:
 --
 -- > import XMonad.Actions.DynamicWorkspaceGroups
 --
@@ -63,14 +67,14 @@ type WSGroup = [(ScreenId,WorkspaceId)]
 
 type WSGroupId = String
 
-data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
-  deriving (Typeable, Read, Show)
+newtype WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
+  deriving (Read, Show)
 
 withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
 withWSG f = WSG . f . unWSG
 
 instance ExtensionClass WSGroupStorage where
-  initialValue = WSG $ M.empty
+  initialValue = WSG M.empty
   extensionType = PersistentExtension
 
 -- | Add a new workspace group of the given name, mapping to an
@@ -85,9 +89,7 @@ addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
 addWSGroup name wids = withWindowSet $ \w -> do
   let wss  = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w
       wmap = mapM (strength . (flip lookup wss &&& id)) wids
-  case wmap of
-    Just ps -> addRawWSGroup name ps
-    Nothing -> return ()
+  for_ wmap (addRawWSGroup name)
  where strength (ma, b) = ma >>= \a -> return (a,b)
 
 -- | Give a name to the current workspace group.
@@ -103,20 +105,23 @@ forgetWSGroup = XS.modify . withWSG . M.delete
 
 -- | View the workspace group with the given name.
 viewWSGroup :: WSGroupId -> X ()
-viewWSGroup name = do
-  WSG m <- XS.get
-  case M.lookup name m of
-    Just grp -> mapM_ (uncurry viewWS) grp
-    Nothing -> return ()
+viewWSGroup = viewGroup (windows . W.greedyView)
 
--- | View the given workspace on the given screen.
-viewWS :: ScreenId -> WorkspaceId -> X ()
-viewWS sid wid = do
+-- | Internal function for viewing a group.
+viewGroup :: (WorkspaceId -> X ()) -> WSGroupId -> X ()
+viewGroup fview name = do
+  WSG m <- XS.get
+  for_ (M.lookup name m) $
+    mapM_ (uncurry (viewWS fview))
+
+-- | View the given workspace on the given screen, using the provided function.
+viewWS :: (WorkspaceId -> X ())  -> ScreenId -> WorkspaceId -> X ()
+viewWS fview sid wid = do
   mw <- findScreenWS sid
   case mw of
     Just w -> do
       windows $ W.view w
-      windows $ W.greedyView wid
+      fview wid
     Nothing -> return ()
 
 -- | Find the workspace which is currently on the given screen.
@@ -124,16 +129,20 @@ findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
 findScreenWS sid = withWindowSet $
   return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens
 
-data WSGPrompt = WSGPrompt String
+newtype WSGPrompt = WSGPrompt String
 
 instance XPrompt WSGPrompt where
   showXPrompt (WSGPrompt s) = s
 
 -- | Prompt for a workspace group to view.
 promptWSGroupView :: XPConfig -> String -> X ()
-promptWSGroupView xp s = do
+promptWSGroupView = promptGroupView viewWSGroup
+
+-- | Internal function for making a prompt to view a workspace group
+promptGroupView :: (WSGroupId -> X ()) -> XPConfig -> String -> X ()
+promptGroupView fview xp s = do
   gs <- fmap (M.keys . unWSG) XS.get
-  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup
+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) fview
 
 -- | Prompt for a name for the current workspace group.
 promptWSGroupAdd :: XPConfig -> String -> X ()
@@ -144,4 +153,25 @@ promptWSGroupAdd xp s =
 promptWSGroupForget :: XPConfig -> String -> X ()
 promptWSGroupForget xp s = do
   gs <- fmap (M.keys . unWSG) XS.get
-  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup
+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) forgetWSGroup
+
+-- $topics
+-- You can use this module with "XMonad.Actions.TopicSpace" — just replace
+-- 'promptWSGroupView' with 'promptTopicGroupView':
+--
+-- >    , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ")
+-- >    , ("M-y g", promptTopicGroupView myTopicConfig myXPConfig "Go to group: ")
+-- >    , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ")
+--
+-- It's also a good idea to replace 'spawn' with
+-- 'XMonad.Actions.SpawnOn.spawnOn' or 'XMonad.Actions.SpawnOn.spawnHere' in
+-- your topic actions, so everything is spawned where it should be.
+
+-- | Prompt for a workspace group to view, treating the workspaces as topics.
+promptTopicGroupView :: TopicConfig -> XPConfig -> String -> X ()
+promptTopicGroupView = promptGroupView . viewTopicGroup
+
+-- | View the workspace group with the given name, treating the workspaces as
+-- topics.
+viewTopicGroup :: TopicConfig -> WSGroupId -> X ()
+viewTopicGroup = viewGroup . switchTopic

XMonad/Actions/DynamicWorkspaceOrder.hs

@@ -1,8 +1,7 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.DynamicWorkspaceOrder
+-- Description :  Remember a dynamically updateable ordering on workspaces.
 -- Copyright   :  (c) Brent Yorgey 2009
 -- License     :  BSD-style (see LICENSE)
 --
@@ -12,7 +11,7 @@
 --
 -- Remember a dynamically updateable ordering on workspaces, together
 -- with tools for using this ordering with "XMonad.Actions.CycleWS"
--- and "XMonad.Hooks.DynamicLog".
+-- and "XMonad.Hooks.StatusBar.PP".
 --
 -----------------------------------------------------------------------------
 
@@ -23,11 +22,16 @@ module XMonad.Actions.DynamicWorkspaceOrder
       getWsCompareByOrder
     , getSortByOrder
     , swapWith
+    , swapWithCurrent
+    , swapOrder
+    , updateName
+    , removeName
 
     , moveTo
     , moveToGreedy
     , shiftTo
 
+    , withNthWorkspace'
     , withNthWorkspace
 
     ) where
@@ -41,11 +45,11 @@ import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo)
 
 import qualified Data.Map as M
 import qualified Data.Set as S
-import Data.Maybe (fromJust, fromMaybe)
+import XMonad.Prelude (fromJust, fromMaybe)
 import Data.Ord (comparing)
 
 -- $usage
--- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
+-- You can use this module by importing it into your @xmonad.hs@ file:
 --
 -- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO
 --
@@ -64,10 +68,10 @@ import Data.Ord (comparing)
 -- order of workspaces must be updated to use the auxiliary ordering.
 --
 -- To change the order in which workspaces are displayed by
--- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your
--- 'XMonad.Hooks.DynamicLog.ppSort' field, for example:
+-- "XMonad.Hooks.StatusBar.PP", use 'getSortByOrder' in your
+-- 'XMonad.Hooks.StatusBar.PP.ppSort' field, for example:
 --
--- >   ... dynamicLogWithPP $ byorgeyPP {
+-- >   myPP = ... byorgeyPP {
 -- >     ...
 -- >     , ppSort = DO.getSortByOrder
 -- >     ...
@@ -86,8 +90,8 @@ import Data.Ord (comparing)
 -- tweak as desired.
 
 -- | Extensible state storage for the workspace order.
-data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
-  deriving (Typeable, Read, Show)
+newtype WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
+  deriving (Read, Show)
 
 instance ExtensionClass WSOrderStorage where
   initialValue = WSO Nothing
@@ -148,10 +152,26 @@ swapOrder :: WorkspaceId -> WorkspaceId -> X ()
 swapOrder w1 w2 = do
   io $ print (w1,w2)
   WSO (Just m) <- XS.get
-  let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2]
+  let i1 = fromJust (w1 `M.lookup` m)
+  let i2 = fromJust (w2 `M.lookup` m)
   XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
   windows id  -- force a status bar update
 
+-- | Update the name of a workspace in the stored order.
+updateName :: WorkspaceId -> WorkspaceId -> X ()
+updateName oldId newId = XS.modify . withWSO $ changeKey oldId newId
+
+-- | Remove a workspace from the stored order.
+removeName :: WorkspaceId -> X ()
+removeName = XS.modify . withWSO . M.delete
+
+-- | Update a key in a Map.
+changeKey :: Ord k => k -> k -> M.Map k a -> M.Map k a
+changeKey oldKey newKey oldMap =
+  case M.updateLookupWithKey (\_ _ -> Nothing) oldKey oldMap of
+    (Nothing, _) -> oldMap
+    (Just val, newMap) -> M.insert newKey val newMap
+
 -- | View the next workspace of the given type in the given direction,
 -- where \"next\" is determined using the dynamic workspace order.
 moveTo :: Direction1D -> WSType -> X ()
@@ -166,13 +186,19 @@ moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)
 shiftTo :: Direction1D -> WSType -> X ()
 shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
 
+-- | Do something with the nth workspace in the dynamic order after
+--   transforming it.  The callback is given the workspace's tag as well
+--   as the 'WindowSet' of the workspace itself.
+withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId]) -> (String -> WindowSet -> WindowSet) -> Int -> X ()
+withNthWorkspace' tr job wnum = do
+  sort <- getSortByOrder
+  ws <- gets (tr . map W.tag . sort . W.workspaces . windowset)
+  case drop wnum ws of
+    (w:_) -> windows $ job w
+    []    -> return ()
+
 -- | Do something with the nth workspace in the dynamic order.  The
 --   callback is given the workspace's tag as well as the 'WindowSet'
 --   of the workspace itself.
 withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
-withNthWorkspace job wnum = do
-  sort <- getSortByOrder
-  ws <- gets (map W.tag . sort . W.workspaces . windowset)
-  case drop wnum ws of
-    (w:_) -> windows $ job w
-    []    -> return ()
+withNthWorkspace = withNthWorkspace' id

XMonad/Actions/DynamicWorkspaces.hs

@@ -1,8 +1,7 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.DynamicWorkspaces
+-- Description :  Provides bindings to add and delete workspaces.
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -35,19 +34,17 @@ module XMonad.Actions.DynamicWorkspaces (
                                          WorkspaceIndex
                                        ) where
 
+import XMonad.Prelude (find, isNothing, nub, when)
 import XMonad hiding (workspaces)
 import XMonad.StackSet hiding (filter, modify, delete)
 import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )
-import XMonad.Prompt ( XPConfig, mkXPrompt )
+import XMonad.Prompt ( XPConfig, mkComplFunFromList', mkXPrompt )
 import XMonad.Util.WorkspaceCompare ( getSortByIndex )
-import Data.List (find)
-import Data.Maybe (isNothing)
-import Control.Monad (when)
 import qualified Data.Map.Strict as Map
 import qualified XMonad.Util.ExtensibleState as XS
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+-- You can use this module with the following in your @xmonad.hs@ file:
 --
 -- > import XMonad.Actions.DynamicWorkspaces
 -- > import XMonad.Actions.CopyWindow(copy)
@@ -78,7 +75,7 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- >    zip (zip (repeat (modm .|. controlMask)) [xK_1..xK_9]) (map (setWorkspaceIndex) [1..])
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. See also the documentation for
 -- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'XPConfig'.
 
 type WorkspaceTag = String
@@ -88,8 +85,8 @@ type WorkspaceIndex  = Int
 
 -- | Internal dynamic project state that stores a mapping between
 --   workspace indexes and workspace tags.
-data DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}
-  deriving (Typeable, Read, Show)
+newtype DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}
+  deriving (Read, Show)
 
 instance ExtensionClass DynamicWorkspaceState where
   initialValue = DynamicWorkspaceState Map.empty
@@ -108,11 +105,7 @@ withWorkspaceIndex job widx = do
   maybe (return ()) (windows . job) wtag
     where
       ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)
-      ilookup idx = Map.lookup idx `fmap` XS.gets workspaceIndexMap
-
-
-mkCompl :: [String] -> String -> IO [String]
-mkCompl l s = return $ filter (\x -> take (length s) x == s) l
+      ilookup idx = Map.lookup idx <$> XS.gets workspaceIndexMap
 
 withWorkspace :: XPConfig -> (String -> X ()) -> X ()
 withWorkspace c job = do ws <- gets (workspaces . windowset)
@@ -120,21 +113,21 @@ withWorkspace c job = do ws <- gets (workspaces . windowset)
                          let ts = map tag $ sort ws
                              job' t | t `elem` ts = job t
                                     | otherwise = addHiddenWorkspace t >> job t
-                         mkXPrompt (Wor "") c (mkCompl ts) job'
+                         mkXPrompt (Wor "") c (mkComplFunFromList' c ts) job'
 
 renameWorkspace :: XPConfig -> X ()
 renameWorkspace conf = workspacePrompt conf renameWorkspaceByName
 
 renameWorkspaceByName :: String -> X ()
 renameWorkspaceByName w = do old  <- gets (currentTag . windowset)
-			     windows $ \s -> let sett wk = wk { tag = w }
-						 setscr scr = scr { workspace = sett $ workspace scr }
-						 sets q = q { current = setscr $ current q }
+                             windows $ \s -> let sett wk = wk { tag = w }
+                                                 setscr scr = scr { workspace = sett $ workspace scr }
+                                                 sets q = q { current = setscr $ current q }
                                              in sets $ removeWorkspace' w s
-			     updateIndexMap old w
-  where updateIndexMap old new = do
+                             updateIndexMap old w
+  where updateIndexMap oldIM newIM = do
           wmap <- XS.gets workspaceIndexMap
-          XS.modify $ \s -> s {workspaceIndexMap = Map.map (\t -> if t == old then new else t) wmap}
+          XS.modify $ \s -> s {workspaceIndexMap = Map.map (\t -> if t == oldIM then newIM else t) wmap}
 
 toNthWorkspace :: (String -> X ()) -> Int -> X ()
 toNthWorkspace job wnum = do sort <- getSortByIndex
@@ -241,20 +234,20 @@ isEmpty t = do wsl <- gets $ workspaces . windowset
                return $ maybe True (isNothing . stack) mws
 
 addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a]) -> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
-addHiddenWorkspace' add newtag l s@(StackSet { hidden = ws }) = s { hidden = add (Workspace newtag l Nothing) ws }
+addHiddenWorkspace' add newtag l s@StackSet{ hidden = ws } = s { hidden = add (Workspace newtag l Nothing) ws }
 
 -- | Remove the hidden workspace with the given tag from the StackSet, if
 --   it exists. All the windows in that workspace are moved to the current
 --   workspace.
-removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
-removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })
-                                   , hidden = hs })
+removeWorkspace' :: (Eq i, Eq a) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
+removeWorkspace' torem s@StackSet{ current = scr@Screen { workspace = wc }
+                                 , hidden  = hs }
     = let (xs, ys) = break ((== torem) . tag) hs
       in removeWorkspace'' xs ys
    where meld Nothing Nothing = Nothing
          meld x Nothing = x
          meld Nothing x = x
-         meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)
+         meld (Just x) (Just y) = differentiate . nub $ integrate x ++ integrate y
          removeWorkspace'' xs (y:ys) = s { current = scr { workspace = wc { stack = meld (stack y) (stack wc) } }
                                          , hidden = xs ++ ys }
          removeWorkspace'' _  _      = s

XMonad/Actions/EasyMotion.hs

@@ -0,0 +1,391 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.EasyMotion
+-- Description :  Focus a visible window using a key chord.
+-- Copyright   :  (c) Matt Kingston <mattkingston@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  mattkingston@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides functionality to use key chords to focus a visible window. Overlays a unique key chord
+-- (a string) above each visible window and allows the user to select a window by typing that
+-- chord.
+-- Inspired by <https://github.com/easymotion/vim-easymotion vim-easymotion>.
+-- Thanks to <https://github.com/larkery Tom Hinton> for some feature inspiration and window
+-- sorting code.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.EasyMotion ( -- * Usage
+                                   -- $usage
+                                   selectWindow
+
+                                   -- * Configuration
+                                 , EasyMotionConfig(..)
+                                 , ChordKeys(..)
+                                 , def
+
+                                   -- * Creating overlays
+                                 , fullSize
+                                 , fixedSize
+                                 , textSize
+                                 , proportional
+                                 , bar
+                                 ) where
+
+import           XMonad
+import           XMonad.Prelude
+import qualified XMonad.StackSet          as W
+import           XMonad.Util.Font         (releaseXMF, initXMF, Align(AlignCenter), XMonadFont(..), textExtentsXMF)
+import           XMonad.Util.XUtils       (createNewWindow, paintAndWrite, deleteWindow, showWindow)
+
+import           Control.Arrow            ((&&&))
+import qualified Data.Map.Strict as M     (Map, elems, map, mapWithKey)
+
+-- $usage
+--
+-- You can use this module's basic functionality with the following in your
+-- @xmonad.hs@:
+--
+-- >    import XMonad.Actions.EasyMotion (selectWindow)
+--
+-- To customise
+--
+-- >    import XMonad.Actions.EasyMotion (selectWindow, EasyMotionConfig(..))
+--
+-- Then add a keybinding and an action to the 'selectWindow' function.
+-- In this case @M-f@ to focus the selected window:
+--
+-- >    , ((modm, xK_f), selectWindow def >>= (`whenJust` windows . W.focusWindow))
+--
+-- Similarly, to kill a window with @M-f@:
+--
+-- >    , ((modm, xK_f), selectWindow def >>= (`whenJust` killWindow))
+--
+-- See 'EasyMotionConfig' for all configuration options. A short summary follows.
+--
+-- Default chord keys are @s,d,f,j,k,l@. To customise these and display options assign
+-- different values to 'def' (the default configuration):
+--
+-- >    , ((modm, xK_f), (selectWindow def{sKeys = AnyKeys [xK_f, xK_d]}) >>= (`whenJust` windows . W.focusWindow))
+--
+-- You must supply at least two different keys in the 'sKeys' list. Keys provided earlier in the list
+-- will be used preferentially—therefore, keys you would like to use more frequently should be
+-- earlier in the list.
+--
+-- To map different sets of keys to different screens. The following configuration maps keys @fdsa@
+-- to screen 0 and @hjkl@ to screen 1. Keys provided earlier in the list will be used preferentially.
+-- Providing the same key for multiple screens is possible but will break down in some scenarios.
+--
+-- >    import qualified Data.Map.Strict as StrictMap (fromList)
+-- >    emConf :: EasyMotionConfig
+-- >    emConf = def { sKeys = PerScreenKeys $ StrictMap.fromList [(0, [xK_f, xK_d, xK_s, xK_a]), (1, [xK_h, xK_j, xK_k, xK_l])] }
+-- >    -- key bindings
+-- >    , ((modm, xK_f), selectWindow emConf >>= (`whenJust` windows . W.focusWindow))
+--
+-- To customise the font:
+--
+-- >    , ((modm, xK_f), (selectWindow def{emFont = "xft: Sans-40"}) >>= (`whenJust` windows . W.focusWindow))
+--
+-- The 'emFont' field provided is supplied directly to the 'initXMF' function. The default is
+-- @"xft:Sans-100"@. Some example options:
+--
+-- >    "xft: Sans-40"
+-- >    "xft: Arial-100"
+-- >    "xft: Cambria-80"
+--
+-- Customise the overlay by supplying a function to 'overlayF'. The signature is
+-- @'Position' -> 'Rectangle' -> 'Rectangle'@. The parameters are the height in pixels of
+-- the selection chord and the rectangle of the window to be overlaid. Some are provided:
+--
+-- >    import XMonad.Actions.EasyMotion (selectWindow, EasyMotionConfig(..), proportional, bar, fullSize)
+-- >    , ((modm, xK_f), (selectWindow def{ overlayF = proportional 0.3  }) >>= (`whenJust` windows . W.focusWindow))
+-- >    , ((modm, xK_f), (selectWindow def{ overlayF = bar 0.5           }) >>= (`whenJust` windows . W.focusWindow))
+-- >    , ((modm, xK_f), (selectWindow def{ overlayF = fullSize          }) >>= (`whenJust` windows . W.focusWindow))
+-- >    , ((modm, xK_f), (selectWindow def{ overlayF = fixedSize 300 350 }) >>= (`whenJust` windows . W.focusWindow))
+
+-- TODO:
+--  - An overlay function that creates an overlay a proportion of the width XOR height of the
+--    window it's over, and with a fixed w/h proportion? E.g. overlay-height = 0.3 *
+--    target-window-height; overlay-width = 0.5 * overlay-height.
+--  - An overlay function that creates an overlay of a fixed w,h, aligned mid,mid, or parametrised
+--    alignment?
+--  - Parametrise chord generation?
+--  - W.shift example; bring window from other screen to current screen? Only useful if we don't
+--    show chords on current workspace.
+--  - Use stringToKeysym, keysymToKeycode, keycodeToKeysym, keysymToString to take a string from
+--    the user?
+--  - Think a bit more about improving functionality with floating windows.
+--    - currently, floating window z-order is not respected
+--    - could ignore floating windows
+--    - may be able to calculate the visible section of a floating window, and display the chord in
+--      that space
+--  - Provide an option to prepend the screen key to the easymotion keys (i.e. w,e,r)?
+--  - overlay alpha
+--  - Delay after selection so the user can see what they've chosen? Min-delay: 0 seconds. If
+--    there's a delay, perhaps keep the other windows covered briefly to naturally draw the user's
+--    attention to the window they've selected? Or briefly highlight the border of the selected
+--    window?
+--  - Option to cover windows that will not be selected by the current chord, such that it's
+--    slightly more obvious where to maintain focus.
+--  - Something unpleasant happens when the user provides only two keys (let's say f, d) for
+--    chords. When they have five windows open, the following chords are generated: ddd, ddf, dfd,
+--    dff, fdd. When 'f' is pressed, all chords disappear unexpectedly because we know there are no
+--    other valid options. The user expects to press 'fdd'. This is an optimisation in software but
+--    pretty bad for usability, as the user continues firing keys into their
+--    now-unexpectedly-active window. And is of course only one concrete example of a more general
+--    problem.
+--    Short-term solution:
+--      - Keep displaying the chord until the user has fully entered it
+--    Fix:
+--      - Show the shortest possible chords
+
+-- | Associates a user window, an overlay window created by this module and a rectangle
+--   circumscribing these windows
+data OverlayWindow =
+  OverlayWindow { win     :: !Window           -- ^ The window managed by xmonad
+                , attrs   :: !WindowAttributes -- ^ Window attributes for @win@
+                , overlay :: !Window           -- ^ Our window used to display the overlay
+                , rect    :: !Rectangle        -- ^ The rectangle of @overlay@
+                }
+
+-- | An overlay window and the chord used to select it
+data Overlay =
+  Overlay { overlayWin :: !OverlayWindow    -- ^ The window managed by xmonad
+          , chord      :: ![KeySym]         -- ^ The chord we'll display in the overlay
+          }
+
+
+-- | Maps keys to windows. 'AnyKeys' maps keys to windows regardless which screen they're on.
+--   'PerScreenKeys' maps keys to screens to windows. See @Usage@ for more examples.
+data ChordKeys = AnyKeys       ![KeySym]
+               | PerScreenKeys !(M.Map ScreenId [KeySym])
+
+-- | Configuration options for EasyMotion.
+--
+--   All colors are hex strings, e.g. "#000000"
+--
+--   If the number of windows for which chords are required exceeds 'maxChordLen', chords
+--   will simply not be generated for these windows. In this way, single-key selection may be
+--   preferred over the ability to select any window.
+--
+--   'cancelKey', @xK_BackSpace@ and any duplicates will be removed from 'sKeys' if included.
+--   See @Usage@ for examples of 'sKeys'.
+data EasyMotionConfig =
+  EMConf { txtCol      :: !String                               -- ^ Color of the text displayed
+         , bgCol       :: !String                               -- ^ Color of the window overlaid
+         , overlayF    :: !(Position -> Rectangle -> Rectangle) -- ^ Function to generate overlay rectangle
+         , borderCol   :: !String                               -- ^ Color of the overlay window borders
+         , sKeys       :: !ChordKeys                            -- ^ Keys to use for window selection
+         , cancelKey   :: !KeySym                               -- ^ Key to use to cancel selection
+         , emFont      :: !String                               -- ^ Font for selection characters (passed to 'initXMF')
+         , borderPx    :: !Int                                  -- ^ Width of border in pixels
+         , maxChordLen :: !Int                                  -- ^ Maximum chord length. Use 0 for no maximum.
+         }
+
+instance Default EasyMotionConfig where
+  def =
+    EMConf { txtCol      = "#ffffff"
+           , bgCol       = "#000000"
+           , overlayF    = proportional (0.3::Double)
+           , borderCol   = "#ffffff"
+           , sKeys       = AnyKeys [xK_s, xK_d, xK_f, xK_j, xK_k, xK_l]
+           , cancelKey   = xK_q
+           , borderPx    = 1
+           , maxChordLen = 0
+#ifdef XFT
+           , emFont      = "xft:Sans-100"
+#else
+           , emFont      = "-misc-fixed-*-*-*-*-200-*-*-*-*-*-*-*"
+#endif
+           }
+
+-- | Create overlay windows of the same size as the window they select
+fullSize :: Position -> Rectangle -> Rectangle
+fullSize _ = id
+
+-- | Create overlay windows a proportion of the size of the window they select
+proportional :: RealFrac f => f -> Position -> Rectangle -> Rectangle
+proportional f th r = Rectangle { rect_width  = newW
+                                , rect_height = newH
+                                , rect_x      = rect_x r + fi (rect_width r - newW) `div` 2
+                                , rect_y      = rect_y r + fi (rect_height r - newH) `div` 2 }
+ where
+  newH = max (fi th) (round $ f * fi (rect_height r))
+  newW = newH
+
+-- | Create fixed-size overlay windows
+fixedSize :: (Integral a, Integral b) => a -> b -> Position -> Rectangle -> Rectangle
+fixedSize w h th r = Rectangle { rect_width  = rw
+                               , rect_height = rh
+                               , rect_x      = rect_x r + fi (rect_width r - rw) `div` 2
+                               , rect_y      = rect_y r + fi (rect_height r - rh) `div` 2 }
+ where
+  rw = max (fi w) (fi th)
+  rh = max (fi h) (fi th)
+
+-- | Create overlay windows the minimum size to contain their key chord
+textSize :: Position -> Rectangle -> Rectangle
+textSize th r = Rectangle { rect_width  = fi th
+                          , rect_height = fi th
+                          , rect_x      = rect_x r + (fi (rect_width r) - fi th) `div` 2
+                          , rect_y      = rect_y r + (fi (rect_height r) - fi th) `div` 2 }
+
+-- | Create overlay windows the full width of the window they select, the minimum height to contain
+--   their chord, and a proportion of the distance from the top of the window they select
+bar :: RealFrac f => f -> Position -> Rectangle -> Rectangle
+bar f th r = Rectangle { rect_width  = rect_width r
+                       , rect_height = fi th
+                       , rect_x      = rect_x r
+                       , rect_y      = rect_y r + round (f' * (fi (rect_height r) - fi th)) }
+ where
+   -- clamp f in [0,1] as other values will appear to lock up xmonad as the overlay will be
+   -- displayed off-screen
+   f' = min 0.0 $ max f 1.0
+
+-- | Handles overlay display and window selection. Called after config has been sanitised.
+handleSelectWindow :: EasyMotionConfig -> X (Maybe Window)
+handleSelectWindow EMConf { sKeys = AnyKeys [] } = return Nothing
+handleSelectWindow c = do
+  f <- initXMF $ emFont c
+  th <- (\(asc, dsc) -> asc + dsc + 2) <$> textExtentsXMF f (concatMap keysymToString (allKeys . sKeys $ c))
+  XConf { theRoot = rw, display = dpy } <- ask
+  XState { mapped = mappedWins, windowset = ws } <- get
+  -- build overlays depending on key configuration
+  overlays :: [Overlay] <- case sKeys c of
+    AnyKeys ks -> buildOverlays ks <$> sortedOverlayWindows
+     where
+      visibleWindows :: [Window]
+      visibleWindows = toList mappedWins
+      sortedOverlayWindows :: X [OverlayWindow]
+      sortedOverlayWindows = sortOverlayWindows <$> buildOverlayWindows th visibleWindows
+    PerScreenKeys m ->
+      fmap concat
+        $ sequence
+        $ M.elems
+        $ M.mapWithKey (\sid ks -> buildOverlays ks <$> sortedOverlayWindows sid) m
+     where
+      screenById :: ScreenId -> Maybe WindowScreen
+      screenById sid = find ((== sid) . W.screen) (W.screens ws)
+      visibleWindowsOnScreen :: ScreenId -> [Window]
+      visibleWindowsOnScreen sid = filter (`elem` toList mappedWins) $ W.integrate' $ screenById sid >>= W.stack . W.workspace
+      sortedOverlayWindows :: ScreenId -> X [OverlayWindow]
+      sortedOverlayWindows sid = sortOverlayWindows <$> buildOverlayWindows th (visibleWindowsOnScreen sid)
+  status <- io $ grabKeyboard dpy rw True grabModeAsync grabModeAsync currentTime
+  if status == grabSuccess
+    then do
+      resultWin <- handleKeyboard dpy (displayOverlay f) (cancelKey c) overlays []
+      io $ ungrabKeyboard dpy currentTime
+      mapM_ (deleteWindow . overlay . overlayWin) overlays
+      io $ sync dpy False
+      releaseXMF f
+      case resultWin of
+        -- focus the selected window
+        Selected o -> return . Just . win . overlayWin $ o
+        -- return focus correctly
+        _ -> whenJust (W.peek ws) (windows . W.focusWindow) $> Nothing
+    else releaseXMF f $> Nothing
+ where
+  allKeys :: ChordKeys -> [KeySym]
+  allKeys (AnyKeys ks) = ks
+  allKeys (PerScreenKeys m) = concat $ M.elems m
+
+  buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay]
+  buildOverlays = appendChords (maxChordLen c)
+
+  buildOverlayWindows :: Position -> [Window] -> X [OverlayWindow]
+  buildOverlayWindows th = fmap (fromMaybe [] . sequenceA)
+                         . traverse (buildOverlayWin th)
+
+  sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow]
+  sortOverlayWindows = sortOn ((wa_x &&& wa_y) . attrs)
+
+  makeRect :: WindowAttributes -> Rectangle
+  makeRect wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) (fi (wa_width wa)) (fi (wa_height wa))
+
+  buildOverlayWin :: Position -> Window -> X (Maybe OverlayWindow)
+  buildOverlayWin th w = safeGetWindowAttributes w >>= \case
+    Nothing     -> pure Nothing
+    Just wAttrs -> do
+      let r = overlayF c th $ makeRect wAttrs
+      o <- createNewWindow r Nothing "" True
+      return . Just $ OverlayWindow { rect=r, overlay=o, win=w, attrs=wAttrs }
+
+  -- | Display an overlay with the provided formatting
+  displayOverlay :: XMonadFont -> Overlay -> X ()
+  displayOverlay f Overlay { overlayWin = OverlayWindow { rect = r, overlay = o }, chord = ch } = do
+    showWindow o
+    paintAndWrite o f (fi (rect_width r)) (fi (rect_height r)) (fi (borderPx c)) (bgCol c) (borderCol c) (txtCol c) (bgCol c) [AlignCenter] [concatMap keysymToString ch]
+
+-- | Display overlay windows and chords for window selection
+selectWindow :: EasyMotionConfig -> X (Maybe Window)
+selectWindow conf =
+  handleSelectWindow conf { sKeys = sanitiseKeys (sKeys conf) }
+ where
+  -- make sure the key lists don't contain: backspace, our cancel key, or duplicates
+  sanitise :: [KeySym] -> [KeySym]
+  sanitise = nub . filter (`notElem` [xK_BackSpace, cancelKey conf])
+  sanitiseKeys :: ChordKeys -> ChordKeys
+  sanitiseKeys cKeys =
+    case cKeys of
+      AnyKeys ks -> AnyKeys . sanitise $ ks
+      PerScreenKeys m -> PerScreenKeys $ M.map sanitise m
+
+-- | Take a list of overlays lacking chords, return a list of overlays with key chords
+appendChords :: Int -> [KeySym] -> [OverlayWindow] -> [Overlay]
+appendChords _ [] _ = []
+appendChords maxUserSelectedLen ks overlayWins =
+  zipWith Overlay overlayWins chords
+ where
+  chords = replicateM chordLen ks
+  -- the minimum necessary chord length to assign a unique chord to each visible window
+  minCoverLen = -((-(length overlayWins)) `div` length ks)
+  -- if the user has specified a max chord length we use this even if it will not cover all
+  -- windows, as they may prefer to focus windows with fewer keys over the ability to focus any
+  -- window
+  chordLen = if maxUserSelectedLen <= 0 then minCoverLen else min minCoverLen maxUserSelectedLen
+
+-- | A three-state result for handling user-initiated selection cancellation, successful selection,
+--   or backspace.
+data HandleResult = Exit | Selected Overlay | Backspace
+
+-- | Handle key press events for window selection.
+handleKeyboard :: Display -> (Overlay -> X()) -> KeySym -> [Overlay] -> [Overlay] -> X HandleResult
+handleKeyboard _ _ _ [] _ = return Exit
+handleKeyboard dpy drawFn cancel selected deselected = do
+  redraw
+  ev <- io $ allocaXEvent $ \e -> do
+    maskEvent dpy (keyPressMask .|. keyReleaseMask .|. buttonPressMask) e
+    getEvent e
+  if | ev_event_type ev == keyPress -> do
+         s <- io $ keycodeToKeysym dpy (ev_keycode ev) 0
+         if | s == cancel -> return Exit
+            | s == xK_BackSpace -> return Backspace
+            | isNextOverlayKey s -> handleNextOverlayKey s
+            | otherwise -> handleKeyboard dpy drawFn cancel selected deselected
+     | ev_event_type ev == buttonPress -> do
+         -- See XMonad.Prompt Note [Allow ButtonEvents]
+         io $ allowEvents dpy replayPointer currentTime
+         handleKeyboard dpy drawFn cancel selected deselected
+     | otherwise -> handleKeyboard dpy drawFn cancel selected deselected
+ where
+  redraw = mapM (mapM_ drawFn) [selected, deselected]
+  retryBackspace x =
+    case x of
+      Backspace -> redraw >> handleKeyboard dpy drawFn cancel selected deselected
+      _ -> return x
+  isNextOverlayKey keySym = isJust (find ((== Just keySym) . listToMaybe .chord) selected)
+  handleNextOverlayKey keySym =
+    case fg of
+      [x] -> return $ Selected x
+      _   -> handleKeyboard dpy drawFn cancel (trim fg) (clear bg) >>= retryBackspace
+   where
+    (fg, bg) = partition ((== Just keySym) . listToMaybe . chord) selected
+    trim = map (\o -> o { chord = drop 1 $ chord o })
+    clear = map (\o -> o { chord = [] })

XMonad/Actions/FindEmptyWorkspace.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.FindEmptyWorkspace
+-- Description :  Find an empty workspace.
 -- Copyright   :  (c) Miikka Koskinen 2007
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -18,15 +19,13 @@ module XMonad.Actions.FindEmptyWorkspace (
     viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace
   ) where
 
-import Data.List
-import Data.Maybe ( isNothing )
-
+import XMonad.Prelude
 import XMonad
 import XMonad.StackSet
 
 -- $usage
 --
--- To use, import this module into your @~\/.xmonad\/xmonad.hs@:
+-- To use, import this module into your @xmonad.hs@:
 --
 -- >   import XMonad.Actions.FindEmptyWorkspace
 --
@@ -39,7 +38,7 @@ import XMonad.StackSet
 -- will tag the current window to an empty workspace and view it.
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Find the first hidden empty workspace in a StackSet. Returns
 -- Nothing if all workspaces are in use. Function searches currently

XMonad/Actions/FlexibleManipulate.hs

@@ -1,8 +1,9 @@
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.FlexibleManipulate
+-- Description :  Move and resize floating windows without warping the mouse.
 -- Copyright   :  (c) Michael Sloan
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -23,11 +24,12 @@ module XMonad.Actions.FlexibleManipulate (
 ) where
 
 import XMonad
+import XMonad.Prelude ((<&>), fi)
 import qualified Prelude as P
-import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise)
+import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, otherwise, round, snd, uncurry, ($))
 
 -- $usage
--- First, add this import to your @~\/.xmonad\/xmonad.hs@:
+-- First, add this import to your @xmonad.hs@:
 --
 -- > import qualified XMonad.Actions.FlexibleManipulate as Flex
 --
@@ -78,43 +80,36 @@ position = const 0.5
 -- | Given an interpolation function, implement an appropriate window
 --   manipulation action.
 mouseWindow :: (Double -> Double) -> Window -> X ()
-mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    [wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs
+mouseWindow f w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
+    let wpos  = (fi (wa_x wa), fi (wa_y wa))
+        wsize = (fi (wa_width wa), fi (wa_height wa))
     sh <- io $ getWMNormalHints d w
-    pointer <- io $ queryPointer d w >>= return . pointerPos
+    pointer <- io $ queryPointer d w <&> pointerPos
 
     let uv = (pointer - wpos) / wsize
         fc = mapP f uv
         mul = mapP (\x -> 2 P.- 2 P.* P.abs(x P.- 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
         atl = ((1, 1) - fc) * mul
         abr = fc * mul
-    mouseDrag (\ex ey -> io $ do
+    mouseDrag (\ex ey -> do
         let offset = (fromIntegral ex, fromIntegral ey) - pointer
             npos = wpos + offset * atl
             nbr = (wpos + wsize) + offset * abr
             ntl = minP (nbr - (32, 32)) npos    --minimum size
             nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl)
-        moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
-        return ())
+        io $ moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
+        float w)
         (float w)
 
     float w
 
   where
     pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
-    winAttrs :: WindowAttributes -> [Pnt]
-    winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height]
-
 
 -- I'd rather I didn't have to do this, but I hate writing component 2d math
 type Pnt = (Double, Double)
 
-pairUp :: [a] -> [(a,a)]
-pairUp [] = []
-pairUp [_] = []
-pairUp (x:y:xs) = (x, y) : (pairUp xs)
-
 mapP :: (a -> b) -> (a, a) -> (b, b)
 mapP f (x, y) = (f x, f y)
 zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c)
@@ -132,4 +127,3 @@ infixl 7  *, /
 (*) = zipP (P.*)
 (/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)
 (/) = zipP (P./)
-

XMonad/Actions/FlexibleResize.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.FlexibleResize
+-- Description :  Resize floating windows from any corner.
 -- Copyright   :  (c) Lukas Mai
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -20,11 +21,11 @@ module XMonad.Actions.FlexibleResize (
 ) where
 
 import XMonad
-import XMonad.Util.XUtils (fi)
+import XMonad.Prelude (fi)
 import Foreign.C.Types
 
 -- $usage
--- To use, first import this module into your @~\/.xmonad\/xmonad.hs@ file:
+-- To use, first import this module into your @xmonad.hs@ file:
 --
 -- > import qualified XMonad.Actions.FlexibleResize as Flex
 --
@@ -49,29 +50,32 @@ mouseResizeEdgeWindow
   :: Rational -- ^ The size of the area where only one edge is resized.
   -> Window   -- ^ The window to resize.
   -> X ()
-mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    wa <- io $ getWindowAttributes d w
+mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     sh <- io $ getWMNormalHints d w
     (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w
     let
-        [pos_x, pos_y, width, height] = map (fi . ($ wa)) [wa_x, wa_y, wa_width, wa_height]
+        pos_x  = fi $ wa_x wa
+        pos_y  = fi $ wa_y wa
+        width  = fi $ wa_width wa
+        height = fi $ wa_height wa
         west  = findPos ix width
         north = findPos iy height
         (cx, fx, gx) = mkSel west  width  pos_x
         (cy, fy, gy) = mkSel north height pos_y
     io $ warpPointer d none w 0 0 0 0 cx cy
     mouseDrag (\ex ey -> do let (nw,nh) = applySizeHintsContents sh (gx ex, gy ey)
-                            io $ moveResizeWindow d w (fx nw) (fy nh) nw nh)
+                            io $ moveResizeWindow d w (fx nw) (fy nh) nw nh
+                            float w)
               (float w)
     where
     findPos :: CInt -> Position -> Maybe Bool
-    findPos m s = if p < 0.5 - edge/2
-                  then Just True
-                  else if p < 0.5 + edge/2
-                       then Nothing
-                       else Just False
-                  where p = fi m / fi s
+    findPos m s
+      | p < 0.5 - edge/2 = Just True
+      | p < 0.5 + edge/2 = Nothing
+      | otherwise = Just False
+      where
+          p = fi m / fi s
     mkSel :: Maybe Bool -> Position -> Position -> (Position, Dimension -> Position, Position -> Dimension)
     mkSel b k p = case b of
                       Just True ->  (0, (fi k + fi p -).fi, (fi k + fi p -).fi)

XMonad/Actions/FloatKeys.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.FloatKeys
+-- Description  :  Move and resize floating windows.
 -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
 -- License      : BSD
 --
@@ -18,13 +19,18 @@ module XMonad.Actions.FloatKeys (
                 keysMoveWindowTo,
                 keysResizeWindow,
                 keysAbsResizeWindow,
-                P, G,
+                directionMoveWindow,
+                directionResizeWindow,
+                Direction2D(..),
+                P, G, ChangeDim
                 ) where
 
 import XMonad
+import XMonad.Prelude (fi)
+import XMonad.Util.Types
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- >    import XMonad.Actions.FloatKeys
 --
@@ -36,17 +42,44 @@ import XMonad
 -- >  , ((modm .|. shiftMask, xK_s     ), withFocused (keysAbsResizeWindow (10,10) (1024,752)))
 -- >  , ((modm,               xK_a     ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))
 --
+-- Using "XMonad.Util.EZConfig" syntax, we can easily build keybindings
+-- where @M-\<arrow-keys\>@ moves the currently focused window and
+-- @M-S-\<arrow-keys\>@ resizes it using 'directionMoveWindow' and
+-- 'directionResizeWindow':
+--
+-- > [ ("M-" <> m <> k, withFocused $ f i)
+-- > | (i, k) <- zip [U, D, R, L] ["<Up>", "<Down>", "<Right>", "<Left>"]
+-- > , (f, m) <- [(directionMoveWindow 10, ""), (directionResizeWindow 10, "S-")]
+-- > ]
+--
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
+
+-- | @directionMoveWindow delta dir win@ moves the window @win@ by
+--   @delta@ pixels in direction @dir@.
+directionMoveWindow :: Int -> Direction2D -> Window -> X ()
+directionMoveWindow delta dir win = case dir of
+  U -> keysMoveWindow (0, -delta) win
+  D -> keysMoveWindow (0, delta)  win
+  R -> keysMoveWindow (delta, 0)  win
+  L -> keysMoveWindow (-delta, 0) win
+
+-- | @directionResizeWindow delta dir win@ resizes the window @win@ by
+--   @delta@ pixels in direction @dir@.
+directionResizeWindow :: Int -> Direction2D -> Window -> X ()
+directionResizeWindow delta dir win = case dir of
+  U -> keysResizeWindow (0, -delta) (0, 0) win
+  D -> keysResizeWindow (0, delta)  (0, 0) win
+  R -> keysResizeWindow (delta, 0)  (0, 0) win
+  L -> keysResizeWindow (-delta, 0) (0, 0) win
 
 -- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the
 --   right and @dy@ pixels down.
-keysMoveWindow :: D -> Window -> X ()
-keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    wa <- io $ getWindowAttributes d w
-    io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + dx))
-                        (fromIntegral (fromIntegral (wa_y wa) + dy))
+keysMoveWindow :: ChangeDim -> Window -> X ()
+keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
+    io $ moveWindow d w (fi (fi (wa_x wa) + dx))
+                        (fi (fi (wa_y wa) + dy))
     float w
 
 -- | @keysMoveWindowTo (x, y) (gx, gy)@ moves the window relative
@@ -60,15 +93,15 @@ keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
 -- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen
 -- > keysMoveWindowTo (1024,0) (1, 0)      -- put window in the top right corner
 keysMoveWindowTo :: P -> G -> Window -> X ()
-keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    wa <- io $ getWindowAttributes d w
-    io $ moveWindow d w (x - round (gx * fromIntegral (wa_width wa)))
-                        (y - round (gy * fromIntegral (wa_height wa)))
+keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
+    io $ moveWindow d w (x - round (gx * fi (wa_width wa)))
+                        (y - round (gy * fi (wa_height wa)))
     float w
 
 type G = (Rational, Rational)
 type P = (Position, Position)
+type ChangeDim = (Int, Int)
 
 -- | @keysResizeWindow (dx, dy) (gx, gy)@ changes the width by @dx@
 --   and the height by @dy@, leaving the window-relative point @(gx,
@@ -80,7 +113,7 @@ type P = (Position, Position)
 -- > keysResizeWindow (10, 0) (0, 1%2)    -- does the same, unless sizeHints are applied
 -- > keysResizeWindow (10, 10) (1%2, 1%2) -- add 5 pixels on each side
 -- > keysResizeWindow (-10, -10) (0, 1)   -- shrink the window in direction of the bottom-left corner
-keysResizeWindow :: D -> G -> Window -> X ()
+keysResizeWindow :: ChangeDim -> G -> Window -> X ()
 keysResizeWindow = keysMoveResize keysResizeWindow'
 
 -- | @keysAbsResizeWindow (dx, dy) (ax, ay)@ changes the width by @dx@
@@ -90,34 +123,34 @@ keysResizeWindow = keysMoveResize keysResizeWindow'
 --   For example:
 --
 -- > keysAbsResizeWindow (10, 10) (0, 0)   -- enlarge the window; if it is not in the top-left corner it will also be moved down and to the right.
-keysAbsResizeWindow :: D -> D -> Window -> X ()
+keysAbsResizeWindow :: ChangeDim -> D -> Window -> X ()
 keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow'
 
-keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D)
+keysAbsResizeWindow' :: SizeHints -> P -> D -> ChangeDim -> D -> (P,D)
 keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh))
     where
-        (nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
+        -- The width and height of a window are positive and thus
+        -- converting to 'Dimension' should be safe.
+        (nw, nh) = applySizeHintsContents sh (fi w + dx, fi h + dy)
         nx :: Rational
-        nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w
+        nx = fi (ax * w + nw * (fi x - ax)) / fi w
         ny :: Rational
-        ny = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h
+        ny = fi (ay * h + nh * (fi y - ay)) / fi h
 
-keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D)
+keysResizeWindow' :: SizeHints -> P -> D -> ChangeDim -> G -> (P,D)
 keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))
     where
-        (nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
-        nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw
-        ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh
+        (nw, nh) = applySizeHintsContents sh (fi w + dx, fi h + dy)
+        nx = round $ fi x + gx * fi w - gx * fi nw
+        ny = round $ fi y + gy * fi h - gy * fi nh
 
 keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()
-keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    wa <- io $ getWindowAttributes d w
+keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     sh <- io $ getWMNormalHints d w
-    let wa_dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)
-        wa_pos = (fromIntegral $ wa_x wa, fromIntegral $ wa_y wa)
+    let wa_dim = (fi $ wa_width wa, fi $ wa_height wa)
+        wa_pos = (fi $ wa_x wa, fi $ wa_y wa)
         (wn_pos, wn_dim) = f sh wa_pos wa_dim move resize
     io $ resizeWindow d w `uncurry` wn_dim
     io $ moveWindow d w `uncurry` wn_pos
     float w
-

XMonad/Actions/FloatSnap.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.FloatSnap
+-- Description :  Snap to other windows or the edge of the screen while moving or resizing.
 -- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -27,9 +28,7 @@ module XMonad.Actions.FloatSnap (
                 ifClick') where
 
 import XMonad
-import Control.Applicative((<$>))
-import Data.List (sort)
-import Data.Maybe (listToMaybe,fromJust,isNothing)
+import XMonad.Prelude (fromJust, isNothing, listToMaybe, sort, when)
 import qualified XMonad.StackSet as W
 import qualified Data.Set as S
 
@@ -38,7 +37,7 @@ import XMonad.Util.Types (Direction2D(..))
 import XMonad.Actions.AfterDrag
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- >    import XMonad.Actions.FloatSnap
 --
@@ -54,7 +53,7 @@ import XMonad.Actions.AfterDrag
 -- >        , ((modm .|. shiftMask, xK_Down),  withFocused $ snapGrow D Nothing)
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 --
 -- And possibly add appropriate mouse bindings, for example:
 --
@@ -93,17 +92,17 @@ snapMagicMouseResize
     -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
     -> Window    -- ^ The window to move and resize.
     -> X ()
-snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     (_, _, _, px, py, _, _, _) <- io $ queryPointer d w
-    let x = (fromIntegral px - wx wa)/(ww wa)
-        y = (fromIntegral py - wy wa)/(wh wa)
-        ml = if x <= (0.5 - middle/2) then [L] else []
-        mr = if x >  (0.5 + middle/2) then [R] else []
-        mu = if y <= (0.5 - middle/2) then [U] else []
-        md = if y >  (0.5 + middle/2) then [D] else []
+    let x = (fromIntegral px - wx wa)/ww wa
+        y = (fromIntegral py - wy wa)/wh wa
+        ml = [L | x <= (0.5 - middle/2)]
+        mr = [R | x >  (0.5 + middle/2)]
+        mu = [U | y <= (0.5 - middle/2)]
+        md = [D | y >  (0.5 + middle/2)]
         mdir = ml++mr++mu++md
-        dir = if mdir == []
+        dir = if null mdir
               then [L,R,U,D]
               else mdir
     snapMagicResize dir collidedist snapdist w
@@ -120,19 +119,17 @@ snapMagicResize
     -> Maybe Int   -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
     -> Window      -- ^ The window to move and resize.
     -> X ()
-snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    wa <- io $ getWindowAttributes d w
-
+snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     (xbegin,xend) <- handleAxis True d wa
     (ybegin,yend) <- handleAxis False d wa
 
-    let xbegin' = if L `elem` dir then xbegin else (wx wa)
-        xend'   = if R `elem` dir then xend   else (wx wa + ww wa)
-        ybegin' = if U `elem` dir then ybegin else (wy wa)
-        yend'   = if D `elem` dir then yend   else (wy wa + wh wa)
+    let xbegin' = if L `elem` dir then xbegin else wx wa
+        xend'   = if R `elem` dir then xend   else wx wa + ww wa
+        ybegin' = if U `elem` dir then ybegin else wy wa
+        yend'   = if D `elem` dir then yend   else wy wa + wh wa
 
-    io $ moveWindow d w (fromIntegral $ xbegin') (fromIntegral $ ybegin')
+    io $ moveWindow d w (fromIntegral xbegin') (fromIntegral ybegin')
     io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin')
     float w
     where
@@ -152,13 +149,13 @@ snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $
                             (Nothing,Nothing) -> wpos wa
                 end = if fs
                       then wpos wa + wdim wa
-                      else case (if mfl==(Just begin) then Nothing else mfl,mfr) of
+                      else case (if mfl==Just begin then Nothing else mfl,mfr) of
                           (Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr
                           (Just fl,Nothing) -> fl
                           (Nothing,Just fr) -> fr
                           (Nothing,Nothing) -> wpos wa + wdim wa
-                begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else (wpos wa)
-                end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else (wpos wa + wdim wa)
+                begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else wpos wa
+                end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else wpos wa + wdim wa
             return (begin',end')
             where
                 (wpos, wdim, _, _) = constructors horiz
@@ -170,10 +167,8 @@ snapMagicMove
     -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
     -> Window    -- ^ The window to move.
     -> X ()
-snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    wa <- io $ getWindowAttributes d w
-
+snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     nx <- handleAxis True d wa
     ny <- handleAxis False d wa
 
@@ -194,8 +189,8 @@ snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
                                     (Just fl,Nothing) -> fl
                                     (Nothing,Just fr) -> fr
                                     (Nothing,Nothing) -> wpos wa
-                              newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else (f - wdim wa)
-                          in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else (wpos wa)
+                              newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else f - wdim wa
+                          in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else wpos wa
             where
                 (wpos, wdim, _, _) = constructors horiz
 
@@ -211,9 +206,8 @@ snapMove U = doSnapMove False True
 snapMove D = doSnapMove False False
 
 doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
-doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    wa <- io $ getWindowAttributes d w
+doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     ((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w
 
     let (mb,mf) = if rev then (bl,fl)
@@ -251,9 +245,8 @@ snapShrink
 snapShrink = snapResize False
 
 snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
-snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    wa <- io $ getWindowAttributes d w
+snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     mr <- case dir of
               L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w
                       return $ case (if grow then mg else ms) of
@@ -274,9 +267,8 @@ snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
 
     case mr of
         Nothing -> return ()
-        Just (nx,ny,nw,nh) -> if nw>0 && nh>0 then do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
-                                                      io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh)
-                                              else return ()
+        Just (nx,ny,nw,nh) -> when (nw>0 && nh>0) $ do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
+                                                       io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh)
     float w
     where
         wx = fromIntegral.wa_x
@@ -291,8 +283,8 @@ getSnap horiz collidedist d w = do
     screen <- W.current <$> gets windowset
     let sr = screenRect $ W.screenDetail screen
         wl = W.integrate' . W.stack $ W.workspace screen
-    gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound]
-    wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
+    gr <- ($ sr) <$> calcGap (S.fromList [minBound .. maxBound])
+    wla <- filter (collides wa) <$> io (mapM (getWindowAttributes d) $ filter (/=w) wl)
 
     return ( neighbours (back wa sr gr wla) (wpos wa)
            , neighbours (front wa sr gr wla) (wpos wa + wdim wa)
@@ -306,8 +298,8 @@ getSnap horiz collidedist d w = do
 
         back wa sr gr wla = dropWhile (< rpos sr) $
                             takeWhile (< rpos sr + rdim sr) $
-                            sort $ (rpos sr):(rpos gr):(rpos gr + rdim gr):
-                                   foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla
+                            sort $ rpos sr:rpos gr:(rpos gr + rdim gr):
+                                   foldr (\a as -> wpos a:(wpos a + wdim a + wborder a + wborder wa):as) [] wla
 
         front wa sr gr wla = dropWhile (<= rpos sr) $
                              takeWhile (<= rpos sr + rdim sr) $
@@ -321,8 +313,8 @@ getSnap horiz collidedist d w = do
 
         collides wa oa = case collidedist of
                              Nothing -> True
-                             Just dist -> (  refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist
-                                          && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa )
+                             Just dist -> refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist
+                                       && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa
 
 
 constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int)

XMonad/Actions/FocusNth.hs

@@ -1,6 +1,9 @@
+{-# LANGUAGE ViewPatterns #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.FocusNth
+-- Description  : Focus the nth window of the current workspace.
 -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
 -- License      : BSD
 --
@@ -17,11 +20,12 @@ module XMonad.Actions.FocusNth (
                  focusNth,focusNth',
                  swapNth,swapNth') where
 
-import XMonad.StackSet
 import XMonad
+import XMonad.Prelude
+import XMonad.StackSet
 
 -- $usage
--- Add the import to your @~\/.xmonad\/xmonad.hs@:
+-- Add the import to your @xmonad.hs@:
 --
 -- > import XMonad.Actions.FocusNth
 --
@@ -32,15 +36,15 @@ import XMonad
 -- >     | (i, k) <- zip [0 .. 8] [xK_1 ..]]
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Give focus to the nth window of the current workspace.
 focusNth :: Int -> X ()
 focusNth = windows . modify' . focusNth'
 
 focusNth' :: Int -> Stack a -> Stack a
-focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s
-                              | otherwise = listToStack n (integrate s)
+focusNth' n s | n >= 0, (ls, t:rs) <- splitAt n (integrate s) = Stack t (reverse ls) rs
+              | otherwise = s
 
 -- | Swap current window with nth. Focus stays in the same position
 swapNth :: Int -> X ()
@@ -49,14 +53,5 @@ swapNth = windows . modify' . swapNth'
 swapNth' :: Int -> Stack a -> Stack a
 swapNth' n s@(Stack c l r)
   | (n < 0) || (n > length l + length r) || (n == length l) = s
-  | n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r
-  | otherwise    = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)
-                                                                          
-
-listToStack :: Int -> [a] -> Stack a
-listToStack n l = Stack t ls rs
- where
-    (t:rs)    = drop n l
-    ls        = reverse (take n l)
-
-
+  | n < length l = let (nl, notEmpty -> nc :| nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r
+  | otherwise    = let (nl, notEmpty -> nc :| nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)

XMonad/Actions/GridSelect.hs

@@ -1,7 +1,8 @@
-{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}
+{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, TupleSections #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.GridSelect
+-- Description :  Display items in a 2D grid and select from it with the keyboard or the mouse.
 -- Copyright   :  Clemens Fruhwirth <clemens@endorphin.org>
 -- License     :  BSD-style (see LICENSE)
 --
@@ -28,7 +29,6 @@ module XMonad.Actions.GridSelect (
     -- * Configuration
     GSConfig(..),
     def,
-    defaultGSConfig,
     TwoDPosition,
     buildDefaultGSConfig,
 
@@ -48,6 +48,7 @@ module XMonad.Actions.GridSelect (
     fromClassName,
     stringColorizer,
     colorRangeFromClassName,
+    stringToRatio,
 
     -- * Navigation Mode assembly
     TwoD,
@@ -79,16 +80,14 @@ module XMonad.Actions.GridSelect (
     -- * Types
     TwoDState,
     ) where
-import Data.Maybe
+import Control.Arrow ((***))
 import Data.Bits
-import Data.Char
 import Data.Ord (comparing)
-import Control.Applicative
 import Control.Monad.State
-import Control.Arrow
 import Data.List as L
 import qualified Data.Map as M
 import XMonad hiding (liftX)
+import XMonad.Prelude
 import XMonad.Util.Font
 import XMonad.Prompt (mkUnmanagedWindow)
 import XMonad.StackSet as W
@@ -96,24 +95,25 @@ import XMonad.Layout.Decoration
 import XMonad.Util.NamedWindows
 import XMonad.Actions.WindowBringer (bringWindow)
 import Text.Printf
-import System.Random (mkStdGen, genRange, next)
+import System.Random (mkStdGen, randomR)
 import Data.Word (Word8)
+import qualified Data.List.NonEmpty as NE
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- >    import XMonad.Actions.GridSelect
 --
 -- Then add a keybinding, e.g.
 --
--- >    , ((modm, xK_g), goToSelected defaultGSConfig)
+-- >    , ((modm, xK_g), goToSelected def)
 --
 -- This module also supports displaying arbitrary information in a grid and letting
 -- the user select from it. E.g. to spawn an application from a given list, you
 -- can use the following:
 --
--- >   , ((modm, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"])
+-- >   , ((modm, xK_s), spawnSelected def ["xterm","gmplayer","gvim"])
 
 -- $commonGSConfig
 --
@@ -123,9 +123,9 @@ import Data.Word (Word8)
 -- > {-# LANGUAGE NoMonomorphismRestriction #-}
 -- > import XMonad
 -- > ...
--- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellwidth = 100 }
+-- > gsconfig1 = def { gs_cellheight = 30, gs_cellwidth = 100 }
 --
--- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig'
+-- An example where 'buildDefaultGSConfig' is used instead of 'def'
 -- in order to specify a custom colorizer is @gsconfig2@ (found in
 -- "XMonad.Actions.GridSelect#Colorizers"):
 --
@@ -143,8 +143,8 @@ import Data.Word (Word8)
 --
 -- Then you can bind to:
 --
--- >     ,((modm, xK_g), goToSelected  $ gsconfig2 myWinColorizer)
--- >     ,((modm, xK_p), spawnSelected $ spawnSelected defaultColorizer)
+-- >     ,((modm, xK_g), goToSelected $ gsconfig2 myWinColorizer)
+-- >     ,((modm, xK_p), spawnSelected (gsconfig2 defaultColorizer) ["xterm","gvim"])
 
 -- $keybindings
 --
@@ -203,9 +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_originFractY :: Double,
+      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
@@ -221,18 +225,14 @@ instance HasColorizer Window where
 instance HasColorizer String where
     defaultColorizer = stringColorizer
 
-instance HasColorizer a where
+instance {-# OVERLAPPABLE #-} HasColorizer a where
     defaultColorizer _ isFg =
         let getColor = if isFg then focusedBorderColor else normalBorderColor
-        in asks $ flip (,) "black" . getColor . config
+        in asks $ (, "black") . getColor . config
 
 instance HasColorizer a => Default (GSConfig a) where
     def = buildDefaultGSConfig defaultColorizer
 
-{-# DEPRECATED defaultGSConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.GridSelect) instead." #-}
-defaultGSConfig :: HasColorizer a => GSConfig a
-defaultGSConfig = def
-
 type TwoDPosition = (Integer, Integer)
 
 type TwoDElementMap a = [(TwoDPosition,(String,a))]
@@ -263,7 +263,7 @@ generateElementmap s = do
     -- Sorts the elementmap
     sortedElements = orderElementmap searchString filteredElements
     -- Case Insensitive version of isInfixOf
-    needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack)
+    needle `isInfixOfI` haystack = upper needle `isInfixOf` upper haystack
     upper = map toUpper
 
 
@@ -289,11 +289,7 @@ orderElementmap searchString elements = if not $ null searchString then sortedEl
 
 
 newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }
-    deriving (Monad,Functor,MonadState (TwoDState a))
-
-instance Applicative (TwoD a) where
-    (<*>) = ap
-    pure = return
+    deriving (Functor, Applicative, Monad, MonadState (TwoDState a))
 
 liftX ::  X a1 -> TwoD a a1
 liftX = TwoD . lift
@@ -307,30 +303,30 @@ diamondLayer n =
   -- tr = top right
   --  r = ur ++ 90 degree clock-wise rotation of ur
   let tr = [ (x,n-x) | x <- [0..n-1] ]
-      r  = tr ++ (map (\(x,y) -> (y,-x)) tr)
-  in r ++ (map (negate *** negate) r)
+      r  = tr ++ map (\(x,y) -> (y,-x)) tr
+  in r ++ map (negate *** negate) r
 
-diamond :: (Enum a, Num a, Eq a) => [(a, a)]
-diamond = concatMap diamondLayer [0..]
+diamond :: (Enum a, Num a, Eq a) => Stream (a, a)
+diamond = fromList $ concatMap diamondLayer [0..]
 
 diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
 diamondRestrict x y originX originY =
   L.filter (\(x',y') -> abs x' <= x && abs y' <= y) .
   map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .
-  take 1000 $ diamond
+  takeS 1000 $ diamond
 
 findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
 findInElementMap pos = find ((== pos) . fst)
 
-drawWinBox :: Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
-drawWinBox win font (fg,bg) ch cw text x y cp =
+drawWinBox :: Window -> XMonadFont -> (String, String) -> String -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
+drawWinBox win font (fg,bg) bc ch cw text x y cp =
   withDisplay $ \dpy -> do
   gc <- liftIO $ createGC dpy win
   bordergc <- liftIO $ createGC dpy win
   liftIO $ do
     Just fgcolor <- initColor dpy fg
     Just bgcolor <- initColor dpy bg
-    Just bordercolor <- initColor dpy borderColor
+    Just bordercolor <- initColor dpy bc
     setForeground dpy gc fgcolor
     setBackground dpy gc bgcolor
     setForeground dpy bordergc bordercolor
@@ -338,9 +334,12 @@ drawWinBox win font (fg,bg) ch cw text x y cp =
     drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
   stext <- shrinkWhile (shrinkIt shrinkText)
            (\n -> do size <- liftIO $ textWidthXMF dpy font n
-                     return $ size > (fromInteger (cw-(2*cp))))
+                     return $ size > fromInteger (cw-(2*cp)))
            text
-  printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext
+  -- calculate the offset to vertically centre the text based on the ascender and descender
+  (asc,desc) <- liftIO $ textExtentsXMF font stext
+  let offset = ((ch - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc
+  printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+offset)) stext
   liftIO $ freeGC dpy gc
   liftIO $ freeGC dpy bordergc
 
@@ -378,6 +377,7 @@ updateElementsWithColorizer colorizer elementmap = do
             colors <- colorizer element (pos == curpos)
             drawWinBox win font
                        colors
+                       (gs_bordercolor gsconfig)
                        cellheight
                        cellwidth
                        text
@@ -387,18 +387,25 @@ updateElementsWithColorizer colorizer elementmap = do
     mapM_ updateElement elementmap
 
 stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
-stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
+stdHandle ButtonEvent{ ev_event_type = t, ev_x = x, ev_y = y } contEventloop
     | t == buttonRelease = do
-        s @  TwoDState { td_paneX = px, td_paneY = py,
-                         td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _) } <- get
+        s@TwoDState{ td_paneX = px
+                   , 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
+stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop
 
 stdHandle _ contEventloop = contEventloop
 
@@ -411,10 +418,11 @@ makeXEventhandler keyhandler = fix $ \me -> join $ liftX $ withDisplay $ \d -> l
                              ev <- getEvent e
                              if ev_event_type ev == keyPress
                                then do
-                                  (ks,s) <- lookupString $ asKeyEvent e
+                                  (_, s) <- lookupString $ asKeyEvent e
+                                  ks <- keycodeToKeysym d (ev_keycode ev) 0
                                   return $ do
-                                      mask <- liftX $ cleanMask (ev_state ev)
-                                      keyhandler (fromMaybe xK_VoidSymbol ks, s, mask)
+                                      mask <- liftX $ cleanKeyMask <*> pure (ev_state ev)
+                                      keyhandler (ks, s, mask)
                                else
                                   return $ stdHandle ev me
 
@@ -430,7 +438,7 @@ shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.l
 select :: TwoD a (Maybe a)
 select = do
   s <- get
-  return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s)
+  return $ snd . snd <$> findInElementMap (td_curpos s) (td_elementmap s)
 
 -- | Closes gridselect returning no element.
 cancel :: TwoD a (Maybe a)
@@ -445,7 +453,7 @@ setPos newPos = do
       oldPos = td_curpos s
   when (isJust newSelectedEl && newPos /= oldPos) $ do
     put s { td_curpos = newPos }
-    updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
+    updateElements (catMaybes [findInElementMap oldPos elmap, newSelectedEl])
 
 -- | Moves the cursor by the offsets specified
 move :: (Integer, Integer) -> TwoD a ()
@@ -545,7 +553,7 @@ navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDef
           ,((0,xK_Up)         , move (0,-1) >> navNSearch)
           ,((0,xK_Tab)        , moveNext >> navNSearch)
           ,((shiftMask,xK_Tab), movePrev >> navNSearch)
-          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch)
+          ,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> navNSearch)
           ]
         -- The navigation handler ignores unknown key symbols, therefore we const
         navNSearchDefaultHandler (_,s,_) = do
@@ -559,7 +567,7 @@ substringSearch returnNavigation = fix $ \me ->
   let searchKeyMap = M.fromList [
            ((0,xK_Escape)   , transformSearchString (const "") >> returnNavigation)
           ,((0,xK_Return)   , returnNavigation)
-          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me)
+          ,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> me)
           ]
       searchDefaultHandler (_,s,_) = do
           transformSearchString (++ s)
@@ -571,8 +579,8 @@ substringSearch returnNavigation = fix $ \me ->
 -- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
 hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
 hsv2rgb (h,s,v) =
-    let hi = (div h 60) `mod` 6 :: Integer
-        f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a
+    let hi = div h 60 `mod` 6 :: Integer
+        f = ((fromInteger h/60) - fromInteger hi) :: Fractional a => a
         q = v * (1-f)
         p = v * (1-s)
         t = v * (1-(1-f)*s)
@@ -589,19 +597,19 @@ hsv2rgb (h,s,v) =
 stringColorizer :: String -> Bool -> X (String, String)
 stringColorizer s active =
     let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer
-        (r,g,b) = hsv2rgb ((seed 83) `mod` 360,
-                           (fromInteger ((seed 191) `mod` 1000))/2500+0.4,
-                           (fromInteger ((seed 121) `mod` 1000))/2500+0.4)
+        (r,g,b) = hsv2rgb (seed 83 `mod` 360,
+                           fromInteger (seed 191 `mod` 1000)/2500+0.4,
+                           fromInteger (seed 121 `mod` 1000)/2500+0.4)
     in if active
          then return ("#faff69", "black")
-         else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white")
+         else return ("#" ++ concatMap (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b], "white")
 
 -- | Colorize a window depending on it's className.
 fromClassName :: Window -> Bool -> X (String, String)
 fromClassName w active = runQuery className w >>= flip defaultColorizer active
 
 twodigitHex :: Word8 -> String
-twodigitHex a = printf "%02x" a
+twodigitHex = printf "%02x"
 
 -- | A colorizer that picks a color inside a range,
 -- and depending on the window's class.
@@ -630,15 +638,12 @@ mix (r1, g1, b1) (r2, g2, b2) r = (mix' r1 r2, mix' g1 g2, mix' b1 b2)
 
 -- | Generates a Double from a string, trying to
 -- achieve a random distribution.
--- We create a random seed from the sum of all characters
+-- We create a random seed from the hash of all characters
 -- in the string, and use it to generate a ratio between 0 and 1
 stringToRatio :: String -> Double
 stringToRatio "" = 0
-stringToRatio s = let gen = mkStdGen $ sum $ map fromEnum s
-                      range = (\(a, b) -> b - a) $ genRange gen
-                      randomInt = foldr1 combine $ replicate 20 next
-                      combine f1 f2 g = let (_, g') = f1 g in f2 g'
-                  in fi (fst $ randomInt gen) / fi range
+stringToRatio s = let gen = mkStdGen $ foldl' (\t c -> t * 31 + fromEnum c) 0 s
+                  in fst $ randomR (0, 1) gen
 
 -- | Brings up a 2D grid of elements in the center of the screen, and one can
 -- select an element with cursors keys. The selected element is returned.
@@ -653,18 +658,18 @@ 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
-    selectedElement <- if (status == grabSuccess) then do
+    selectedElement <- if status == grabSuccess then do
                             let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double
                                 restrictX = floor $ restriction screenWidth gs_cellwidth
                                 restrictY = floor $ restriction screenHeight gs_cellheight
-                                originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX
-                                originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY
+                                originPosX = floor $ (gs_originFractX gsconfig - (1/2)) * 2 * fromIntegral restrictX
+                                originPosY = floor $ (gs_originFractY gsconfig - (1/2)) * 2 * fromIntegral restrictY
                                 coords = diamondRestrict restrictX restrictY originPosX originPosY
-                                s = TwoDState { td_curpos = (head coords),
+                                s = TwoDState { td_curpos = NE.head (notEmpty coords),
                                                 td_availSlots = coords,
                                                 td_elements = elements,
                                                 td_gsconfig = gsconfig,
@@ -675,7 +680,7 @@ gridselect gsconfig elements =
                                                 td_searchString = "",
                                                 td_elementmap = [] }
                             m <- generateElementmap s
-                            evalTwoD (updateAllElements >> (gs_navigate gsconfig))
+                            evalTwoD (updateAllElements >> gs_navigate gsconfig)
                                      (s { td_elementmap = m })
                       else
                           return Nothing
@@ -697,27 +702,21 @@ gridselectWindow gsconf = windowMap >>= gridselect gsconf
 withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
 withSelectedWindow callback conf = do
     mbWindow <- gridselectWindow conf
-    case mbWindow of
-        Just w -> callback w
-        Nothing -> return ()
+    for_ mbWindow callback
 
 windowMap :: X [(String,Window)]
 windowMap = do
     ws <- gets windowset
-    wins <- mapM keyValuePair (W.allWindows ws)
-    return wins
- where keyValuePair w = flip (,) w `fmap` decorateName' w
+    mapM keyValuePair (W.allWindows ws)
+ where keyValuePair w = (, w) <$> decorateName' w
 
 decorateName' :: Window -> X String
 decorateName' w = do
-  fmap show $ getName w
+  show <$> getName w
 
 -- | 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)
-
-borderColor :: String
-borderColor = "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 ()
@@ -768,7 +767,7 @@ gridselectWorkspace' conf func = withWindowSet $ \ws -> do
 --
 -- > import XMonad.Actions.DynamicWorkspaces (addWorkspace)
 -- >
--- > gridselectWorkspace' defaultGSConfig
+-- > gridselectWorkspace' def
 -- >                          { gs_navigate   = navNSearch
 -- >                          , gs_rearranger = searchStringRearrangerGenerator id
 -- >                          }
@@ -787,7 +786,7 @@ noRearranger _ = return
 -- already present).
 searchStringRearrangerGenerator :: (String -> a) -> Rearranger a
 searchStringRearrangerGenerator f =
-    let r "" xs                       = return $ xs
-        r s  xs | s `elem` map fst xs = return $ xs
+    let r "" xs                       = return xs
+        r s  xs | s `elem` map fst xs = return xs
                 | otherwise           = return $ xs ++ [(s, f s)]
     in r

XMonad/Actions/GroupNavigation.hs

@@ -1,8 +1,8 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-
+{-# language DeriveGeneric, DeriveAnyClass #-}
 ----------------------------------------------------------------------
 -- |
 -- Module      : XMonad.Actions.GroupNavigation
+-- Description : Cycle through groups of windows across workspaces.
 -- Copyright   : (c) nzeh@cs.dal.ca
 -- License     : BSD3-style (see LICENSE)
 --
@@ -16,7 +16,7 @@
 -- query.
 --
 -- Also provides a method for jumping back to the most recently used
--- window in any given group.
+-- window in any given group, and predefined groups.
 --
 ----------------------------------------------------------------------
 
@@ -27,24 +27,33 @@ module XMonad.Actions.GroupNavigation ( -- * Usage
                                       , nextMatchOrDo
                                       , nextMatchWithThis
                                       , historyHook
+
+                                        -- * Utilities
+                                        -- $utilities
+                                      , isOnAnyVisibleWS
                                       ) where
 
-import Control.Monad.Reader
-import Data.Foldable as Fold
-import Data.Map as Map
-import Data.Sequence as Seq
-import Data.Set as Set
+import Control.Monad.Reader (ask, asks)
+import Control.Monad.State (gets)
+import Control.DeepSeq
+import Data.Map ((!))
+import qualified Data.Map as Map
+import Data.Sequence (Seq, ViewL (EmptyL, (:<)), viewl, (<|), (><), (|>))
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
 import Graphics.X11.Types
-import Prelude hiding (concatMap, drop, elem, filter, null, reverse)
+import GHC.Generics
+import Prelude hiding (drop, elem, filter, null, reverse)
 import XMonad.Core
 import XMonad.ManageHook
 import XMonad.Operations (windows, withFocused)
+import XMonad.Prelude (elem, foldl', (>=>))
 import qualified XMonad.StackSet as SS
 import qualified XMonad.Util.ExtensibleState as XS
 
 {- $usage
 
-Import the module into your @~\/.xmonad\/xmonad.hs@:
+Import the module into your @xmonad.hs@:
 
 > import XMonad.Actions.GroupNavigation
 
@@ -120,14 +129,14 @@ focusNextMatchOrDo qry act = findM (runQuery qry)
                              >=> maybe act (windows . SS.focusWindow)
 
 -- Returns the list of windows ordered by workspace as specified in
--- ~/.xmonad/xmonad.hs
+-- @xmonad.hs@.
 orderedWindowList :: Direction -> X (Seq Window)
-orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get
+orderedWindowList History = fmap (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get
 orderedWindowList dir     = withWindowSet $ \ss -> do
   wsids <- asks (Seq.fromList . workspaces . config)
   let wspcs = orderedWorkspaceList ss wsids
       wins  = dirfun dir
-              $ Fold.foldl' (><) Seq.empty
+              $ foldl' (><) Seq.empty
               $ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs
       cur   = SS.peek ss
   return $ maybe wins (rotfun wins) cur
@@ -136,13 +145,13 @@ orderedWindowList dir     = withWindowSet $ \ss -> do
     dirfun _        = id
     rotfun wins x   = rotate $ rotateTo (== x) wins
 
--- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs
+-- Returns the ordered workspace list as specified in @xmonad.hs@.
 orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace
 orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
     where
       wspcs      = SS.workspaces ss
-      wspcsMap   = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs
-      wspcs'     = fmap (\wsid -> wspcsMap ! wsid) wsids
+      wspcsMap   = foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs
+      wspcs'     = fmap (wspcsMap !) wsids
       isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)
 
 --- History navigation, requires a layout modifier -------------------
@@ -150,7 +159,7 @@ orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
 -- The state extension that holds the history information
 data HistoryDB = HistoryDB (Maybe Window) -- currently focused window
                            (Seq Window)   -- previously focused windows
-               deriving (Read, Show, Typeable)
+               deriving (Read, Show, Generic, NFData)
 
 instance ExtensionClass HistoryDB where
 
@@ -160,33 +169,18 @@ instance ExtensionClass HistoryDB where
 -- | Action that needs to be executed as a logHook to maintain the
 -- focus history of all windows as the WindowSet changes.
 historyHook :: X ()
-historyHook = XS.get >>= updateHistory >>= XS.put
+historyHook = (XS.put $!) . force =<< updateHistory =<< XS.get
 
 -- Updates the history in response to a WindowSet change
 updateHistory :: HistoryDB -> X HistoryDB
-updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do
+updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss ->
   let newcur   = SS.peek ss
       wins     = Set.fromList $ SS.allWindows ss
-      newhist  = flt (flip Set.member wins) (ins oldcur oldhist)
-  return $ HistoryDB newcur (del newcur newhist)
+      newhist  = Seq.filter (`Set.member` wins) (ins oldcur oldhist)
+  in pure $ HistoryDB newcur (del newcur newhist)
   where
     ins x xs = maybe xs (<| xs) x
-    del x xs = maybe xs (\x' -> flt (/= x') xs) x
-
---- Two replacements for Seq.filter and Seq.breakl available only in
---- containers-0.3.0.0, which only ships with ghc 6.12.  Once we
---- decide to no longer support ghc < 6.12, these should be replaced
---- with Seq.filter and Seq.breakl.
-
-flt :: (a -> Bool) -> Seq a -> Seq a
-flt p = Fold.foldl (\xs x -> if p x then xs |> x else xs) Seq.empty
-
-brkl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
-brkl p xs = flip Seq.splitAt xs
-            $ snd
-            $ Fold.foldr (\x (i, j) -> if p x then (i-1, i-1) else (i-1, j)) (l, l) xs
-  where
-    l = Seq.length xs
+    del x xs = maybe xs (\x' -> Seq.filter (/= x') xs) x
 
 --- Some sequence helpers --------------------------------------------
 
@@ -200,7 +194,7 @@ rotate xs = rotate' (viewl xs)
 -- Rotates the sequence until an element matching the given condition
 -- is at the beginning of the sequence.
 rotateTo :: (a -> Bool) -> Seq a -> Seq a
-rotateTo cond xs = let (lxs, rxs) = brkl cond xs in rxs >< lxs
+rotateTo cond xs = let (lxs, rxs) = Seq.breakl cond xs in rxs >< lxs
 
 --- A monadic find ---------------------------------------------------
 
@@ -216,3 +210,21 @@ findM cond xs = findM' cond (viewl xs)
       if isMatch
         then return (Just x')
         else findM qry xs'
+
+
+-- $utilities
+-- #utilities#
+-- Below are handy queries for use with 'nextMatch', 'nextMatchOrDo',
+-- and 'nextMatchWithThis'.
+
+-- | A query that matches all windows on visible workspaces. This is
+-- useful for configurations with multiple screens, and matches even
+-- invisible windows.
+isOnAnyVisibleWS :: Query Bool
+isOnAnyVisibleWS = do
+  w <- ask
+  ws <- liftX $ gets windowset
+  let allVisible = concatMap (maybe [] SS.integrate . SS.stack . SS.workspace) (SS.current ws:SS.visible ws)
+      visibleWs = w `elem` allVisible
+      unfocused = Just w /= SS.peek ws
+  return $ visibleWs && unfocused

XMonad/Actions/KeyRemap.hs

@@ -1,7 +1,7 @@
- {-# LANGUAGE DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.KeyRemap
+-- Description :  Remap Keybinding on the fly.
 -- Copyright   :  (c) Christian Dietrich
 -- License     :  BSD-style (as xmonad)
 --
@@ -27,14 +27,13 @@ module XMonad.Actions.KeyRemap (
   ) where
 
 import XMonad
+import XMonad.Prelude
 import XMonad.Util.Paste
-import Data.List
 
 import qualified XMonad.Util.ExtensibleState as XS
-import Control.Monad
 
 
-data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)
+newtype KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Show)
 
 instance ExtensionClass KeymapTable where
    initialValue = KeymapTable []
@@ -125,8 +124,8 @@ extractKeyMapping (KeymapTable table) mask sym =
 buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())]
 buildKeyRemapBindings keyremaps =
   [((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]
-  where mappings = concat (map (\(KeymapTable table) -> table) keyremaps)
-        bindings = nub (map (\binding -> fst binding) mappings)
+  where mappings = concatMap (\(KeymapTable table) -> table) keyremaps
+        bindings = nub (map fst mappings)
 
 
 -- Here come the Keymappings
@@ -138,7 +137,7 @@ emptyKeyRemap = KeymapTable []
 dvorakProgrammerKeyRemap :: KeymapTable
 dvorakProgrammerKeyRemap =
   KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) |
-               (maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)]
+               (maskFrom, from, maskTo, to) <- zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey]
   where
 
     layoutUs    = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?"  :: [KeySym]
@@ -149,8 +148,6 @@ dvorakProgrammerKeyRemap =
 
     layoutDvorakShift = map getShift layoutDvorak
     layoutDvorakKey   = map getKey layoutDvorak
-    getKey  char = let Just index = elemIndex char layoutUs
-                    in layoutUsKey !! index
-    getShift char = let Just index = elemIndex char layoutUs
-                    in layoutUsShift !! index
+    getKey   char = fromJust $ (layoutUsKey   !?) =<< elemIndex char layoutUs
+    getShift char = fromJust $ (layoutUsShift !?) =<< elemIndex char layoutUs
     charToMask char = if [char] == "0" then 0 else shiftMask

XMonad/Actions/Launcher.hs

@@ -1,5 +1,6 @@
 {- |
 Module      :  XMonad.Actions.Launcher
+Description :  A set of prompts for XMonad.
 Copyright   :  (C) 2012 Carlos López-Camey
 License     :  None; public domain
 
@@ -18,10 +19,9 @@ module XMonad.Actions.Launcher(
   , launcherPrompt
 ) where
 
-import           Data.List       (find, findIndex, isPrefixOf, tails)
 import qualified Data.Map        as M
-import           Data.Maybe      (isJust)
 import           XMonad          hiding (config)
+import           XMonad.Prelude
 import           XMonad.Prompt
 import           XMonad.Util.Run
 
@@ -62,15 +62,15 @@ type ExtensionActions = M.Map String (String -> X())
 instance XPrompt CalculatorMode where
   showXPrompt CalcMode = "calc %s> "
   commandToComplete CalcMode = id --send the whole string to `calc`
-  completionFunction CalcMode = \s -> if (length s == 0) then return [] else do
-    fmap lines $ runProcessWithInput "calc" [s] ""
+  completionFunction CalcMode s = if null s then return [] else
+    lines <$> runProcessWithInput "calc" [s] ""
   modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard
 
 -- | Uses the program `hoogle` to search for functions
 instance XPrompt HoogleMode where
   showXPrompt _ = "hoogle %s> "
   commandToComplete _ = id
-  completionFunction (HMode pathToHoogleBin' _) = \s -> completionFunctionWith pathToHoogleBin' ["--count","8",s]
+  completionFunction (HMode pathToHoogleBin' _) s = completionFunctionWith pathToHoogleBin' ["--count","8",s]
   -- This action calls hoogle again to find the URL corresponding to the autocompleted item
   modeAction (HMode pathToHoogleBin'' browser') query result = do
     completionsWithLink <- liftIO $ completionFunctionWith pathToHoogleBin'' ["--count","5","--link",query]
@@ -88,7 +88,7 @@ instance XPrompt HoogleMode where
 
 -- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command.
 completionFunctionWith :: String -> [String] -> IO [String]
-completionFunctionWith cmd args = do fmap lines $ runProcessWithInput cmd args ""
+completionFunctionWith cmd args = lines <$> runProcessWithInput cmd args ""
 
 -- | Creates a prompt with the given modes
 launcherPrompt :: XPConfig -> [XPMode] -> X()

XMonad/Actions/LinkWorkspaces.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.LinkWorkspaces
+-- Description : Bindings to add and delete links between workspaces.
 -- Copyright   :  (c) Jan-David Quesel <quesel@gmail.org>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -14,7 +15,6 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE DeriveDataTypeable  #-}
 module XMonad.Actions.LinkWorkspaces (
                                          -- * Usage
                                          -- $usage
@@ -27,6 +27,7 @@ module XMonad.Actions.LinkWorkspaces (
                                        ) where
 
 import XMonad
+import XMonad.Prelude (for_)
 import qualified XMonad.StackSet as W
 import XMonad.Layout.IndependentScreens(countScreens)
 import qualified XMonad.Util.ExtensibleState as XS (get, put)
@@ -35,7 +36,7 @@ import qualified Data.Map as M
     ( insert, delete, Map, lookup, empty, filter )
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+-- You can use this module with the following in your @xmonad.hs@ file:
 --
 -- > import XMonad.Actions.LinkWorkspaces
 --
@@ -57,9 +58,9 @@ import qualified Data.Map as M
 -- >       , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]]
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
-data MessageConfig = MessageConfig {  messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X())
+data MessageConfig = MessageConfig {  messageFunction :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
                     , foreground :: [Char]
                     , alertedForeground :: [Char]
                     , background :: [Char]
@@ -75,8 +76,8 @@ noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
 noMessageFn _ _ _ _ = return () :: X ()
 
 -- | Stuff for linking workspaces
-data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)
-instance ExtensionClass WorkspaceMap 
+newtype WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show)
+instance ExtensionClass WorkspaceMap
     where initialValue = WorkspaceMap M.empty
           extensionType = PersistentExtension
 
@@ -85,12 +86,12 @@ switchWS f m ws = switchWS' f m ws Nothing
 
 -- | Switch to the given workspace in a non greedy way, stop if we reached the first screen
 -- | we already did switching on
-switchWS' :: (WorkspaceId -> X ()) -> MessageConfig  -> WorkspaceId -> (Maybe ScreenId) -> X ()
+switchWS' :: (WorkspaceId -> X ()) -> MessageConfig  -> WorkspaceId -> Maybe ScreenId -> X ()
 switchWS' switchFn message workspace stopAtScreen = do
   ws <- gets windowset
   nScreens <- countScreens
   let now = W.screen (W.current ws)
-  let next = ((now + 1) `mod` nScreens)
+  let next = (now + 1) `mod` nScreens
   switchFn workspace
   case stopAtScreen of
     Nothing -> sTM now next (Just now)
@@ -99,21 +100,21 @@ switchWS' switchFn message workspace stopAtScreen = do
 
 -- | Switch to the workspace that matches the current one, executing switches for that workspace as well.
 -- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again.
-switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId 
-    -> ScreenId -> (Maybe ScreenId) -> X ()
+switchToMatching :: (WorkspaceId -> Maybe ScreenId -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId
+    -> ScreenId -> Maybe ScreenId -> X ()
 switchToMatching f message t now next stopAtScreen = do
     WorkspaceMap matchings <- XS.get :: X WorkspaceMap
-    case (M.lookup t matchings) of
+    case M.lookup t matchings of
         Nothing -> return () :: X()
         Just newWorkspace -> do
-            onScreen' (f newWorkspace stopAtScreen) FocusCurrent next 
+            onScreen' (f newWorkspace stopAtScreen) FocusCurrent next
             messageFunction message now (foreground message) (background message) ("Switching to: " ++ (t ++ " and " ++ newWorkspace))
 
 -- | Insert a mapping between t1 and t2 or remove it was already present
 toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X ()
 toggleMatching message t1 t2 = do
     WorkspaceMap matchings <- XS.get :: X WorkspaceMap
-    case (M.lookup t1 matchings) of
+    case M.lookup t1 matchings of
         Nothing -> setMatching message t1 t2 matchings
         Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings
     return ()
@@ -142,7 +143,7 @@ removeAllMatchings :: MessageConfig -> X ()
 removeAllMatchings message = do
    ws <- gets windowset
    let now = W.screen (W.current ws)
-   XS.put $ WorkspaceMap $ M.empty
+   XS.put $ WorkspaceMap M.empty
    messageFunction message now (alertedForeground message) (background message) "All links removed!"
 
 -- | remove all matching regarding a given workspace
@@ -163,7 +164,6 @@ toggleLinkWorkspaces' first message = do
     let now = W.screen (W.current ws)
     let next = (now + 1) `mod` nScreens
     if next == first then return () else do -- this is also the case if there is only one screen
-        case (W.lookupWorkspace next ws) of
-            Nothing -> return ()
-            Just name -> toggleMatching message (W.currentTag ws) (name)
+        for_ (W.lookupWorkspace next ws)
+             (toggleMatching message (W.currentTag ws))
         onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next

XMonad/Actions/MessageFeedback.hs

@@ -1,7 +1,9 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.MessageFeedback
--- Copyright    : (c) Quentin Moser <moserq@gmail.com>
+-- Description :  An alternative @sendMessage@.
+-- Copyright    : (c) --   Quentin Moser <moserq@gmail.com>
+--                    2018 Yclept Nemo
 -- License      : BSD3
 --
 -- Maintainer   : orphaned
@@ -13,87 +15,212 @@
 -- this facility.
 -----------------------------------------------------------------------------
 
-module XMonad.Actions.MessageFeedback (
-                                      -- * Usage
-                                      -- $usage
+module XMonad.Actions.MessageFeedback
+    ( -- * Usage
+      -- $usage
 
-                                        send
-                                      , tryMessage
-                                      , tryMessage_
-                                      , tryInOrder
-                                      , tryInOrder_
-                                      , sm
-                                      , sendSM
-                                      , sendSM_
-                                      ) where
+      -- * Messaging variants
 
-import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX )
-import XMonad.StackSet ( current, workspace, layout, tag )
-import XMonad.Operations ( updateLayout )
+      -- ** 'SomeMessage'
+      sendSomeMessageB, sendSomeMessage
+    , sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh
+    , sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent
 
-import Control.Monad.State ( gets )
-import Data.Maybe ( isJust )
-import Control.Applicative ((<$>))
+      -- ** 'Message'
+    , sendMessageB
+    , sendMessageWithNoRefreshB
+    , sendMessageWithNoRefreshToCurrentB, sendMessageWithNoRefreshToCurrent
+
+      -- * Utility Functions
+
+      -- ** Send All
+    , sendSomeMessagesB, sendSomeMessages, sendMessagesB, sendMessages
+
+      -- ** Send Until
+    , tryInOrderB, tryInOrderWithNoRefreshToCurrentB, tryInOrderWithNoRefreshToCurrent
+    , tryMessageB, tryMessageWithNoRefreshToCurrentB, tryMessageWithNoRefreshToCurrent
+
+      -- ** Aliases
+    , sm
+    ) where
+
+import XMonad               ( Window )
+import XMonad.Core          ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust )
+import XMonad.Operations    ( updateLayout, windowBracket, modifyWindowSet )
+import XMonad.Prelude
+import XMonad.StackSet      ( Workspace, current, workspace, layout, tag )
+
+import Control.Monad.State  ( gets )
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- > import XMonad.Actions.MessageFeedback
 --
--- You can then use this module's functions wherever an action is expected.
+-- You can then use this module's functions wherever an action is expected. All
+-- feedback variants are supported:
+--
+-- * message to any workspace with no refresh
+-- * message to current workspace with no refresh
+-- * message to current workspace with refresh
+--
+-- Except "message to any workspace with refresh" which makes little sense.
 --
 -- Note that most functions in this module have a return type of @X Bool@
--- whereas configuration options will expect a @X ()@ action.
--- For example, the key binding
+-- whereas configuration options will expect a @X ()@ action. For example, the
+-- key binding:
 --
 -- > -- Shrink the master area of a tiled layout, or move the focused window
 -- > -- to the left in a WindowArranger-based layout
--- > ((modKey, xK_Left), tryMessage Shrink (MoveLeft 50))
+-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrentB Shrink (MoveLeft 50))
 --
--- is mis-typed. For this reason, this module provides alternatives (ending with
--- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@.
--- For example, to correct the previous example:
+-- is mis-typed. For this reason, this module provides alternatives (not ending
+-- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than
+-- 'sendMessageB') that discard their boolean result and return an @X ()@. For
+-- example, to correct the previous example:
 --
--- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50))
+-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrent Shrink (MoveLeft 50))
 --
+-- This module also provides 'SomeMessage' variants of each 'Message' function
+-- for when the messages are of differing types (but still instances of
+-- 'Message'). First box each message using 'SomeMessage' or the convenience
+-- alias 'sm'. Then, for example, to send each message:
+--
+-- > sendSomeMessages [sm messageOfTypeA, sm messageOfTypeB]
+--
+-- This is /not/ equivalent to the following example, which will not refresh
+-- the workspace unless the last message is handled:
+--
+-- > sendMessageWithNoRefreshToCurrent messageOfTypeA >> sendMessage messageOfTypeB
 
 
--- | Behaves like 'XMonad.Operations.sendMessage', but returns True of the
--- message was handled by the layout, False otherwise.
-send :: Message a => a -> X Bool
-send = sendSM . sm
+-- | Variant of 'XMonad.Operations.sendMessage'. Accepts 'SomeMessage'; to use
+-- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled,
+-- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB'
+-- for efficiency this is pretty much an exact copy of the
+-- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'.
+sendSomeMessageB :: SomeMessage -> X Bool
+sendSomeMessageB m = windowBracket id $ do
+    w  <- gets ((workspace . current) . windowset)
+    ml <- handleMessage (layout w) m `catchX` return Nothing
+    whenJust ml $ \l ->
+        modifyWindowSet $ \ws -> ws { current = (current ws)
+                                { workspace = (workspace $ current ws)
+                                    { layout = l }}}
+    return $ isJust ml
 
--- | Sends the first message, and if it was not handled, sends the second.
--- Returns True if either message was handled, False otherwise.
-tryMessage :: (Message a, Message b) => a -> b -> X Bool
-tryMessage m1 m2 = do b <- send m1
-                      if b then return True else send m2
+-- | Variant of 'sendSomeMessageB' that discards the result.
+sendSomeMessage :: SomeMessage -> X ()
+sendSomeMessage = void . sendSomeMessageB
 
-tryMessage_ :: (Message a, Message b) => a -> b -> X ()
-tryMessage_ m1 m2 = tryMessage m1 m2 >> return ()
+-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh'. Accepts
+-- 'SomeMessage'; to use 'Message' see 'sendMessageWithNoRefreshB'. Returns
+-- @True@ if the message was handled, @False@ otherwise.
+sendSomeMessageWithNoRefreshB :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X Bool
+sendSomeMessageWithNoRefreshB m w
+    =   handleMessage (layout w) m `catchX` return Nothing
+    >>= liftA2 (>>) (updateLayout $ tag w) (return . isJust)
 
--- | Tries sending every message of the list in order until one of them
--- is handled. Returns True if one of the messages was handled, False otherwise.
-tryInOrder :: [SomeMessage] -> X Bool
-tryInOrder [] = return False
-tryInOrder (m:ms) = do b <- sendSM m
-                       if b then return True else tryInOrder ms
+-- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result.
+sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X ()
+sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m
 
-tryInOrder_ :: [SomeMessage] -> X ()
-tryInOrder_ ms = tryInOrder ms >> return ()
+-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh' that sends the
+-- message to the current layout. Accepts 'SomeMessage'; to use 'Message' see
+-- 'sendMessageWithNoRefreshToCurrentB'. Returns @True@ if the message was
+-- handled, @False@ otherwise. This function is somewhat of a cross between
+-- 'XMonad.Operations.sendMessage' (sends to the current layout) and
+-- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh).
+sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool
+sendSomeMessageWithNoRefreshToCurrentB m
+    =   gets (workspace . current . windowset)
+    >>= sendSomeMessageWithNoRefreshB m
+
+-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the
+-- result.
+sendSomeMessageWithNoRefreshToCurrent :: SomeMessage -> X ()
+sendSomeMessageWithNoRefreshToCurrent = void . sendSomeMessageWithNoRefreshToCurrentB
 
 
--- | Convenience shorthand for 'XMonad.Core.SomeMessage'.
+-- | Variant of 'sendSomeMessageB' which like 'XMonad.Operations.sendMessage'
+-- accepts 'Message' rather than 'SomeMessage'. Returns @True@ if the message
+-- was handled, @False@ otherwise.
+sendMessageB :: Message a => a -> X Bool
+sendMessageB = sendSomeMessageB . SomeMessage
+
+-- | Variant of 'sendSomeMessageWithNoRefreshB' which like
+-- 'XMonad.Operations.sendMessageWithNoRefresh' accepts 'Message' rather than
+-- 'SomeMessage'. Returns @True@ if the message was handled, @False@ otherwise.
+sendMessageWithNoRefreshB :: Message a => a -> Workspace WorkspaceId (Layout Window) Window -> X Bool
+sendMessageWithNoRefreshB = sendSomeMessageWithNoRefreshB . SomeMessage
+
+-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' which accepts
+-- 'Message' rather than 'SomeMessage'. Returns @True@ if the message was
+-- handled, @False@ otherwise.
+sendMessageWithNoRefreshToCurrentB :: Message a => a -> X Bool
+sendMessageWithNoRefreshToCurrentB = sendSomeMessageWithNoRefreshToCurrentB . SomeMessage
+
+-- | Variant of 'sendMessageWithNoRefreshToCurrentB' that discards the result.
+sendMessageWithNoRefreshToCurrent :: Message a => a -> X ()
+sendMessageWithNoRefreshToCurrent = void . sendMessageWithNoRefreshToCurrentB
+
+
+-- | Send each 'SomeMessage' to the current layout without refresh (using
+-- 'sendSomeMessageWithNoRefreshToCurrentB') and collect the results. If any
+-- message was handled, refresh. If you want to sequence a series of messages
+-- that would have otherwise used 'XMonad.Operations.sendMessage' while
+-- minimizing refreshes, use this.
+sendSomeMessagesB :: [SomeMessage] -> X [Bool]
+sendSomeMessagesB
+    = windowBracket or
+    . mapM sendSomeMessageWithNoRefreshToCurrentB
+
+-- | Variant of 'sendSomeMessagesB' that discards the results.
+sendSomeMessages :: [SomeMessage] -> X ()
+sendSomeMessages = void . sendSomeMessagesB
+
+-- | Variant of 'sendSomeMessagesB' which accepts 'Message' rather than
+-- 'SomeMessage'. Use this if all the messages are of the same type.
+sendMessagesB :: Message a => [a] -> X [Bool]
+sendMessagesB = sendSomeMessagesB . map SomeMessage
+
+-- | Variant of 'sendMessagesB' that discards the results.
+sendMessages :: Message a => [a] -> X ()
+sendMessages = void . sendMessagesB
+
+
+-- | Apply the dispatch function in order to each message of the list until one
+-- is handled. Returns @True@ if so, @False@ otherwise.
+tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
+tryInOrderB _ []     = return False
+tryInOrderB f (m:ms) = do b <- f m
+                          if b then return True else tryInOrderB f ms
+
+-- | Variant of 'tryInOrderB' that sends messages to the current layout without
+-- refresh using 'sendSomeMessageWithNoRefreshToCurrentB'.
+tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool
+tryInOrderWithNoRefreshToCurrentB = tryInOrderB sendSomeMessageWithNoRefreshToCurrentB
+
+-- | Variant of 'tryInOrderWithNoRefreshToCurrent' that discards the results.
+tryInOrderWithNoRefreshToCurrent :: [SomeMessage] -> X ()
+tryInOrderWithNoRefreshToCurrent = void . tryInOrderWithNoRefreshToCurrentB
+
+-- | Apply the dispatch function to the first message, and if it was not
+-- handled, apply it to the second. Returns @True@ if either message was
+-- handled, @False@ otherwise.
+tryMessageB :: (Message a, Message b) => (SomeMessage -> X Bool) -> a -> b -> X Bool
+tryMessageB f m1 m2 = tryInOrderB f [sm m1,sm m2]
+
+-- | Variant of 'tryMessageB' that sends messages to the current layout without
+-- refresh using 'sendMessageWithNoRefreshToCurrentB'.
+tryMessageWithNoRefreshToCurrentB :: (Message a, Message b) => a -> b -> X Bool
+tryMessageWithNoRefreshToCurrentB = tryMessageB sendSomeMessageWithNoRefreshToCurrentB
+
+-- | Variant of 'tryMessage' that discards the results.
+tryMessageWithNoRefreshToCurrent :: (Message a, Message b) => a -> b -> X ()
+tryMessageWithNoRefreshToCurrent m = void . tryMessageWithNoRefreshToCurrentB m
+
+
+-- | Convenience shorthand for 'SomeMessage'.
 sm :: Message a => a -> SomeMessage
 sm = SomeMessage
-
-
-sendSM :: SomeMessage -> X Bool
-sendSM m = do w <- workspace . current <$> gets windowset
-              ml' <- handleMessage (layout w) m `catchX` return Nothing
-              updateLayout (tag w) ml'
-              return $ isJust ml'
-
-
-sendSM_ :: SomeMessage -> X ()
-sendSM_ m = sendSM m >> return ()

XMonad/Actions/Minimize.hs

@@ -0,0 +1,147 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Minimize
+-- Description :  Actions for minimizing and maximizing windows.
+-- Copyright   :  (c) Bogdan Sinitsyn (2016)
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Bogdan Sinitsyn <bogdan.sinitsyn@gmail.com>
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Adds actions for minimizing and maximizing windows
+--
+-- This module should be used with "XMonad.Layout.Minimize". Add 'minimize' to your
+-- layout modifiers as described in "XMonad.Layout.Minimize" and use actions from
+-- this module
+--
+-- Possible keybindings:
+--
+-- >        , ((modm,               xK_m     ), withFocused minimizeWindow)
+-- >        , ((modm .|. shiftMask, xK_m     ), withLastMinimized maximizeWindowAndFocus)
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Minimize
+  ( -- * Usage
+    -- $usage
+    minimizeWindow
+  , maximizeWindow
+  , maximizeWindowAndFocus
+  , withLastMinimized
+  , withLastMinimized'
+  , withFirstMinimized
+  , withFirstMinimized'
+  , withMinimized
+  ) where
+
+import XMonad
+import XMonad.Prelude (fromMaybe, join, listToMaybe)
+import qualified XMonad.StackSet as W
+
+import qualified XMonad.Layout.BoringWindows as BW
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Util.Minimize
+import XMonad.Util.WindowProperties (getProp32)
+
+import Foreign.C.Types (CLong)
+import qualified Data.List as L
+import qualified Data.Map as M
+
+-- $usage
+-- Import this module with "XMonad.Layout.Minimize" and "XMonad.Layout.BoringWindows":
+--
+-- > import XMonad.Actions.Minimize
+-- > import XMonad.Layout.Minimize
+-- > import qualified XMonad.Layout.BoringWindows as BW
+--
+-- Then apply 'minimize' and 'boringWindows' to your layout hook and use some
+-- actions from this module:
+--
+-- > main = xmonad def { layoutHook = minimize . BW.boringWindows $ whatever }
+--
+-- Example keybindings:
+--
+-- >        , ((modm,               xK_m     ), withFocused minimizeWindow      )
+-- >        , ((modm .|. shiftMask, xK_m     ), withLastMinimized maximizeWindow)
+
+setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()
+setMinimizedState win st f = do
+    setWMState win st
+    withDisplay $ \dpy -> do
+        wm_state <- getAtom "_NET_WM_STATE"
+        hidden <- fromIntegral <$> getAtom "_NET_WM_STATE_HIDDEN"
+        wstate <- fromMaybe [] <$> getProp32 wm_state win
+        io $ changeProperty32 dpy win wm_state aTOM propModeReplace (f hidden wstate)
+
+setMinimized :: Window -> X ()
+setMinimized win = setMinimizedState win iconicState (:)
+
+setNotMinimized :: Window -> X ()
+setNotMinimized win = setMinimizedState win normalState L.delete
+
+-- It does not just set minimizedStack to newWindows because it should save
+-- order in which elements were added (newer first)
+modified :: (RectMap -> RectMap) -> X Bool
+modified f = XS.modified $
+    \Minimized { rectMap = oldRectMap, minimizedStack = oldStack } ->
+      let newRectMap = f oldRectMap
+          newWindows = M.keys newRectMap
+       in Minimized { rectMap = newRectMap
+                    , minimizedStack = (newWindows L.\\ oldStack)
+                                       ++
+                                       (oldStack `L.intersect` newWindows)
+                    }
+
+
+-- | Minimize a window
+minimizeWindow :: Window -> X ()
+minimizeWindow w = withWindowSet $ \ws ->
+  whenX (modified $ M.insert w (M.lookup w $ W.floating ws)) $ do
+    setMinimized w
+    windows $ W.sink w
+    BW.focusDown
+
+
+-- | Maximize window and apply a function to maximized window and 'WindowSet'
+maximizeWindowAndChangeWSet :: (Window -> WindowSet -> WindowSet) -> Window -> X ()
+maximizeWindowAndChangeWSet f w = do
+  mrect <- XS.gets (join . M.lookup w . rectMap)
+  whenX (modified $ M.delete w) $ do
+    setNotMinimized w
+    broadcastMessage BW.UpdateBoring
+    windows $ f w . maybe id (W.float w) mrect
+
+-- | Just maximize a window without focusing
+maximizeWindow :: Window -> X ()
+maximizeWindow = maximizeWindowAndChangeWSet $ const id
+
+-- | Maximize a window and then focus it
+maximizeWindowAndFocus :: Window -> X ()
+maximizeWindowAndFocus = maximizeWindowAndChangeWSet W.focusWindow
+
+-- | Perform an action with first minimized window on current workspace
+--   or do nothing if there is no minimized windows on current workspace
+withFirstMinimized :: (Window -> X ()) -> X ()
+withFirstMinimized action = withFirstMinimized' (`whenJust` action)
+
+-- | Like withFirstMinimized but the provided action is always invoked with a
+--   'Maybe Window', that will be nothing if there is no first minimized window.
+withFirstMinimized' :: (Maybe Window -> X ()) -> X ()
+withFirstMinimized' action = withMinimized (action . listToMaybe . reverse)
+
+-- | Perform an action with last minimized window on current workspace
+--   or do nothing if there is no minimized windows on current workspace
+withLastMinimized :: (Window -> X ()) -> X ()
+withLastMinimized action = withLastMinimized' (`whenJust` action)
+
+-- | Like withLastMinimized but the provided action is always invoked with a
+--   'Maybe Window', that will be nothing if there is no last minimized window.
+withLastMinimized' :: (Maybe Window -> X ()) -> X ()
+withLastMinimized' action = withMinimized (action . listToMaybe)
+
+withMinimized :: ([Window] -> X a) -> X a
+withMinimized action = do
+  minimized <- XS.gets minimizedStack
+  currentStack <- withWindowSet $ return . W.index
+  action $ minimized `L.intersect` currentStack

XMonad/Actions/MostRecentlyUsed.hs

@@ -0,0 +1,205 @@
+{-# LANGUAGE NamedFieldPuns, GeneralizedNewtypeDeriving #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.MostRecentlyUsed
+-- Description :  Tab through windows by recency of use.
+-- Copyright   :  (c) 2022 L. S. Leary
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  @LSLeary (on github)
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Based on the Alt+Tab behaviour common outside of xmonad.
+--
+-----------------------------------------------------------------------------
+
+-- --< Imports & Exports >-- {{{
+
+module XMonad.Actions.MostRecentlyUsed (
+
+  -- * Usage
+  -- $usage
+
+  -- * Interface
+  configureMRU,
+  mostRecentlyUsed,
+  withMostRecentlyUsed,
+  Location(..),
+
+  ) where
+
+-- base
+import Data.List.NonEmpty (nonEmpty)
+import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef)
+import Control.Monad.IO.Class (MonadIO)
+
+-- mtl
+import Control.Monad.Trans (lift)
+import Control.Monad.State (get, put, gets)
+
+-- containers
+import qualified Data.Map.Strict as M
+
+-- xmonad
+import XMonad
+  ( Window, KeySym, keyPress, io
+  , Event (DestroyWindowEvent, UnmapEvent, ev_send_event, ev_window)
+  )
+import XMonad.Core
+  ( X, XConfig(..), windowset, WorkspaceId, ScreenId
+  , ExtensionClass(..), StateExtension(..)
+  , waitingUnmap
+  )
+import XMonad.Operations (screenWorkspace)
+import qualified XMonad.StackSet as W
+
+-- xmonad-contrib
+import qualified XMonad.Util.ExtensibleConf  as XC
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Util.PureX
+  (handlingRefresh, curScreenId, curTag, greedyView, view, peek, focusWindow)
+import XMonad.Util.History (History, origin, event, erase, ledger)
+import XMonad.Actions.Repeatable (repeatableSt)
+import XMonad.Prelude
+
+-- }}}
+
+-- --< Core Data Types: WindowHistory & Location >-- {{{
+
+data WindowHistory = WinHist
+  { busy :: !Bool
+  , hist :: !(History Window Location)
+  } deriving (Show, Read)
+
+instance ExtensionClass WindowHistory where
+  initialValue = WinHist
+    { busy = False
+    , hist = origin
+    }
+  extensionType = PersistentExtension
+
+data Location = Location
+  { workspace :: !WorkspaceId
+  , screen    :: !ScreenId
+  } deriving (Show, Read, Eq, Ord)
+
+-- }}}
+
+-- --< Interface >-- {{{
+
+-- $usage
+--
+-- 'configureMRU' must be applied to your config in order for 'mostRecentlyUsed'
+-- to work.
+--
+-- > main :: IO ()
+-- > main = xmonad . configureMRU . ... $ def
+-- >   { ...
+-- >   }
+--
+-- Once that's done, it can be used normally in keybinds:
+--
+-- > , ((mod1Mask, xK_Tab), mostRecentlyUsed [xK_Alt_L, xK_Alt_R] xK_Tab)
+--
+-- N.B.: This example assumes that 'mod1Mask' corresponds to alt, which is not
+-- always the case, depending on how your system is configured.
+
+-- | Configure xmonad to support 'mostRecentlyUsed'.
+configureMRU :: XConfig l -> XConfig l
+configureMRU = XC.once f (MRU ()) where
+  f cnf = cnf
+    { logHook         = logHook         cnf <> logWinHist
+    , handleEventHook = handleEventHook cnf <> winHistEH
+    }
+newtype MRU = MRU () deriving Semigroup
+
+-- | An action to browse through the history of focused windows, taking
+--   another step back with each tap of the key.
+mostRecentlyUsed
+  :: [KeySym] -- ^ The 'KeySym's corresponding to the modifier to which the
+              --   action is bound.
+  -> KeySym   -- ^ The 'KeySym' corresponding to the key to which the action
+              --   is bound.
+  -> X ()
+mostRecentlyUsed mods key = do
+  (toUndo, undo) <- undoer
+  let undoably curThing withThing thing = curThing >>= \cur ->
+        when (cur /= thing) $ withThing thing >> toUndo (withThing cur)
+  withMostRecentlyUsed mods key $ \win Location{workspace,screen} ->
+    handlingRefresh $ do
+      undo
+      undoably curScreenId viewScreen screen
+      undoably curTag      greedyView workspace
+      mi <- gets (W.findTag win . windowset)
+      for_ mi $ \i -> do
+        undoably curTag greedyView i
+        mfw <- peek
+        for_ mfw $ \fw -> do
+          undoably (pure fw) focusWindow win
+  where
+    undoer :: (MonadIO m, Monoid a) => m (m a -> m (), m a)
+    undoer = do
+      ref <- io . newIORef $ pure mempty
+      let toUndo = io . modifyIORef ref . liftA2 (<>)
+          undo   = join (io $ readIORef ref)
+                <* io (writeIORef ref $ pure mempty)
+      pure (toUndo, undo)
+    viewScreen :: ScreenId -> X Any
+    viewScreen scr = screenWorkspace scr >>= foldMap view
+
+-- | A version of 'mostRecentlyUsed' that allows you to customise exactly what
+--   is done with each window you tab through (the default being to visit its
+--   previous 'Location' and give it focus).
+withMostRecentlyUsed
+  :: [KeySym]                     -- ^ The 'KeySym's corresponding to the
+                                  --   modifier to which the action is bound.
+  -> KeySym                       -- ^ The 'KeySym' corresponding to the key to
+                                  --   which the action is bound.
+  -> (Window -> Location -> X ()) -- ^ The function applied to each window.
+  -> X ()
+withMostRecentlyUsed mods tab preview = do
+  wh@WinHist{busy,hist} <- XS.get
+  unless busy $ do
+    XS.put wh{ busy = True }
+
+    for_ (nonEmpty $ ledger hist) $ \ne -> do
+      mfw <- gets (W.peek . windowset)
+      let iSt = case cycleS ne of
+            (w, _) :~ s | mfw == Just w -> s
+            s                           -> s
+      repeatableSt iSt mods tab $ \t s ->
+        when (t == keyPress && s == tab) (pop >>= lift . uncurry preview)
+
+    XS.modify $ \ws@WinHist{} -> ws{ busy = False }
+    logWinHist
+  where
+    pop = do
+      h :~ t <- get
+      put t $> h
+
+-- }}}
+
+-- --< Raw Config >-- {{{
+
+logWinHist :: X ()
+logWinHist = do
+  wh@WinHist{busy,hist} <- XS.get
+  unless busy $ do
+    cs <- gets (W.current . windowset)
+    let cws = W.workspace cs
+    for_ (W.stack cws) $ \st -> do
+      let location = Location{ workspace = W.tag cws, screen = W.screen cs }
+      XS.put wh{ hist = event (W.focus st) location hist }
+
+winHistEH :: Event -> X All
+winHistEH ev = All True <$ case ev of
+  UnmapEvent{ ev_send_event = synth, ev_window = w } -> do
+    e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
+    when (synth || e == 0) (collect w)
+  DestroyWindowEvent{                ev_window = w } -> collect w
+  _                                                  -> pure ()
+  where collect w = XS.modify $ \wh@WinHist{hist} -> wh{ hist = erase w hist }
+
+-- }}}

XMonad/Actions/MouseGestures.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.MouseGestures
+-- Description :  Support for simple mouse gestures.
 -- Copyright   :  (c) Lukas Mai
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -21,18 +22,17 @@ module XMonad.Actions.MouseGestures (
     mkCollect
 ) where
 
+import XMonad.Prelude
 import XMonad
 import XMonad.Util.Types (Direction2D(..))
 
 import Data.IORef
 import qualified Data.Map as M
 import Data.Map (Map)
-import Data.Maybe
-import Control.Monad
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- > import XMonad.Actions.MouseGestures
 -- > import qualified XMonad.StackSet as W
@@ -79,17 +79,11 @@ gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Pos
 gauge hook op st nx ny = do
     let np = (nx, ny)
     stx <- io $ readIORef st
-    let
-        (~(Just od), pivot) = case stx of
-            Nothing -> (Nothing, op)
-            Just (d, zp) -> (Just d, zp)
-        cont = do
-            guard $ significant np pivot
-            return $ do
-                let d' = dir pivot np
-                when (isNothing stx || od /= d') $ hook d'
-                io $ writeIORef st (Just (d', np))
-    fromMaybe (return ()) cont
+    let pivot = maybe op snd stx
+    when (significant np pivot) $ do
+        let d' = dir pivot np
+        when ((fst <$> stx) /= Just d') $ hook d'
+        io $ writeIORef st (Just (d', np))
     where
     significant a b = delta a b >= 10
 
@@ -111,7 +105,7 @@ mouseGestureH moveHook endHook = do
 mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
 mouseGesture tbl win = do
     (mov, end) <- mkCollect
-    mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest ->
+    mouseGestureH (void . mov) $ end >>= \gest ->
         case M.lookup gest tbl of
             Nothing -> return ()
             Just f -> f win

XMonad/Actions/MouseResize.hs

@@ -1,8 +1,9 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
 
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.MouseResize
+-- Description :  A layout modifier to resize windows with the mouse.
 -- Copyright   :  (c) 2007 Andrea Rossato
 -- License     :  BSD-style (see xmonad/LICENSE)
 --
@@ -36,7 +37,7 @@ import XMonad.Util.XUtils
 -- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness".
 --
 -- You can use this module with the following in your
--- @~\/.xmonad\/xmonad.hs@:
+-- @xmonad.hs@:
 --
 -- > import XMonad.Actions.MouseResize
 -- > import XMonad.Layout.WindowArranger
@@ -49,14 +50,14 @@ import XMonad.Util.XUtils
 --
 -- > main = xmonad def { layoutHook = myLayout }
 --
--- For more detailed instructions on editing the layoutHook see:
---
--- "XMonad.Doc.Extending#Editing_the_layout_hook"
+-- For more detailed instructions on editing the layoutHook see
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
+-- "XMonad.Doc.Extending#Editing_the_layout_hook".
 
 mouseResize :: l a -> ModifiedLayout MouseResize l a
 mouseResize = ModifiedLayout (MR [])
 
-data MouseResize a = MR [((a,Rectangle),Maybe a)]
+newtype MouseResize a = MR [((a,Rectangle),Maybe a)]
 instance Show (MouseResize a) where show        _ = ""
 instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
 
@@ -68,7 +69,7 @@ instance LayoutModifier MouseResize Window where
         where
           wrs'         = wrs_to_state [] . filter (isInStack s . fst) $ wrs
           initState    = mapM createInputWindow wrs'
-          processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs'
+          processState = mapM_ (deleteInputWin . snd) st >> mapM createInputWindow wrs'
 
           inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10
 
@@ -105,7 +106,7 @@ handleResize st ButtonEvent { ev_window = ew, ev_event_type = et }
 handleResize _ _ = return ()
 
 createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
-createInputWindow ((w,r),mr) = do
+createInputWindow ((w,r),mr) =
   case mr of
     Just tr  -> withDisplay $ \d -> do
                   tw <- mkInputWindow d tr

XMonad/Actions/Navigation2D.hs

@@ -1,8 +1,9 @@
-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}
 
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.Navigation2D
+-- Description :  Directional navigation of windows and screens.
 -- Copyright   :  (c) 2011  Norbert Zeh <nzeh@cs.dal.ca>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -39,11 +40,12 @@ module XMonad.Actions.Navigation2D ( -- * Usage
                                    , withNavigation2DConfig
                                    , Navigation2DConfig(..)
                                    , def
-                                   , defaultNavigation2DConfig
                                    , Navigation2D
                                    , lineNavigation
                                    , centerNavigation
-                                   , hybridNavigation
+                                   , sideNavigation
+                                   , sideNavigationWithBias
+                                   , hybridOf
                                    , fullScreenRect
                                    , singleWindowRect
                                    , switchLayer
@@ -55,33 +57,35 @@ module XMonad.Actions.Navigation2D ( -- * Usage
                                    , Direction2D(..)
                                    ) where
 
-import Control.Applicative
 import qualified Data.List as L
 import qualified Data.Map as M
-import Data.Maybe
+import Control.Arrow (second)
+import XMonad.Prelude
 import XMonad hiding (Screen)
 import qualified XMonad.StackSet as W
 import qualified XMonad.Util.ExtensibleState as XS
 import XMonad.Util.EZConfig (additionalKeys, additionalKeysP)
 import XMonad.Util.Types
+import qualified Data.List.NonEmpty as NE
 
 -- $usage
 -- #Usage#
 -- Navigation2D provides directional navigation (go left, right, up, down) for
 -- windows and screens.  It treats floating and tiled windows as two separate
 -- layers and provides mechanisms to navigate within each layer and to switch
--- between layers.  Navigation2D provides two different navigation strategies
--- (see <#Technical_Discussion> for details): /Line navigation/ feels rather
--- natural but may make it impossible to navigate to a given window from the
--- current window, particularly in the floating layer.  /Center navigation/
--- feels less natural in certain situations but ensures that all windows can be
--- reached without the need to involve the mouse. A third option is to use
--- /Hybrid navigation/, which automatically chooses between the two whenever
--- navigation is attempted.  Navigation2D allows different navigation strategies
--- to be used in the two layers and allows customization of the navigation strategy
--- for the tiled layer based on the layout currently in effect.
+-- between layers.  Navigation2D provides three different navigation strategies
+-- (see <#Technical_Discussion> for details): /Line navigation/ and
+-- /Side navigation/ feel rather natural but may make it impossible to navigate
+-- to a given window from the current window, particularly in the floating
+-- layer. /Center navigation/ feels less natural in certain situations but
+-- ensures that all windows can be reached without the need to involve the
+-- mouse. Another option is to use a /Hybrid/ of the three strategies,
+-- automatically choosing whichever first provides a suitable target window.
+-- Navigation2D allows different navigation strategies to be used in the two
+-- layers and allows customization of the navigation strategy for the tiled
+-- layer based on the layout currently in effect.
 --
--- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with (a subset of) the following in your @xmonad.hs@:
 --
 -- > import XMonad.Actions.Navigation2D
 --
@@ -94,17 +98,25 @@ import XMonad.Util.Types
 -- >                              False
 -- >               $ def
 --
--- Alternatively, you can use navigation2DP:
+-- /NOTE/: the @def@ argument to 'navigation2D' contains the strategy
+-- that decides which windows actually get selected.  While the default
+-- behaviour tries to keep them into account, if you use modules that
+-- influence tiling in some way, like "XMonad.Layout.Spacing" or
+-- "XMonad.Layout.Gaps", you should think about using a different
+-- strategy, if you find the default behaviour to be unnatural.  Check
+-- out the [finer points](#g:Finer_Points) below for more information.
 --
--- > main = xmonad $ navigation2D def
--- >                              ("<Up>", "<Left>", "<Down>", "<Right>")
--- >                              [("M-",   windowGo  ),
--- >                               ("M-S-", windowSwap)]
--- >                              False
+-- Alternatively to 'navigation2D', you can use 'navigation2DP':
+--
+-- > main = xmonad $ navigation2DP def
+-- >                               ("<Up>", "<Left>", "<Down>", "<Right>")
+-- >                               [("M-",   windowGo  ),
+-- >                                ("M-S-", windowSwap)]
+-- >                               False
 -- >               $ def
 --
 -- That's it. If instead you'd like more control, you can combine
--- withNavigation2DConfig and additionalNav2DKeys or additionalNav2DKeysP:
+-- 'withNavigation2DConfig' and 'additionalNav2DKeys' or 'additionalNav2DKeysP':
 --
 -- > main = xmonad $ withNavigation2DConfig def
 -- >               $ additionalNav2DKeys (xK_Up, xK_Left, xK_Down, xK_Right)
@@ -158,7 +170,7 @@ import XMonad.Util.Types
 --
 -- For detailed instruction on editing the key binding see:
 --
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- $finer_points
 -- #Finer_Points#
@@ -175,9 +187,19 @@ import XMonad.Util.Types
 -- values in the above example to 'True'.  You could also decide you want
 -- wrapping only for a subset of the operations and no wrapping for others.
 --
--- By default, all layouts use the 'defaultTiledNavigation' strategy specified
--- in the 'Navigation2DConfig' (by default, line navigation is used).  To
--- override this behaviour for some layouts, add a pair (\"layout name\",
+-- By default, all layouts use the 'defaultTiledNavigation' strategy
+-- specified in the 'Navigation2DConfig' (by default, line navigation is
+-- used).  Many more navigation strategies are available; some may feel
+-- more natural, depending on the layout and user:
+--
+--   * 'lineNavigation'
+--   * 'centerNavigation'
+--   * 'sideNavigation'
+--   * 'sideNavigationWithBias'
+--
+-- There is also the ability to combine two strategies with 'hybridOf'.
+--
+-- To override the default behaviour for some layouts, add a pair (\"layout name\",
 -- navigation strategy) to the 'layoutNavigation' list in the
 -- 'Navigation2DConfig', where \"layout name\" is the string reported by the
 -- layout's description method (normally what is shown as the layout name in
@@ -318,12 +340,42 @@ lineNavigation = N 1 doLineNavigation
 centerNavigation :: Navigation2D
 centerNavigation = N 2 doCenterNavigation
 
--- | Hybrid navigation. This attempts Line navigation, then falls back on Center
--- navigation if it does not find any suitable target windows. This is useful since
--- Line navigation tends to fail on gaps, but provides more intuitive motions
--- when it succeeds—provided there are no floating windows.
-hybridNavigation :: Navigation2D
-hybridNavigation = N 2 doHybridNavigation
+-- | Side navigation. Consider navigating to the right this time. The strategy
+-- is to take the line segment forming the right boundary of the current window,
+-- and push it to the right until it intersects with at least one other window.
+-- Of those windows, one with a point that is the closest to the centre of the
+-- line (+1) is selected. This is probably the most intuitive strategy for the
+-- tiled layer when using "XMonad.Layout.Spacing".
+sideNavigation :: Navigation2D
+sideNavigation = N 1 (doSideNavigationWithBias 1)
+
+-- | Side navigation with bias. Consider a case where the screen is divided
+-- up into three vertical panes; the side panes occupied by one window each and
+-- the central pane split across the middle by two windows. By the criteria
+-- of side navigation, the two central windows are equally good choices when
+-- navigating inwards from one of the side panes. Hence in order to be
+-- equitable, symmetric and pleasant to use, different windows are chosen when
+-- navigating from different sides. In particular, the lower is chosen when
+-- going left and the higher when going right, causing L, L, R, R, L, L, etc to
+-- cycle through the four windows clockwise. This is implemented by using a bias
+-- of 1. /Bias/ is how many pixels off centre the vertical split can be before
+-- this behaviour is lost and the same window chosen every time. A negative bias
+-- swaps the preferred window for each direction. A bias of zero disables the
+-- behaviour.
+sideNavigationWithBias :: Int -> Navigation2D
+sideNavigationWithBias b = N 1 (doSideNavigationWithBias b)
+
+-- | Hybrid of two modes of navigation, preferring the motions of the first.
+-- Use this if you want to fall back on a second strategy whenever the first
+-- does not find a candidate window. E.g.
+-- @hybridOf lineNavigation centerNavigation@ is a good strategy for the
+-- floating layer, and @hybridOf sideNavigation centerNavigation@ will enable
+-- you to take advantage of some of the latter strategy's more interesting
+-- motions in the tiled layer.
+hybridOf :: Navigation2D -> Navigation2D -> Navigation2D
+hybridOf (N g1 s1) (N g2 s2) = N (max g1 g2) $ applyToBoth s1 s2
+  where
+    applyToBoth f g a b c = f a b c <|> g a b c
 
 -- | Stores the configuration of directional navigation. The 'Default' instance
 -- uses line navigation for the tiled layer and for navigation between screens,
@@ -347,10 +399,10 @@ data Navigation2DConfig = Navigation2DConfig
                                                        -- function calculates a rectangle for a given unmapped
                                                        -- window from the screen it is on and its window ID.
                                                        -- See <#Finer_Points> for how to use this.
-  } deriving Typeable
+  }
 
 -- | Shorthand for the tedious screen type
-type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
+type Screen = WindowScreen
 
 -- | Convenience function for enabling Navigation2D with typical keybindings.
 -- Takes a Navigation2DConfig, an (up, left, down, right) tuple, a mapping from
@@ -395,7 +447,7 @@ additionalNav2DKeys (u, l, d, r) modifiers wrap =
 -- mapping from key prefix to action, and a bool to indicate if wrapping should
 -- occur, and returns a function from XConfig to XConfig. Example:
 --
--- >  additionalNav2DKeysP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig
+-- >  additionalNav2DKeysP ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig
 additionalNav2DKeysP :: (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->
                         Bool -> XConfig l -> XConfig l
 additionalNav2DKeysP (u, l, d, r) modifiers wrap =
@@ -412,12 +464,8 @@ withNavigation2DConfig conf2d xconf = xconf { startupHook  = startupHook xconf
                                                           >> XS.put conf2d
                                             }
 
-{-# DEPRECATED defaultNavigation2DConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.Navigation2D) instead." #-}
-defaultNavigation2DConfig :: Navigation2DConfig
-defaultNavigation2DConfig = def
-
 instance Default Navigation2DConfig where
-    def                   = Navigation2DConfig { defaultTiledNavigation = lineNavigation
+    def                   = Navigation2DConfig { defaultTiledNavigation = hybridOf lineNavigation sideNavigation
                                                , floatNavigation        = centerNavigation
                                                , screenNavigation       = lineNavigation
                                                , layoutNavigation       = []
@@ -443,7 +491,7 @@ switchLayer = actOnLayer otherLayer
 -- navigation should wrap around (e.g., from the left edge of the leftmost
 -- screen to the right edge of the rightmost screen).
 windowGo :: Direction2D -> Bool -> X ()
-windowGo dir wrap = actOnLayer thisLayer
+windowGo dir = actOnLayer thisLayer
                                ( \ conf cur wins -> windows
                                  $ doTiledNavigation conf dir W.focusWindow cur wins
                                )
@@ -453,7 +501,6 @@ windowGo dir wrap = actOnLayer thisLayer
                                ( \ conf cur wspcs -> windows
                                  $ doScreenNavigation conf dir W.view cur wspcs
                                )
-                               wrap
 
 -- | Swaps the current window with the next window in the given direction and in
 -- the same layer as the current window.  (In the floating layer, all that
@@ -462,7 +509,7 @@ windowGo dir wrap = actOnLayer thisLayer
 -- window's screen but retains its position and size relative to the screen.)
 -- The second argument indicates wrapping (see 'windowGo').
 windowSwap :: Direction2D -> Bool -> X ()
-windowSwap dir wrap = actOnLayer thisLayer
+windowSwap dir = actOnLayer thisLayer
                                  ( \ conf cur wins -> windows
                                    $ doTiledNavigation conf dir swap cur wins
                                  )
@@ -470,32 +517,28 @@ windowSwap dir wrap = actOnLayer thisLayer
                                    $ doFloatNavigation conf dir swap cur wins
                                  )
                                  ( \ _ _ _ -> return () )
-                                 wrap
 
 -- | Moves the current window to the next screen in the given direction.  The
 -- second argument indicates wrapping (see 'windowGo').
 windowToScreen :: Direction2D -> Bool -> X ()
-windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows
+windowToScreen dir = actOnScreens ( \ conf cur wspcs -> windows
                                          $ doScreenNavigation conf dir W.shift cur wspcs
                                        )
-                                       wrap
 
 -- | Moves the focus to the next screen in the given direction.  The second
 -- argument indicates wrapping (see 'windowGo').
 screenGo :: Direction2D -> Bool -> X ()
-screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows
+screenGo dir = actOnScreens ( \ conf cur wspcs -> windows
                                    $ doScreenNavigation conf dir W.view cur wspcs
                                  )
-                                 wrap
 
 -- | Swaps the workspace on the current screen with the workspace on the screen
 -- in the given direction.  The second argument indicates wrapping (see
 -- 'windowGo').
 screenSwap :: Direction2D -> Bool -> X ()
-screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows
+screenSwap dir = actOnScreens ( \ conf cur wspcs -> windows
                                      $ doScreenNavigation conf dir W.greedyView cur wspcs
                                    )
-                                   wrap
 
 -- | Maps each window to a fullscreen rect.  This may not be the same rectangle the
 -- window maps to under the Full layout or a similar layout if the layout
@@ -587,11 +630,8 @@ actOnScreens act wrap = withWindowSet $ \winset -> do
 
 -- | Determines whether a given window is mapped
 isMapped :: Window -> X Bool
-isMapped win  =  withDisplay
-              $  \dpy -> io
-              $  (waIsUnmapped /=)
-              .  wa_map_state
-             <$> getWindowAttributes dpy win
+isMapped = fmap (maybe False ((waIsUnmapped /=) .  wa_map_state))
+         . safeGetWindowAttributes
 
 ----------------------------------------------------------------------------------------------------
 ----------------------------------------------------------------------------------------------------
@@ -615,7 +655,7 @@ doFocusClosestWindow (cur, rect) winrects
   where
     ctr     = centerOf rect
     winctrs = filter ((cur /=) . fst)
-            $ map (\(w, r) -> (w, centerOf r)) winrects
+            $ map (second centerOf) winrects
     closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2
                                    | otherwise                   = wc1
 
@@ -635,8 +675,7 @@ doTiledNavigation conf dir act cur winrects winset
     nav     = maximum
             $ map ( fromMaybe (defaultTiledNavigation conf)
                   . flip L.lookup (layoutNavigation conf)
-                  )
-            $ layouts
+                  ) layouts
 
 -- | Implements navigation for the float layer
 doFloatNavigation :: Navigation2DConfig
@@ -681,7 +720,7 @@ doLineNavigation dir (cur, rect) winrects
 
     -- The list of windows that are candidates to receive focus.
     winrects'     = filter dirFilter
-                  $ filter ((cur /=) . fst)
+                  . filter ((cur /=) . fst)
                   $ winrects
 
     -- Decides whether a given window matches the criteria to be a candidate to
@@ -722,9 +761,8 @@ doCenterNavigation dir (cur, rect) winrects
     -- center rotated so the right cone becomes the relevant cone.
     -- The windows are ordered in the order they should be preferred
     -- when they are otherwise tied.
-    winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r))
-            $ stackTransform
-            $ winrects
+    winctrs = map (second (dirTransform . centerOf))
+            $ stackTransform winrects
 
     -- Give preference to windows later in the stack for going left or up and to
     -- windows earlier in the stack for going right or down.  (The stack order
@@ -746,8 +784,7 @@ doCenterNavigation dir (cur, rect) winrects
 
     -- All the points that coincide with the current center and succeed it
     -- in the (appropriately ordered) window stack.
-    onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr
-             -- tail should be safe here because cur should be in onCtr
+    onCtr' = L.drop 1 $ L.dropWhile ((cur /=) . fst) onCtr
 
     -- All the points that do not coincide with the current center and which
     -- lie in the (rotated) right cone.
@@ -767,12 +804,53 @@ doCenterNavigation dir (cur, rect) winrects
                                              -- or it has the same distance but comes later
                                              -- in the window stack
 
--- | Implements Hybrid navigation. This attempts Line navigation first,
--- then falls back on Center navigation if it finds no suitable target window.
-doHybridNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
-doHybridNavigation = applyToBoth (<|>) doLineNavigation doCenterNavigation
-    where
-        applyToBoth f g h a b c = f (g a b c) (h a b c)
+-- x -y w h format is a pain. Let's use side coordinates. We assume x1 <= x2 and
+-- y1 <= y2, and make the assumption valid by initialising SideRects with the
+-- property and carefully preserving it over any individual transformation.
+data SideRect = SideRect { x1 :: Int, x2 :: Int, y1 :: Int, y2 :: Int }
+  deriving Show
+
+-- Conversion from Rectangle format to SideRect.
+toSR :: Rectangle -> SideRect
+toSR (Rectangle x y w h) = SideRect (fi x) (fi x + fi w) (-fi y - fi h) (-fi y)
+
+-- Implements side navigation with bias.
+doSideNavigationWithBias ::
+  Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
+doSideNavigationWithBias bias dir (cur, rect)
+  = fmap fst . listToMaybe
+  . L.sortOn dist . foldr acClosest []
+  . filter (`toRightOf` (cur, transform rect))
+  . map (fmap transform)
+  where
+    -- Getting the center of the current window so we can make it the new origin.
+    cOf r = ((x1 r + x2 r) `div` 2, (y1 r + y2 r) `div` 2)
+    (x0, y0) = cOf . toSR $ rect
+
+    -- Translate the given SideRect by (-x0, -y0).
+    translate r = SideRect (x1 r - x0) (x2 r - x0) (y1 r - y0) (y2 r - y0)
+
+    -- Rotate the given SideRect 90 degrees counter-clockwise about the origin.
+    rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r)
+
+    -- Apply the above function until d becomes synonymous with R (wolog).
+    rotateToR d = fromJust . lookup d . zip [R, D, L, U] . iterate rHalfPiCC
+
+    transform = rotateToR dir . translate . toSR
+
+    -- (_, r) `toRightOf` (_, c) iff r has points to the right of c that aren't
+    -- below or above c, i.e. iff:
+    -- [x1 r, x2 r] x [y1 r, y2 r] intersects (x2 c, infinity) x (y1 c, y2 c)
+    toRightOf (_, r) (_, c) = (x2 r > x2 c) && (y2 r > y1 c) && (y1 r < y2 c)
+
+    -- Greedily accumulate the windows tied for the leftmost left side.
+    acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l
+                                   | x1 r >  x1 r' =          l
+    acClosest (w, r) _                             = [(w, r)]
+
+    -- Given a (_, SideRect), calculate how far it is from the y=bias line.
+    dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0
+                | otherwise = min (abs $ y1 r - bias) (abs $ y2 r - bias)
 
 -- | Swaps the current window with the window given as argument
 swap :: Window -> WindowSet -> WindowSet
@@ -789,7 +867,7 @@ swap win winset = W.focusWindow cur
     visws    = map W.workspace scrs
 
     -- The focused windows of the visible workspaces
-    focused  = mapMaybe (\ws -> W.focus <$> W.stack ws) visws
+    focused  = mapMaybe (fmap W.focus . W.stack) visws
 
     -- The window lists of the visible workspaces
     wins     = map (W.integrate' . W.stack) visws
@@ -806,22 +884,18 @@ swap win winset = W.focusWindow cur
     -- Reconstruct the workspaces' window stacks to reflect the swap.
     newvisws  = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins
     newscrs   = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws
-    newwinset = winset { W.current = head newscrs
-                       , W.visible = tail newscrs
+    newwinset = winset { W.current = NE.head (notEmpty newscrs) -- Always at least one screen.
+                       , W.visible = drop 1 newscrs
                        }
 
 -- | Calculates the center of a rectangle
 centerOf :: Rectangle -> (Position, Position)
 centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2)
 
--- | Shorthand for integer conversions
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral
-
 -- | Functions to choose the subset of windows to operate on
 thisLayer, otherLayer :: a -> a -> a
-thisLayer  = curry fst
-otherLayer = curry snd
+thisLayer  = const
+otherLayer _ x = x
 
 -- | Returns the list of visible workspaces and their screen rects
 visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
@@ -858,8 +932,8 @@ wrapOffsets winset = (max_x - min_x, max_y - min_y)
   where
     min_x = fi $ minimum $ map rect_x rects
     min_y = fi $ minimum $ map rect_y rects
-    max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width  r)) rects
-    max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects
+    max_x = fi $ maximum $ map (\r -> rect_x r + fi (rect_width  r)) rects
+    max_y = fi $ maximum $ map (\r -> rect_y r + fi (rect_height r)) rects
     rects = map snd $ visibleWorkspaces winset False
 
 
@@ -869,16 +943,16 @@ sortedScreens :: WindowSet -> [Screen]
 sortedScreens winset = L.sortBy cmp
                      $ W.screens winset
   where
-    cmp s1 s2 | x1 < x2   = LT
-              | x1 > x2   = GT
-              | y1 < x2   = LT
-              | y1 > y2   = GT
+    cmp s1 s2 | x < x'   = LT
+              | x > x'   = GT
+              | y < x'   = LT
+              | y > y'   = GT
               | otherwise = EQ
       where
-        (x1, y1) = centerOf (screenRect . W.screenDetail $ s1)
-        (x2, y2) = centerOf (screenRect . W.screenDetail $ s2)
+        (x , y ) = centerOf (screenRect . W.screenDetail $ s1)
+        (x', y') = centerOf (screenRect . W.screenDetail $ s2)
 
 
 -- | Calculates the L1-distance between two points.
 lDist :: (Position, Position) -> (Position, Position) -> Int
-lDist (x1, y1) (x2, y2) = abs (fi $ x1 - x2) + abs (fi $ y1 - y2)
+lDist (x, y) (x', y') = abs (fi $ x - x') + abs (fi $ y - y')

XMonad/Actions/NoBorders.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.NoBorders
+-- Description :  Helper functions for dealing with window borders.
 -- Copyright   :  (c) Lukas Mai
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -26,8 +27,7 @@ import XMonad
 toggleBorder :: Window -> X ()
 toggleBorder w = do
     bw <- asks (borderWidth . config)
-    withDisplay $ \d -> io $ do
-        cw <- wa_border_width `fmap` getWindowAttributes d w
-        if cw == 0
+    withDisplay $ \d -> withWindowAttributes d w $ \wa -> io $
+        if wa_border_width wa == 0
             then setWindowBorderWidth d w bw
             else setWindowBorderWidth d w 0

XMonad/Actions/OnScreen.hs

@@ -1,157 +1,187 @@
------------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.OnScreen
--- Copyright   :  (c) 2009 Nils Schweinsberg
+-- Description :  Control workspaces on different screens (in xinerama mode).
+-- 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'
-    , Focus(..)
-    , viewOnScreen
-    , greedyViewOnScreen
-    , onlyOnScreen
-    , toggleOnScreen
-    , toggleGreedyOnScreen
-    ) where
+    onScreen,
+    onScreen',
+    Focus (..),
+    viewOnScreen,
+    greedyViewOnScreen,
+    onlyOnScreen,
+    toggleOnScreen,
+    toggleGreedyOnScreen,
+  )
+where
 
 import XMonad
+import XMonad.Prelude (empty, fromMaybe, guard)
 import XMonad.StackSet hiding (new)
 
-import Control.Monad (guard)
--- import Control.Monad.State.Class (gets)
-import Data.Maybe (fromMaybe)
-
-
 -- | Focus data definitions
-data Focus = FocusNew                       -- ^ always focus the new screen
-           | FocusCurrent                   -- ^ always keep the focus on the current screen
-           | FocusTag WorkspaceId           -- ^ always focus tag i on the new stack
-           | FocusTagVisible WorkspaceId    -- ^ focus tag i only if workspace with tag i is visible on the old stack
-
+data Focus
+  = -- | always focus the new screen
+    FocusNew
+  | -- | 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
-         -> Focus                    -- ^ what to do with the focus
-         -> ScreenId                 -- ^ screen id
-         -> WindowSet                -- ^ current stack
-         -> WindowSet
+onScreen ::
+  -- | function to run
+  (WindowSet -> WindowSet) ->
+  -- | what to do with the focus
+  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
-
-    return $ setFocus foc st fStack
+  let fStack = f $ view ws st
 
+  return $ setFocus foc st fStack
 
 -- set focus for new stack
-setFocus :: Focus
-         -> WindowSet -- ^ old stack
-         -> WindowSet -- ^ new stack
-         -> WindowSet
-setFocus FocusNew _ new             = new
-setFocus FocusCurrent old new        =
-    case lookupWorkspace (screen $ current old) new of
-         Nothing -> new
-         Just i -> view i new
-setFocus (FocusTag i) _ new         = view i new
+setFocus ::
+  Focus ->
+  -- | old stack
+  WindowSet ->
+  -- | new stack
+  WindowSet ->
+  WindowSet
+setFocus FocusNew _ new = new
+setFocus FocusCurrent old 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)
-       then setFocus (FocusTag i) old new
-       else setFocus FocusCurrent old new
+  if i `elem` map (tag . workspace) (visible old)
+    then setFocus (FocusTag i) 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
-          -> Focus      -- ^ focus
-          -> ScreenId   -- ^ screen id
-          -> X ()
+onScreen' ::
+  -- | X function to run
+  X () ->
+  -- | focus
+  Focus ->
+  -- | screen id
+  ScreenId ->
+  X ()
 onScreen' x foc sc = do
-    st <- gets windowset
-    case lookupWorkspace sc st of
-         Nothing -> return ()
-         Just ws -> do
-             windows $ view ws
-             x
-             windows $ setFocus foc st
-
+  st <- gets windowset
+  case lookupWorkspace sc st of
+    Nothing -> return ()
+    Just ws -> do
+      windows $ view ws
+      x
+      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
-             -> WorkspaceId -- ^ index of the workspace
-             -> WindowSet   -- ^ current stack
-             -> WindowSet
+viewOnScreen ::
+  -- | screen id
+  ScreenId ->
+  -- | 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
-                   -> WorkspaceId -- ^ index of the workspace
-                   -> WindowSet   -- ^ current stack
-                   -> WindowSet
+greedyViewOnScreen ::
+  -- | screen id
+  ScreenId ->
+  -- | 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
-             -> WorkspaceId -- ^ index of the workspace
-             -> WindowSet   -- ^ current stack
-             -> WindowSet
+onlyOnScreen ::
+  -- | screen id
+  ScreenId ->
+  -- | 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
-               -> WorkspaceId -- ^ index of the workspace
-               -> WindowSet   -- ^ current stack
-               -> WindowSet
+toggleOnScreen ::
+  -- | screen id
+  ScreenId ->
+  -- | 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
-                     -> WorkspaceId -- ^ index of the workspace
-                     -> WindowSet   -- ^ current stack
-                     -> WindowSet
+toggleGreedyOnScreen ::
+  -- | screen id
+  ScreenId ->
+  -- | 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
-              -> WorkspaceId                               -- ^ tag to look for
-              -> WindowSet                                 -- ^ current stackset
-              -> WindowSet
+toggleOrView' ::
+  -- | function to run
+  (WorkspaceId -> WindowSet -> WindowSet) ->
+  -- | tag to look for
+  WorkspaceId ->
+  -- | current stackset
+  WindowSet ->
+  WindowSet
 toggleOrView' f i st = fromMaybe (f i st) $ do
-    let st' = hidden st
-    -- make sure we actually have to do something
-    guard $ i == (tag . workspace $ current st)
-    guard $ not (null st')
-    -- finally, toggle!
-    return $ f (tag . head $ st') st
-
+  let st' = hidden st
+  -- make sure we actually have to do something
+  guard $ i == (tag . workspace $ current st)
+  case st' of
+    [] -> empty
+    (h : _) -> return $ f (tag h) st -- finally, toggle!
 
 -- $usage
 --
 -- This module provides an easy way to control, what you see on other screens in
 -- xinerama mode without having to focus them. Put this into your
--- @~\/.xmonad\/xmonad.hs@:
+-- @xmonad.hs@:
 --
 -- > import XMonad.Actions.OnScreen
 --
@@ -185,4 +215,4 @@ toggleOrView' f i st = fromMaybe (f i st) $ do
 -- where 0 is the first screen and \"1\" the workspace with the tag \"1\".
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

XMonad/Actions/PerLayoutKeys.hs

@@ -0,0 +1,49 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.PerLayoutKeys
+-- Description :  Define key-bindings on per-layout basis.
+-- Copyright   :  (c) brandon s allbery kf8nh 2022, Roman Cheplyaka, 2008
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  brandon s allbery kf8ng <allbery.b@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Define key-bindings on per-layout basis.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.PerLayoutKeys (
+                                 -- * Usage
+                                 -- $usage
+                                 chooseActionByLayout,
+                                 bindByLayout
+                                ) where
+
+import XMonad
+import XMonad.StackSet as S
+
+-- $usage
+--
+-- You can use this module with the following in your @xmonad.hs@:
+--
+-- >  import XMonad.Actions.PerLayoutKeys
+--
+-- >   ,((0, xK_F2), bindByLayout [("Tall", spawn "rxvt"), ("Mirror Tall", spawn "xeyes"), ("", spawn "xmessage hello")])
+--
+-- For detailed instructions on editing your key bindings, see
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
+
+-- | Uses supplied function to decide which action to run depending on current layout name.
+chooseActionByLayout :: (String->X()) -> X()
+chooseActionByLayout f = withWindowSet (f . description . S.layout. S.workspace . S.current)
+
+-- | If current layout is listed, run appropriate action (only the first match counts!)
+-- If it isn't listed, then run default action (marked with empty string, \"\"), or do nothing if default isn't supplied.
+bindByLayout :: [(String, X())] -> X()
+bindByLayout bindings = chooseActionByLayout chooser where
+    chooser l = case lookup l bindings of
+        Just action -> action
+        Nothing -> case lookup "" bindings of
+            Just action -> action
+            Nothing -> return ()

XMonad/Actions/PerWindowKeys.hs

@@ -0,0 +1,61 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.PerWindowKeys
+-- Description :  Define key-bindings on a per-window basis.
+-- Copyright   :  (c) Wilson Sales, 2019
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Wilson Sales <spoonm@spoonm.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Define key-bindings on a per-window basis.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.PerWindowKeys (
+                                    -- * Usage
+                                    -- $usage
+                                    bindAll,
+                                    bindFirst
+                                   ) where
+
+import XMonad
+
+-- $usage
+--
+-- You can use this module with the following in your @xmonad.hs@:
+--
+-- >  import XMonad.Actions.PerWindowKeys
+--
+-- >   ,((0, xK_F2), bindFirst [(className =? "firefox", spawn "dmenu"), (isFloat, withFocused $ windows . W.sink)])
+--
+-- >   ,((0, xK_F3), bindAll [(isDialog, kill), (pure True, doSomething)])
+--
+-- If you want an action that will always run, but also want to do something for
+-- other queries, you can use @'bindAll' [(query1, action1), ..., (pure True,
+-- alwaysDoThisAction)]@.
+--
+-- Similarly, if you want a default action to be run if all the others failed,
+-- you can use @'bindFirst' [(query1, action1), ..., (pure True,
+-- doThisIfTheOthersFail)]@.
+--
+-- For detailed instructions on editing your key bindings, see
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
+
+-- | Run an action if a Query holds true. Doesn't stop at the first one that
+-- does, however, and could potentially run all actions.
+bindAll :: [(Query Bool, X ())] -> X ()
+bindAll = mapM_ choose where
+  choose (mh,action) = withFocused $ \w -> whenX (runQuery mh w) action
+
+-- | Run the action paired with the first Query that holds true.
+bindFirst :: [(Query Bool, X ())] -> X ()
+bindFirst = withFocused . chooseOne
+
+chooseOne :: [(Query Bool, X ())] -> Window -> X ()
+chooseOne [] _ = return ()
+chooseOne ((mh,a):bs) w = do
+  c <- runQuery mh w
+  if c then a
+       else chooseOne bs w

XMonad/Actions/PerWorkspaceKeys.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.PerWorkspaceKeys
+-- Description :  Define key-bindings on per-workspace basis.
 -- Copyright   :  (c) Roman Cheplyaka, 2008
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -24,14 +25,14 @@ import XMonad.StackSet as S
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- >  import XMonad.Actions.PerWorkspaceKeys
 --
 -- >   ,((0, xK_F2), bindOn [("1", spawn "rxvt"), ("2", spawn "xeyes"), ("", spawn "xmessage hello")])
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Uses supplied function to decide which action to run depending on current workspace name.
 chooseAction :: (String->X()) -> X()
@@ -46,4 +47,3 @@ bindOn bindings = chooseAction chooser where
         Nothing -> case lookup "" bindings of
             Just action -> action
             Nothing -> return ()
-

XMonad/Actions/PhysicalScreens.hs

@@ -1,7 +1,10 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ParallelListComp #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.PhysicalScreens
+-- Description  : Manipulate screens ordered by physical location instead of ID.
 -- Copyright    : (c) Nelson Elhage <nelhage@mit.edu>
 -- License      : BSD
 --
@@ -21,14 +24,21 @@ module XMonad.Actions.PhysicalScreens (
                                       , sendToScreen
                                       , onNextNeighbour
                                       , onPrevNeighbour
+                                      , horizontalScreenOrderer
+                                      , verticalScreenOrderer
+                                      , ScreenComparator(ScreenComparator)
+                                      , getScreenIdAndRectangle
+                                      , screenComparatorById
+                                      , screenComparatorByRectangle
+                                      , rescreen
                                       ) where
 
-import XMonad
+import Data.List.NonEmpty (nonEmpty)
+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
 
-import Data.List (sortBy,findIndex)
-import Data.Function (on)
-
 {- $usage
 
 This module allows you name Xinerama screens from XMonad using their
@@ -36,17 +46,20 @@ physical location relative to each other (as reported by Xinerama),
 rather than their @ScreenID@ s, which are arbitrarily determined by
 your X server and graphics hardware.
 
-Screens are ordered by the upper-left-most corner, from top-to-bottom
+You can specify how to order the screen by giving a ScreenComparator.
+To create a screen comparator you can use screenComparatorByRectangle or screenComparatorByScreenId.
+The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
 and then left-to-right.
 
-Example usage in your @~\/.xmonad\/xmonad.hs@ file:
+Example usage in your @xmonad.hs@ file:
 
 > import XMonad.Actions.PhysicalScreens
+> import Data.Default
 
-> , ((modMask, xK_a), onPrevNeighbour W.view)
-> , ((modMask, xK_o), onNextNeighbour W.view)
-> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)
-> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)
+> , ((modMask, xK_a), onPrevNeighbour def W.view)
+> , ((modMask, xK_o), onNextNeighbour def W.view)
+> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour def W.shift)
+> , ((modMask .|. shiftMask, xK_o), onNextNeighbour def W.shift)
 
 > --
 > -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
@@ -54,61 +67,137 @@ Example usage in your @~\/.xmonad\/xmonad.hs@ file:
 > --
 > [((modm .|. mask, key), f sc)
 >     | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
->     , (f, mask) <- [(viewScreen, 0), (sendToScreen, shiftMask)]]
+>     , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]]
 
 For detailed instructions on editing your key bindings, see
-"XMonad.Doc.Extending#Editing_key_bindings".
+<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
  -}
 
 -- | The type of the index of a screen by location
 newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
 
--- | Translate a physical screen index to a "ScreenId"
-getScreen :: PhysicalScreen -> X (Maybe ScreenId)
-getScreen (P i) = do w <- gets windowset
-                     let screens = W.current w : W.visible w
-                     if i<0 || i >= length screens
-                      then return Nothing
-                      else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens
-                           in return $ Just $ W.screen $ ss !! i
+getScreenIdAndRectangle :: W.Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
+getScreenIdAndRectangle screen = (W.screen screen, rect) where
+  rect = screenRect $ W.screenDetail screen
+
+-- | Translate a physical screen index to a 'ScreenId'
+getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
+getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset
+                                                  let screens = W.current w : W.visible w
+                                                  if i<0 || i >= length screens
+                                                    then return Nothing
+                                                    else let ss = sortBy (cmpScreen `on` getScreenIdAndRectangle) screens
+                                                    in return $ Just $ W.screen $ ss !! i
 
 -- | Switch to a given physical screen
-viewScreen :: PhysicalScreen -> X ()
-viewScreen p = do i <- getScreen p
-                  whenJust i $ \s -> do
-                  w <- screenWorkspace s
-                  whenJust w $ windows . W.view
+viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
+viewScreen sc p = do i <- getScreen sc p
+                     whenJust i $ \s -> do
+                         w <- screenWorkspace s
+                         whenJust w $ windows . W.view
 
 -- | Send the active window to a given physical screen
-sendToScreen :: PhysicalScreen -> X ()
-sendToScreen p = do i <- getScreen p
-                    whenJust i $ \s -> do
-                      w <- screenWorkspace s
-                      whenJust w $ windows . W.shift
+sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
+sendToScreen sc p = do i <- getScreen sc p
+                       whenJust i $ \s -> do
+                         w <- screenWorkspace s
+                         whenJust w $ windows . W.shift
 
--- | Compare two screens by their top-left corners, ordering
--- | top-to-bottom and then left-to-right.
-cmpScreen :: Rectangle -> Rectangle -> Ordering
-cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)
+-- | A ScreenComparator allow to compare two screen based on their coordonate and Xinerama Id
+newtype ScreenComparator = ScreenComparator ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
 
+-- | The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
+instance Default ScreenComparator where
+  def= verticalScreenOrderer
+
+-- | Compare screen only by their coordonate
+screenComparatorByRectangle :: (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
+screenComparatorByRectangle rectComparator = ScreenComparator comparator where
+  comparator (_, rec1) (_, rec2) = rectComparator rec1 rec2
+
+-- | Compare screen only by their Xinerama id
+screenComparatorById :: (ScreenId -> ScreenId -> Ordering) -> ScreenComparator
+screenComparatorById idComparator = ScreenComparator comparator where
+  comparator (id1, _) (id2, _) = idComparator id1 id2
+
+-- | orders screens by the upper-left-most corner, from top-to-bottom
+verticalScreenOrderer :: ScreenComparator
+verticalScreenOrderer = screenComparatorByRectangle comparator where
+    comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1, x1) (y2, x2)
+
+-- | orders screens by the upper-left-most corner, from left-to-right
+horizontalScreenOrderer :: ScreenComparator
+horizontalScreenOrderer = screenComparatorByRectangle comparator where
+    comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (x1, y1) (x2, y2)
 
 -- | Get ScreenId for neighbours of the current screen based on position offset.
-getNeighbour :: Int -> X ScreenId
-getNeighbour d = do w <- gets windowset
-                    let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w
-                        curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
-                        pos = (curPos + d) `mod` length ss
-                    return $ ss !! pos
+getNeighbour :: ScreenComparator -> Int -> X ScreenId
+getNeighbour (ScreenComparator cmpScreen) d =
+  do w <- gets windowset
+     let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w
+         curPos = fromMaybe 0 $ elemIndex (W.screen (W.current w)) ss
+         pos = (curPos + d) `mod` length ss
+     return $ ss !! pos
 
-neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
-neighbourWindows d f = do s <- getNeighbour d
-                          w <- screenWorkspace s
-                          whenJust w $ windows . f
+neighbourWindows :: ScreenComparator -> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+neighbourWindows sc d f = do s <- getNeighbour sc d
+                             w <- screenWorkspace s
+                             whenJust w $ windows . f
 
 -- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.
-onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
-onNextNeighbour = neighbourWindows 1
+onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+onNextNeighbour sc = neighbourWindows sc 1
 
 -- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
-onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
-onPrevNeighbour = neighbourWindows (-1)
+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.

XMonad/Actions/Plane.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.Plane
+-- Description :  Navigate through workspaces in a bidimensional manner.
 -- Copyright   :  (c) Marco Túlio Gontijo e Silva <marcot@riseup.net>,
 --                    Leonardo Serra <leoserra@minaslivre.org>
 -- License     :  BSD3-style (see LICENSE)
@@ -38,17 +39,15 @@ module XMonad.Actions.Plane
     )
     where
 
-import Control.Monad
-import Data.List
-import Data.Map hiding (split)
-import Data.Maybe
+import Data.Map (Map, fromList)
 
+import XMonad.Prelude hiding (fromList)
 import XMonad
 import XMonad.StackSet hiding (workspaces)
 import XMonad.Util.Run
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+-- You can use this module with the following in your @xmonad.hs@ file:
 --
 -- > import XMonad.Actions.Plane
 -- > import Data.Map (union)
@@ -60,7 +59,7 @@ import XMonad.Util.Run
 -- > myNewKeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Direction to go in the plane.
 data Direction =  ToLeft | ToUp | ToRight | ToDown deriving Enum

XMonad/Actions/Prefix.hs

@@ -0,0 +1,222 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Prefix
+-- Description :  Use an Emacs-style prefix argument for commands.
+-- Copyright   :  (c) Matus Goljer <matus.goljer@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Matus Goljer <matus.goljer@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A module that allows the user to use a prefix argument (raw or numeric).
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Prefix
+       (
+      -- * Usage
+      -- $usage
+
+      -- * Installation
+      -- $installation
+
+         PrefixArgument(..)
+       , usePrefixArgument
+       , useDefaultPrefixArgument
+       , withPrefixArgument
+       , isPrefixRaw
+       , isPrefixNumeric
+       , orIfPrefixed
+       , ppFormatPrefix
+       ) where
+
+import qualified Data.Map as M
+
+import XMonad.Prelude
+import XMonad
+import XMonad.Util.ExtensibleState as XS
+import XMonad.Util.Paste (sendKey)
+import XMonad.Actions.Submap (submapDefaultWithKey)
+import XMonad.Util.EZConfig (readKeySequence)
+import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty ((<|))
+
+{- $usage
+
+This module implements Emacs-style prefix argument.  The argument
+comes in two flavours, 'Raw' and 'Numeric'.
+
+To initiate the "prefix mode" you hit the prefix keybinding (default
+C-u).  This sets the Raw argument value to 1.  Repeatedly hitting this
+key increments the raw value by 1.  The Raw argument is usually used
+as a toggle, changing the behaviour of the function called in some way.
+
+An example might be calling "mpc add" to add new song to the playlist,
+but with C-u we also clean up the playlist beforehand.
+
+When in the "Raw mode", you can hit numeric keys 0..9 (with no
+modifier) to enter a "Numeric argument".  Numeric argument represents
+a natural number.  Hitting numeric keys in sequence produces the
+decimal number that would result from typing them.  That is, the
+sequence C-u 4 2 sets the Numeric argument value to the number 42.
+
+If you have a function which understands the prefix argument, for example:
+
+>    addMaybeClean :: PrefixArgument -> X ()
+>    addMaybeClean (Raw _) = spawn "mpc clear" >> spawn "mpc add <file>"
+>    addMaybeClean _ = spawn "mpc add <file>"
+
+you can turn it into an X action with the function 'withPrefixArgument'.
+
+Binding it in your config
+
+>    ((modm, xK_a), withPrefixArgument addMaybeClean)
+
+Hitting MOD-a will add the @\<file\>@ to the playlist while C-u MOD-a will
+clear the playlist and then add the file.
+
+You can of course use an anonymous action, like so:
+
+>    ((modm, xK_a), withPrefixArgument $ \prefix -> do
+>        case prefix of ...
+>    )
+
+If the prefix key is followed by a binding which is unknown to XMonad,
+the prefix along with that binding is sent to the active window.
+
+There is one caveat: when you use an application which has a nested
+C-u binding, for example C-c C-u in Emacs org-mode, you have to hit
+C-g (or any other non-recognized key really) to get out of the "xmonad
+grab" and let the C-c C-u be sent to the application.
+
+-}
+
+{- $installation
+
+The simplest way to enable this is to use 'useDefaultPrefixArgument'
+
+>    xmonad $ useDefaultPrefixArgument $ def { .. }
+
+The default prefix argument is C-u.  If you want to customize the
+prefix argument, 'usePrefixArgument' can be used:
+
+>    xmonad $ usePrefixArgument "M-u" $ def { .. }
+
+where the key is entered in Emacs style (or "XMonad.Util.EZConfig"
+style) notation.  The letter `M` stands for your chosen modifier.  The
+function defaults to C-u if the argument could not be parsed.
+-}
+
+data PrefixArgument = Raw Int | Numeric Int | None
+                      deriving (Read, Show)
+instance ExtensionClass PrefixArgument where
+  initialValue = None
+  extensionType = PersistentExtension
+
+-- | Run 'job' in the 'X' monad and then execute 'cleanup'.  In case
+-- of exception, 'cleanup' is executed anyway.
+--
+-- Return the return value of 'job'.
+finallyX :: X a -> X a -> X a
+finallyX job cleanup = catchX (job >>= \r -> cleanup >> return r) cleanup
+
+-- | Set up Prefix.  Defaults to C-u when given an invalid key.
+--
+-- See usage section.
+usePrefixArgument :: LayoutClass l Window
+                  => String
+                  -> XConfig l
+                  -> XConfig l
+usePrefixArgument prefix conf =
+  conf{ keys = M.insert binding (handlePrefixArg (binding :| [])) . keys conf }
+ where
+  binding = case readKeySequence conf prefix of
+    Just (key :| []) -> key
+    _                -> (controlMask, xK_u)
+
+-- | Set Prefix up with default prefix key (C-u).
+useDefaultPrefixArgument :: LayoutClass l Window
+                         => XConfig l
+                         -> XConfig l
+useDefaultPrefixArgument = usePrefixArgument "C-u"
+
+handlePrefixArg :: NonEmpty (KeyMask, KeySym) -> X ()
+handlePrefixArg events = do
+  ks <- asks keyActions
+  logger <- asks (logHook . config)
+  flip finallyX (XS.put None >> logger) $ do
+    prefix <- XS.get
+    case prefix of
+      Raw a -> XS.put $ Raw (a + 1)
+      None -> XS.put $ Raw 1
+      _ -> return ()
+    logger
+    submapDefaultWithKey defaultKey ks
+  where defaultKey key@(m, k) =
+          if k `elem` (xK_0 : [xK_1 .. xK_9]) && m == noModMask
+          then do
+            prefix <- XS.get
+            let x = fromJust (Prelude.lookup k keyToNum)
+            case prefix of
+              Raw _ -> XS.put $ Numeric x
+              Numeric a -> XS.put $ Numeric $ a * 10 + x
+              None -> return () -- should never happen
+            handlePrefixArg (key <| events)
+          else do
+            prefix <- XS.get
+            mapM_ (uncurry sendKey) $ case prefix of
+              Raw a -> replicate a (NE.head events) ++ [key]
+              _ -> reverse (key : toList events)
+        keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9]
+
+-- | Turn a prefix-aware X action into an X-action.
+--
+-- First, fetch the current prefix, then pass it as argument to the
+-- original function.  You should use this to "run" your commands.
+withPrefixArgument :: (PrefixArgument -> X a) -> X a
+withPrefixArgument = (>>=) XS.get
+
+-- | Test if 'PrefixArgument' is 'Raw' or not.
+isPrefixRaw :: PrefixArgument -> Bool
+isPrefixRaw (Raw _) = True
+isPrefixRaw _ = False
+
+-- | Test if 'PrefixArgument' is 'Numeric' or not.
+isPrefixNumeric :: PrefixArgument -> Bool
+isPrefixNumeric (Numeric _) = True
+isPrefixNumeric _ = False
+
+-- | Execute the first action, unless any prefix argument is given,
+-- in which case the second action is chosen instead.
+--
+-- > action1 `orIfPrefixed` action2
+orIfPrefixed :: X a -> X a -> X a
+orIfPrefixed xa xb = withPrefixArgument $ bool xa xb . isPrefixRaw
+
+-- | Format the prefix using the Emacs convetion for use in a
+-- statusbar, like xmobar.
+--
+-- To add this formatted prefix to printer output, you can set it up
+-- like so
+--
+-- > myPrinter :: PP
+-- > myPrinter = def { ppExtras = [ppFormatPrefix] }
+--
+-- And then add to your status bar using "XMonad.Hooks.StatusBar":
+--
+-- > mySB = statusBarProp "xmobar" myPrinter
+-- > main = xmonad $ withEasySB mySB defToggleStrutsKey def
+--
+-- Or, directly in your 'logHook' configuration
+--
+-- > logHook = dynamicLogWithPP myPrinter
+ppFormatPrefix :: X (Maybe String)
+ppFormatPrefix = do
+  prefix <- XS.get
+  return $ case prefix of
+    Raw n -> Just $ foldr1 (\a b -> a ++ " " ++ b) $ replicate n "C-u"
+    Numeric n -> Just $ "C-u " ++ show n
+    None -> Nothing

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

XMonad/Actions/Promote.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.Promote
+-- Description :  Alternate promote function for xmonad.
 -- Copyright   :  (c) Miikka Koskinen 2007
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -27,7 +28,7 @@ import XMonad.StackSet
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- >    import XMonad.Actions.Promote
 --
@@ -36,7 +37,7 @@ import XMonad.StackSet
 -- >   , ((modm,               xK_Return), promote)
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Move the focused window to the master pane. All other windows
 --   retain their order. If focus is in the master, swap it with the

XMonad/Actions/RandomBackground.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.RandomBackground
+-- Description :  Start terminals with a random background color.
 -- Copyright   :  (c) 2009 Anze Slosar
 --                translation to Haskell by Adam Vogt
 -- License     :  BSD3-style (see LICENSE)
@@ -24,7 +25,6 @@ module XMonad.Actions.RandomBackground (
 import XMonad(X, XConf(config), XConfig(terminal), io, spawn,
               MonadIO, asks)
 import System.Random
-import Control.Monad(liftM)
 import Numeric(showHex)
 
 -- $usage
@@ -55,7 +55,7 @@ randPermutation xs g = swap $ zip (randoms g) xs
 
 -- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@
 randomBg' ::  (MonadIO m) => RandomColor -> m String
-randomBg' (RGB l h) = io $ liftM (toHex . take 3 . randomRs (l,h)) newStdGen
+randomBg' (RGB l h) = io $ fmap (toHex . take 3 . randomRs (l,h)) newStdGen
 randomBg' (HSV s v) = io $ do
     g <- newStdGen
     let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g

XMonad/Actions/RepeatAction.hs

@@ -0,0 +1,84 @@
+{-# LANGUAGE LambdaCase #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.RepeatAction
+-- Description :  Repeat the last performed action.
+-- Copyright   :  (c) 2022 Martin Kozlovsky
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  <kozlovsky.m7@gmail.com>
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Ability to repeat the last action.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.RepeatAction (
+  -- * Usage
+  -- $usage
+  rememberAction,
+  rememberActions,
+  repeatLast,
+) where
+
+import XMonad
+
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- $usage
+--
+-- You can use this module with the following in your @xmonad.hs@:
+--
+-- > import XMonad.Actions.RepeatAction
+--
+-- Then join a dedicated key to run the last action with the rest of your
+-- key bindings using the 'rememberActions':
+--
+-- > rememberActions (modm, xK_period) [((modm, xK_c), kill), …]
+--
+-- It can be also used in the same way for "XMonad.Util.EZConfig":
+--
+-- > rememberActions "M-." [("M-c", kill), …]
+--
+-- For example, if you use 'XMonad.Util.EZConfig.additionalKeysP',
+--
+-- > main = xmonad $ … $ def
+-- >   {
+-- >     …
+-- >   }
+-- >  `additionalKeysP` myKeys
+--
+-- you would adjust the call to 'XMonad.Util.EZConfig.additionalKeysP'
+-- like so:
+--
+-- > `additionalKeysP` (rememberActions "M-." myKeys)
+--
+-- For more detailed instructions on editing your key bindings, see
+-- <https://xmonad.org/TUTORIAL.html the tutorial>.
+
+newtype LastAction = LastAction { runLastAction :: X () }
+
+instance ExtensionClass LastAction where
+  initialValue = LastAction $ pure ()
+
+-- | Transforms an action into an action that can be remembered and repeated.
+rememberAction :: X () -> X ()
+rememberAction x = userCode x >>= \case
+  Nothing -> pure ()
+  Just () -> XS.put (LastAction x)  -- Only remember action if nothing went wrong.
+
+-- | Maps 'rememberAction' over a list of key bindings.
+rememberActions' :: [(a, X ())] -> [(a, X ())]
+rememberActions' = map (fmap rememberAction)
+
+infixl 4 `rememberActions`
+-- | Maps 'rememberAction' over a list of key bindings and adds a dedicated
+-- key to repeat the last action.
+rememberActions :: a -> [(a, X ())] -> [(a, X ())]
+rememberActions key keyList = (key, repeatLast) : rememberActions' keyList
+
+-- | Runs the last remembered action.
+-- / Be careful not to include this action in the remembered actions! /
+repeatLast :: X ()
+repeatLast = XS.get >>= runLastAction

XMonad/Actions/Repeatable.hs

@@ -0,0 +1,89 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Repeatable
+-- Description :  Actions you'd like to repeat.
+-- Copyright   :  (c) 2022 L. S. Leary
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  @LSLeary (on github)
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This module factors out the shared logic of "XMonad.Actions.CycleRecentWS",
+-- "XMonad.Actions.CycleWorkspaceByScreen", "XMonad.Actions.CycleWindows" and
+-- "XMonad.Actions.MostRecentlyUsed".
+--
+-- See the source of these modules for usage examples.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Repeatable
+  ( repeatable
+  , repeatableSt
+  , repeatableM
+  ) where
+
+-- mtl
+import Control.Monad.State (StateT(..))
+
+-- X11
+import Graphics.X11.Xlib.Extras
+
+-- xmonad
+import XMonad
+
+
+-- | An action that temporarily usurps and responds to key press/release events,
+--   concluding when one of the modifier keys is released.
+repeatable
+  :: [KeySym]                      -- ^ The list of 'KeySym's under the
+                                   --   modifiers used to invoke the action.
+  -> KeySym                        -- ^ The keypress that invokes the action.
+  -> (EventType -> KeySym -> X ()) -- ^ The keypress handler.
+  -> X ()
+repeatable = repeatableM id
+
+-- | A more general variant of 'repeatable' with a stateful handler,
+--   accumulating a monoidal return value throughout the events.
+repeatableSt
+  :: Monoid a
+  => s                                     -- ^ Initial state.
+  -> [KeySym]                              -- ^ The list of 'KeySym's under the
+                                           --   modifiers used to invoke the
+                                           --   action.
+  -> KeySym                                -- ^ The keypress that invokes the
+                                           --   action.
+  -> (EventType -> KeySym -> StateT s X a) -- ^ The keypress handler.
+  -> X (a, s)
+repeatableSt iSt = repeatableM $ \m -> runStateT m iSt
+
+-- | A more general variant of 'repeatable' with an arbitrary monadic handler,
+--   accumulating a monoidal return value throughout the events.
+repeatableM
+  :: (MonadIO m, Monoid a)
+  => (m a -> X b)                 -- ^ How to run the monad in 'X'.
+  -> [KeySym]                     -- ^ The list of 'KeySym's under the
+                                  --   modifiers used to invoke the action.
+  -> KeySym                       -- ^ The keypress that invokes the action.
+  -> (EventType -> KeySym -> m a) -- ^ The keypress handler.
+  -> X b
+repeatableM run mods key pressHandler = do
+  XConf{ theRoot = root, display = d } <- ask
+  run (repeatableRaw d root mods key pressHandler)
+
+repeatableRaw
+  :: (MonadIO m, Monoid a)
+  => Display -> Window
+  -> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> m a
+repeatableRaw d root mods key pressHandler = do
+  io (grabKeyboard d root False grabModeAsync grabModeAsync currentTime)
+  handleEvent (keyPress, key) <* io (ungrabKeyboard d currentTime)
+  where
+    getNextEvent = io $ allocaXEvent $ \p -> do
+      maskEvent d (keyPressMask .|. keyReleaseMask) p
+      KeyEvent{ ev_event_type = t, ev_keycode = c } <- getEvent p
+      s <- keycodeToKeysym d c 0
+      return (t, s)
+    handleEvent (t, s)
+      | t == keyRelease && s `elem` mods = pure mempty
+      | otherwise = (<>) <$> pressHandler t s <*> (getNextEvent >>= handleEvent)

XMonad/Actions/RotSlaves.hs

@@ -1,6 +1,9 @@
+{-# LANGUAGE ViewPatterns #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.RotSlaves
+-- Description  : Rotate all windows except the master window and keep the focus in place.
 -- Copyright    : (c) Hans Philipp Annen <haphi@gmx.net>, Mischa Dieterle <der_m@freenet.de>
 -- License      : BSD3-style (see LICENSE)
 --
@@ -14,11 +17,16 @@
 module XMonad.Actions.RotSlaves (
         -- $usage
         rotSlaves', rotSlavesUp, rotSlavesDown,
-        rotAll', rotAllUp, rotAllDown
+        rotAll', rotAllUp, rotAllDown,
+
+        -- * Generic list rotations
+        -- $generic
+        rotUp, rotDown
         ) where
 
-import XMonad.StackSet
 import XMonad
+import XMonad.StackSet
+import XMonad.Prelude
 
 -- $usage
 --
@@ -35,28 +43,37 @@ import XMonad
 -- TwoPane layout (see "XMonad.Layout.TwoPane").
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Rotate the windows in the current stack, excluding the first one
 --   (master).
 rotSlavesUp,rotSlavesDown :: X ()
-rotSlavesUp   = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l]))
-rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l)))
+rotSlavesUp   = windows $ modify' (rotSlaves' rotUp)
+rotSlavesDown = windows $ modify' (rotSlaves' rotDown)
 
 -- | The actual rotation, as a pure function on the window stack.
 rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
 rotSlaves' _ s@(Stack _ [] []) = s
 rotSlaves' f   (Stack t [] rs) = Stack t [] (f rs)                -- Master has focus
 rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs'    -- otherwise
-    where  (master:ws)     = integrate s
-           (revls',t':rs') = splitAt (length ls) (master:(f ws))
+    where  (notEmpty -> master :| ws)      = integrate s
+           (revls', notEmpty -> t' :| rs') = splitAt (length ls) (master:f ws)
 
 -- | Rotate all the windows in the current stack.
 rotAllUp,rotAllDown :: X ()
-rotAllUp   = windows $ modify' (rotAll' (\l -> (tail l)++[head l]))
-rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l)))
+rotAllUp   = windows $ modify' (rotAll' rotUp)
+rotAllDown = windows $ modify' (rotAll' rotDown)
 
 -- | The actual rotation, as a pure function on the window stack.
 rotAll' :: ([a] -> [a]) -> Stack a -> Stack a
 rotAll' f s = Stack r (reverse revls) rs
-    where (revls,r:rs) = splitAt (length (up s)) (f (integrate s))
+    where (revls, notEmpty -> r :| rs) = splitAt (length (up s)) (f (integrate s))
+
+-- $generic
+-- Generic list rotations such that @rotUp [1..4]@ is equivalent to
+-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are
+-- @id@ for null or singleton lists.
+rotUp :: [a] -> [a]
+rotUp   l = drop 1 l ++ take 1 l
+rotDown :: [a] -> [a]
+rotDown = reverse . rotUp . reverse

XMonad/Actions/RotateSome.hs

@@ -0,0 +1,163 @@
+{-# LANGUAGE ViewPatterns #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.RotateSome
+-- Description :  Rotate some elements around the stack.
+-- Copyright   :  (c) 2020 Ivan Brennan <ivanbrennan@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Ivan Brennan <ivanbrennan@gmail.com>
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- Functions for rotating some elements around the stack while keeping others
+-- anchored in place. Useful in combination with layouts that dictate window
+-- visibility based on stack position, such as "XMonad.Layout.LimitWindows".
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.RotateSome (
+    -- * Usage
+    -- $usage
+    -- * Example
+    -- $example
+    surfaceNext,
+    surfacePrev,
+    rotateSome,
+  ) where
+
+import Control.Arrow ((***))
+import XMonad.Prelude (NonEmpty(..), notEmpty, partition, sortOn, (\\))
+import qualified Data.Map as M
+import XMonad (Window, WindowSpace, Rectangle, X, runLayout, screenRect, windows, withWindowSet)
+import XMonad.StackSet (Screen (Screen), Stack (Stack), current, floating, modify', stack)
+import XMonad.Util.Stack (reverseS)
+
+{- $usage
+You can use this module with the following in your @xmonad.hs@:
+
+> import XMonad.Actions.RotateSome
+
+and add keybindings such as the following:
+
+>   , ((modMask .|. controlMask, xK_n), surfaceNext)
+>   , ((modMask .|. controlMask, xK_p), surfacePrev)
+
+-}
+
+{- $example
+#Example#
+
+Consider a workspace whose stack contains five windows A B C D E but whose
+layout limits how many will actually be shown, showing only the first plus
+two additional windows, starting with the third:
+
+>  ┌─────┬─────┐
+>  │     │  C  │
+>  │  A  ├─────┤
+>  │     │  D  │
+>  └─────┴─────┘
+>
+>  A  B  C  D  E
+>  _     ____
+
+If C has focus and we'd like to replace it with one of the unshown windows,
+'surfaceNext' will move the next unshown window, E, into the focused position:
+
+>  ┌─────┬─────┐                ┌─────┬─────┐
+>  │     │ *C* │                │     │ *E* │
+>  │  A  ├─────┤ surfaceNext -> │  A  ├─────┤
+>  │     │  D  │                │     │  D  │
+>  └─────┴─────┘                └─────┴─────┘
+>
+>  A  B *C* D  E                A  C *E* D  B
+>  _     ____                   _     ____
+
+This repositioned windows B C E by treating them as a sequence that can be
+rotated through the focused stack position. Windows A and D remain anchored
+to their original (visible) positions.
+
+A second call to 'surfaceNext' moves B into focus:
+
+>  ┌─────┬─────┐                ┌─────┬─────┐
+>  │     │ *E* │                │     │ *B* │
+>  │  A  ├─────┤ surfaceNext -> │  A  ├─────┤
+>  │     │  D  │                │     │  D  │
+>  └─────┴─────┘                └─────┴─────┘
+>
+>  A  C *E* D  B                A  E *B* D  C
+>  _     ____                   _     ____
+
+A third call would complete the cycle, bringing C back into focus.
+
+-}
+
+-- |
+-- Treating the focused window and any unshown windows as a ring that can be
+-- rotated through the focused position, surface the next element in the ring.
+surfaceNext :: X ()
+surfaceNext = do
+  ring <- surfaceRing
+  windows . modify' $ rotateSome (`elem` ring)
+
+-- | Like 'surfaceNext' in reverse.
+surfacePrev :: X ()
+surfacePrev = do
+  ring <- surfaceRing
+  windows . modify' $ reverseS . rotateSome (`elem` ring) . reverseS
+
+-- |
+-- Return a list containing the current focus plus any unshown windows. Note
+-- that windows are shown if 'runLayout' provides them with a rectangle or if
+-- they are floating.
+surfaceRing :: X [Window]
+surfaceRing = withWindowSet $ \wset -> do
+  let Screen wsp _ sd = current wset
+
+  case stack wsp >>= filter' (`M.notMember` floating wset) of
+    Nothing -> pure []
+    Just st -> go st <$> layoutWindows wsp {stack = Just st} (screenRect sd)
+  where
+    go :: Stack Window -> [Window] -> [Window]
+    go (Stack t ls rs) shown = t : ((ls ++ rs) \\ shown)
+
+    layoutWindows :: WindowSpace -> Rectangle -> X [Window]
+    layoutWindows wsp rect = map fst . fst <$> runLayout wsp rect
+
+-- | Like "XMonad.StackSet.filter" but won't move focus.
+filter' :: (a -> Bool) -> Stack a -> Maybe (Stack a)
+filter' p (Stack f ls rs)
+  | p f       = Just $ Stack f (filter p ls) (filter p rs)
+  | otherwise = Nothing
+
+-- |
+-- @'rotateSome' p stack@ treats the elements of @stack@ that satisfy predicate
+-- @p@ as a ring that can be rotated, while all other elements remain anchored
+-- in place.
+rotateSome :: (a -> Bool) -> Stack a -> Stack a
+rotateSome p (Stack t ls rs) =
+  let
+    -- Flatten the stack, index each element relative to the focused position,
+    -- then partition into movable and anchored elements.
+    (movables, anchors) =
+      partition (p . snd) $
+        zip
+          [negate (length ls)..]
+          (reverse ls ++ t : rs)
+
+    -- Pair each movable element with the index of its next movable neighbor.
+    -- Append anchored elements, along with their unchanged indices, and sort
+    -- by index. Separate lefts (negative indices) from the rest, and grab the
+    -- new focus from the head of the remaining elements.
+    (ls', notEmpty -> t' :| rs') =
+      (map snd *** map snd)
+        . span ((< 0) . fst)
+        . sortOn fst
+        . (++) anchors
+        $ zipWith (curry (fst *** snd)) movables (rotate movables)
+  in
+    Stack t' (reverse ls') rs'
+
+rotate :: [a] -> [a]
+rotate = uncurry (flip (++)) . splitAt 1

XMonad/Actions/Search.hs

@@ -1,4 +1,6 @@
-{- | Module      :  XMonad.Actions.Search
+{- |
+   Module      :  XMonad.Actions.Search
+   Description :  Easily run Internet searches on web sites through xmonad.
    Copyright   :  (C) 2007 Gwern Branwen
    License     :  None; public domain
 
@@ -18,6 +20,7 @@ module XMonad.Actions.Search (   -- * Usage
                                  searchEngineF,
                                  promptSearch,
                                  promptSearchBrowser,
+                                 promptSearchBrowser',
                                  selectSearch,
                                  selectSearchBrowser,
                                  isPrefixOf,
@@ -28,32 +31,50 @@ module XMonad.Actions.Search (   -- * Usage
                                  prefixAware,
                                  namedEngine,
 
-                                 amazon,
                                  alpha,
+                                 amazon,
+                                 arXiv,
+                                 aur,
+                                 clojureDocs,
                                  codesearch,
+                                 cratesIo,
                                  deb,
                                  debbts,
                                  debpts,
                                  dictionary,
+                                 duckduckgo,
+                                 ebay,
+                                 flora,
+                                 github,
                                  google,
                                  hackage,
+                                 homeManager,
                                  hoogle,
                                  images,
                                  imdb,
-                                 isohunt,
                                  lucky,
                                  maps,
                                  mathworld,
+                                 ncatlab,
+                                 nixos,
+                                 noogle,
                                  openstreetmap,
+                                 protondb,
+                                 rosettacode,
+                                 rustStd,
                                  scholar,
+                                 sourcehut,
                                  stackage,
+                                 steam,
                                  thesaurus,
+                                 vocabulary,
+                                 voidpgks_x86_64,
+                                 voidpgks_x86_64_musl,
                                  wayback,
                                  wikipedia,
                                  wiktionary,
                                  youtube,
-                                 vocabulary,
-                                 duckduckgo,
+                                 zbmath,
                                  multi,
                                   -- * Use case: searching with a submap
                                   -- $tip
@@ -63,13 +84,12 @@ module XMonad.Actions.Search (   -- * Usage
                           ) where
 
 import           Codec.Binary.UTF8.String (encode)
-import           Data.Char                (isAlphaNum, isAscii)
-import           Data.List                (isPrefixOf)
 import           Text.Printf
 import           XMonad                   (X (), liftIO)
 import           XMonad.Prompt            (XPConfig (), XPrompt (showXPrompt, nextCompletion, commandToComplete),
                                            getNextCompletion,
                                            historyCompletionP, mkXPrompt)
+import           XMonad.Prelude           (isAlphaNum, isAscii, isPrefixOf)
 import           XMonad.Prompt.Shell      (getBrowser)
 import           XMonad.Util.Run          (safeSpawn)
 import           XMonad.Util.XSelection   (getSelection)
@@ -99,12 +119,20 @@ import           XMonad.Util.XSelection   (getSelection)
 
    The currently available search engines are:
 
-* 'amazon' -- Amazon keyword search.
-
 * 'alpha' -- Wolfram|Alpha query.
 
+* 'amazon' -- Amazon keyword search.
+
+* 'arXiv' -- Open-access preprint archive.
+
+* 'aur' -- Arch User Repository.
+
+* 'clojureDocs' -- Documentation and examples repository for Clojure.
+
 * 'codesearch' -- Google Labs Code Search search.
 
+* 'cratesIo' -- Rust crate registry.
+
 * 'deb'    -- Debian package search.
 
 * 'debbts' -- Debian Bug Tracking System.
@@ -113,41 +141,71 @@ import           XMonad.Util.XSelection   (getSelection)
 
 * 'dictionary' -- dictionary.reference.com search.
 
+* 'duckduckgo' -- DuckDuckGo search engine.
+
+* 'ebay' -- Ebay keyword search.
+
+* 'flora' -- Prettier Haskell package database.
+
+* 'github' -- GitHub keyword search.
+
 * 'google' -- basic Google search.
 
 * 'hackage' -- Hackage, the Haskell package database.
 
-* 'hoogle' -- Hoogle, the Haskell libraries API search engine.
+* 'homeManager' -- Search Nix's home-manager's options.
 
-* 'stackage' -- Stackage, An alternative Haskell libraries API search engine.
+* 'hoogle' -- Hoogle, the Haskell libraries API search engine.
 
 * 'images' -- Google images.
 
 * 'imdb'   -- the Internet Movie Database.
 
-* 'isohunt' -- isoHunt search.
-
 * 'lucky' -- Google "I'm feeling lucky" search.
 
 * 'maps'   -- Google maps.
 
 * 'mathworld' -- Wolfram MathWorld search.
 
+* 'ncatlab' -- Higer Algebra, Homotopy and Category Theory Wiki.
+
+* 'nixos' -- Search NixOS packages and options.
+
+* 'noogle' -- 'hoogle'-like Nix API search engine.
+
 * 'openstreetmap' -- OpenStreetMap free wiki world map.
 
+* 'protondb' -- Steam Proton Game Database.
+
+* 'rosettacode' -- Programming chrestomathy wiki.
+
+* 'rustStd' -- Rust standard library documentation.
+
 * 'scholar' -- Google scholar academic search.
 
-* 'thesaurus' -- thesaurus.reference.com search.
+* 'sourcehut' -- Sourcehut projects search.
+
+* 'stackage' -- Stackage, An alternative Haskell libraries API search engine.
+
+* 'steam' -- Steam games search.
+
+* 'thesaurus' -- thesaurus.com search.
+
+* 'vocabulary' -- Dictionary search.
+
+* 'voidpgks_x86_64' -- Void Linux packages search for @x86_64@.
+
+* 'voidpgks_x86_64_musl' -- Void Linux packages search for @x86_64-musl@.
 
 * 'wayback' -- the Wayback Machine.
 
 * 'wikipedia' -- basic Wikipedia search.
 
+* 'wiktionary' -- Wiktionary search.
+
 * 'youtube' -- Youtube video search.
 
-* 'vocabulary' -- Dictionary search
-
-* 'duckduckgo' -- DuckDuckGo search engine.
+* 'zbmath' -- Open alternative to MathSciNet.
 
 * 'multi' -- Search based on the prefix. \"amazon:Potter\" will use amazon, etc. With no prefix searches google.
 
@@ -191,7 +249,7 @@ Or in combination with XMonad.Util.EZConfig:
 >
 > searchList :: [(String, S.SearchEngine)]
 > searchList = [ ("g", S.google)
->              , ("h", S.hoohle)
+>              , ("h", S.hoogle)
 >              , ("w", S.wikipedia)
 >              ]
 
@@ -210,7 +268,7 @@ engine.
 Happy searching! -}
 
 -- | A customized prompt indicating we are searching, and the name of the site.
-data Search = Search Name
+newtype Search = Search Name
 instance XPrompt Search where
     showXPrompt (Search name)= "Search [" ++ name ++ "]: "
     nextCompletion _ = getNextCompletion
@@ -248,7 +306,7 @@ search browser site query = safeSpawn browser [site query]
    appends it to the base. You can easily define a new engine locally using
    exported functions without needing to modify "XMonad.Actions.Search":
 
-> myNewEngine = searchEngine "site" "http://site.com/search="
+> myNewEngine = searchEngine "site" "https://site.com/search="
 
    The important thing is that the site has a interface which accepts the escaped query
    string as part of the URL. Alas, the exact URL to feed searchEngine varies
@@ -257,21 +315,21 @@ search browser site query = safeSpawn browser [site query]
    Generally, examining the resultant URL of a search will allow you to reverse-engineer
    it if you can't find the necessary URL already described in other projects such as Surfraw. -}
 searchEngine :: Name -> String -> SearchEngine
-searchEngine name site = searchEngineF name (\s -> site ++ (escape s))
+searchEngine name site = searchEngineF name (\s -> site ++ escape s)
 
 {- | If your search engine is more complex than this (you may want to identify
    the kind of input and make the search URL dependent on the input or put the query
    inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.
 
 > searchFunc :: String -> String
-> searchFunc s | "wiki:"   `isPrefixOf` s = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)
->              | "http://" `isPrefixOf` s = s
->              | otherwise               = (use google) s
+> searchFunc s | "wiki:"    `isPrefixOf` s = "https://en.wikipedia.org/wiki/" ++ (escape $ drop 1 $ snd $ break (==':') s)
+>              | "https://" `isPrefixOf` s = s
+>              | otherwise                 = (use google) s
 > myNewEngine = searchEngineF "mymulti" searchFunc
 
    @searchFunc@ here searches for a word in wikipedia if it has a prefix
    of \"wiki:\" (you can use the 'escape' function to escape any forbidden characters), opens an address
-   directly if it starts with \"http:\/\/\" and otherwise uses the provided google search engine.
+   directly if it starts with \"https:\/\/\" and otherwise uses the provided google search engine.
    You can use other engines inside of your own through the 'use' function as shown above to make
    complex searches.
 
@@ -281,38 +339,57 @@ searchEngineF :: Name -> Site -> SearchEngine
 searchEngineF = SearchEngine
 
 -- The engines.
-amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,
-  images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, vocabulary, wayback, wikipedia, wiktionary,
-  youtube, duckduckgo :: SearchEngine
-amazon        = searchEngine "amazon"        "http://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="
-alpha         = searchEngine "alpha"         "http://www.wolframalpha.com/input/?i="
-codesearch    = searchEngine "codesearch"    "http://www.google.com/codesearch?q="
-deb           = searchEngine "deb"           "http://packages.debian.org/"
-debbts        = searchEngine "debbts"        "http://bugs.debian.org/"
-debpts        = searchEngine "debpts"        "http://packages.qa.debian.org/"
-dictionary    = searchEngine "dict"          "http://dictionary.reference.com/browse/"
-google        = searchEngine "google"        "http://www.google.com/search?num=100&q="
-hackage       = searchEngine "hackage"       "http://hackage.haskell.org/package/"
-hoogle        = searchEngine "hoogle"        "http://www.haskell.org/hoogle/?q="
-images        = searchEngine "images"        "http://images.google.fr/images?q="
-imdb          = searchEngine "imdb"          "http://www.imdb.com/find?s=all&q="
-isohunt       = searchEngine "isohunt"       "http://isohunt.com/torrents/?ihq="
-lucky         = searchEngine "lucky"         "http://www.google.com/search?btnI&q="
-maps          = searchEngine "maps"          "http://maps.google.com/maps?q="
-mathworld     = searchEngine "mathworld"     "http://mathworld.wolfram.com/search/?query="
-openstreetmap = searchEngine "openstreetmap" "http://gazetteer.openstreetmap.org/namefinder/?find="
-scholar       = searchEngine "scholar"       "http://scholar.google.com/scholar?q="
-stackage      = searchEngine "stackage"      "www.stackage.org/lts/hoogle?q="
-thesaurus     = searchEngine "thesaurus"     "http://thesaurus.reference.com/search?q="
-wikipedia     = searchEngine "wiki"          "http://en.wikipedia.org/wiki/Special:Search?go=Go&search="
-wiktionary    = searchEngine "wikt"          "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="
-youtube       = searchEngine "youtube"       "http://www.youtube.com/results?search_type=search_videos&search_query="
-wayback       = searchEngineF "wayback"      ("http://web.archive.org/web/*/"++)
-vocabulary    = searchEngine "vocabulary"    "http://www.vocabulary.com/search?q="
+alpha, amazon, arXiv, aur, clojureDocs, codesearch, cratesIo, deb, debbts, debpts, dictionary, duckduckgo, ebay, flora,
+  github, google, hackage, homeManager, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, nixos, noogle, openstreetmap, protondb, 
+  rosettacode, rustStd, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, 
+  wikipedia, wiktionary, youtube, zbmath :: SearchEngine
+alpha         = searchEngine "alpha"         "https://www.wolframalpha.com/input/?i="
+amazon        = searchEngine "amazon"        "https://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="
+arXiv         = searchEngineF "arXiv"        (\s -> "https://arxiv.org/search/?query=" <> s <> "&searchtype=all")
+aur           = searchEngine "aur"           "https://aur.archlinux.org/packages?&K="
+clojureDocs   = searchEngine "clojureDocs"   "https://clojuredocs.org/search?q="
+codesearch    = searchEngine "codesearch"    "https://developers.google.com/s/results/code-search?q="
+cratesIo      = searchEngine  "cratesIo"     "https://crates.io/search?q="
+deb           = searchEngine "deb"           "https://packages.debian.org/"
+debbts        = searchEngine "debbts"        "https://bugs.debian.org/"
+debpts        = searchEngine "debpts"        "https://packages.qa.debian.org/"
+dictionary    = searchEngine "dict"          "https://dictionary.reference.com/browse/"
 duckduckgo    = searchEngine "duckduckgo"    "https://duckduckgo.com/?t=lm&q="
+ebay          = searchEngine "ebay"          "https://www.ebay.com/sch/i.html?_nkw="
+flora         = searchEngine "flora"         "https://flora.pm/search?q="
+github        = searchEngine "github"        "https://github.com/search?q="
+google        = searchEngine "google"        "https://www.google.com/search?q="
+hackage       = searchEngine "hackage"       "https://hackage.haskell.org/package/"
+homeManager   = searchEngine "homeManager"   "https://mipmip.github.io/home-manager-option-search/?query="
+hoogle        = searchEngine "hoogle"        "https://hoogle.haskell.org/?hoogle="
+images        = searchEngine "images"        "https://images.google.fr/images?q="
+imdb          = searchEngine "imdb"          "https://www.imdb.com/find?s=all&q="
+lucky         = searchEngine "lucky"         "https://www.google.com/search?btnI&q="
+maps          = searchEngine "maps"          "https://maps.google.com/maps?q="
+mathworld     = searchEngine "mathworld"     "https://mathworld.wolfram.com/search/?query="
+ncatlab       = searchEngine "ncatlab"       "https://ncatlab.org/nlab/search?query="
+nixos         = searchEngine "nixos"         "https://search.nixos.org/packages?channel=unstable&from=0&size=200&sort=relevance&type=packages&query="
+noogle        = searchEngineF "noogle"       (\s -> "https://noogle.dev/?search=" <> s <> "&page=1&to=any&from=any")
+openstreetmap = searchEngine "openstreetmap" "https://www.openstreetmap.org/search?query="
+protondb      = searchEngine "protondb"      "https://www.protondb.com/search?q="
+rosettacode   = searchEngine "rosettacode"   "https://rosettacode.org/w/index.php?search="
+rustStd       = searchEngine "rustStd"       "https://doc.rust-lang.org/std/index.html?search="
+scholar       = searchEngine "scholar"       "https://scholar.google.com/scholar?q="
+sourcehut     = searchEngine "sourcehut"     "https://sr.ht/projects?search="
+stackage      = searchEngine "stackage"      "https://www.stackage.org/lts/hoogle?q="
+steam         = searchEngine "steam"         "https://store.steampowered.com/search/?term="
+thesaurus     = searchEngine "thesaurus"     "https://thesaurus.com/browse/"
+vocabulary    = searchEngine "vocabulary"    "https://www.vocabulary.com/search?q="
+voidpgks_x86_64      = searchEngine "voidpackages" "https://voidlinux.org/packages/?arch=x86_64&q="
+voidpgks_x86_64_musl = searchEngine "voidpackages" "https://voidlinux.org/packages/?arch=x86_64-musl&q="
+wayback       = searchEngineF "wayback"      ("https://web.archive.org/web/*/"++)
+wikipedia     = searchEngine "wiki"          "https://en.wikipedia.org/wiki/Special:Search?go=Go&search="
+wiktionary    = searchEngine "wikt"          "https://en.wiktionary.org/wiki/Special:Search?go=Go&search="
+youtube       = searchEngine "youtube"       "https://www.youtube.com/results?search_type=search_videos&search_query="
+zbmath        = searchEngine "zbmath"        "https://zbmath.org/?q="
 
 multi :: SearchEngine
-multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)]
+multi = namedEngine "multi" $ foldr1 (!>) [alpha, amazon, aur, codesearch, deb, debbts, debpts, dictionary, duckduckgo, ebay, flora, github, hackage, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, openstreetmap, protondb, rosettacode, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, wikipedia, wiktionary, youtube, prefixAware google]
 
 {- | This function wraps up a search engine and creates a new one, which works
    like the argument, but goes directly to a URL if one is given rather than
@@ -320,9 +397,9 @@ multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbt
 
 > myIntelligentGoogleEngine = intelligent google
 
-   Now if you search for http:\/\/xmonad.org it will directly open in your browser-}
+   Now if you search for https:\/\/xmonad.org it will directly open in your browser-}
 intelligent :: SearchEngine -> SearchEngine
-intelligent (SearchEngine name site) = searchEngineF name (\s -> if (fst $ break (==':') s) `elem` ["http", "https", "ftp"] then s else (site s))
+intelligent (SearchEngine name site) = searchEngineF name (\s -> if takeWhile (/= ':') s `elem` ["http", "https", "ftp"] then s else site s)
 
 -- | > removeColonPrefix "foo://bar" ~> "//bar"
 -- > removeColonPrefix "foo//bar" ~> "foo//bar"
@@ -342,6 +419,7 @@ removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s
   google. The use of intelligent will make sure that URLs are opened directly. -}
 (!>) :: SearchEngine -> SearchEngine -> SearchEngine
 (SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++":") `isPrefixOf` s then site1 (removeColonPrefix s) else site2 s)
+infixr 6 !>
 
 {- | Makes a search engine prefix-aware. Especially useful together with '!>'.
    It will automatically remove the prefix from a query so that you don\'t end
@@ -358,8 +436,18 @@ namedEngine name (SearchEngine _ site) = searchEngineF name site
    Prompt's result, passes it to a given searchEngine and opens it in a given
    browser. -}
 promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
-promptSearchBrowser config browser (SearchEngine name site) =
-    mkXPrompt (Search name) config (historyCompletionP ("Search [" `isPrefixOf`)) $ search browser site
+promptSearchBrowser config browser (SearchEngine name site) = do
+    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 config (searchName `isPrefixOf`)
+    mkXPrompt (Search name) config hc $ search browser site
+  where
+    searchName = showXPrompt (Search name)
 
 {- | Like 'search', but in this case, the string is not specified but grabbed
  from the user's response to a prompt. Example:

XMonad/Actions/ShowText.hs

@@ -1,7 +1,9 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MultiWayIf #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.ShowText
+-- Description :  Display text on the screen.
 -- Copyright   :  (c) Mario Pastorelli (2012)
 -- License     :  BSD-style (see xmonad/LICENSE)
 --
@@ -17,17 +19,15 @@ module XMonad.Actions.ShowText
     ( -- * Usage
       -- $usage
       def
-    , defaultSTConfig
     , handleTimerEvent
     , flashText
     , ShowTextConfig(..)
     ) where
 
-import Control.Monad (when)
 import Data.Map (Map,empty,insert,lookup)
-import Data.Monoid (mempty, All)
 import Prelude hiding (lookup)
 import XMonad
+import XMonad.Prelude (All, fi, listToMaybe)
 import XMonad.StackSet (current,screen)
 import XMonad.Util.Font (Align(AlignCenter)
                        , initXMF
@@ -37,19 +37,18 @@ import XMonad.Util.Font (Align(AlignCenter)
 import XMonad.Util.Timer (startTimer)
 import XMonad.Util.XUtils (createNewWindow
                          , deleteWindow
-                         , fi
                          , showWindow
                          , paintAndWrite)
 import qualified XMonad.Util.ExtensibleState as ES
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- > import XMonad.Actions.ShowText
 --
 -- Then add the event hook handler:
 --
--- > xmonad { handleEventHook = myHandleEventHooks <+> handleTimerEvent }
+-- > xmonad { handleEventHook = myHandleEventHooks <> handleTimerEvent }
 --
 -- You can then use flashText in your keybindings:
 --
@@ -58,7 +57,7 @@ import qualified XMonad.Util.ExtensibleState as ES
 
 -- | ShowText contains the map with timers as keys and created windows as values
 newtype ShowText = ShowText (Map Atom Window)
-    deriving (Read,Show,Typeable)
+    deriving (Read,Show)
 
 instance ExtensionClass ShowText where
     initialValue = ShowText empty
@@ -75,22 +74,23 @@ data ShowTextConfig =
 
 instance Default ShowTextConfig where
   def =
+#ifdef XFT
+    STC { st_font = "xft:monospace-20"
+#else
     STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
+#endif
         , st_bg   = "black"
         , st_fg   = "white"
     }
 
-{-# DEPRECATED defaultSTConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.ShowText) instead." #-}
-defaultSTConfig :: ShowTextConfig
-defaultSTConfig = def
-
 -- | Handles timer events that notify when a window should be removed
 handleTimerEvent :: Event -> X All
 handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do
     (ShowText m) <- ES.get :: X ShowText
     a <- io $ internAtom dis "XMONAD_TIMER" False
-    when (mtyp == a && length d >= 1)
-         (whenJust (lookup (fromIntegral $ d !! 0) m) deleteWindow)
+    if | mtyp == a, Just dh <- listToMaybe d ->
+           whenJust (lookup (fromIntegral dh) m) deleteWindow
+       | otherwise -> pure ()
     mempty
 handleTimerEvent _ = mempty
 

XMonad/Actions/Sift.hs

@@ -0,0 +1,56 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Sift
+-- Description :  Functions for sifting windows up and down.
+-- Copyright   :  (c) 2020 Ivan Brennan <ivanbrennan@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Ivan Brennan <ivanbrennan@gmail.com>
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- Functions for sifting windows up and down. Sifts behave identically to
+-- swaps (i.e. 'swapUp' and 'swapDown' from "XMonad.StackSet"), except in
+-- the wrapping case: rather than rotating the entire stack by one position
+-- like a swap would, a sift causes the windows at either end of the stack
+-- to trade positions.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Sift (
+    -- * Usage
+    -- $usage
+    siftUp,
+    siftDown,
+  ) where
+
+import XMonad.StackSet (Stack (Stack), StackSet, modify')
+import XMonad.Util.Stack (reverseS)
+
+-- $usage
+-- You can use this module with the following in your @xmonad.hs@:
+--
+-- > import XMonad.Actions.Sift
+--
+-- and add keybindings such as the following:
+--
+-- >   , ((modMask .|. shiftMask, xK_j ), windows siftDown)
+-- >   , ((modMask .|. shiftMask, xK_k ), windows siftUp  )
+--
+
+-- |
+-- siftUp, siftDown. Exchange the focused window with its neighbour in
+-- the stack ordering, wrapping if we reach the end. Unlike 'swapUp' and
+-- 'swapDown', wrapping is handled by trading positions with the window
+-- at the other end of the stack.
+--
+siftUp, siftDown :: StackSet i l a s sd -> StackSet i l a s sd
+siftUp   = modify' siftUp'
+siftDown = modify' (reverseS . siftUp' . reverseS)
+
+siftUp' :: Stack a -> Stack a
+siftUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)
+siftUp' (Stack t []     rs) =
+  case reverse rs of
+    (x:xs) -> Stack t (xs ++ [x]) []
+    []     -> Stack t []          []

XMonad/Actions/SimpleDate.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.SimpleDate
+-- Description :  An example external contrib module for XMonad.
 -- Copyright   :  (c) Don Stewart 2007
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -23,7 +24,7 @@ import XMonad.Core
 import XMonad.Util.Run
 
 -- $usage
--- To use, import this module into @~\/.xmonad\/xmonad.hs@:
+-- To use, import this module into @xmonad.hs@:
 --
 -- >     import XMonad.Actions.SimpleDate
 --
@@ -34,7 +35,7 @@ import XMonad.Util.Run
 -- In this example, a popup date menu will now be bound to @mod-d@.
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 date :: X ()
 date = unsafeSpawn "(date; sleep 10) | dzen2"

XMonad/Actions/SinkAll.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.SinkAll
+-- Description  : (DEPRECATED) Push floating windows back into tiling.
 -- License      : BSD3-style (see LICENSE)
 -- Stability    : unstable
 -- Portability  : unportable
@@ -12,7 +13,7 @@
 -- 'sinkAll' function for backwards compatibility.
 -----------------------------------------------------------------------------
 
-module XMonad.Actions.SinkAll (
+module XMonad.Actions.SinkAll {-# DEPRECATED "Use XMonad.Actions.WithAll instead" #-} (
     -- * Usage
     -- $usage
 
@@ -22,7 +23,7 @@ import XMonad.Actions.WithAll (sinkAll)
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- > import XMonad.Actions.SinkAll
 --
@@ -31,4 +32,4 @@ import XMonad.Actions.WithAll (sinkAll)
 -- >   , ((modm .|. shiftMask, xK_t), sinkAll)
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

XMonad/Actions/SpawnOn.hs

@@ -1,7 +1,9 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE LambdaCase #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.SpawnOn
+-- Description  : Modify a window spawned by a command.
 -- Copyright    : (c) Spencer Janssen
 -- License      : BSD
 --
@@ -28,26 +30,27 @@ module XMonad.Actions.SpawnOn (
     shellPromptOn
 ) where
 
-import Data.List (isInfixOf)
 import System.Posix.Types (ProcessID)
 
 import XMonad
+import XMonad.Prelude
 import qualified XMonad.StackSet as W
 
 import XMonad.Hooks.ManageHelpers
 import XMonad.Prompt
 import XMonad.Prompt.Shell
 import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Util.Process (getPPIDChain)
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- >    import XMonad.Actions.SpawnOn
 --
 -- >    main = do
 -- >      xmonad def {
 -- >         ...
--- >         manageHook = manageSpawn <+> manageHook def
+-- >         manageHook = manageSpawn <> manageHook def
 -- >         ...
 -- >      }
 --
@@ -60,9 +63,9 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- the spawned application(e.g. float or resize it).
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
-newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeable
+newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]}
 
 instance ExtensionClass Spawner where
     initialValue = Spawner []
@@ -72,6 +75,9 @@ instance ExtensionClass Spawner where
 modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
 modifySpawner f = XS.modify (Spawner . f . pidsRef)
 
+modifySpawnerM :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -> X ()
+modifySpawnerM f = XS.modifyM (fmap Spawner . f . pidsRef)
+
 -- | Provides a manage hook to react on process spawned with
 -- 'spawnOn', 'spawnHere' etc.
 manageSpawn :: ManageHook
@@ -80,20 +86,20 @@ manageSpawn = manageSpawnWithGC (return . take 20)
 manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)])
         -- ^ function to stop accumulation of entries for windows that never set @_NET_WM_PID@
        -> ManageHook
-manageSpawnWithGC garbageCollect = do
-    Spawner pids <- liftX XS.get
-    mp <- pid
-    case flip lookup pids =<< mp of
-        Nothing -> idHook
-        Just mh  -> do
-            whenJust mp $ \p -> liftX $ do
-                ps <- XS.gets pidsRef
-                XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps)
-            mh
+manageSpawnWithGC garbageCollect = pid >>= \case
+    Nothing -> mempty
+    Just p -> do
+        Spawner pids <- liftX XS.get
+        ppid_chain <- io $ getPPIDChain p
+        case mapMaybe (`lookup` pids) ppid_chain of
+            [] -> mempty
+            mh : _ -> liftX (gc p) >> mh
+  where
+    gc p = modifySpawnerM $ garbageCollect . filter ((/= p) . fst)
 
 mkPrompt :: (String -> X ()) -> XPConfig -> X ()
 mkPrompt cb c = do
-    cmds <- io $ getCommands
+    cmds <- io getCommands
     mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb
 
 -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
@@ -114,13 +120,13 @@ spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd
 -- | Replacement for 'spawn' which launches
 -- application on given workspace.
 spawnOn :: WorkspaceId -> String -> X ()
-spawnOn ws cmd = spawnAndDo (doShift ws) cmd
+spawnOn ws = spawnAndDo (doShift ws)
 
 -- | Spawn an application and apply the manage hook when it opens.
 spawnAndDo :: ManageHook -> String -> X ()
 spawnAndDo mh cmd = do
     p <- spawnPID $ mangle cmd
-    modifySpawner $ ((p,mh) :)
+    modifySpawner ((p,mh) :)
  where
     -- TODO this is silly, search for a better solution
     mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs

XMonad/Actions/Submap.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.Submap
+-- Description :  Create a sub-mapping of key bindings.
 -- Copyright   :  (c) Jason Creighton <jcreigh@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -16,21 +17,23 @@ module XMonad.Actions.Submap (
                              -- * Usage
                              -- $usage
                              submap,
+                             visualSubmap,
+                             visualSubmapSorted,
                              submapDefault,
-                             submapDefaultWithKey
+                             submapDefaultWithKey,
+
+                             -- * Utilities
+                             subName,
                             ) where
 import Data.Bits
-import Data.Maybe (fromMaybe)
-import XMonad hiding (keys)
 import qualified Data.Map as M
-import Control.Monad.Fix (fix)
+import XMonad hiding (keys)
+import XMonad.Prelude (fix, fromMaybe, keyToString, cleanKeyMask)
+import XMonad.Util.XUtils
 
 {- $usage
 
-
-
-
-First, import this module into your @~\/.xmonad\/xmonad.hs@:
+First, import this module into your @xmonad.hs@:
 
 > import XMonad.Actions.Submap
 
@@ -51,7 +54,7 @@ because that is a special value passed to XGrabKey() and not an actual
 modifier.
 
 For detailed instructions on editing your key bindings, see
-"XMonad.Doc.Extending#Editing_key_bindings".
+<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -}
 
@@ -62,6 +65,61 @@ For detailed instructions on editing your key bindings, see
 submap :: M.Map (KeyMask, KeySym) (X ()) -> X ()
 submap = submapDefault (return ())
 
+-- | Like 'submap', but visualise the relevant options.
+--
+-- ==== __Example__
+--
+-- > import qualified Data.Map as Map
+-- > import XMonad.Actions.Submap
+-- >
+-- > gotoLayout :: [(String, X ())]   -- for use with EZConfig
+-- > gotoLayout =  -- assumes you have a layout named "Tall" and one named "Full".
+-- >   [("M-l", visualSubmap def $ Map.fromList $ map (\(k, s, a) -> ((0, k), (s, a)))
+-- >              [ (xK_t, "Tall", switchToLayout "Tall")     -- "M-l t" switches to "Tall"
+-- >              , (xK_r, "Full", switchToLayout "Full")     -- "M-l r" switches to "full"
+-- >              ])]
+--
+-- One could alternatively also write @gotoLayout@ as
+--
+-- > gotoLayout = [("M-l", visualSubmap def $ Map.fromList $
+-- >                         [ ((0, xK_t), subName "Tall" $ switchToLayout "Tall")
+-- >                         , ((0, xK_r), subName "Full" $ switchToLayout "Full")
+-- >                         ])]
+visualSubmap :: WindowConfig -- ^ The config for the spawned window.
+             -> M.Map (KeyMask, KeySym) (String, X ())
+                             -- ^ A map @keybinding -> (description, action)@.
+             -> X ()
+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 =
+        map (\(key, desc) -> keyToString key <> ": " <> desc)
+            . sorted
+            $ zip (M.keys keys) (map fst (M.elems keys))
+
+-- | Give a name to an action.
+subName :: String -> X () -> (String, X ())
+subName = (,)
+
 -- | Like 'submap', but executes a default action if the key did not match.
 submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X ()
 submapDefault = submapDefaultWithKey . const
@@ -71,27 +129,32 @@ submapDefault = submapDefaultWithKey . const
 submapDefaultWithKey :: ((KeyMask, KeySym) -> X ())
                      -> M.Map (KeyMask, KeySym) (X ())
                      -> X ()
-submapDefaultWithKey defAction keys = do
-    XConf { theRoot = root, display = d } <- ask
+submapDefaultWithKey defAction keys = waitForKeyPress >>=
+    \(m', s) -> fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)
 
-    io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
-    io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync
-                     none none currentTime
+-----------------------------------------------------------------------
+-- Internal stuff
+
+waitForKeyPress :: X (KeyMask, KeySym)
+waitForKeyPress = do
+    XConf{ theRoot = root, display = dpy } <- ask
+
+    io $ do grabKeyboard dpy root False grabModeAsync grabModeAsync currentTime
+            grabPointer dpy root False buttonPressMask grabModeAsync grabModeAsync
+                        none none currentTime
 
     (m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
-        maskEvent d (keyPressMask .|. buttonPressMask) p
+        maskEvent dpy (keyPressMask .|. buttonPressMask) p
         ev <- getEvent p
         case ev of
           KeyEvent { ev_keycode = code, ev_state = m } -> do
-            keysym <- keycodeToKeysym d code 0
+            keysym <- keycodeToKeysym dpy code 0
             if isModifierKey keysym
                 then nextkey
                 else return (m, keysym)
           _ -> return (0, 0)
-    -- Remove num lock mask and Xkb group state bits
-    m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)
-
-    io $ ungrabPointer d currentTime
-    io $ ungrabKeyboard d currentTime
-
-    fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)
+    m' <- cleanKeyMask <*> pure m
+    io $ do ungrabPointer dpy currentTime
+            ungrabKeyboard dpy currentTime
+            sync dpy False
+    pure (m', s)

XMonad/Actions/SwapPromote.hs

@@ -0,0 +1,404 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.SwapPromote
+-- Description :  Track the master window history per workspace.
+-- Copyright   :  (c) 2018 Yclept Nemo
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Module for tracking master window history per workspace, and associated
+-- functions for manipulating the stack using such history.
+--
+-----------------------------------------------------------------------------
+
+
+module XMonad.Actions.SwapPromote
+    ( -- * Usage
+      -- $usage
+      MasterHistory (..)
+      -- * State Accessors
+    , getMasterHistoryMap
+    , getMasterHistoryFromTag
+    , getMasterHistoryCurrent
+    , getMasterHistoryFromWindow
+    , modifyMasterHistoryFromTag
+    , modifyMasterHistoryCurrent
+      -- * Log Hook
+    , masterHistoryHook
+      -- * Log Hook Building Blocks
+    , masterHistoryHook'
+    , updateMasterHistory
+      -- * Actions
+    , swapPromote
+    , swapPromote'
+    , swapIn
+    , swapIn'
+    , swapHybrid
+    , swapHybrid'
+      -- * Action Building Blocks
+    , swapApply
+    , swapPromoteStack
+    , swapInStack
+    , swapHybridStack
+      -- * List Utilities
+    , cycleN
+    , split
+    , split'
+    , merge
+    , merge'
+      -- * Stack Utilities
+    , stackSplit
+    , stackMerge
+    ) where
+
+
+import           XMonad
+import           XMonad.Prelude
+import qualified XMonad.StackSet                as W
+import qualified XMonad.Util.ExtensibleState    as XS
+
+import qualified Data.Map                       as M
+import qualified Data.Set                       as S
+import           Control.Arrow
+import qualified Data.List.NonEmpty             as NE
+
+
+-- $usage
+-- Given your configuration file, import this module:
+--
+-- > import XMonad.Actions.SwapPromote
+--
+-- First add 'masterHistoryHook' to your 'logHook' to track master windows per
+-- workspace:
+--
+-- > myLogHook = otherHook >> masterHistoryHook
+--
+-- Then replace xmonad's default promote keybinding with 'swapPromote'':
+--
+-- > , ((mod1Mask, xK_Return), swapPromote' False)
+--
+-- Depending on your xmonad configuration or window actions the master history
+-- may be empty. If this is the case you can still chain another promotion
+-- function:
+--
+-- > import XMonad.Actions.DwmPromote
+-- > , ((mod1Mask, xK_Return), whenX (swapPromote False) dwmpromote)
+--
+-- To be clear, this is only called when the lack of master history hindered
+-- the swap and not other conditions, such as having a only a single window.
+--
+-- While 'swapPromote' preserves window focus, 'swapIn' preserves the focus
+-- position - effectively "swapping" new windows into focus without moving the
+-- zipper. A mix of both, 'swapHybrid' promotes focused non-master windows
+-- while swapping windows into the focused master. This works well on layouts
+-- with large masters. Both come with chainable variants, see 'swapIn'' and
+-- 'swapHybrid''.
+--
+-- So far floating windows have been treated no differently than tiled windows
+-- even though their positions are independent of the stack. Often, yanking
+-- floating windows in and out of the workspace will obliterate the stack
+-- history - particularly frustrating with "XMonad.Util.Scratchpad" since it is
+-- toggled so frequenty and always replaces the master window. That's why the
+-- swap functions accept a boolean argument; when @True@ non-focused floating
+-- windows will be ignored.
+--
+-- All together:
+--
+-- > , ((mod1Mask, xK_Return), whenX (swapHybrid True) dwmpromote)
+
+
+-- | Mapping from workspace tag to master history list. The current master is
+-- the head of the list, the previous master the second element, and so on.
+-- Without history, the list is empty.
+newtype MasterHistory = MasterHistory
+    { getMasterHistory :: M.Map WorkspaceId [Window]
+    } deriving (Read,Show)
+
+instance ExtensionClass MasterHistory where
+    initialValue = MasterHistory M.empty
+
+-- | Return the master history map from the state.
+getMasterHistoryMap :: X (M.Map WorkspaceId [Window])
+getMasterHistoryMap = XS.gets getMasterHistory
+
+-- | Return the master history list of a given tag. The master history list may
+-- be empty. An invalid tag will also result in an empty list.
+getMasterHistoryFromTag :: WorkspaceId -> X [Window]
+getMasterHistoryFromTag t = M.findWithDefault [] t <$> getMasterHistoryMap
+
+-- | Return the master history list of the current workspace.
+getMasterHistoryCurrent :: X [Window]
+getMasterHistoryCurrent =   gets (W.currentTag . windowset)
+                        >>= getMasterHistoryFromTag
+
+-- | Return the master history list of the workspace containing the given
+-- window. Return an empty list if the window is not in the stackset.
+getMasterHistoryFromWindow :: Window -> X [Window]
+getMasterHistoryFromWindow w =   gets (W.findTag w . windowset)
+                             >>= maybe (return []) getMasterHistoryFromTag
+
+-- | Modify the master history list of a given workspace, or the empty list of
+-- no such workspace is mapped. The result is then re-inserted into the master
+-- history map.
+modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X ()
+modifyMasterHistoryFromTag t f = XS.modify $ \(MasterHistory m) ->
+    let l = M.findWithDefault [] t m
+    in  MasterHistory $ M.insert t (f l) m
+
+-- | Modify the master history list of the current workspace. While the current
+-- workspace is guaranteed to exist; its master history may not. For more
+-- information see 'modifyMasterHistoryFromTag'.
+modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X ()
+modifyMasterHistoryCurrent f =   gets (W.currentTag . windowset)
+                             >>= flip modifyMasterHistoryFromTag f
+
+-- | A 'logHook' to update the master history mapping. Non-existent workspaces
+-- are removed, and the master history list for the current workspaces is
+-- updated. See 'masterHistoryHook''.
+masterHistoryHook :: X ()
+masterHistoryHook = masterHistoryHook' True updateMasterHistory
+
+-- | Backend for 'masterHistoryHook'.
+masterHistoryHook' :: Bool
+                        -- ^ If @True@, remove non-existent workspaces.
+                   -> ([Window] -> [Window] -> [Window])
+                        -- ^ Function used to update the master history list of
+                        -- the current workspace. First argument is the master
+                        -- history, second is the integrated stack.  See
+                        -- 'updateMasterHistory' for more details.
+                   -> X ()
+masterHistoryHook' removeWorkspaces historyModifier = do
+    wset <- gets windowset
+    let W.Workspace wid _ mst = W.workspace . W.current $ wset
+        tags = map W.tag $ W.workspaces wset
+        st = W.integrate' mst
+    XS.modify $ \(MasterHistory mm) ->
+        let mm' = if removeWorkspaces
+                  then restrictKeys mm $ S.fromList tags
+                  else mm
+            ms  = M.findWithDefault [] wid mm'
+            ms' = historyModifier ms st
+        in  MasterHistory $ M.insert wid ms' mm'
+
+-- | Less efficient version of 'M.restrictKeys'. Given broader eventual
+-- adoption, replace this with 'M.restrictKeys'.
+restrictKeys :: Ord k => M.Map k a -> S.Set k -> M.Map k a
+restrictKeys m s = M.filterWithKey (\k _ -> k `S.member` s) m
+
+-- | Given the current master history list and an integrated stack, return the
+-- new master history list. The current master is either moved (if it exists
+-- within the history) or added to the head of the list, and all missing (i.e.
+-- closed) windows are removed.
+updateMasterHistory :: [Window] -- ^ The master history list.
+                    -> [Window] -- ^ The integrated stack.
+                    -> [Window]
+updateMasterHistory _  []       = []
+updateMasterHistory ms ws@(w:_) = (w : delete w ms) `intersect` ws
+
+-- | Wrap 'swapPromoteStack'; see also 'swapApply'.
+swapPromote :: Bool -> X Bool
+swapPromote = flip swapApply swapPromoteStack
+
+-- | Like 'swapPromote'' but discard the result.
+swapPromote' :: Bool -> X ()
+swapPromote' = void . swapPromote
+
+-- | Wrap 'swapInStack'; see also 'swapApply'.
+swapIn :: Bool -> X Bool
+swapIn = flip swapApply swapInStack
+
+-- | Like 'swapIn'' but discard the result.
+swapIn' :: Bool -> X ()
+swapIn' = void . swapIn
+
+-- | Wrap 'swapHybridStack'; see also 'swapApply'.
+swapHybrid :: Bool -> X Bool
+swapHybrid = flip swapApply swapHybridStack
+
+-- | Like 'swapHybrid'' but discard the result.
+swapHybrid' :: Bool -> X ()
+swapHybrid' = void . swapHybrid
+
+-- | Apply the given master history stack modifier to the current stack. If
+-- given @True@, all non-focused floating windows will be ignored. Return
+-- @True@ if insufficient history; if so use 'whenX' to sequence a backup
+-- promotion function.
+swapApply :: Bool
+          -> (Maybe Window -> W.Stack Window -> (Bool,W.Stack Window))
+          -> X Bool
+swapApply ignoreFloats swapFunction = do
+    fl <- gets $ W.floating . windowset
+    st <- gets $ W.stack . W.workspace . W.current . windowset
+    ch <- getMasterHistoryCurrent
+    let swapApply' s1 =
+            let fl' = if ignoreFloats then M.keysSet fl else S.empty
+                ff = (||) <$> (`S.notMember` fl') <*> (== W.focus s1)
+                fh = filter ff ch
+                pm = listToMaybe . drop 1 $ fh
+                (r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window)
+                (b,s3) = swapFunction pm s2
+                s4 = stackMerge s3 r
+                mh = let w = NE.head . notEmpty . W.integrate $ s3
+                     in const $ w : delete w ch
+            in (b,Just s4,mh)
+        (x,y,z) = maybe (False,Nothing,id) swapApply' st
+    -- Any floating master windows will be added to the history when 'windows'
+    -- calls the log hook.
+    modifyMasterHistoryCurrent z
+    windows $ W.modify Nothing . const $ y
+    return x
+
+-- | If the focused window is the master window and there is no previous
+-- master, do nothing. Otherwise swap the master with the previous master. If
+-- the focused window is not the master window, swap it with the master window.
+-- In either case focus follows the original window, i.e. the focused window
+-- does not change, only its position.
+--
+-- The first argument is the previous master (which may not exist), the second
+-- a window stack. Return @True@ if the master history hindered the swap; the
+-- history is either empty or out-of-sync. Though the latter shouldn't happen
+-- this function never changes the stack under such circumstances.
+swapPromoteStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
+swapPromoteStack _         st@(W.Stack _x [] []) = (False,st)
+swapPromoteStack Nothing   st@(W.Stack _x [] _r) = (True,st)
+swapPromoteStack (Just pm)    (W.Stack  x []  r) =
+    let (r',l') = (reverse *** cycleN 1) $ span (/= pm) $ reverse r
+        st'     = W.Stack x l' r'
+        b       = null l'
+    in  (b,st')
+swapPromoteStack _            (W.Stack  x l   r) =
+    let r'  = (++ r) . cycleN 1 . reverse $ l
+        st' = W.Stack x [] r'
+    in  (False,st')
+
+-- | Perform the same swap as 'swapPromoteStack'. However the new window
+-- receives the focus; it appears to "swap into" the position of the original
+-- window. Under this model focus follows stack position and the zipper does
+-- not move.
+--
+-- See 'swapPromoteStack' for more details regarding the parameters.
+swapInStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
+swapInStack _         st@(W.Stack _x [] []) = (False,st)
+swapInStack Nothing   st@(W.Stack _x [] _r) = (True,st)
+swapInStack (Just pm)    (W.Stack  x []  r) =
+    let (x',r') = case span (/= pm) r of
+            (__,[]) -> (x,r)
+            (sl,sr) -> (pm,sl ++ x : drop 1 sr)
+        st'     = W.Stack x' [] r'
+        b       = x' == x
+    in  (b,st')
+swapInStack _            (W.Stack  x l   r) =
+    let l'  = init l ++ [x]
+        x'  = last l
+        st' = W.Stack x' l' r
+    in  (False,st')
+
+-- | If the focused window is the master window, use 'swapInStack'. Otherwise use
+-- 'swapPromoteStack'.
+--
+-- See 'swapPromoteStack' for more details regarding the parameters.
+swapHybridStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
+swapHybridStack m st@(W.Stack _ [] _) = swapInStack m st
+swapHybridStack m st                  = swapPromoteStack m st
+
+-- | Cycle a list by the given count. If positive, cycle to the left. If
+-- negative, cycle to the right:
+--
+-- >>> cycleN 2 [1,2,3,4,5]
+-- [3,4,5,1,2]
+-- >>> cycleN (-2) [1,2,3,4,5]
+-- [4,5,1,2,3]
+cycleN :: Int -> [a] -> [a]
+cycleN n ls =
+    let l = length ls
+    in  take l $ drop (n `mod` l) $ cycle ls
+
+-- | Wrap 'split'' with an initial index of @0@, discarding the list's length.
+split :: (Num a, Enum a) => (b -> Bool) -> [b] -> ([(a,b)],[b])
+split p l =
+    let (_,ys,ns) = split' p 0 l
+    in  (ys,ns)
+
+-- | Given a predicate, an initial index and a list, return a tuple containing:
+--
+--  * List length.
+--  * Indexed list of elements which satisfy the predicate. An indexed element
+--    is a tuple containing the element index (offset by the initial index) and
+--    the element.
+--  * List of elements which do not satisfy the predicate.
+--
+-- The initial index and length of the list simplify chaining calls to this
+-- function, such as for zippers of lists.
+split' :: (Num a, Enum a) => (b -> Bool) -> a -> [b] -> (a,[(a,b)],[b])
+split' p i l =
+    let accumulate e (c,ys,ns) = if p (snd e)
+            then (c+1,e:ys,ns)
+            else (c+1,ys,e:ns)
+        (c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l
+    in  (c',ys',map snd ns')
+
+-- | Wrap 'merge'' with an initial virtual index of @0@. Return only the
+-- unindexed list with elements from the leftover indexed list appended.
+merge :: (Ord a, Num a) => [(a,b)] -> [b] -> [b]
+merge il ul =
+    let (_,il',ul') = merge' 0 il ul
+    in  ul' ++ map snd il'
+
+-- | Inverse of 'split'. Merge an indexed list with an unindexed list (see
+-- 'split''). Given a virtual index, an indexed list and an unindexed list,
+-- return a tuple containing:
+--
+--  * Virtual index /after/ the unindexed list
+--  * Remainder of the indexed list
+--  * Merged unindexed list
+--
+-- If the indexed list is empty, this functions consumes the entire unindexed
+-- list. If the unindexed list is empty, this function consumes only adjacent
+-- indexed elements. For example, @[(10,"ten"),(12,"twelve")]@ implies missing
+-- unindexed elements and so once @(10,"ten")@ is consumed this function
+-- concludes.
+--
+-- The indexed list is assumed to have been created by 'split'' and not checked
+-- for correctness. Indices are assumed to be ascending, i.e.
+-- > [(1,"one"),(2,"two"),(4,"four")]
+--
+-- The initial and final virtual indices simplify chaining calls to the this
+-- function, as as for zippers of lists. Positive values shift the unindexed
+-- list towards the tail, as if preceded by that many elements.
+merge' :: (Ord a, Num a) => a -> [(a,b)] -> [b] -> (a,[(a,b)],[b])
+merge' i il@((j,a):ps) ul@(b:bs) = if j <= i
+    then let (x,y,z) = merge' (i+1) ps ul
+         in  (x,y,a:z)
+    else let (x,y,z) = merge' (i+1) il bs
+         in  (x,y,b:z)
+merge' i [] (b:bs) =
+         let (x,y,z) = merge' (i+1) [] bs
+         in  (x,y,b:z)
+merge' i il@((j,a):ps) [] = if j <= i
+    then let (x,y,z) = merge' (i+1) ps []
+         in  (x,y,a:z)
+    else (i,il,[])
+merge' i [] [] =
+         (i,[],[])
+
+-- | Remove all elements of the set from the stack. Skip the currently focused
+-- member. Return an indexed list of excluded elements and the modified stack.
+-- Use 'stackMerge' to re-insert the elements using this list.
+stackSplit :: (Num a, Enum a, Ord b) => W.Stack b -> S.Set b -> ([(a,b)],W.Stack b)
+stackSplit (W.Stack x l r) s =
+    let (c,fl,tl) = split' (`S.member` s) 0 (reverse l)
+        (_,fr,tr) = split' (`S.member` s) (c+1) r
+    in  (fl++fr,W.Stack x (reverse tl) tr)
+
+-- | Inverse of 'stackSplit'. Given a list of elements and their original
+-- indices, re-insert the elements into these same positions within the stack.
+-- Skip the currently focused member. Works best if the stack's length hasn't
+-- changed, though if shorter any leftover elements will be tacked on.
+stackMerge :: (Ord a, Num a) => W.Stack b -> [(a,b)] -> W.Stack b
+stackMerge (W.Stack x l r) il =
+    let (i,il1,l') = merge' 0 il (reverse l)
+        (_,il2,r') = merge' (i+1) il1 r
+    in  W.Stack x (reverse l') (r' ++ map snd il2)

XMonad/Actions/SwapWorkspaces.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.SwapWorkspaces
+-- Description :  Swap workspace tags without having to move individual windows.
 -- Copyright   :  (c) Devin Mullins <me@twifkak.com>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -29,7 +30,7 @@ import XMonad.Util.WorkspaceCompare
 
 
 -- $usage
--- Add this import to your @~\/.xmonad\/xmonad.hs@:
+-- Add this import to your @xmonad.hs@:
 --
 -- > import XMonad.Actions.SwapWorkspaces
 --
@@ -43,7 +44,7 @@ import XMonad.Util.WorkspaceCompare
 -- will swap workspaces 1 and 5.
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Swaps the currently focused workspace with the given workspace tag, via
 --   @swapWorkspaces@.
@@ -53,12 +54,13 @@ swapWithCurrent t s = swapWorkspaces t (currentTag s) s
 -- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace.
 -- This is an @X ()@ so can be hooked up to your keybindings directly.
 swapTo :: Direction1D -> X ()
-swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent
+swapTo dir = findWorkspace getSortByIndex dir anyWS 1 >>= windows . swapWithCurrent
 
 -- | Takes two workspace tags and an existing XMonad.StackSet and returns a new
 --   one with the two corresponding workspaces' tags swapped.
 swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
 swapWorkspaces t1 t2 = mapWorkspace swap
-    where swap w = if      tag w == t1 then w { tag = t2 }
-                   else if tag w == t2 then w { tag = t1 }
-                   else w
+    where swap w
+            | tag w == t1 = w { tag = t2 }
+            | tag w == t2 = w { tag = t1 }
+            | otherwise = w

XMonad/Actions/TagWindows.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.TagWindows
+-- Description  : Functions for tagging windows and selecting them by tags.
 -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
 -- License      : BSD
 --
@@ -26,21 +27,19 @@ module XMonad.Actions.TagWindows (
                  TagPrompt,
                  ) where
 
-import Data.List (nub,sortBy)
-import Control.Monad
 import Control.Exception as E
 
-import XMonad.StackSet hiding (filter)
-
-import XMonad.Prompt
 import XMonad hiding (workspaces)
+import XMonad.Prelude
+import XMonad.Prompt
+import XMonad.StackSet hiding (filter)
 
 econst :: Monad m => a -> IOException -> m a
 econst = const . return
 
 -- $usage
 --
--- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:
+-- To use window tags, import this module into your @xmonad.hs@:
 --
 -- > import XMonad.Actions.TagWindows
 -- > import XMonad.Prompt    -- to use tagPrompt
@@ -65,7 +64,7 @@ econst = const . return
 --       the tags \"a\" and \"b\" but not \"a b\".
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | set multiple tags for a window at once (overriding any previous tags)
 setTags :: [String] -> Window -> X ()
@@ -84,18 +83,17 @@ getTags w = withDisplay $ \d ->
     io $ E.catch (internAtom d "_XMONAD_TAGS" False >>=
                 getTextProperty d w >>=
                 wcTextPropertyToTextList d)
-               (econst [[]])
-    >>= return . words . unwords
+               (econst [[]]) <&> (words . unwords)
 
 -- | check a window for the given tag
 hasTag :: String -> Window -> X Bool
-hasTag s w = (s `elem`) `fmap` getTags w
+hasTag s w = (s `elem`) <$> getTags w
 
 -- | add a tag to the existing ones
 addTag :: String -> Window -> X ()
 addTag s w = do
     tags <- getTags w
-    if (s `notElem` tags) then setTags (s:tags) w else return ()
+    when (s `notElem` tags) $ setTags (s:tags) w
 
 -- | remove a tag from a window, if it exists
 delTag :: String -> Window -> X ()
@@ -136,11 +134,6 @@ focusTagged' :: (WindowSet -> [Window]) -> String -> X ()
 focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>=
     maybe (return ()) (windows . focusWindow)
 
-findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
-findM _ []      = return Nothing
-findM p (x:xs)  = do b <- p x
-                     if b then return (Just x) else findM p xs
-
 -- | apply a pure function to windows with a tag
 withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X ()
 withTaggedP       t f = withTagged'       t (winMap f)
@@ -158,7 +151,7 @@ withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m
 
 withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
 withTaggedGlobal' t m = gets windowset >>=
-    filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m
+    filterM (hasTag t) . concatMap (integrate' . stack) . workspaces >>= m
 
 withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
 withFocusedP f = withFocused $ windows . f
@@ -167,7 +160,7 @@ shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s
 shiftHere w s = shiftWin (currentTag s) w s
 
 shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd
-shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of
+shiftToScreen sid w s = case filter (\m -> sid /= screen m) (current s:visible s) of
                                 []      -> s
                                 (t:_)   -> shiftWin (tag . workspace $ t) w s
 
@@ -180,20 +173,19 @@ instance XPrompt TagPrompt where
 tagPrompt :: XPConfig -> (String -> X ()) -> X ()
 tagPrompt c f = do
   sc <- tagComplList
-  mkXPrompt TagPrompt c (mkComplFunFromList' sc) f
+  mkXPrompt TagPrompt c (mkComplFunFromList' c sc) f
 
 tagComplList :: X [String]
-tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=
-    mapM getTags >>=
-    return . nub . concat
+tagComplList = gets (concatMap (integrate' . stack) . workspaces . windowset)
+           >>= mapM getTags
+           <&> nub . concat
 
 
 tagDelPrompt :: XPConfig -> X ()
 tagDelPrompt c = do
   sc <- tagDelComplList
-  if (sc /= [])
-    then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s))
-    else return ()
+  when (sc /= []) $
+    mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (withFocused . delTag)
 
 tagDelComplList :: X [String]
 tagDelComplList = gets windowset >>= maybe (return []) getTags . peek

XMonad/Actions/TiledWindowDragging.hs

@@ -0,0 +1,92 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.TiledWindowDragging
+-- Description :  Change the position of windows by dragging them.
+-- Copyright   :  (c) 2020 Leon Kowarschick
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Leon Kowarschick. <thereal.elkowar@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides an action that allows you to change the position of windows by dragging them around.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.TiledWindowDragging
+  (
+  -- * Usage
+  -- $usage
+    dragWindow
+  )
+where
+
+import           XMonad
+import           XMonad.Prelude
+import qualified XMonad.StackSet               as W
+import           XMonad.Layout.DraggingVisualizer
+
+-- $usage
+-- You can use this module with the following in your @xmonad.hs@:
+--
+-- > import XMonad.Actions.TiledWindowDragging
+-- > import XMonad.Layout.DraggingVisualizer
+--
+-- then edit your 'layoutHook' by adding the draggingVisualizer to your layout:
+--
+-- > myLayout = draggingVisualizer $ layoutHook def
+--
+-- Then add a mouse binding for 'dragWindow':
+--
+-- > , ((modMask .|. shiftMask, button1), dragWindow)
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
+
+
+
+-- | Create a mouse binding for this to be able to drag your windows around.
+-- You need "XMonad.Layout.DraggingVisualizer" for this to look good.
+dragWindow :: Window -> X ()
+dragWindow window = whenX (isClient window) $ withDisplay $ \dpy ->
+  withWindowAttributes dpy window $ \wa -> do
+    focus window
+    (offsetX, offsetY)                    <- getPointerOffset window
+    let (winX, winY, winWidth, winHeight)  = getWindowPlacement wa
+
+    mouseDrag
+        (\posX posY ->
+          let rect = Rectangle (fi (fi winX + (posX - fi offsetX)))
+                               (fi (fi winY + (posY - fi offsetY)))
+                               (fi winWidth)
+                               (fi winHeight)
+          in  sendMessage $ DraggingWindow window rect
+        )
+        (sendMessage DraggingStopped >> performWindowSwitching window)
+
+
+-- | get the pointer offset relative to the given windows root coordinates
+getPointerOffset :: Window -> X (Int, Int)
+getPointerOffset win = do
+    (_, _, _, oX, oY, _, _, _) <- withDisplay (\d -> io $ queryPointer d win)
+    return (fi oX, fi oY)
+
+-- | return a tuple of windowX, windowY, windowWidth, windowHeight
+getWindowPlacement :: WindowAttributes -> (Int, Int, Int, Int)
+getWindowPlacement wa = (fi $ wa_x wa, fi $ wa_y wa, fi $ wa_width wa, fi $ wa_height wa)
+
+performWindowSwitching :: Window -> X ()
+performWindowSwitching win = do
+    root                          <- asks theRoot
+    (_, _, selWin, _, _, _, _, _) <- withDisplay (\d -> io $ queryPointer d root)
+    ws                            <- gets windowset
+    let allWindows = W.index ws
+    when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
+        let allWindowsSwitched = map (switchEntries win selWin) allWindows
+        (ls, t : rs)          <- pure $ break (== win) allWindowsSwitched
+        let newStack           = W.Stack t (reverse ls) rs
+        windows $ W.modify' $ const newStack
+   where
+    switchEntries a b x | x == a    = b
+                        | x == b    = a
+                        | otherwise = x

XMonad/Actions/ToggleFullFloat.hs

@@ -0,0 +1,122 @@
+-- |
+-- Module      :  XMonad.Actions.ToggleFullFloat
+-- Description :  Fullscreen (float) a window while remembering its original state.
+-- Copyright   :  (c) 2022 Tomáš Janoušek <tomi@nomi.cz>
+-- License     :  BSD3
+-- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>
+--
+module XMonad.Actions.ToggleFullFloat (
+    -- * Usage
+    -- $usage
+    toggleFullFloatEwmhFullscreen,
+    toggleFullFloat,
+    fullFloat,
+    unFullFloat,
+    gcToggleFullFloat,
+    ) where
+
+import qualified Data.Map.Strict as M
+
+import XMonad
+import XMonad.Prelude
+import XMonad.Hooks.EwmhDesktops (setEwmhFullscreenHooks)
+import XMonad.Hooks.ManageHelpers
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- ---------------------------------------------------------------------
+-- $usage
+--
+-- The main use-case is to make 'ewmhFullscreen' (re)store the size and
+-- position of floating windows instead of just unconditionally sinking them
+-- into the floating layer. To enable this, you'll need this in your
+-- @xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Actions.ToggleFullFloat
+-- > import XMonad.Hooks.EwmhDesktops
+-- >
+-- > main = xmonad $ … . toggleFullFloatEwmhFullscreen . ewmhFullscreen . ewmh . … $ def{…}
+--
+-- Additionally, this "smart" fullscreening can be bound to a key and invoked
+-- manually whenever one needs a larger window temporarily:
+--
+-- >   , ((modMask .|. shiftMask, xK_t), withFocused toggleFullFloat)
+
+newtype ToggleFullFloat = ToggleFullFloat{ fromToggleFullFloat :: M.Map Window (Maybe W.RationalRect) }
+    deriving (Show, Read)
+
+instance ExtensionClass ToggleFullFloat where
+    extensionType = PersistentExtension
+    initialValue = ToggleFullFloat mempty
+
+-- | Full-float a window, remembering its state (tiled/floating and
+-- position/size).
+fullFloat :: Window -> X ()
+fullFloat = windows . appEndo <=< runQuery doFullFloatSave
+
+-- | Restore window to its remembered state.
+unFullFloat :: Window -> X ()
+unFullFloat = windows . appEndo <=< runQuery doFullFloatRestore
+
+-- | Full-float a window, if it's not already full-floating. Otherwise,
+-- restore its original state.
+toggleFullFloat :: Window -> X ()
+toggleFullFloat w = ifM (isFullFloat w) (unFullFloat w) (fullFloat w)
+
+isFullFloat :: Window -> X Bool
+isFullFloat w = gets $ (Just fullRect ==) . M.lookup w . W.floating . windowset
+  where
+    fullRect = W.RationalRect 0 0 1 1
+
+doFullFloatSave :: ManageHook
+doFullFloatSave = do
+    w <- ask
+    liftX $ do
+        f <- gets $ M.lookup w . W.floating . windowset
+        -- @M.insertWith const@ = don't overwrite stored original state
+        XS.modify' $ ToggleFullFloat . M.insertWith const w f . fromToggleFullFloat
+    doFullFloat
+
+doFullFloatRestore :: ManageHook
+doFullFloatRestore = do
+    w <- ask
+    mf <- liftX $ do
+        mf <- XS.gets $ M.lookup w . fromToggleFullFloat
+        XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat
+        pure mf
+    doF $ case mf of
+        Just (Just f) -> W.float w f  -- was floating before
+        Just Nothing -> W.sink w      -- was tiled before
+        Nothing -> W.sink w           -- fallback when not found in ToggleFullFloat
+
+-- | Install ToggleFullFloat garbage collection hooks.
+--
+-- Note: This is included in 'toggleFullFloatEwmhFullscreen', only needed if
+-- using the 'toggleFullFloat' separately from the EWMH hook.
+gcToggleFullFloat :: XConfig a -> XConfig a
+gcToggleFullFloat c = c { startupHook     = startupHook c <> gcToggleFullFloatStartupHook
+                        , handleEventHook = handleEventHook c <> gcToggleFullFloatEventHook }
+
+-- | ToggleFullFloat garbage collection: drop windows when they're destroyed.
+gcToggleFullFloatEventHook :: Event -> X All
+gcToggleFullFloatEventHook DestroyWindowEvent{ev_window = w} = do
+    XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat
+    mempty
+gcToggleFullFloatEventHook _ = mempty
+
+-- | ToggleFullFloat garbage collection: restrict to existing windows at
+-- startup.
+gcToggleFullFloatStartupHook :: X ()
+gcToggleFullFloatStartupHook = withWindowSet $ \ws ->
+    XS.modify' $ ToggleFullFloat . M.filterWithKey (\w _ -> w `W.member` ws) . fromToggleFullFloat
+
+-- | Hook this module into 'XMonad.Hooks.EwmhDesktops.ewmhFullscreen'. This
+-- makes windows restore their original state (size and position if floating)
+-- instead of unconditionally sinking into the tiling layer.
+--
+-- ('gcToggleFullFloat' is included here.)
+toggleFullFloatEwmhFullscreen :: XConfig a -> XConfig a
+toggleFullFloatEwmhFullscreen =
+    setEwmhFullscreenHooks doFullFloatSave doFullFloatRestore .
+    gcToggleFullFloat

XMonad/Actions/TopicSpace.hs

@@ -1,7 +1,8 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE NamedFieldPuns #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.TopicSpace
+-- Description :  Turns your workspaces into a more topic oriented system.
 -- Copyright   :  (c) Nicolas Pouillard
 -- License     :  BSD-style (see LICENSE)
 --
@@ -19,21 +20,49 @@ module XMonad.Actions.TopicSpace
 
   -- * Usage
   -- $usage
-   Topic
+
+  -- * Types for Building Topics
+    Topic
   , Dir
   , TopicConfig(..)
-  , def
-  , defaultTopicConfig
-  , getLastFocusedTopics
-  , setLastFocusedTopic
-  , reverseLastFocusedTopics
-  , pprWindowSet
+  , TopicItem(..)
+
+    -- * Managing 'TopicItem's
+  , topicNames
+  , tiActions
+  , tiDirs
+  , noAction
+  , inHome
+
+    -- * Switching and Shifting Topics
+  , switchTopic
+  , switchNthLastFocused
+  , switchNthLastFocusedByScreen
+  , switchNthLastFocusedExclude
+  , shiftNthLastFocused
+
+    -- * Topic Actions
   , topicActionWithPrompt
   , topicAction
   , currentTopicAction
-  , switchTopic
-  , switchNthLastFocused
-  , shiftNthLastFocused
+
+    -- * Getting the Topic History
+  , getLastFocusedTopics
+  , workspaceHistory
+  , workspaceHistoryByScreen
+
+    -- * Modifying the Topic History
+  , setLastFocusedTopic
+  , reverseLastFocusedTopics
+
+    -- * History hooks
+  , workspaceHistoryHook
+  , workspaceHistoryHookExclude
+
+    -- * Pretty Printing
+  , pprWindowSet
+
+    -- * Utility
   , currentTopicDir
   , checkTopicConfig
   , (>*>)
@@ -41,25 +70,26 @@ module XMonad.Actions.TopicSpace
 where
 
 import XMonad
+import XMonad.Prelude
 
-import Data.List
-import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
-import Data.Ord
-import qualified Data.Map as M
-import Control.Monad (liftM2,when,unless,replicateM_)
-import System.IO
+import qualified Data.Map.Strict           as M
+import qualified XMonad.Hooks.StatusBar.PP as SBPP
+import qualified XMonad.StackSet           as W
 
-import qualified XMonad.StackSet as W
+import Data.Map (Map)
 
-import XMonad.Prompt
-import XMonad.Prompt.Workspace
+import XMonad.Prompt (XPConfig)
+import XMonad.Prompt.Workspace (workspacePrompt)
 
-import XMonad.Hooks.UrgencyHook
-import XMonad.Hooks.DynamicLog (PP(..))
-import qualified XMonad.Hooks.DynamicLog as DL
-
-import XMonad.Util.Run (spawnPipe)
-import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Hooks.StatusBar.PP (PP(ppHidden, ppVisible))
+import XMonad.Hooks.UrgencyHook (readUrgents)
+import XMonad.Hooks.WorkspaceHistory
+    ( workspaceHistory
+    , workspaceHistoryByScreen
+    , workspaceHistoryHook
+    , workspaceHistoryHookExclude
+    , workspaceHistoryModify
+    )
 
 -- $overview
 -- This module allows to organize your workspaces on a precise topic basis.  So
@@ -73,112 +103,133 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- display your topics in an historical way using a custom `pprWindowSet'
 -- function. You can also easily switch to recent topics using this history
 -- of last focused topics.
+--
+-- A blog post highlighting some features of this module can be found
+-- <https://tony-zorman.com/posts/topic-space/2022-09-11-topic-spaces.html here>.
 
 -- $usage
--- Here is an example of configuration using TopicSpace:
+-- You can use this module with the following in your @xmonad.hs@:
 --
--- > -- The list of all topics/workspaces of your xmonad configuration.
--- > -- The order is important, new topics must be inserted
--- > -- at the end of the list if you want hot-restarting
--- > -- to work.
--- > myTopics :: [Topic]
--- > myTopics =
--- >   [ "dashboard" -- the first one
--- >   , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"
--- >   , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad"
--- >   , "yi", "documents", "twitter", "pdf"
--- >   ]
+-- > import qualified Data.Map.Strict as M
+-- > import qualified XMonad.StackSet as W
 -- >
+-- > import XMonad.Actions.TopicSpace
+-- > import XMonad.Util.EZConfig    -- for the keybindings
+-- > import XMonad.Prompt.Workspace -- if you want to use the prompt
+--
+-- You will then have to
+--
+--   * Define a new 'TopicConfig' via 'TopicItem's
+--
+--   * Add the appropriate keybindings
+--
+--   * Replace the @workspaces@ field in your 'XConfig' with a list of
+--     your topics names
+--
+--   * Optionally, if you want to use the history features, add
+--     'workspaceHistoryHook' from "XMonad.Hooks.WorkspaceHistory"
+--     (re-exported by this module) or an equivalent function to your
+--     @logHook@.  See the documentation of
+--     "XMonad.Hooks.WorkspaceHistory" for further details
+--
+-- Let us go through a full example together.
+--
+-- A 'TopicItem' consists of three things: the name of the topic, its
+-- root directory, and the action associated to it—to be executed if the
+-- topic is empty or the action is forced via a keybinding.
+--
+-- We start by specifying our chosen topics as a list of such
+-- 'TopicItem's:
+--
+-- > topicItems :: [TopicItem]
+-- > topicItems =
+-- >   [ inHome   "1:WEB"              (spawn "firefox")
+-- >   , noAction "2"      "."
+-- >   , noAction "3:VID"  "videos"
+-- >   , TI       "4:VPN"  "openvpn"   (spawn "urxvt -e randomVPN.sh")
+-- >   , inHome   "5:IM"               (spawn "signal" *> spawn "telegram")
+-- >   , inHome   "6:IRC"              (spawn "urxvt -e weechat")
+-- >   , TI       "dts"    ".dotfiles" spawnShell
+-- >   , TI       "xm-con" "hs/xm-con" (spawnShell *> spawnShellIn "hs/xm")
+-- >   ]
+--
+-- Then we just need to put together our topic config:
+--
 -- > myTopicConfig :: TopicConfig
 -- > myTopicConfig = def
--- >   { topicDirs = M.fromList $
--- >       [ ("conf", "w/conf")
--- >       , ("dashboard", "Desktop")
--- >       , ("yi", "w/dev-haskell/yi")
--- >       , ("darcs", "w/dev-haskell/darcs")
--- >       , ("haskell", "w/dev-haskell")
--- >       , ("xmonad", "w/dev-haskell/xmonad")
--- >       , ("tools", "w/tools")
--- >       , ("movie", "Movies")
--- >       , ("talk", "w/talks")
--- >       , ("music", "Music")
--- >       , ("documents", "w/documents")
--- >       , ("pdf", "w/documents")
--- >       ]
--- >   , defaultTopicAction = const $ spawnShell >*> 3
--- >   , defaultTopic = "dashboard"
--- >   , topicActions = M.fromList $
--- >       [ ("conf",       spawnShell >> spawnShellIn "wd/ertai/private")
--- >       , ("darcs",      spawnShell >*> 3)
--- >       , ("yi",         spawnShell >*> 3)
--- >       , ("haskell",    spawnShell >*> 2 >>
--- >                        spawnShellIn "wd/dev-haskell/ghc")
--- >       , ("xmonad",     spawnShellIn "wd/x11-wm/xmonad" >>
--- >                        spawnShellIn "wd/x11-wm/xmonad/contrib" >>
--- >                        spawnShellIn "wd/x11-wm/xmonad/utils" >>
--- >                        spawnShellIn ".xmonad" >>
--- >                        spawnShellIn ".xmonad")
--- >       , ("mail",       mailAction)
--- >       , ("irc",        ssh somewhere)
--- >       , ("admin",      ssh somewhere >>
--- >                        ssh nowhere)
--- >       , ("dashboard",  spawnShell)
--- >       , ("twitter",    spawnShell)
--- >       , ("web",        spawn browserCmd)
--- >       , ("movie",      spawnShell)
--- >       , ("documents",  spawnShell >*> 2 >>
--- >                        spawnShellIn "Documents" >*> 2)
--- >       , ("pdf",        spawn pdfViewerCmd)
--- >       ]
+-- >   { topicDirs          = tiDirs    topicItems
+-- >   , topicActions       = tiActions topicItems
+-- >   , defaultTopicAction = const (pure ()) -- by default, do nothing
+-- >   , defaultTopic       = "1:WEB"         -- fallback
 -- >   }
--- >
--- > -- extend your keybindings
--- > myKeys conf@XConfig{modMask=modm} =
--- >   [ ((modm              , xK_n     ), spawnShell) -- %! Launch terminal
--- >   , ((modm              , xK_a     ), currentTopicAction myTopicConfig)
--- >   , ((modm              , xK_g     ), promptedGoto)
--- >   , ((modm .|. shiftMask, xK_g     ), promptedShift)
--- >   {- more  keys ... -}
--- >   ]
--- >   ++
--- >   [ ((modm, k), switchNthLastFocused myTopicConfig i)
--- >   | (i, k) <- zip [1..] workspaceKeys]
--- >
+--
+-- Above, we have used the `spawnShell` and `spawnShellIn` helper
+-- functions; here they are:
+--
 -- > spawnShell :: X ()
 -- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
 -- >
 -- > spawnShellIn :: Dir -> X ()
--- > spawnShellIn dir = spawn $ "urxvt '(cd ''" ++ dir ++ "'' && " ++ myShell ++ " )'"
--- >
+-- > spawnShellIn dir = spawn $ "alacritty --working-directory " ++ dir
+--
+-- Next, we define some other other useful helper functions.  It is
+-- rather common to have a lot of topics—much more than available keys!
+-- In a situation like that, it's very convenient to switch topics with
+-- a prompt; the following use of 'workspacePrompt' does exactly that.
+--
 -- > goto :: Topic -> X ()
 -- > goto = switchTopic myTopicConfig
 -- >
 -- > promptedGoto :: X ()
--- > promptedGoto = workspacePrompt myXPConfig goto
+-- > promptedGoto = workspacePrompt def goto
 -- >
 -- > promptedShift :: X ()
--- > promptedShift = workspacePrompt myXPConfig $ windows . W.shift
--- >
--- > myConfig = do
--- >     checkTopicConfig myTopics myTopicConfig
--- >     myLogHook <- makeMyLogHook
--- >     return $ def
--- >          { borderWidth = 1 -- Width of the window border in pixels.
--- >          , workspaces = myTopics
--- >          , layoutHook = myModifiers myLayout
--- >          , manageHook = myManageHook
--- >          , logHook = myLogHook
--- >          , handleEventHook = myHandleEventHook
--- >          , terminal = myTerminal -- The preferred terminal program.
--- >          , normalBorderColor = "#3f3c6d"
--- >          , focusedBorderColor = "#4f66ff"
--- >          , XMonad.modMask = mod1Mask
--- >          , keys = myKeys
--- >          , mouseBindings = myMouseBindings
--- >          }
+-- > promptedShift = workspacePrompt def $ windows . W.shift
 -- >
+-- > -- Toggle between the two most recently used topics, but keep
+-- > -- screens separate.  This needs @workspaceHistoryHook@.
+-- > toggleTopic :: X ()
+-- > toggleTopic = switchNthLastFocusedByScreen myTopicConfig 1
+--
+-- Hopefully you've gotten a general feeling of how to define these kind of
+-- small helper functions using what's provided in this module.
+--
+-- Adding the appropriate keybindings works as it normally would.  Here,
+-- we'll use "XMonad.Util.EZConfig" syntax:
+--
+-- > myKeys :: [(String, X ())]
+-- > myKeys =
+-- >   [ ("M-n"        , spawnShell)
+-- >   , ("M-a"        , currentTopicAction myTopicConfig)
+-- >   , ("M-g"        , promptedGoto)
+-- >   , ("M-S-g"      , promptedShift)
+-- >   , ("M-S-<Space>", toggleTopic)
+-- >   ]
+-- >   ++
+-- >   -- The following does two things:
+-- >   --   1. Switch topics (no modifier)
+-- >   --   2. Move focused window to topic N (shift modifier)
+-- >   [ ("M-" ++ m ++ k, f i)
+-- >   | (i, k) <- zip (topicNames topicItems) (map show [1 .. 9 :: Int])
+-- >   , (f, m) <- [(goto, ""), (windows . W.shift, "S-")]
+-- >   ]
+--
+-- This makes @M-1@ to @M-9@ switch to the first nine topics that we
+-- have specified in @topicItems@.
+--
+-- You can also switch to the nine last-used topics instead:
+--
+-- >   [ ("M-" ++ show i, switchNthLastFocused myTopicConfig i)
+-- >   | i <- [1 .. 9]
+-- >   ]
+--
+-- We can now put the whole configuration together with the following:
+--
 -- > main :: IO ()
--- > main = xmonad =<< myConfig
+-- > main = xmonad $ def
+-- >   { workspaces = topicNames topicItems
+-- >   }
+-- >  `additionalKeysP` myKeys
 
 -- | An alias for @flip replicateM_@
 (>*>) :: Monad m => m a -> Int -> m ()
@@ -188,85 +239,79 @@ infix >*>
 -- | 'Topic' is just an alias for 'WorkspaceId'
 type Topic = WorkspaceId
 
--- | 'Dir' is just an alias for 'FilePath' but should points to a directory.
+-- | 'Dir' is just an alias for 'FilePath', but should point to a directory.
 type Dir = FilePath
 
 -- | Here is the topic space configuration area.
-data TopicConfig = TopicConfig { topicDirs          :: M.Map Topic Dir
-                                 -- ^ This mapping associate a directory to each topic.
-                               , topicActions       :: M.Map Topic (X ())
-                                 -- ^ This mapping associate an action to trigger when
+data TopicConfig = TopicConfig { topicDirs          :: Map Topic Dir
+                                 -- ^ This mapping associates a directory to each topic.
+                               , topicActions       :: Map Topic (X ())
+                                 -- ^ This mapping associates an action to trigger when
                                  -- switching to a given topic which workspace is empty.
                                , defaultTopicAction :: Topic -> X ()
                                  -- ^ This is the default topic action.
                                , defaultTopic       :: Topic
-                                 -- ^ This is the default topic.
+                                 -- ^ This is the default (= fallback) topic.
                                , maxTopicHistory    :: Int
-                                 -- ^ This setups the maximum depth of topic history, usually
-                                 -- 10 is a good default since we can bind all of them using
-                                 -- numeric keypad.
+                                 -- ^ This specifies the maximum depth of the topic history;
+                                 -- usually 10 is a good default since we can bind all of
+                                 -- them using numeric keypad.
                                }
+{-# DEPRECATED maxTopicHistory "This field will be removed in the future; history is now handled by XMonad.Hooks.WorkspaceHistory" #-}
 
 instance Default TopicConfig where
-    def            = TopicConfig { topicDirs = M.empty
-                                 , topicActions = M.empty
-                                 , defaultTopicAction = const (ask >>= spawn . terminal . config)
-                                 , defaultTopic = "1"
-                                 , maxTopicHistory = 10
-                                 }
+  def            = TopicConfig { topicDirs = M.empty
+                               , topicActions = M.empty
+                               , defaultTopicAction = const (ask >>= spawn . terminal . config)
+                               , defaultTopic = "1"
+                               , maxTopicHistory = 10
+                               }
 
-{-# DEPRECATED defaultTopicConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TopicSpace) instead." #-}
-defaultTopicConfig :: TopicConfig
-defaultTopicConfig = def
+-- | Return the (possibly empty) list of last focused topics.
+getLastFocusedTopics :: X [Topic]
+getLastFocusedTopics = workspaceHistory
+{-# DEPRECATED getLastFocusedTopics "Use XMonad.Hooks.WorkspaceHistory.workspaceHistory (re-exported by this module) instead" #-}
 
-newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)
-instance ExtensionClass PrevTopics where
-    initialValue = PrevTopics []
-    extensionType = PersistentExtension
-
--- | Returns the list of last focused workspaces the empty list otherwise.
-getLastFocusedTopics :: X [String]
-getLastFocusedTopics = XS.gets getPrevTopics
-
--- | Given a 'TopicConfig', the last focused topic, and a predicate that will
--- select topics that one want to keep, this function will set the property
--- of last focused topics.
-setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()
-setLastFocusedTopic w predicate =
-  XS.modify $ PrevTopics
-    . seqList . nub . (w:) . filter predicate
-    . getPrevTopics
-  where seqList xs = length xs `seq` xs
+-- | Given a 'TopicConfig', a topic, and a predicate to select topics that one
+-- wants to keep, this function will cons the topic in front of the list of
+-- last focused topics and filter it according to the predicate.  Note that we
+-- prune the list in case that its length exceeds 'maxTopicHistory'.
+setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
+setLastFocusedTopic tc w predicate = do
+  sid <- gets $ W.screen . W.current . windowset
+  workspaceHistoryModify $
+    take (maxTopicHistory tc) . nub . filter (predicate . snd) . ((sid, w) :)
+{-# DEPRECATED setLastFocusedTopic "Use XMonad.Hooks.WorkspaceHistory instead" #-}
 
 -- | Reverse the list of "last focused topics"
 reverseLastFocusedTopics :: X ()
-reverseLastFocusedTopics =
-  XS.modify $ PrevTopics . reverse . getPrevTopics
+reverseLastFocusedTopics = workspaceHistoryModify reverse
 
--- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration
--- and a pretty-printing record 'PP'. It will show the list of topics sorted historically
--- and highlighting topics with urgent windows.
+-- | This function is a variant of 'SBPP.pprWindowSet' which takes a topic
+-- configuration and a pretty-printing record 'PP'. It will show the list of
+-- topics sorted historically and highlight topics with urgent windows.
 pprWindowSet :: TopicConfig -> PP -> X String
 pprWindowSet tg pp = do
-    winset <- gets windowset
-    urgents <- readUrgents
-    let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
-        maxDepth = maxTopicHistory tg
-    setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)
-                        (`notElem` empty_workspaces)
-    lastWs <- getLastFocusedTopics
-    let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
-        add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
-        pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
-        sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag)
-    return $ DL.pprWindowSet sortWindows urgents pp' winset
+  winset <- gets windowset
+  urgents <- readUrgents
+  let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
+      maxDepth = maxTopicHistory tg
+  setLastFocusedTopic tg
+                      (W.tag . W.workspace . W.current $ winset)
+                      (`notElem` empty_workspaces)
+  lastWs <- workspaceHistory
+  let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
+      add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
+      pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
+      sortWindows = take maxDepth . sortOn (depth . W.tag)
+  return $ SBPP.pprWindowSet sortWindows urgents pp' winset
 
--- | Given a prompt configuration and a topic configuration, triggers the action associated with
+-- | Given a prompt configuration and a topic configuration, trigger the action associated with
 -- the topic given in prompt.
 topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
-topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg))
+topicActionWithPrompt xp tg = workspacePrompt xp (liftA2 (>>) (switchTopic tg) (topicAction tg))
 
--- | Given a configuration and a topic, triggers the action associated with the given topic.
+-- | Given a configuration and a topic, trigger the action associated with the given topic.
 topicAction :: TopicConfig -> Topic -> X ()
 topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg
 
@@ -276,46 +321,94 @@ currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current
 
 -- | Switch to the given topic.
 switchTopic :: TopicConfig -> Topic -> X ()
-switchTopic tg topic = do
+switchTopic tc topic = do
+  -- Switch to topic and add it to the last seen topics
   windows $ W.greedyView topic
+
+  -- If applicable, execute the topic action
   wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
-  when (null wins) $ topicAction tg topic
+  when (null wins) $ topicAction tc topic
 
--- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.
+-- | Switch to the Nth last focused topic or fall back to the 'defaultTopic'.
 switchNthLastFocused :: TopicConfig -> Int -> X ()
-switchNthLastFocused tg depth = do
-  lastWs <- getLastFocusedTopics
-  switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth
+switchNthLastFocused = switchNthLastFocusedExclude []
 
--- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing.
+-- | Like 'switchNthLastFocused', but also filter out certain topics.
+switchNthLastFocusedExclude :: [Topic] -> TopicConfig -> Int -> X ()
+switchNthLastFocusedExclude excludes tc depth = do
+  lastWs <- filter (`notElem` excludes) <$> workspaceHistory
+  switchTopic tc $ (lastWs ++ repeat (defaultTopic tc)) !! depth
+
+-- | Like 'switchNthLastFocused', but only consider topics that used to
+-- be on the current screen.
+--
+-- For example, the following function allows one to toggle between the
+-- currently focused and the last used topic, while treating different
+-- screens completely independently from one another.
+--
+-- > toggleTopicScreen = switchNthLastFocusedByScreen myTopicConfig 1
+switchNthLastFocusedByScreen :: TopicConfig -> Int -> X ()
+switchNthLastFocusedByScreen tc depth = do
+  sid <- gets $ W.screen . W.current . windowset
+  sws <- fromMaybe []
+       . listToMaybe
+       . map snd
+       . filter ((== sid) . fst)
+     <$> workspaceHistoryByScreen
+  switchTopic tc $ (sws ++ repeat (defaultTopic tc)) !! depth
+
+-- | Shift the focused window to the Nth last focused topic, or fall back to doing nothing.
 shiftNthLastFocused :: Int -> X ()
 shiftNthLastFocused n = do
-  ws <- fmap (listToMaybe . drop n) getLastFocusedTopics
+  ws <- fmap (listToMaybe . drop n) workspaceHistory
   whenJust ws $ windows . W.shift
 
--- | Returns the directory associated with current topic returns the empty string otherwise.
-currentTopicDir :: TopicConfig -> X String
+-- | Return the directory associated with the current topic, or return the empty
+-- string if the topic could not be found.
+currentTopicDir :: TopicConfig -> X FilePath
 currentTopicDir tg = do
   topic <- gets (W.tag . W.workspace . W.current . windowset)
   return . fromMaybe "" . M.lookup topic $ topicDirs tg
 
--- | Check the given topic configuration for duplicates topics or undefined topics.
+-- | Check the given topic configuration for duplicate or undefined topics.
 checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
 checkTopicConfig tags tg = do
-    -- tags <- gets $ map W.tag . workspaces . windowset
+  -- tags <- gets $ map W.tag . workspaces . windowset
 
-    let
-      seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
-      dups       = tags \\ nub tags
-      diffTopic  = seenTopics \\ sort tags
-      check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst
+  let
+    seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
+    dups       = tags \\ nub tags
+    diffTopic  = seenTopics \\ sort tags
+    check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst
 
-    check diffTopic "Seen but missing topics/workspaces"
-    check dups      "Duplicate topics/workspaces"
+  check diffTopic "Seen but missing topics/workspaces"
+  check dups      "Duplicate topics/workspaces"
 
--- | Display the given message using the @xmessage@ program.
-xmessage :: String -> IO ()
-xmessage s = do
-  h <- spawnPipe "xmessage -file -"
-  hPutStr h s
-  hClose h
+-- | Convenience type for specifying topics.
+data TopicItem = TI
+  { tiName   :: !Topic  -- ^ 'Topic' ≡ 'String'
+  , tiDir    :: !Dir    -- ^ Directory associated with topic; 'Dir' ≡ 'String'
+  , tiAction :: !(X ()) -- ^ Startup hook when topic is empty
+  }
+
+-- | Extract the names from a given list of 'TopicItem's.
+topicNames :: [TopicItem] -> [Topic]
+topicNames = map tiName
+
+-- | From a list of 'TopicItem's, build a map that can be supplied as
+-- the 'topicDirs'.
+tiDirs :: [TopicItem] -> Map Topic Dir
+tiDirs = M.fromList . map (\TI{ tiName, tiDir } -> (tiName, tiDir))
+
+-- | From a list of 'TopicItem's, build a map that can be supplied as
+-- the 'topicActions'.
+tiActions :: [TopicItem] -> Map Topic (X ())
+tiActions = M.fromList . map (\TI{ tiName, tiAction } -> (tiName, tiAction))
+
+-- | Associate a directory with the topic, but don't spawn anything.
+noAction :: Topic -> Dir -> TopicItem
+noAction n d = TI n d (pure ())
+
+-- | Topic with @tiDir = ~/@.
+inHome :: Topic -> X () -> TopicItem
+inHome n = TI n "."

XMonad/Actions/TreeSelect.hs

@@ -1,9 +1,12 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE LambdaCase #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.TreeSelect
+-- Description :  Display workspaces or actions in a tree-like format.
 -- Copyright   :  (c) Tom Smeets <tom.tsmeets@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -39,6 +42,7 @@ module XMonad.Actions.TreeSelect
 
     , TSConfig(..)
     , tsDefaultConfig
+    , def
 
       -- * Navigation
       -- $navigation
@@ -60,16 +64,13 @@ module XMonad.Actions.TreeSelect
     , treeselectAt
     ) where
 
-import Control.Applicative
 import Control.Monad.Reader
 import Control.Monad.State
-import Data.List (find)
-import Data.Maybe
 import Data.Tree
-import Foreign
+import Foreign (shiftL, shiftR, (.&.))
 import System.IO
-import System.Posix.Process (forkProcess, executeFile)
 import XMonad hiding (liftX)
+import XMonad.Prelude
 import XMonad.StackSet as W
 import XMonad.Util.Font
 import XMonad.Util.NamedWindows
@@ -78,8 +79,9 @@ import XMonad.Hooks.WorkspaceHistory
 import qualified Data.Map as M
 
 #ifdef XFT
-import Graphics.X11.Xft
+import qualified Data.List.NonEmpty as NE
 import Graphics.X11.Xrender
+import Graphics.X11.Xft
 #endif
 
 -- $usage
@@ -113,10 +115,10 @@ import Graphics.X11.Xrender
 --
 -- Optionally, if you add 'workspaceHistoryHook' to your 'logHook' you can use the \'o\' and \'i\' keys to select from previously-visited workspaces
 --
--- > xmonad $ defaultConfig { ...
--- >                        , workspaces = toWorkspaces myWorkspaces
--- >                        , logHook = workspaceHistoryHook
--- >                        }
+-- > xmonad $ def { ...
+-- >              , workspaces = toWorkspaces myWorkspaces
+-- >              , logHook = workspaceHistoryHook
+-- >              }
 --
 -- After that you still need to bind buttons to 'treeselectWorkspace' to start selecting a workspaces and moving windows
 --
@@ -131,22 +133,22 @@ import Graphics.X11.Xrender
 -- $config
 -- The selection menu is very configurable, you can change the font, all colors and the sizes of the boxes.
 --
--- The default config defined as 'tsDefaultConfig'
+-- The default config defined as 'def'
 --
--- > tsDefaultConfig = TSConfig { ts_hidechildren = True
--- >                            , ts_background   = 0xc0c0c0c0
--- >                            , ts_font         = "xft:Sans-16"
--- >                            , ts_node         = (0xff000000, 0xff50d0db)
--- >                            , ts_nodealt      = (0xff000000, 0xff10b8d6)
--- >                            , ts_highlight    = (0xffffffff, 0xffff0000)
--- >                            , ts_extra        = 0xff000000
--- >                            , ts_node_width   = 200
--- >                            , ts_node_height  = 30
--- >                            , ts_originX      = 0
--- >                            , ts_originY      = 0
--- >                            , ts_indent       = 80
--- >                            , ts_navigate     = defaultNavigation
--- >                            }
+-- > def = TSConfig { ts_hidechildren = True
+-- >                , ts_background   = 0xc0c0c0c0
+-- >                , ts_font         = "xft:Sans-16"
+-- >                , ts_node         = (0xff000000, 0xff50d0db)
+-- >                , ts_nodealt      = (0xff000000, 0xff10b8d6)
+-- >                , ts_highlight    = (0xffffffff, 0xffff0000)
+-- >                , ts_extra        = 0xff000000
+-- >                , ts_node_width   = 200
+-- >                , ts_node_height  = 30
+-- >                , ts_originX      = 0
+-- >                , ts_originY      = 0
+-- >                , ts_indent       = 80
+-- >                , ts_navigate     = defaultNavigation
+-- >                }
 
 -- $pixel
 --
@@ -160,8 +162,8 @@ import Graphics.X11.Xrender
 -- white       = 0xffffffff
 -- black       = 0xff000000
 -- red         = 0xffff0000
--- blue        = 0xff00ff00
--- green       = 0xff0000ff
+-- green       = 0xff00ff00
+-- blue        = 0xff0000ff
 -- transparent = 0x00000000
 -- @
 
@@ -258,6 +260,7 @@ defaultNavigation = M.fromList
 -- Using nice alternating blue nodes
 tsDefaultConfig :: TSConfig a
 tsDefaultConfig = def
+{-# DEPRECATED tsDefaultConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TreeSelect) instead." #-}
 
 -- | Tree Node With a name and extra text
 data TSNode a = TSNode { tsn_name  :: String
@@ -316,7 +319,9 @@ treeselectAt conf@TSConfig{..} zipper hist = withDisplay $ \display -> do
         set_colormap attributes colormap
         set_background_pixel attributes ts_background
         set_border_pixel attributes 0
-        createWindow display rootw rect_x rect_y rect_width rect_height 0 (visualInfo_depth vinfo) inputOutput (visualInfo_visual vinfo) (cWColormap .|. cWBorderPixel .|. cWBackPixel) attributes
+        w <- createWindow display rootw rect_x rect_y rect_width rect_height 0 (visualInfo_depth vinfo) inputOutput (visualInfo_visual vinfo) (cWColormap .|. cWBorderPixel .|. cWBackPixel) attributes
+        setClassHint display w (ClassHint "xmonad-tree_select" "xmonad")
+        pure w
 
     liftIO $ do
         -- TODO: move below?
@@ -405,7 +410,7 @@ treeselectWorkspace c xs f = do
                             , "XConfig.workspaces: "
                             ] ++ map tag ws
         hPutStrLn stderr msg
-        _ <- forkProcess $ executeFile "xmessage" True [msg] Nothing
+        xmessage msg
         return ()
   where
     mkNode n w = do
@@ -448,8 +453,8 @@ splitPath i = case break (== '.') i of
 -- >        ]
 -- >    ]
 treeselectAction :: TSConfig (X a) -> Forest (TSNode (X a)) -> X ()
-treeselectAction c xs = treeselect c xs >>= \x -> case x of
-    Just a  -> a >> return ()
+treeselectAction c xs = treeselect c xs >>= \case
+    Just a  -> void a
     Nothing -> return ()
 
 forMForest :: (Functor m, Applicative m, Monad m) => [Tree a] -> (a -> m b) -> m [Tree b]
@@ -461,7 +466,7 @@ mapMTree f (Node x xs) = Node <$> f x <*>  mapM (mapMTree f) xs
 
 -- | Quit returning the currently selected node
 select :: TreeSelect a (Maybe a)
-select = Just <$> gets (tsn_value . cursor . tss_tree)
+select = gets (Just . (tsn_value . cursor . tss_tree))
 
 -- | Quit without returning anything
 cancel :: TreeSelect a (Maybe a)
@@ -523,18 +528,21 @@ moveWith f = do
 -- | wait for keys and run navigation
 navigate :: TreeSelect a (Maybe a)
 navigate = gets tss_display >>= \d -> join . liftIO . allocaXEvent $ \e -> do
-    maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
+    maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask .|. buttonPressMask) e
 
     ev <- getEvent e
 
-    if ev_event_type ev == keyPress
-      then do
-        (ks, _) <- lookupString $ asKeyEvent e
-        return $ do
-            mask <- liftX $ cleanMask (ev_state ev)
-            f <- asks ts_navigate
-            fromMaybe navigate $ M.lookup (mask, fromMaybe xK_VoidSymbol ks) f
-      else return navigate
+    if | ev_event_type ev == keyPress -> do
+           ks <- keycodeToKeysym d (ev_keycode ev) 0
+           return $ do
+               mask <- liftX $ cleanKeyMask <*> pure (ev_state ev)
+               f <- asks ts_navigate
+               fromMaybe navigate $ M.lookup (mask, ks) f
+       | ev_event_type ev == buttonPress -> do
+           -- See XMonad.Prompt Note [Allow ButtonEvents]
+           allowEvents d replayPointer currentTime
+           return navigate
+       | otherwise -> return navigate
 
 -- | Request a full redraw
 redraw :: TreeSelect a ()
@@ -599,7 +607,7 @@ drawNode ix iy TSNode{..} col = do
     colormap <- gets tss_colormap
     visual   <- gets tss_visual
     liftIO $ drawWinBox window display visual colormap gc font col tsn_name ts_extra tsn_extra
-        (ix * ts_indent) (iy * ts_node_height)
+        (ix * ts_indent + ts_originX) (iy * ts_node_height + ts_originY)
         ts_node_width ts_node_height
 
     -- TODO: draw extra text (transparent background? or ts_background)
@@ -641,17 +649,29 @@ drawStringXMF display window visual colormap gc font col x y text = case font of
         setForeground display gc col
         wcDrawImageString display window fnt gc x y text
 #ifdef XFT
-    Xft fnt -> do
+    Xft fnts -> do
         withXftDraw display window visual colormap $
             \ft_draw -> withXftColorValue display visual colormap (fromARGB col) $
-            \ft_color -> xftDrawString ft_draw ft_color fnt x y text
+#if MIN_VERSION_X11_xft(0, 3, 4)
+            \ft_color -> xftDrawStringFallback ft_draw ft_color (NE.toList fnts) (fi x) (fi y) text
+#else
+            \ft_color -> xftDrawString ft_draw ft_color (NE.head fnts) x y text
+#endif
 
 -- | Convert 'Pixel' to 'XRenderColor'
 --
 -- Note that it uses short to represent its components
 fromARGB :: Pixel -> XRenderColor
-fromARGB x = XRenderColor (fromIntegral $ 0xff00 .&. shiftR x 8)  -- red
-                          (fromIntegral $ 0xff00 .&. x)           -- green
-                          (fromIntegral $ 0xff00 .&. shiftL x 8)  -- blue
-                          (fromIntegral $ 0xff00 .&. shiftR x 16) -- alpha
+fromARGB x =
+#if MIN_VERSION_X11_xft(0, 3, 3)
+    XRenderColor r g b a
+#else
+    -- swapped green/blue as a workaround for the faulty Storable instance in X11-xft < 0.3.3
+    XRenderColor r b g a
+#endif
+  where
+    r = fromIntegral $ 0xff00 .&. shiftR x 8
+    g = fromIntegral $ 0xff00 .&. x
+    b = fromIntegral $ 0xff00 .&. shiftL x 8
+    a = fromIntegral $ 0xff00 .&. shiftR x 16
 #endif

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

XMonad/Actions/UpdateFocus.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.UpdateFocus
+-- Description :  Updates the focus on mouse move in unfocused windows.
 -- Copyright   :  (c) Daniel Schoepe
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -16,17 +17,17 @@ module XMonad.Actions.UpdateFocus (
     -- * Usage
     -- $usage
     focusOnMouseMove,
-    adjustEventInput
+    adjustEventInput,
+    focusUnderPointer,
 ) where
 
 import XMonad
+import XMonad.Prelude
 import qualified XMonad.StackSet as W
-import Control.Monad (when)
-import Data.Monoid
 
 -- $usage
 -- To make the focus update on mouse movement within an unfocused window, add the
--- following to your @~\/.xmonad\/xmonad.hs@:
+-- following to your @xmonad.hs@:
 --
 -- > import XMonad.Actions.UpdateFocus
 -- > xmonad $ def {
@@ -40,7 +41,7 @@ import Data.Monoid
 
 -- | Changes the focus if the mouse is moved within an unfocused window.
 focusOnMouseMove :: Event -> X All
-focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do
+focusOnMouseMove MotionEvent{ ev_x = x, ev_y = y, ev_window = root } = do
     -- check only every 15 px to avoid excessive calls to translateCoordinates
     when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do
       dpy <- asks display
@@ -58,3 +59,25 @@ adjustEventInput = withDisplay $ \dpy -> do
   io $ selectInput dpy rootw $  substructureRedirectMask .|. substructureNotifyMask
                                 .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
                                 .|. buttonPressMask .|. pointerMotionMask
+
+-- | Focus the window under the mouse pointer, unless we're currently changing
+-- focus with the mouse or dragging. This is the inverse to
+-- "XMonad.Actions.UpdatePointer": instead of moving the mouse pointer to
+-- match the focus, we change the focus to match the mouse pointer.
+--
+-- This is meant to be used together with
+-- 'XMonad.Actions.UpdatePointer.updatePointer' in individual key bindings.
+-- Bindings that change focus should invoke
+-- 'XMonad.Actions.UpdatePointer.updatePointer' at the end, bindings that
+-- switch workspaces or change layouts should call 'focusUnderPointer' at the
+-- end. Neither should go to 'logHook', as that would override the other.
+--
+-- This is more finicky to set up than 'focusOnMouseMove', but ensures that
+-- focus is updated immediately, without having to touch the mouse.
+focusUnderPointer :: X ()
+focusUnderPointer = whenX (not <$> (asks mouseFocused <||> gets (isJust . dragging))) $ do
+  dpy <- asks display
+  root <- asks theRoot
+  (_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root
+  w <- gets (W.peek . windowset)
+  when (w' /= none && Just w' /= w) (focus w')

XMonad/Actions/UpdatePointer.hs

@@ -2,6 +2,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.UpdatePointer
+-- Description :  Causes the pointer to follow whichever window focus changes to.
 -- Copyright   :  (c) Robert Marlow <robreim@bobturf.org>, 2015 Evgeny Kurnevsky
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -24,15 +25,13 @@ module XMonad.Actions.UpdatePointer
     where
 
 import XMonad
-import XMonad.Util.XUtils (fi)
-import Control.Arrow
-import Control.Monad
+import XMonad.Prelude
 import XMonad.StackSet (member, peek, screenDetail, current)
-import Data.Maybe
-import Control.Exception
+
+import Control.Arrow ((&&&), (***))
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- > import XMonad
 -- > import XMonad.Actions.UpdatePointer
@@ -61,6 +60,11 @@ import Control.Exception
 -- | Update the pointer's location to the currently focused
 -- window or empty screen unless it's already there, or unless the user was changing
 -- focus with the mouse
+--
+-- See also 'XMonad.Actions.UpdateFocus.focusUnderPointer' for an inverse
+-- operation that updates the focus instead. The two can be combined in a
+-- single config if neither goes into 'logHook' but are invoked explicitly in
+-- individual key bindings.
 updatePointer :: (Rational, Rational) -> (Rational, Rational) -> X ()
 updatePointer refPos ratio = do
   ws <- gets windowset
@@ -68,10 +72,9 @@ updatePointer refPos ratio = do
   let defaultRect = screenRect $ screenDetail $ current ws
   rect <- case peek ws of
         Nothing -> return defaultRect
-        Just w  -> do tryAttributes <- io $ try $ getWindowAttributes dpy w
-                      return $ case tryAttributes of
-                        Left (_ :: SomeException) -> defaultRect
-                        Right attributes          -> windowAttributesToRectangle attributes
+        Just w  -> maybe defaultRect windowAttributesToRectangle
+               <$> safeGetWindowAttributes w
+
   root <- asks theRoot
   mouseIsMoving <- asks mouseFocused
   (_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root
@@ -105,6 +108,7 @@ lerp :: (RealFrac r, Real a, Real b) => r -> a -> b -> r
 lerp r a b = (1 - r) * realToFrac a + r * realToFrac b
 
 clip :: Ord a => (a, a) -> a -> a
-clip (lower, upper) x = if x < lower then lower
-    else if x > upper then upper else x
-
+clip (lower, upper) x
+  | x < lower = lower
+  | x > upper = upper
+  | otherwise = x

XMonad/Actions/Warp.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.Warp
+-- Description :  Warp the pointer to a given window or screen.
 -- Copyright   :  (c) daniel@wagner-home.com
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -22,12 +23,12 @@ module XMonad.Actions.Warp (
                            warpToWindow
                           ) where
 
-import Data.List
+import XMonad.Prelude
 import XMonad
 import XMonad.StackSet as W
 
 {- $usage
-You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+You can use this module with the following in your @xmonad.hs@:
 
 > import XMonad.Actions.Warp
 
@@ -44,7 +45,7 @@ Note that warping to a particular screen may change the focus.
 -}
 
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 
 data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight
@@ -90,18 +91,16 @@ warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y
 -- | Warp the pointer to a given position relative to the currently
 --   focused window.  Top left = (0,0), bottom right = (1,1).
 warpToWindow :: Rational -> Rational -> X ()
-warpToWindow h v =
-    withDisplay $ \d ->
-        withFocused $ \w -> do
-            wa <- io $ getWindowAttributes d w
-            warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
+warpToWindow h v = withDisplay $ \d -> withFocused $ \w ->
+  withWindowAttributes d w $ \wa ->
+    warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
 
 -- | Warp the pointer to the given position (top left = (0,0), bottom
 --   right = (1,1)) on the given screen.
 warpToScreen :: ScreenId -> Rational -> Rational -> X ()
 warpToScreen n h v = do
     root <- asks theRoot
-    (StackSet {current = x, visible = xs}) <- gets windowset
+    StackSet{current = x, visible = xs} <- gets windowset
     whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs)
         $ \r ->
             warp root (rect_x r + fraction h (rect_width  r))

XMonad/Actions/WindowBringer.hs

@@ -2,6 +2,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.WindowBringer
+-- Description :  Dmenu operations to bring windows to you, and bring you to windows.
 -- Copyright   :  Devin Mullins <me@twifkak.com>
 -- License     :  BSD-style (see LICENSE)
 --
@@ -21,21 +22,23 @@ module XMonad.Actions.WindowBringer (
                     WindowBringerConfig(..),
                     gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
                     bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
-                    windowMap, windowMap', bringWindow, actionMenu
+                    copyMenu, copyMenuConfig, copyMenu', copyMenuArgs, copyMenuArgs',
+                    windowMap, windowAppMap, windowMap', bringWindow, actionMenu
                    ) where
 
-import Control.Applicative((<$>))
+import Control.Monad
 import qualified Data.Map as M
 
 import qualified XMonad.StackSet as W
 import XMonad
 import qualified XMonad as X
 import XMonad.Util.Dmenu (menuMapArgs)
-import XMonad.Util.NamedWindows (getName)
+import XMonad.Util.NamedWindows (getName, getNameWMClass)
+import XMonad.Actions.CopyWindow (copyWindow)
 
 -- $usage
 --
--- Import the module into your @~\/.xmonad\/xmonad.hs@:
+-- Import the module into your @xmonad.hs@:
 --
 -- > import XMonad.Actions.WindowBringer
 --
@@ -43,20 +46,23 @@ import XMonad.Util.NamedWindows (getName)
 --
 -- > , ((modm .|. shiftMask, xK_g     ), gotoMenu)
 -- > , ((modm .|. shiftMask, xK_b     ), bringMenu)
+-- > , ((modm .|. shiftMask, xK_y     ), copyMenu)
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 data WindowBringerConfig = WindowBringerConfig
     { menuCommand :: String -- ^ The shell command that will handle window selection
     , menuArgs :: [String] -- ^ Arguments to be passed to menuCommand
     , windowTitler :: X.WindowSpace -> Window -> X String -- ^ A function that produces window titles given a workspace and a window
+    , windowFilter :: Window -> X Bool -- ^ Filter function to decide which windows to consider
     }
 
 instance Default WindowBringerConfig where
     def = WindowBringerConfig{ menuCommand = "dmenu"
                              , menuArgs = ["-i"]
                              , windowTitler = decorateName
+                             , windowFilter = \_ -> return True
                              }
 
 -- | Pops open a dmenu with window titles. Choose one, and you will be
@@ -87,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 ()
@@ -123,11 +160,8 @@ bringWindow w ws = W.shiftWin (W.currentTag ws) w ws
 -- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
 --   if found.
 actionMenu :: WindowBringerConfig -> (Window -> X.WindowSet -> X.WindowSet) -> X ()
-actionMenu WindowBringerConfig{ menuCommand = cmd
-                              , menuArgs = args
-                              , windowTitler = titler
-                              } action
-    = windowMap' titler >>= menuMapFunction >>= flip X.whenJust (windows . action)
+actionMenu c@WindowBringerConfig{ menuCommand = cmd, menuArgs = args } action =
+  windowMap' c >>= menuMapFunction >>= flip X.whenJust (windows . action)
     where
       menuMapFunction :: M.Map String a -> X (Maybe a)
       menuMapFunction = menuMapArgs cmd args
@@ -135,15 +169,20 @@ actionMenu WindowBringerConfig{ menuCommand = cmd
 
 -- | A map from window names to Windows.
 windowMap :: X (M.Map String Window)
-windowMap = windowMap' decorateName
+windowMap = windowMap' def
+
+-- | A map from application executable names to Windows.
+windowAppMap :: X (M.Map String Window)
+windowAppMap = windowMap' def { windowTitler = decorateAppName }
 
 -- | A map from window names to Windows, given a windowTitler function.
-windowMap' :: (X.WindowSpace -> Window -> X String) -> X (M.Map String Window)
-windowMap' titler = do
-  ws <- gets X.windowset
-  M.fromList . concat <$> mapM keyValuePairs (W.workspaces ws)
- where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
-       keyValuePair ws w = flip (,) w <$> titler ws w
+windowMap' :: WindowBringerConfig -> X (M.Map String Window)
+windowMap' WindowBringerConfig{ windowTitler = titler, windowFilter = include } = do
+  windowSet <- gets X.windowset
+  M.fromList . concat <$> mapM keyValuePairs (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
 
 -- | Returns the window name as will be listed in dmenu.
 --   Tagged with the workspace ID, to guarantee uniqueness, and to let the user
@@ -152,3 +191,11 @@ decorateName :: X.WindowSpace -> Window -> X String
 decorateName ws w = do
   name <- show <$> getName w
   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 its workspace
+-- ID.
+decorateAppName :: X.WindowSpace -> Window -> X String
+decorateAppName ws w = do
+  name <- show <$> getNameWMClass w
+  return $ name ++ " [" ++ W.tag ws ++ "]"

XMonad/Actions/WindowGo.hs

@@ -1,5 +1,8 @@
+{-# LANGUAGE ViewPatterns #-}
+
 {- |
 Module      :  XMonad.Actions.WindowGo
+Description :  Operations for raising (traveling to) windows.
 License     :  Public domain
 
 Maintainer  :  <gwern0@gmail.com>
@@ -36,10 +39,8 @@ module XMonad.Actions.WindowGo (
                  module XMonad.ManageHook
                 ) where
 
-import Control.Monad
-import Data.Char (toLower)
 import qualified Data.List as L (nub,sortBy)
-import Data.Monoid
+import XMonad.Prelude
 import XMonad (Query(), X(), ManageHook, WindowSet, withWindowSet, runQuery, liftIO, ask)
 import Graphics.X11 (Window)
 import XMonad.ManageHook
@@ -47,9 +48,11 @@ import XMonad.Operations (windows)
 import XMonad.Prompt.Shell (getBrowser, getEditor)
 import qualified XMonad.StackSet as W (peek, swapMaster, focusWindow, workspaces, StackSet, Workspace, integrate', tag, stack)
 import XMonad.Util.Run (safeSpawnProg)
+import qualified Data.List.NonEmpty as NE
+
 {- $usage
 
-Import the module into your @~\/.xmonad\/xmonad.hs@:
+Import the module into your @xmonad.hs@:
 
 > import XMonad.Actions.WindowGo
 
@@ -65,7 +68,8 @@ appropriate one, or cover your bases by using instead something like:
 > (className =? "Firefox" <||> className =? "Firefox-bin")
 
 For detailed instructions on editing your key bindings, see
-"XMonad.Doc.Extending#Editing_key_bindings". -}
+<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
+-}
 
 -- | Get the list of workspaces sorted by their tag
 workspacesSorted :: Ord i => W.StackSet i l a s sd -> [W.Workspace i l a]
@@ -88,7 +92,10 @@ ifWindows qry f el = withWindowSet $ \wins -> do
 -- | The same as ifWindows, but applies a ManageHook to the first match
 -- instead and discards the other matches
 ifWindow :: Query Bool -> ManageHook -> X () -> X ()
-ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head)
+ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . NE.head . notEmpty)
+-- ifWindows guarantees that the list given to the function is
+-- non-empty. This should really use Data.List.NonEmpty, but, alas,
+-- that would be a breaking change.
 
 {- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.
    Presumably this executable is the same one that you were looking for.
@@ -159,9 +166,12 @@ raiseNextMaybeCustomFocus :: (Window -> WindowSet -> WindowSet) -> X() -> Query
 raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do
   foc <- withWindowSet $ return . W.peek
   case foc of
-    Just w | w `elem` ws -> let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match
-                            in windows $ focusFn y
-    _ -> windows . focusFn . head $ ws
+    Just w | w `elem` ws ->
+        let (notEmpty -> _ :| (notEmpty -> y :| _)) = dropWhile (/=w) $ cycle ws
+            -- cannot fail to match
+        in windows $ focusFn y
+    _ -> windows . focusFn . NE.head . notEmpty $ ws
+         -- ws is non-empty by ifWindows's definition.
 
 -- | Given a function which gets us a String, we try to raise a window with that classname,
 --   or we then interpret that String as a executable name.

XMonad/Actions/WindowMenu.hs

@@ -1,6 +1,7 @@
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.WindowMenu
+-- Description :  Display window management actions in the center of the focused window.
 -- Copyright   :  (c) Jan Vornberger 2009
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -28,12 +29,12 @@ import XMonad
 import qualified XMonad.StackSet as W
 import XMonad.Actions.GridSelect
 import XMonad.Layout.Maximize
-import XMonad.Layout.Minimize
-import XMonad.Util.XUtils (fi)
+import XMonad.Actions.Minimize
+import XMonad.Prelude (fi)
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- >    import XMonad.Actions.WindowMenu
 --
@@ -50,9 +51,9 @@ colorizer _ isFg = do
                 else (nBC, fBC)
 
 windowMenu :: X ()
-windowMenu = withFocused $ \w -> do
+windowMenu = withFocused $ \w -> withDisplay $ \d -> withWindowAttributes d w $ \wa -> do
     tags <- asks (workspaces . config)
-    Rectangle x y wh ht <- getSize w
+    let Rectangle x y wh ht = getSize wa
     Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset
     let originFractX = (fi x - fi sx + fi wh / 2) / fi swh
         originFractY = (fi y - fi sy + fi ht / 2) / fi sht
@@ -68,12 +69,10 @@ windowMenu = withFocused $ \w -> do
                     | tag <- tags ]
     runSelectedAction gsConfig actions
 
-getSize :: Window -> X (Rectangle)
-getSize w = do
-  d  <- asks display
-  wa <- io $ getWindowAttributes d w
+getSize :: WindowAttributes -> Rectangle
+getSize wa =
   let x = fi $ wa_x wa
       y = fi $ wa_y wa
       wh = fi $ wa_width wa
       ht = fi $ wa_height wa
-  return (Rectangle x y wh ht)
+   in Rectangle x y wh ht

XMonad/Actions/WindowNavigation.hs

@@ -1,9 +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
@@ -36,21 +39,20 @@ module XMonad.Actions.WindowNavigation (
                                        withWindowNavigationKeys,
                                        WNAction(..),
                                        go, swap,
+                                       goPure, swapPure,
                                        Direction2D(..), WNState,
                                        ) where
 
-import XMonad
+import XMonad hiding (state)
+import XMonad.Prelude (catMaybes, fromMaybe, sortOn)
 import XMonad.Util.Types (Direction2D(..))
 import qualified XMonad.StackSet as W
 
-import Control.Applicative ((<$>))
 import Control.Arrow (second)
 import Data.IORef
-import Data.List (sortBy)
 import Data.Map (Map())
+import Data.List (partition, find)
 import qualified Data.Map as M
-import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
-import Data.Ord (comparing)
 import qualified Data.Set as S
 
 -- $usage
@@ -65,6 +67,11 @@ import qualified Data.Set as S
 -- >             $ def { ... }
 -- >     xmonad config
 --
+-- Or, for the brave souls:
+--
+-- > main = xmonad =<< withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
+-- >             $ def { ... }
+--
 -- Here, we pass in the keys for navigation in counter-clockwise order from up.
 -- It creates keybindings for @modMask@ to move to window, and @modMask .|. shiftMask@
 -- to swap windows.
@@ -98,118 +105,316 @@ 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
-    return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys)
+    stateRef <- newIORef M.empty
+    return conf { keys = \cnf -> M.fromList (map (second (fromWNAction stateRef)) wnKeys)
                                  `M.union` keys conf cnf,
-                  logHook = logHook conf >> trackMovement posRef }
-  where fromWNAction posRef (WNGo dir)   = go   posRef dir
-        fromWNAction posRef (WNSwap dir) = swap posRef dir
+                  logHook = logHook conf >> trackMovement stateRef }
+  where fromWNAction stateRef (WNGo dir)   = go   stateRef dir
+        fromWNAction stateRef (WNSwap dir) = swap stateRef dir
 
 data WNAction = WNGo Direction2D | WNSwap Direction2D
 
 type WNState = Map WorkspaceId Point
 
--- go:
--- 1. get current position, verifying it matches the current window
--- 2. get target windowrect
--- 3. focus window
--- 4. set new position
+-- | Focus window in the given direction.
 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 $
                                    mapWindows (swapWin currentWin targetWin) winSet
                 Nothing -> winSet
-        mapWindows f ss = W.mapWorkspace (mapWindows' f) ss
-        mapWindows' f ws@(W.Workspace { W.stack = s }) = ws { W.stack = mapWindows'' f <$> s }
+        mapWindows f = W.mapWorkspace (mapWindows' f)
+        mapWindows' f ws@W.Workspace{ W.stack = s } = ws { W.stack = mapWindows'' f <$> s }
         mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down)
-        swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win
+        swapWin win1 win2 win
+          | win == win1 = win2
+          | win == win2 = win1
+          | otherwise = win
 
-withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
-withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
-    targets <- filter ((/= win) . fst) <$> navigableTargets pos dir
-    whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do
-      windows (adj targetWin)
-      setPosition posRef pos targetRect
+-- | Select a target window in the given direction and modify the WindowSet.
+-- 1. Get current position, verifying it matches the current window (exit if no focused window).
+-- 2. Get the target window.
+-- 3. Execute an action on the target window and windowset.
+-- 4. Set the new position.
+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 -> do
-                           windowRect win >>= flip whenJust (setPosition posRef pos . snd)
+trackMovement stateRef = do
+  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 ()
-fromCurrentPoint posRef f = withFocused $ \win -> do
-                                currentPosition posRef >>= f win
+-- | Get focused window and current position.
+getCurrentWindow :: Monad x => WNInput x -> x (Maybe (Window, Rectangle, Point))
+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
--- a restart), derives the current position from the current window. Also,
--- verifies that the position is congruent with the current window (say, if you
--- used mod-j/k or mouse or something).
-currentPosition :: IORef WNState -> X Point
-currentPosition posRef = do
-    root <- asks theRoot
-    currentWindow <- gets (W.peek . windowset)
-    currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow)
+-- | Gets the current position from the state passed in, or if nothing
+-- (say, from a restart), derives the current position from the current window.
+-- Also, verifies that the position is congruent with the current window
+-- (say, if you moved focus using mouse or something).
+-- Returns the window rectangle for convenience, since we'll need it later anyway.
+currentPosition :: Monad x => WNInput x -> x (Point, Rectangle)
+currentPosition (state, oldWindowSet, _, windowRect) = do
+  currentRect <- fromMaybe (Rectangle 0 0 0 0) <$> maybe (pure Nothing) windowRect (W.peek oldWindowSet)
+  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)
-    mp <- M.lookup wsid <$> io (readIORef posRef)
+-- | Inserts new position into the state.
+modifyState :: WindowSet -> Point -> WNState -> WNState
+modifyState oldWindowSet =
+  M.insert (W.currentTag oldWindowSet)
 
-    return $ maybe (middleOf currentRect) (`inside` currentRect) mp
-
-  where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)
-
-setPosition :: IORef WNState -> Point -> Rectangle -> X ()
-setPosition posRef oldPos newRect = do
-    wsid <- gets (W.currentTag . windowset)
-    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
+-- | "Jumps" the current position into the middle of target rectangle.
+-- (keeps the position as-is if it is already inside the target rectangle)
+centerPosition :: Rectangle -> Point -> Point
+centerPosition r@(Rectangle rx ry rw rh) pos@(Point x y) = do
+  if pointWithin x y r
+  then pos
+  else Point (midPoint rx rw) (midPoint ry rh)
 
 midPoint :: Position -> Dimension -> Position
 midPoint pos dim = pos + fromIntegral dim `div` 2
 
-navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
-navigableTargets point dir = navigable dir point <$> windowRects
+-- | Make a list of target windows we can navigate to,
+-- 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
--- the Direction2D.
-navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
-navigable d pt = sortby d . filter (inr d pt . snd)
+    pos = pointTransform dir currentPos
+    wr = rectTransform dir currentRect
 
--- Produces a list of normal-state windows, on any screen. Rectangles are
--- adjusted based on screen position relative to the current screen, because I'm
--- bad like that.
-windowRects :: X [(Window, Rectangle)]
-windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped
+    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) &&
+                   ((rect_o1 r >= rect_o1 wr && rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr && rect_o2 r <= rect_o2 wr) ||
+                    (rect_o1 r <= rect_o1 wr && rect_o2 r >= rect_o2 wr)) -- include windows that fully overlaps current on the orthogonal axis
+    sortByP2 = sortOn (rect_p2 . snd)
+    posBeforeEdge r = point_p pos < rect_p2 r
 
-windowRect :: Window -> X (Maybe (Window, Rectangle))
-windowRect win = withDisplay $ \dpy -> do
+    rectOverlapsEdge r = rect_p1 r <= rect_p2 wr && rect_p2 r > rect_p2 wr &&
+                         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
-inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w &&
-                                                        py < ry + fromIntegral h
-inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w &&
-                                            py >  ry
-inr R (Point px py) (Rectangle rx ry _ h) = px <  rx &&
-                                            py >= ry && py < ry + fromIntegral h
-inr L (Point px py) (Rectangle rx ry w h) =             px > rx + fromIntegral w &&
-                                            py >= ry && py < ry + fromIntegral h
+-- | Execute a monadic action on the contents if Just, otherwise wrap default value and return it.
+whenJust' :: Monad x => x (Maybe a) -> b -> (a -> x b) -> x b
+whenJust' monadMaybeValue deflt f = do
+  maybeValue <- monadMaybeValue
+  case maybeValue of
+    Nothing -> return deflt
+    Just value -> f value
 
-sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
-sortby D = sortBy $ comparing (rect_y . snd)
-sortby R = sortBy $ comparing (rect_x . snd)
-sortby U = reverse . sortby D
-sortby L = reverse . sortby R
+-- | Filter a list of tuples on the second tuple member.
+filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)]
+filterSnd f = filter (f . snd)
+
+-- | Map a second tuple member in a list of tuples.
+mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')]
+mapSnd f = map (second f)

XMonad/Actions/WithAll.hs

@@ -1,28 +1,30 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.WithAll
+-- Description  : Perform a given action on all or certain groups of windows.
 -- License      : BSD3-style (see LICENSE)
 -- Stability    : unstable
 -- Portability  : unportable
 --
--- Provides functions for performing a given action on all windows of
--- the current workspace.
+-- Provides functions for performing a given action on all or certain
+-- groups of windows on the current workspace.
 -----------------------------------------------------------------------------
 
 module XMonad.Actions.WithAll (
     -- * Usage
     -- $usage
     sinkAll, withAll,
-    withAll', killAll) where
+    withAll', killAll,
+    killOthers) where
 
-import Data.Foldable hiding (foldr)
+import XMonad.Prelude hiding (foldr)
 
 import XMonad
 import XMonad.StackSet
 
 -- $usage
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- > import XMonad.Actions.WithAll
 --
@@ -31,7 +33,7 @@ import XMonad.StackSet
 --     , ((modm .|. shiftMask, xK_t), sinkAll)
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 -- | Un-float all floating windows on the current workspace.
 sinkAll :: X ()
@@ -49,4 +51,8 @@ withAll f = withWindowSet $ \ws -> let all' = integrate' . stack . workspace . c
 
 -- | Kill all the windows on the current workspace.
 killAll :: X()
-killAll = withAll killWindow
+killAll = withAll killWindow
+
+-- | Kill all the unfocused windows on the current workspace.
+killOthers :: X ()
+killOthers = withUnfocused killWindow

XMonad/Actions/Workscreen.hs

@@ -1,6 +1,9 @@
+{-# LANGUAGE ViewPatterns #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module     :  XMonad.Actions.Workscreen
+-- Description:  Display a set of workspaces on several screens.
 -- Copyright  :  (c) 2012 kedals0
 -- License    :  BSD3-style (see LICENSE)
 --
@@ -20,7 +23,6 @@
 -- This also permits to see all workspaces of a workscreen even if just
 -- one screen is present, and to move windows from workspace to workscreen.
 -----------------------------------------------------------------------------
-{-# LANGUAGE DeriveDataTypeable #-}
 
 module XMonad.Actions.Workscreen (
   -- * Usage
@@ -35,12 +37,13 @@ module XMonad.Actions.Workscreen (
   ) where
 
 import XMonad hiding (workspaces)
+import XMonad.Prelude
 import qualified XMonad.StackSet as W
 import qualified XMonad.Util.ExtensibleState as XS
 import XMonad.Actions.OnScreen
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+-- You can use this module with the following in your @xmonad.hs@:
 --
 -- > import XMonad.Actions.Workscreen
 -- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"]
@@ -55,26 +58,26 @@ import XMonad.Actions.OnScreen
 -- >      , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]]
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 
-data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show,Typeable)
+data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show)
 type WorkscreenId=Int
 
-data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Show,Typeable)
+data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Show)
 instance ExtensionClass WorkscreenStorage where
   initialValue = WorkscreenStorage 0 []
 
 -- | Helper to group workspaces. Multiply workspace by screens number.
 expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
-expandWorkspace nscr ws = concat $ map expandId ws
+expandWorkspace nscr = concatMap expandId
   where expandId wsId = let t = wsId ++ "_"
                         in map ((++) t . show ) [1..nscr]
 
 -- | Create workscreen list from workspace list. Group workspaces to
 -- packets of screens number size.
 fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]
-fromWorkspace n ws = map (\(a,b) -> Workscreen a b) $ zip [0..] (fromWorkspace' n ws)
+fromWorkspace n ws = zipWith Workscreen [0..] (fromWorkspace' n ws)
 fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
 fromWorkspace' _ [] = []
 fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws)
@@ -90,7 +93,7 @@ viewWorkscreen wscrId = do (WorkscreenStorage c a) <- XS.get
                            let wscr = if wscrId == c
                                           then Workscreen wscrId $ shiftWs (workspaces $ a !! wscrId)
                                           else a !! wscrId
-                               (x,_:ys) = splitAt wscrId a
+                               (x, notEmpty -> _ :| ys) = splitAt wscrId a
                                newWorkscreenStorage = WorkscreenStorage wscrId (x ++ [wscr] ++ ys)
                            windows (viewWorkscreen' wscr)
                            XS.put newWorkscreenStorage
@@ -106,5 +109,6 @@ shiftWs a = drop 1 a ++ take 1 a
 -- @WorkscreenId@.
 shiftToWorkscreen :: WorkscreenId -> X ()
 shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get
-                              let ws = head . workspaces $ a !! wscrId
-                              windows $ W.shift ws
+                              case workspaces (a !! wscrId) of
+                                []      -> pure ()
+                                (w : _) -> windows $ W.shift w

XMonad/Actions/WorkspaceCursors.hs

@@ -1,7 +1,8 @@
-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.WorkspaceCursors
+-- Description  : Like "XMonad.Actions.Plane" for an arbitrary number of dimensions.
 -- Copyright    : (c) 2009 Adam Vogt <vogt.adam@gmail.com>
 -- License      : BSD
 --
@@ -46,14 +47,10 @@ import qualified XMonad.StackSet as W
 import XMonad.Actions.FocusNth(focusNth')
 import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
                                     LayoutModifier(handleMess, redoLayout))
-import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset),
+import XMonad(Message, WorkspaceId, X, XState(windowset),
               fromMessage, sendMessage, windows, gets)
-import Control.Monad((<=<), guard, liftM, liftM2, when)
-import Control.Applicative((<$>))
-import Data.Foldable(Foldable(foldMap), toList)
-import Data.Maybe(fromJust, listToMaybe)
-import Data.Monoid(Monoid(mappend, mconcat))
-import Data.Traversable(sequenceA)
+import XMonad.Util.Stack (reverseS)
+import XMonad.Prelude
 
 -- $usage
 --
@@ -61,13 +58,10 @@ import Data.Traversable(sequenceA)
 --
 -- > import XMonad
 -- > import XMonad.Actions.WorkspaceCursors
--- > import XMonad.Hooks.DynamicLog
 -- > import XMonad.Util.EZConfig
 -- > import qualified XMonad.StackSet as W
 -- >
--- > main = do
--- >     x <- xmobar conf
--- >     xmonad x
+-- > main = xmonad conf
 -- >
 -- > conf = additionalKeysP def
 -- >        { layoutHook = workspaceCursors myCursors $ layoutHook def
@@ -92,7 +86,8 @@ import Data.Traversable(sequenceA)
 --   workspaces. Or change it such that workspaces are created when you try to
 --   view it.
 --
--- * Function for pretty printing for DynamicLog that groups workspaces by
+-- * Function for pretty printing for "XMonad.Hooks.StatusBar.PP" that groups
+--   workspaces by
 -- common prefixes
 --
 -- * Examples of adding workspaces to the cursors, having them appear multiple
@@ -100,10 +95,10 @@ import Data.Traversable(sequenceA)
 
 -- | makeCursors requires a nonempty string, and each sublist must be nonempty
 makeCursors ::  [[String]] -> Cursors String
-makeCursors [] = error "Workspace Cursors cannot be empty"
-makeCursors a = concat . reverse <$> foldl addDim x xs
-    where x = end $ map return $ head a
-          xs = map (map return) $ tail a
+makeCursors []       = error "Workspace Cursors cannot be empty"
+makeCursors (a : as) = concat . reverse <$> foldl addDim x xs
+    where x = end $ map return a
+          xs = map (map return) as
           -- this could probably be simplified, but this true:
           -- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[]))
           -- the strange order is used because it makes the regular M-1..9
@@ -118,7 +113,7 @@ end = Cons . fromJust . W.differentiate . map End
 
 data Cursors a
     = Cons (W.Stack (Cursors a))
-    | End a deriving (Eq,Show,Read,Typeable)
+    | End a deriving (Eq,Show,Read)
 
 instance Foldable Cursors where
     foldMap f (End x) = f x
@@ -144,7 +139,7 @@ getFocus (End x) = x
 
 -- This could be made more efficient, if the fact that the suffixes are grouped
 focusTo ::  (Eq t) => t -> Cursors t -> Maybe (Cursors t)
-focusTo x = listToMaybe . filter ((x==) . getFocus) . changeFocus (const True)
+focusTo x = find ((x==) . getFocus) . changeFocus (const True)
 
 -- | non-wrapping version of 'W.focusUp''
 noWrapUp ::  W.Stack t -> W.Stack t
@@ -153,20 +148,19 @@ noWrapUp x@(W.Stack _ []   _ ) = x
 
 -- | non-wrapping version of 'W.focusDown''
 noWrapDown ::  W.Stack t -> W.Stack t
-noWrapDown = reverseStack . noWrapUp . reverseStack
-    where reverseStack (W.Stack t ls rs) = W.Stack t rs ls
+noWrapDown = reverseS . noWrapUp . reverseS
 
 focusDepth ::  Cursors t -> Int
 focusDepth (Cons x) = 1 + focusDepth (W.focus x)
 focusDepth (End  _) = 0
 
 descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a)
-descend f 1 (Cons x) = Cons `liftM` f x
-descend f n (Cons x) | n > 1 = liftM Cons $ descend f (pred n) `onFocus` x
+descend f 1 (Cons x) = Cons <$> f x
+descend f n (Cons x) | n > 1 = fmap Cons $ descend f (pred n) `onFocus` x
 descend _ _ x = return x
 
 onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1)
-onFocus f st = (\x -> st { W.focus = x}) `liftM` f (W.focus st)
+onFocus f st = (\x -> st { W.focus = x}) <$> f (W.focus st)
 
 -- | @modifyLayer@ is used to change the focus at a given depth
 modifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X ()
@@ -192,10 +186,10 @@ modifyLayer' :: (W.Stack (Cursors String) -> X (W.Stack (Cursors String))) -> In
 modifyLayer' f depth = modifyCursors (descend f depth)
 
 modifyCursors ::  (Cursors String -> X (Cursors String)) -> X ()
-modifyCursors = sendMessage . ChangeCursors . (liftM2 (>>) updateXMD return <=<)
+modifyCursors = sendMessage . ChangeCursors . (liftA2 (>>) updateXMD return <=<)
 
-data WorkspaceCursors a = WorkspaceCursors (Cursors String)
-    deriving (Typeable,Read,Show)
+newtype WorkspaceCursors a = WorkspaceCursors (Cursors String)
+    deriving (Read,Show)
 
 -- | The state is stored in the 'WorkspaceCursors' layout modifier. Put this as
 -- your outermost modifier, unless you want different cursors at different
@@ -203,8 +197,7 @@ data WorkspaceCursors a = WorkspaceCursors (Cursors String)
 workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a
 workspaceCursors = ModifiedLayout . WorkspaceCursors
 
-data ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) }
-    deriving (Typeable)
+newtype ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) }
 
 instance Message ChangeCursors
 
@@ -219,4 +212,4 @@ instance LayoutModifier WorkspaceCursors a where
         return (arrs,WorkspaceCursors <$> focusTo cws cs)
 
     handleMess (WorkspaceCursors cs) m =
-        sequenceA $ fmap WorkspaceCursors . ($ cs) . unWrap <$> fromMessage m
+        traverse (fmap WorkspaceCursors . ($ cs) . unWrap) (fromMessage m)

XMonad/Actions/WorkspaceNames.hs

@@ -1,6 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.WorkspaceNames
+-- Description :  Persistently rename workspace and swap them along with their names.
 -- Copyright   :  (c) Tomas Janousek <tomi@nomi.cz>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -8,22 +9,19 @@
 -- Stability   :  experimental
 -- Portability :  unportable
 --
--- Provides bindings to rename workspaces, show these names in DynamicLog and
+-- Provides bindings to rename workspaces, show these names in a status bar and
 -- swap workspaces along with their names. These names survive restart.
 -- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully
 -- dynamic topic space workflow.
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE DeriveDataTypeable #-}
-
 module XMonad.Actions.WorkspaceNames (
     -- * Usage
     -- $usage
 
     -- * Workspace naming
     renameWorkspace,
-    workspaceNamesPP,
     getWorkspaceNames',
     getWorkspaceNames,
     getWorkspaceName,
@@ -37,26 +35,30 @@ module XMonad.Actions.WorkspaceNames (
     swapWithCurrent,
 
     -- * Workspace prompt
-    workspaceNamePrompt
+    workspaceNamePrompt,
+
+    -- * StatusBar, EwmhDesktops integration
+    workspaceNamesPP,
+    workspaceNamesEwmh,
     ) where
 
 import XMonad
+import XMonad.Prelude (fromMaybe, isInfixOf, (<&>), (>=>))
 import qualified XMonad.StackSet as W
 import qualified XMonad.Util.ExtensibleState as XS
 
-import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..))
+import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), anyWS)
 import qualified XMonad.Actions.SwapWorkspaces as Swap
-import XMonad.Hooks.DynamicLog (PP(..))
-import XMonad.Prompt (mkXPrompt, XPConfig)
+import XMonad.Hooks.StatusBar.PP (PP(..))
+import XMonad.Hooks.EwmhDesktops (addEwmhWorkspaceRename)
+import XMonad.Prompt (mkXPrompt, XPConfig, historyCompletionP)
 import XMonad.Prompt.Workspace (Wor(Wor))
 import XMonad.Util.WorkspaceCompare (getSortByIndex)
 
 import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
-import Data.List (isInfixOf)
 
 -- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+-- You can use this module with the following in your @xmonad.hs@ file:
 --
 -- > import XMonad.Actions.WorkspaceNames
 --
@@ -64,10 +66,17 @@ import Data.List (isInfixOf)
 --
 -- >   , ((modm .|. shiftMask, xK_r      ), renameWorkspace def)
 --
--- and apply workspaceNamesPP to your DynamicLog pretty-printer:
+-- and apply workspaceNamesPP to your pretty-printer:
 --
--- > myLogHook =
--- >     workspaceNamesPP xmobarPP >>= dynamicLogString >>= xmonadPropLog
+-- > myPP = workspaceNamesPP xmobarPP
+--
+-- Check "XMonad.Hooks.StatusBar" for more information on how to incorprate
+-- this into your status bar.
+--
+-- To expose workspace names to pagers and other EWMH clients, integrate this
+-- with "XMonad.Hooks.EwmhDesktops":
+--
+-- > main = xmonad $ … . workspaceNamesEwmh . ewmh . … $ def{…}
 --
 -- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s
 -- functionality, which may be used this way:
@@ -79,13 +88,13 @@ import Data.List (isInfixOf)
 -- >     | (i, k) <- zip workspaces [xK_1 ..]]
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 
 
 
 -- | Workspace names container.
 newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)
-    deriving (Typeable, Read, Show)
+    deriving (Read, Show)
 
 instance ExtensionClass WorkspaceNames where
     initialValue = WorkspaceNames M.empty
@@ -97,21 +106,20 @@ getWorkspaceNames' = do
     WorkspaceNames m <- XS.get
     return (`M.lookup` m)
 
--- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for
--- workspaces with a name, and to @\"t\"@ otherwise.
-getWorkspaceNames :: X (WorkspaceId -> String)
-getWorkspaceNames = do
-    lookup <- getWorkspaceNames'
-    return $ \wks -> wks ++ maybe "" (':' :) (lookup wks)
+-- | Returns a function for 'ppRename' that appends @sep@ and the workspace
+-- name, if set.
+getWorkspaceNames :: String -> X (String -> WindowSpace -> String)
+getWorkspaceNames sep = ren <$> getWorkspaceNames'
+  where
+    ren name s w = s ++ maybe "" (sep ++) (name (W.tag w))
 
 -- | Gets the name of a workspace, if set, otherwise returns nothing.
 getWorkspaceName :: WorkspaceId -> X (Maybe String)
-getWorkspaceName w = ($ w) `fmap` getWorkspaceNames'
+getWorkspaceName w = ($ w) <$> getWorkspaceNames'
 
 -- | Gets the name of the current workspace. See 'getWorkspaceName'
 getCurrentWorkspaceName :: X (Maybe String)
-getCurrentWorkspaceName = do
-    getWorkspaceName =<< gets (W.currentTag . windowset)
+getCurrentWorkspaceName = getWorkspaceName =<< gets (W.currentTag . windowset)
 
 -- | Sets the name of a workspace. Empty string makes the workspace unnamed
 -- again.
@@ -130,26 +138,14 @@ setCurrentWorkspaceName name = do
 -- | Prompt for a new name for the current workspace and set it.
 renameWorkspace :: XPConfig -> X ()
 renameWorkspace conf = do
-    mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
-    where pr = Wor "Workspace name: "
-
--- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show
--- workspace names as well.
-workspaceNamesPP :: PP -> X PP
-workspaceNamesPP pp = do
-    names <- getWorkspaceNames
-    return $
-        pp {
-            ppCurrent         = ppCurrent         pp . names,
-            ppVisible         = ppVisible         pp . names,
-            ppHidden          = ppHidden          pp . names,
-            ppHiddenNoWindows = ppHiddenNoWindows pp . names,
-            ppUrgent          = ppUrgent          pp . names
-        }
+    completion <- historyCompletionP conf (prompt ==)
+    mkXPrompt (Wor prompt) conf completion setCurrentWorkspaceName
+  where
+    prompt = "Workspace name: "
 
 -- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.
 swapTo :: Direction1D -> X ()
-swapTo dir = swapTo' dir AnyWS
+swapTo dir = swapTo' dir anyWS
 
 -- | Swap with the previous or next workspace of the given type.
 swapTo' :: Direction1D -> WSType -> X ()
@@ -169,19 +165,27 @@ swapNames w1 w2 = do
     WorkspaceNames m <- XS.get
     let getname w = fromMaybe "" $ M.lookup w m
         set w name m' = if null name then M.delete w m' else M.insert w name m'
-    XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m
+    XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) m
 
 -- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module.
-workspaceNamePrompt :: XPConfig -> (String -> X ()) -> X ()
+workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X ()
 workspaceNamePrompt conf job = do
-    myWorkspaces <- gets $ map W.tag . W.workspaces . windowset
-    myWorkspacesName <- getWorkspaceNames >>= \f -> return $ map f myWorkspaces
-    let pairs = zip myWorkspacesName myWorkspaces
+    myWorkspaces <- gets $ W.workspaces . windowset
+    myWorkspacesName <- getWorkspaceNames ":" <&> \n -> [n (W.tag w) w | w <- myWorkspaces]
+    let pairs = zip myWorkspacesName (map W.tag myWorkspaces)
     mkXPrompt (Wor "Select workspace: ") conf
               (contains myWorkspacesName)
               (job . toWsId pairs)
-  where toWsId pairs name = case lookup name pairs of
-                                Nothing -> ""
-                                Just i -> i
+  where toWsId pairs name = fromMaybe "" (lookup name pairs)
         contains completions input =
-          return $ filter (Data.List.isInfixOf input) completions
+          return $ filter (isInfixOf input) completions
+
+-- | Modify 'XMonad.Hooks.StatusBar.PP.PP'\'s pretty-printing format to show
+-- workspace names as well.
+workspaceNamesPP :: PP -> X PP
+workspaceNamesPP pp = getWorkspaceNames ":" <&> \ren -> pp{ ppRename = ppRename pp >=> ren }
+
+-- | Tell "XMonad.Hooks.EwmhDesktops" to append workspace names to desktop
+-- names.
+workspaceNamesEwmh :: XConfig l -> XConfig l
+workspaceNamesEwmh = addEwmhWorkspaceRename $ getWorkspaceNames ":"

XMonad/Config/Arossato.hs

@@ -3,6 +3,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Config.Arossato
+-- Description :  Andrea Rossato's xmonad configuration.
 -- Copyright   :  (c) Andrea Rossato 2007
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -15,6 +16,7 @@
 ------------------------------------------------------------------------
 
 module XMonad.Config.Arossato
+    {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib.  If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-}
     ( -- * Usage
       -- $usage
       arossatoConfig
@@ -22,7 +24,7 @@ module XMonad.Config.Arossato
 
 import qualified Data.Map as M
 
-import XMonad hiding ( (|||) )
+import XMonad
 import qualified XMonad.StackSet as W
 
 import XMonad.Actions.CycleWS
@@ -30,7 +32,6 @@ import XMonad.Hooks.DynamicLog hiding (xmobar)
 import XMonad.Hooks.ManageDocks
 import XMonad.Hooks.ServerMode
 import XMonad.Layout.Accordion
-import XMonad.Layout.LayoutCombinators
 import XMonad.Layout.Magnifier
 import XMonad.Layout.NoBorders
 import XMonad.Layout.SimpleFloat
@@ -46,7 +47,7 @@ import XMonad.Util.Themes
 
 -- $usage
 -- The simplest way to use this configuration module is to use an
--- @~\/.xmonad\/xmonad.hs@ like this:
+-- @xmonad.hs@ like this:
 --
 -- > module Main (main) where
 -- >
@@ -63,7 +64,7 @@ import XMonad.Util.Themes
 --
 -- You can use this module also as a starting point for writing your
 -- own configuration module from scratch. Save it as your
--- @~\/.xmonad\/xmonad.hs@ and:
+-- @xmonad.hs@ and:
 --
 -- 1. Change the module name from
 --
@@ -147,8 +148,8 @@ arossatoConfig = do
           , ((modMask x              , xK_F3    ), shellPrompt       def                 )
           , ((modMask x              , xK_F4    ), sshPrompt         def                 )
           , ((modMask x              , xK_F5    ), themePrompt       def                 )
-          , ((modMask x              , xK_F6    ), windowPromptGoto  def                 )
-          , ((modMask x              , xK_F7    ), windowPromptBring def                 )
+          , ((modMask x              , xK_F6    ), windowPrompt def Goto  allWindows     )
+          , ((modMask x              , xK_F7    ), windowPrompt def Bring allWindows     )
           , ((modMask x              , xK_comma ), prevWS                                )
           , ((modMask x              , xK_period), nextWS                                )
           , ((modMask x              , xK_Right ), windows W.focusDown                   )

XMonad/Config/Azerty.hs

@@ -3,6 +3,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Config.Azerty
+-- Description  : Fix some keybindings for users of French keyboard layouts.
 -- Copyright    : (c) Devin Mullins <me@twifkak.com>
 -- License      : BSD
 --
@@ -17,7 +18,7 @@
 module XMonad.Config.Azerty (
     -- * Usage
     -- $usage
-    azertyConfig, azertyKeys
+    azertyConfig, azertyKeys, belgianConfig, belgianKeys
     ) where
 
 import XMonad
@@ -26,7 +27,7 @@ import qualified XMonad.StackSet as W
 import qualified Data.Map as M
 
 -- $usage
--- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+-- To use this module, start with the following @xmonad.hs@:
 --
 -- > import XMonad
 -- > import XMonad.Config.Azerty
@@ -36,15 +37,21 @@ import qualified Data.Map as M
 -- If you prefer, an azertyKeys function is provided which you can use as so:
 --
 -- > import qualified Data.Map as M
--- > main = xmonad someConfig { keys = \c -> azertyKeys c <+> keys someConfig c }
+-- > main = xmonad someConfig { keys = \c -> azertyKeys c <> keys someConfig c }
 
-azertyConfig = def { keys = azertyKeys <+> keys def }
+azertyConfig = def { keys = azertyKeys <> keys def }
 
-azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
+belgianConfig = def { keys = belgianKeys <> keys def }
+
+azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0]
+
+belgianKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0xa7,0xe8,0x21,0xe7,0xe0]
+
+azertyKeysTop topRow conf@XConfig{modMask = modm} = M.fromList $
     [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
     ++
     [((m .|. modm, k), windows $ f i)
-        | (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0],
+        | (i, k) <- zip (workspaces conf) topRow,
           (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
     ++
     -- mod-{z,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3

XMonad/Config/Bepo.hs

@@ -3,6 +3,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Config.Bepo
+-- Description  : Fix keybindings for the BEPO keyboard layout.
 -- Copyright    : (c) Yorick Laupa <yo.eight@gmail.com>
 -- License      : BSD
 --
@@ -25,7 +26,7 @@ import qualified XMonad.StackSet as W
 import qualified Data.Map as M
 
 -- $usage
--- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+-- To use this module, start with the following @xmonad.hs@:
 --
 -- > import XMonad
 -- > import XMonad.Config.Bepo
@@ -37,11 +38,10 @@ import qualified Data.Map as M
 -- > import qualified Data.Map as M
 -- > main = xmonad someConfig { keys = \c -> bepoKeys c `M.union` keys someConfig c }
 
-bepoConfig = def { keys = bepoKeys <+> keys def }
+bepoConfig = def { keys = bepoKeys <> keys def }
 
-bepoKeys conf@(XConfig { modMask = modm }) = M.fromList $
-    [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
-    ++
-    [((m .|. modm, k), windows $ f i)
-        | (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a],
-          (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
+bepoKeys conf@XConfig { modMask = modm } = M.fromList $
+    ((modm, xK_semicolon), sendMessage (IncMasterN (-1)))
+    : [((m .|. modm, k), windows $ f i)
+          | (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a],
+            (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]

XMonad/Config/Bluetile.hs

@@ -3,6 +3,7 @@
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Config.Bluetile
+-- Description :  Default configuration of [Bluetile](http://projects.haskell.org/bluetile/).
 -- Copyright   :  (c) Jan Vornberger 2009
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -25,25 +26,25 @@ module XMonad.Config.Bluetile (
     bluetileConfig
     ) where
 
-import XMonad hiding ( (|||) )
+import XMonad
 
 import XMonad.Layout.BorderResize
-import XMonad.Layout.BoringWindows
+import XMonad.Layout.BoringWindows hiding (Replace)
 import XMonad.Layout.ButtonDecoration
 import XMonad.Layout.Decoration
 import XMonad.Layout.DecorationAddons
 import XMonad.Layout.DraggingVisualizer
-import XMonad.Layout.LayoutCombinators
 import XMonad.Layout.Maximize
 import XMonad.Layout.Minimize
 import XMonad.Layout.MouseResizableTile
-import XMonad.Layout.Named
+import XMonad.Layout.Renamed
 import XMonad.Layout.NoBorders
 import XMonad.Layout.PositionStoreFloat
 import XMonad.Layout.WindowSwitcherDecoration
 
 import XMonad.Actions.BluetileCommands
 import XMonad.Actions.CycleWS
+import XMonad.Actions.Minimize
 import XMonad.Actions.WindowMenu
 
 import XMonad.Hooks.CurrentWorkspaceOnTop
@@ -61,11 +62,10 @@ import qualified XMonad.StackSet as W
 import qualified Data.Map as M
 
 import System.Exit
-import Data.Monoid
-import Control.Monad(when)
+import XMonad.Prelude(when)
 
 -- $usage
--- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+-- To use this module, start with the following @xmonad.hs@:
 --
 -- > import XMonad
 -- > import XMonad.Config.Bluetile
@@ -81,7 +81,7 @@ bluetileWorkspaces :: [String]
 bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"]
 
 bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
-bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
+bluetileKeys conf@XConfig{XMonad.modMask = modMask'} = M.fromList $
     -- launching and killing programs
     [ ((modMask'              , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal
     , ((modMask',               xK_p     ), gnomeRun)    --  %! Launch Gnome "Run application" dialog
@@ -112,14 +112,14 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
 
     -- floating layer support
     , ((modMask',               xK_t     ), withFocused $ windows . W.sink) -- %! Push window back into tiling
-    , ((modMask' .|. shiftMask, xK_t     ), withFocused $ float ) -- %! Float window
+    , ((modMask' .|. shiftMask, xK_t     ), withFocused float ) -- %! Float window
 
     -- increase or decrease number of windows in the master area
     , ((modMask'              , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area
     , ((modMask'              , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
 
     -- quit, or restart
-    , ((modMask' .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit
+    , ((modMask' .|. shiftMask, xK_q     ), io exitSuccess) -- %! Quit
     , ((modMask'              , xK_q     ), restart "xmonad" True) -- %! Restart
 
     -- Metacity-like workspace switching
@@ -143,7 +143,7 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
 
     -- Minimizing
     , ((modMask',               xK_m     ), withFocused minimizeWindow)
-    , ((modMask' .|. shiftMask, xK_m     ), sendMessage RestoreNextMinimizedWin)
+    , ((modMask' .|. shiftMask, xK_m     ), withLastMinimized maximizeWindow)
     ]
     ++
     -- mod-[1..9] ++ [0] %! Switch to workspace N
@@ -159,19 +159,19 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
         , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
 
 bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
-bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $
+bluetileMouseBindings XConfig{XMonad.modMask = modMask'} = M.fromList
     -- mod-button1 %! Move a floated window by dragging
-    [ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $
-                                focus w >> mouseMoveWindow w >> windows W.shiftMaster))
+    [ ((modMask', button1), \w -> isFloating w >>= \isF -> when isF $
+                                focus w >> mouseMoveWindow w >> windows W.shiftMaster)
     -- mod-button2 %! Switch to next and first layout
-    , ((modMask', button2), (\_ -> sendMessage NextLayout))
-    , ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating"))
+    , ((modMask', button2), \_ -> sendMessage NextLayout)
+    , ((modMask' .|. shiftMask, button2), \_ -> sendMessage $ JumpToLayout "Floating")
     -- mod-button3 %! Resize a floated window by dragging
-    , ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $
-                                focus w >> mouseResizeWindow w >> windows W.shiftMaster))
+    , ((modMask', button3), \w -> isFloating w >>= \isF -> when isF $
+                                focus w >> mouseResizeWindow w >> windows W.shiftMaster)
     ]
 
-isFloating :: Window -> X (Bool)
+isFloating :: Window -> X Bool
 isFloating w = do
     ws <- gets windowset
     return $ M.member w (W.floating ws)
@@ -182,31 +182,28 @@ bluetileManageHook = composeAll
                 , className =? "MPlayer" --> doFloat
                 , isFullscreen --> doFullFloat]
 
-bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
-                        named "Floating" floating |||
-                        named "Tiled1" tiled1 |||
-                        named "Tiled2" tiled2 |||
-                        named "Fullscreen" fullscreen
-                        )
+bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $
+                        renamed [Replace "Floating"] floating |||
+                        renamed [Replace "Tiled1"] tiled1 |||
+                        renamed [Replace "Tiled2"] tiled2 |||
+                        renamed [Replace "Fullscreen"] fullscreen
         where
-            floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat
-            tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored
-            tiled2 = tilingDeco $ maximize $ mouseResizableTile
+            floating = floatingDeco $ maximize $ borderResize positionStoreFloat
+            tiled1 = tilingDeco $ maximize mouseResizableTileMirrored
+            tiled2 = tilingDeco $ maximize mouseResizableTile
             fullscreen = tilingDeco $ maximize $ smartBorders Full
 
             tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l)
-            floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l
+            floatingDeco = buttonDeco shrinkText defaultThemeWithButtons
 
 bluetileConfig =
-    docks $
+    docks . ewmhFullscreen . ewmh $
     def
         { modMask = mod4Mask,   -- logo key
           manageHook = bluetileManageHook,
           layoutHook = bluetileLayoutHook,
-          logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook,
-          handleEventHook = ewmhDesktopsEventHook
-                                `mappend` fullscreenEventHook
-                                `mappend` minimizeEventHook
+          logHook = currentWorkspaceOnTop,
+          handleEventHook = minimizeEventHook
                                 `mappend` serverModeEventHook' bluetileCommands
                                 `mappend` positionStoreEventHook,
           workspaces = bluetileWorkspaces,

XMonad/Config/Desktop.hs

@@ -3,6 +3,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Config.Desktop
+-- Description  : Core settings for interfacing with desktop environments.
 -- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com>
 -- License      : BSD
 --
@@ -23,7 +24,7 @@ module XMonad.Config.Desktop (
     -- specification. Extra xmonad settings unique to specific DE's are
     -- added by overriding or modifying @desktopConfig@ fields in the
     -- same way that the default configuration is customized in
-    -- @~\/.xmonad/xmonad.hs@.
+    -- @xmonad.hs@.
     --
     -- For more information about EWMH see:
     --
@@ -57,6 +58,7 @@ module XMonad.Config.Desktop (
 import XMonad
 import XMonad.Hooks.ManageDocks
 import XMonad.Hooks.EwmhDesktops
+import XMonad.Layout.LayoutModifier (ModifiedLayout)
 import XMonad.Util.Cursor
 
 import qualified Data.Map as M
@@ -70,7 +72,7 @@ import qualified Data.Map as M
 -- <http://haskell.org/haskellwiki/Xmonad>
 --
 -- To configure xmonad for use with a DE or with DE tools like panels
--- and pagers, in place of @def@ in your @~\/.xmonad/xmonad.hs@,
+-- and pagers, in place of @def@ in your @xmonad.hs@,
 -- use @desktopConfig@ or one of the other desktop configs from the
 -- @XMonad.Config@ namespace. The following setup and customization examples
 -- work the same way for the other desktop configs as for @desktopConfig@.
@@ -89,7 +91,7 @@ import qualified Data.Map as M
 
 -- $customizing
 -- To customize a desktop config, modify its fields as is illustrated with
--- the default configuration @def@ in "XMonad.Doc.Extending#Extending xmonad".
+-- the default configuration @def@ in <https://xmonad.org/TUTORIAL.html the tutorial>.
 
 -- $layouts
 -- See also "XMonad.Util.EZConfig" for more options for modifying key bindings.
@@ -104,7 +106,7 @@ import qualified Data.Map as M
 -- > main =
 -- >   xmonad $ desktopConfig {
 -- >     -- add manage hooks while still ignoring panels and using default manageHooks
--- >       manageHook = myManageHook <+> manageHook desktopConfig
+-- >       manageHook = myManageHook <> manageHook desktopConfig
 -- >
 -- >     -- add a fullscreen tabbed layout that does not avoid covering
 -- >     -- up desktop panels before the desktop layouts
@@ -127,7 +129,7 @@ import qualified Data.Map as M
 -- To add to the logHook while still sending workspace and window information
 -- to DE apps use something like:
 --
--- >  , logHook = myLogHook <+> logHook desktopConfig
+-- >  , logHook = myLogHook <> logHook desktopConfig
 --
 -- Or for more elaborate logHooks you can use @do@:
 --
@@ -141,7 +143,7 @@ import qualified Data.Map as M
 -- To customize xmonad's event handling while still having it respond
 -- to EWMH events from pagers, task bars:
 --
--- >  , handleEventHook = myEventHooks <+> handleEventHook desktopConfig
+-- >  , handleEventHook = myEventHooks <> handleEventHook desktopConfig
 --
 -- or 'mconcat' if you write a list event of event hooks
 --
@@ -155,7 +157,7 @@ import qualified Data.Map as M
 
 -- $startupHook
 -- To run the desktop startupHook, plus add further actions to be run each
--- time xmonad starts or restarts, use '<+>' to combine actions as in the
+-- time xmonad starts or restarts, use '<>' to combine actions as in the
 -- logHook example, or something like:
 --
 -- >  , startupHook = do
@@ -164,13 +166,16 @@ import qualified Data.Map as M
 -- >        adjustEventInput
 --
 
+desktopConfig :: XConfig (ModifiedLayout AvoidStruts
+                             (Choose Tall (Choose (Mirror Tall) Full)))
 desktopConfig = docks $ ewmh def
-    { startupHook     = setDefaultCursor xC_left_ptr <+> startupHook def
+    { startupHook     = setDefaultCursor xC_left_ptr <> startupHook def
     , layoutHook      = desktopLayoutModifiers $ layoutHook def
-    , keys            = desktopKeys <+> keys def }
+    , keys            = desktopKeys <> keys def }
 
-desktopKeys (XConfig {modMask = modm}) = M.fromList $
+desktopKeys :: XConfig l -> M.Map (KeyMask, KeySym) (X ())
+desktopKeys XConfig{modMask = modm} = M.fromList
     [ ((modm, xK_b), sendMessage ToggleStruts) ]
 
-desktopLayoutModifiers layout = avoidStruts layout
-
+desktopLayoutModifiers :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a
+desktopLayoutModifiers = avoidStruts

XMonad/Config/Dmwit.hs

@@ -1,14 +1,16 @@
 -- boilerplate {{{
-{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances #-}
+{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances, ViewPatterns, LambdaCase #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-}
-module XMonad.Config.Dmwit where
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Config.Dmwit
+-- Description :  Daniel Wagner's xmonad configuration.
+--
+------------------------------------------------------------------------
+module XMonad.Config.Dmwit {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib.  If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} where
 
 -- system imports
-import Control.Applicative
-import Control.Monad
 import Control.Monad.Trans
-import Data.Char
-import Data.List
 import Data.Map (Map, fromList)
 import Data.Ratio
 import Data.Word
@@ -29,9 +31,10 @@ import XMonad.Hooks.DynamicLog
 import XMonad.Hooks.ManageDocks
 import XMonad.Hooks.ManageHelpers
 import XMonad.Layout.Grid
-import XMonad.Layout.IndependentScreens
+import XMonad.Layout.IndependentScreens hiding (withScreen)
 import XMonad.Layout.Magnifier
 import XMonad.Layout.NoBorders
+import XMonad.Prelude hiding (fromList)
 import XMonad.Util.Dzen hiding (x, y)
 import XMonad.Util.SpawnOnce
 -- }}}
@@ -75,7 +78,7 @@ modVolume kind n = do
     where
     sign | n > 0 = "+" | otherwise = "-"
     ctlKind      = map (\c -> if c == ' ' then '-' else c) kind
-    parseKind    = unwords . map (\(c:cs) -> toUpper c : cs) . words $ kind
+    parseKind    = unwords . map (\(notEmpty -> c :| cs) -> toUpper c : cs) . words $ kind
     setCommand i = "pactl set-" ++ ctlKind ++ "-volume " ++ i ++ " -- " ++ sign ++ show (abs n) ++ "%"
     listCommand  = "pactl list " ++ ctlKind ++ "s"
 -- }}}
@@ -112,7 +115,6 @@ fullscreenMPlayer = className =? "MPlayer" --> do
         Just (16 :% 9)  -> viewFullOn 1 "5" win
         _               -> doFloat
     where
-    fi               = fromIntegral :: Dimension -> Double
     approx (n, d)    = approxRational (fi n / fi d) (1/100)
 
 operationOn f s n w = do
@@ -215,13 +217,13 @@ dmwitConfig nScreens = docks $ def {
     keys                    = keyBindings,
     layoutHook              = magnifierOff $ avoidStruts (GridRatio 0.9) ||| noBorders Full,
     manageHook              =     (title =? "CGoban: Main Window" --> doF sinkFocus)
-                              <+> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5")
-                              <+> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5")
-                              <+> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <+> compared to) this one
-                              <+> (appName =? "huludesktop" --> doRectFloat fullscreen43on169)
-                              <+> fullscreenMPlayer
-                              <+> floatAll ["Gimp", "Wine"]
-                              <+> manageSpawn,
+                              <> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5")
+                              <> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5")
+                              <> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <> compared to) this one
+                              <> (appName =? "huludesktop" --> doRectFloat fullscreen43on169)
+                              <> fullscreenMPlayer
+                              <> floatAll ["Gimp", "Wine"]
+                              <> manageSpawn,
     logHook                 = allPPs nScreens,
     startupHook             = refresh
                            >> mapM_ (spawnOnce . xmobarCommand) [0 .. nScreens-1]
@@ -236,7 +238,7 @@ keyBindings conf = let m = modMask conf in fromList . anyMask $ [
     ((m .|. shiftMask  , xK_p          ), spawnHere termLauncher),
     ((m .|. shiftMask  , xK_c          ), kill),
     ((m                , xK_q          ), restart "xmonad" True),
-    ((m .|. shiftMask  , xK_q          ), io (exitWith ExitSuccess)),
+    ((m .|. shiftMask  , xK_q          ), io exitSuccess),
     ((m                , xK_grave      ), sendMessage NextLayout),
     ((m .|. shiftMask  , xK_grave      ), setLayout $ layoutHook conf),
     ((m                , xK_o          ), sendMessage Toggle),
@@ -306,7 +308,7 @@ allPPs nScreens = sequence_ [dynamicLogWithPP (pp s) | s <- [0..nScreens-1], pp
 color c = xmobarColor c ""
 
 ppFocus s@(S s_) = whenCurrentOn s def {
-    ppOrder  = \(_:_:windowTitle:_) -> [windowTitle],
+    ppOrder  = \case{ _:_:windowTitle:_ -> [windowTitle]; _ -> [] },
     ppOutput = appendFile (pipeName "focus" s_) . (++ "\n")
     }
 
@@ -316,7 +318,7 @@ ppWorkspaces s@(S s_) = marshallPP s def {
     ppHiddenNoWindows   = color dark,
     ppUrgent            = color "red",
     ppSep               = "",
-    ppOrder             = \(wss:_layout:_title:_) -> [wss],
+    ppOrder             = \case{ wss:_layout:_title:_ -> [wss]; _ -> [] },
     ppOutput            = appendFile (pipeName "workspaces" s_) . (++"\n")
     }
 -- }}}

XMonad/Config/Droundy.hs

@@ -1,25 +1,27 @@
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE TupleSections #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
+-- Module      :  XMonad.Config.Droundy
+-- Description :  David Roundy's xmonad config.
 -- Copyright   :  (c) Spencer Janssen 2007
 -- License     :  BSD3-style (see LICENSE)
 --
 ------------------------------------------------------------------------
+module XMonad.Config.Droundy {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib.  If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} ( config, mytab ) where
 
-module XMonad.Config.Droundy ( config, mytab ) where
-
-import XMonad hiding (keys, config, (|||))
+import XMonad hiding (keys, config)
 import qualified XMonad (keys)
 
 import qualified XMonad.StackSet as W
 import qualified Data.Map as M
-import System.Exit ( exitWith, ExitCode(ExitSuccess) )
+import System.Exit ( exitSuccess )
 
 import XMonad.Layout.Tabbed ( tabbed,
                               shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )
 import XMonad.Layout.Combo ( combineTwo )
-import XMonad.Layout.Named ( named )
+import XMonad.Layout.Renamed ( Rename(Replace), renamed )
 import XMonad.Layout.LayoutCombinators
 import XMonad.Layout.Square ( Square(Square) )
 import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L),
@@ -39,8 +41,8 @@ import XMonad.Prompt.Shell ( shellPrompt )
 import XMonad.Actions.CopyWindow ( kill1, copy )
 import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,
                                           selectWorkspace, renameWorkspace, removeWorkspace )
-import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),
-                                Direction1D( Prev, Next) )
+import XMonad.Actions.CycleWS ( moveTo, hiddenWS, emptyWS,
+                                Direction1D( Prev, Next), WSType ((:&:), Not) )
 
 import XMonad.Hooks.ManageDocks ( avoidStruts, docks )
 import XMonad.Hooks.EwmhDesktops ( ewmh )
@@ -77,11 +79,11 @@ keys x = M.fromList $
     , ((modMask x,               xK_t     ), withFocused $ windows . W.sink) -- %! Push window back into tiling
 
     -- quit, or restart
-    , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad
+    , ((modMask x .|. shiftMask, xK_Escape), io exitSuccess) -- %! Quit xmonad
     , ((modMask x              , xK_Escape), restart "xmonad" True) -- %! Restart xmonad
 
-    , ((modMask x .|. shiftMask, xK_Right), moveTo Next HiddenNonEmptyWS)
-    , ((modMask x .|. shiftMask, xK_Left), moveTo Prev HiddenNonEmptyWS)
+    , ((modMask x .|. shiftMask, xK_Right), moveTo Next $ hiddenWS :&: Not emptyWS)
+    , ((modMask x .|. shiftMask, xK_Left), moveTo Prev $ hiddenWS :&: Not emptyWS)
     , ((modMask x, xK_Right), sendMessage $ Go R)
     , ((modMask x, xK_Left), sendMessage $ Go L)
     , ((modMask x, xK_Up), sendMessage $ Go U)
@@ -113,9 +115,9 @@ keys x = M.fromList $
     ]
 
     ++
-    zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..])
+    zip (map (modMask x,) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..])
     ++
-    zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])
+    zip (map (modMask x .|. shiftMask,) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])
 
 config = docks $ ewmh def
          { borderWidth = 1 -- Width of the window border in pixels.
@@ -123,10 +125,10 @@ config = docks $ ewmh def
          , layoutHook = showWName $ workspaceDir "~" $
                         boringWindows $ smartBorders $ windowNavigation $
                         maximizeVertical $ toggleLayouts Full $ avoidStruts $
-                        named "tabbed" mytab |||
-                        named "xclock" (mytab ****//* combineTwo Square mytab mytab) |||
-                        named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) |||
-                        named "widescreen" ((mytab *||* mytab)
+                        renamed [Replace "tabbed"] mytab |||
+                        renamed [Replace "xclock"] (mytab ****//* combineTwo Square mytab mytab) |||
+                        renamed [Replace "three"] (mytab **//* mytab *//* combineTwo Square mytab mytab) |||
+                        renamed [Replace "widescreen"] ((mytab *||* mytab)
                                                 ****//* combineTwo Square mytab mytab) --   |||
                         --mosaic 0.25 0.5
          , terminal = "xterm" -- The preferred terminal program.