INSTALL: Suggest newer tagged releases

In [1] xmobar renamed the "examples" directory to "etc".

[1]: 6330397707

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

@@ -2,14 +2,16 @@ Piggy-back on the haskell-ci workflow for automatic releases to Hackage.
 
 This extends the workflow with two additional triggers:
 
- * When a release is created on GitHub, 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).
+ * 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).
 
- * To make a final release, the workflow can be triggered manually by entering
-   the correct version number matching the version in the cabal file. This is
-   here because promoting the candidate on Hackage discards the uploaded docs
-   (https://github.com/haskell/hackage-server/issues/70).
+   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
@@ -17,7 +19,7 @@ set in GitHub repository secrets.
 
 --- .github/workflows/haskell-ci.yml.orig
 +++ .github/workflows/haskell-ci.yml
-@@ -14,8 +14,17 @@
+@@ -14,8 +14,15 @@
  #
  name: Haskell-CI
  on:
@@ -31,21 +33,19 @@ set in GitHub repository secrets.
 +  workflow_dispatch:
 +    inputs:
 +      version:
-+        # releases to Hackage are final and cannot be reverted, thus require
-+        # manual entry of version as a poor man's mistake avoidance
-+        description: version (must match version in cabal file)
++        description: candidate version (must match version in cabal file)
  jobs:
    linux:
      name: Haskell-CI - Linux - ${{ matrix.compiler }}
-@@ -28,6 +37,7 @@
-         include:
-           - compiler: ghc-9.0.1
+@@ -31,6 +38,7 @@
+             compilerVersion: 9.0.2
+             setup-method: ghcup
              allow-failure: false
 +            upload: true
-           - compiler: ghc-8.10.4
-             allow-failure: false
-           - compiler: ghc-8.8.4
-@@ -171,8 +181,66 @@
+           - compiler: ghc-8.10.7
+             compilerKind: ghc
+             compilerVersion: 8.10.7
+@@ -209,8 +217,80 @@
            ${CABAL} -vnormal check
        - name: haddock
          run: |
@@ -66,50 +66,64 @@ set in GitHub repository secrets.
 +        with:
 +          path: ${{ github.workspace }}/haddock/*-docs.tar.gz
 +      - name: hackage upload (candidate)
-+        if: matrix.upload && github.event_name == 'release'
++        if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''
++        shell: bash
 +        run: |
 +          set -ex
 +          PACKAGE_VERSION="${PACKAGE_VERSION#v}"
-+          curl \
-+            --silent --show-error --fail \
-+            --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/
-+          curl \
-+            --silent --show-error --fail \
-+            -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
-+        env:
-+          HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
-+          PACKAGE_NAME: ${{ github.event.repository.name }}
-+          PACKAGE_VERSION: ${{ github.event.release.tag_name }}
-+      - name: hackage upload (release)
-+        if: matrix.upload && github.event_name == 'workflow_dispatch'
-+        run: |
-+          set -ex
-+          PACKAGE_VERSION="${PACKAGE_VERSION#v}"
-+          curl \
-+            --silent --show-error --fail \
-+            --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/
-+          curl \
-+            --silent --show-error --fail \
-+            -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=$(
++            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

@@ -8,9 +8,9 @@
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.12
+# version: 0.14.3
 #
-# REGENDATA ("0.12",["github","cabal.project"])
+# REGENDATA ("0.14.3",["github","cabal.project"])
 #
 name: Haskell-CI
 on:
@@ -22,63 +22,109 @@ on:
   workflow_dispatch:
     inputs:
       version:
-        # releases to Hackage are final and cannot be reverted, thus require
-        # manual entry of version as a poor man's mistake avoidance
-        description: version (must match version in cabal file)
+        description: candidate version (must match version in cabal file)
 jobs:
   linux:
     name: Haskell-CI - Linux - ${{ matrix.compiler }}
     runs-on: ubuntu-18.04
+    timeout-minutes:
+      60
     container:
       image: buildpack-deps:bionic
     continue-on-error: ${{ matrix.allow-failure }}
     strategy:
       matrix:
         include:
-          - compiler: ghc-9.0.1
+          - compiler: ghc-9.2.2
+            compilerKind: ghc
+            compilerVersion: 9.2.2
+            setup-method: ghcup
+            allow-failure: false
+          - compiler: ghc-9.0.2
+            compilerKind: ghc
+            compilerVersion: 9.0.2
+            setup-method: ghcup
             allow-failure: false
             upload: true
-          - compiler: ghc-8.10.4
+          - 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: hvr-ppa
             allow-failure: false
           - compiler: ghc-8.6.5
+            compilerKind: ghc
+            compilerVersion: 8.6.5
+            setup-method: hvr-ppa
             allow-failure: false
           - compiler: ghc-8.4.4
+            compilerKind: ghc
+            compilerVersion: 8.4.4
+            setup-method: hvr-ppa
             allow-failure: false
       fail-fast: false
     steps:
       - name: apt
         run: |
           apt-get update
-          apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common
-          apt-add-repository -y 'ppa:hvr/ghc'
-          apt-get update
-          apt-get install -y $CC cabal-install-3.4 libx11-dev libxext-dev libxinerama-dev libxrandr-dev libxss-dev
+          apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
+          if [ "${{ matrix.setup-method }}" = ghcup ]; then
+            mkdir -p "$HOME/.ghcup/bin"
+            curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
+            chmod a+x "$HOME/.ghcup/bin/ghcup"
+            "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"
+            "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
+            apt-get update
+            apt-get install -y libx11-dev libxext-dev libxinerama-dev libxrandr-dev libxss-dev
+          else
+            apt-add-repository -y 'ppa:hvr/ghc'
+            apt-get update
+            apt-get install -y "$HCNAME" libx11-dev libxext-dev libxinerama-dev libxrandr-dev libxss-dev
+            mkdir -p "$HOME/.ghcup/bin"
+            curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
+            chmod a+x "$HOME/.ghcup/bin/ghcup"
+            "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
+          fi
         env:
-          CC: ${{ matrix.compiler }}
+          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
-          HCDIR=$(echo "/opt/$CC" | sed 's/-/\//')
-          HCNAME=ghc
-          HC=$HCDIR/bin/$HCNAME
-          echo "HC=$HC" >> $GITHUB_ENV
-          echo "HCPKG=$HCDIR/bin/$HCNAME-pkg" >> $GITHUB_ENV
-          echo "HADDOCK=$HCDIR/bin/haddock" >> $GITHUB_ENV
-          echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV
+          echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
+          echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
+          echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
+          HCDIR=/opt/$HCKIND/$HCVER
+          if [ "${{ matrix.setup-method }}" = ghcup ]; then
+            HC=$HOME/.ghcup/bin/$HCKIND-$HCVER
+            echo "HC=$HC" >> "$GITHUB_ENV"
+            echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
+            echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
+            echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
+          else
+            HC=$HCDIR/bin/$HCKIND
+            echo "HC=$HC" >> "$GITHUB_ENV"
+            echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
+            echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
+            echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
+          fi
+
           HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
-          echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV
-          echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV
-          echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV
-          echo "HEADHACKAGE=false" >> $GITHUB_ENV
-          echo "ARG_COMPILER=--$HCNAME --with-compiler=$HC" >> $GITHUB_ENV
-          echo "GHCJSARITH=0" >> $GITHUB_ENV
+          echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
+          echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
+          echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
+          echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
+          echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
+          echo "GHCJSARITH=0" >> "$GITHUB_ENV"
         env:
-          CC: ${{ matrix.compiler }}
+          HCKIND: ${{ matrix.compilerKind }}
+          HCNAME: ${{ matrix.compiler }}
+          HCVER: ${{ matrix.compilerVersion }}
       - name: env
         run: |
           env
@@ -101,6 +147,10 @@ jobs:
           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: |
@@ -110,6 +160,11 @@ jobs:
       - name: update cabal index
         run: |
           $CABAL v2-update -v
+      - name: cache (tools)
+        uses: actions/cache@v2
+        with:
+          key: ${{ runner.os }}-${{ matrix.compiler }}-tools-c0dbbd39
+          path: ~/.haskell-ci-tools
       - name: install cabal-plan
         run: |
           mkdir -p $HOME/.cabal/bin
@@ -119,6 +174,12 @@ jobs:
           rm -f cabal-plan.xz
           chmod a+x $HOME/.cabal/bin/cabal-plan
           cabal-plan --version
+      - name: install hlint
+        run: |
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then HLINTVER=$(cd /tmp && (${CABAL} v2-install -v $ARG_COMPILER --dry-run hlint  --constraint='hlint >=3.4 && <3.5' |  perl -ne 'if (/\bhlint-(\d+(\.\d+)*)\b/) { print "$1"; last; }')); echo "HLint version $HLINTVER" ; fi
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then if [ ! -e $HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint ]; then echo "Downloading HLint version $HLINTVER"; mkdir -p $HOME/.haskell-ci-tools; curl --write-out 'Status Code: %{http_code} Redirects: %{num_redirects} Total time: %{time_total} Total Dsize: %{size_download}\n' --silent --location --output $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz "https://github.com/ndmitchell/hlint/releases/download/v$HLINTVER/hlint-$HLINTVER-x86_64-linux.tar.gz"; tar -xzv -f $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz -C $HOME/.haskell-ci-tools; fi ; fi
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then mkdir -p $CABAL_DIR/bin && ln -sf "$HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint" $CABAL_DIR/bin/hlint ; fi
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then hlint --version ; fi
       - name: checkout
         uses: actions/checkout@v2
         with:
@@ -139,7 +200,8 @@ jobs:
       - name: generate cabal.project
         run: |
           PKGDIR_xmonad="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/xmonad-[0-9.]*')"
-          echo "PKGDIR_xmonad=${PKGDIR_xmonad}" >> $GITHUB_ENV
+          echo "PKGDIR_xmonad=${PKGDIR_xmonad}" >> "$GITHUB_ENV"
+          rm -f cabal.project cabal.project.local
           touch cabal.project
           touch cabal.project.local
           echo "packages: ${PKGDIR_xmonad}" >> cabal.project
@@ -177,6 +239,10 @@ jobs:
       - name: tests
         run: |
           $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
+      - name: hlint
+        run: |
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then (cd ${PKGDIR_xmonad} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 src) ; fi
+          if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then (cd ${PKGDIR_xmonad} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 .) ; fi
       - name: cabal check
         run: |
           cd ${PKGDIR_xmonad} || false
@@ -199,50 +265,64 @@ jobs:
         with:
           path: ${{ github.workspace }}/haddock/*-docs.tar.gz
       - name: hackage upload (candidate)
-        if: matrix.upload && github.event_name == 'release'
+        if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''
+        shell: bash
         run: |
           set -ex
           PACKAGE_VERSION="${PACKAGE_VERSION#v}"
-          curl \
-            --silent --show-error --fail \
-            --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/
-          curl \
-            --silent --show-error --fail \
-            -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
-        env:
-          HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
-          PACKAGE_NAME: ${{ github.event.repository.name }}
-          PACKAGE_VERSION: ${{ github.event.release.tag_name }}
-      - name: hackage upload (release)
-        if: matrix.upload && github.event_name == 'workflow_dispatch'
-        run: |
-          set -ex
-          PACKAGE_VERSION="${PACKAGE_VERSION#v}"
-          curl \
-            --silent --show-error --fail \
-            --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/
-          curl \
-            --silent --show-error --fail \
-            -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=$(
+            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/packdeps.yml

@@ -38,3 +38,12 @@ jobs:
             --preferred \
             --exclude X11 \
             *.cabal
+
+  workflow-keepalive:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Re-enable workflow
+        env:
+          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+        run: |
+          gh api -X PUT repos/${{ github.repository }}/actions/workflows/packdeps.yml/enable

.github/workflows/stack.yml

@@ -18,10 +18,10 @@ jobs:
             ghc: 8.6.5
           - resolver: lts-16
             ghc: 8.8.4
-          - resolver: lts-17
-            ghc: 8.10.4
           - resolver: lts-18
             ghc: 8.10.7
+          - resolver: lts-19
+            ghc: 9.0.2
 
     steps:
       - name: Clone project
@@ -55,17 +55,17 @@ jobs:
       - 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
+        # 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: |
-          echo "::set-output name=date::$(date +%Y-%m)"
+          echo "::set-output name=date::1-$(date +%Y-%m)"
 
       - name: Cache Haskell package metadata
         uses: actions/cache@v2
         with:
           path: ~/.stack/pantry
           key: stack-pantry-${{ runner.os }}-${{ steps.cache-date.outputs.date }}
-          restore-keys: |
-            stack-pantry-${{ runner.os }}-
 
       - name: Cache Haskell dependencies
         uses: actions/cache@v2
@@ -78,7 +78,6 @@ jobs:
           restore-keys: |
             stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-${{ hashFiles('stack.yaml') }}-
             stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-
-            stack-${{ runner.os }}-${{ matrix.resolver }}-
 
       - name: Update hackage index
         # always update index to prevent the shared ~/.stack/pantry cache from being empty

.hlint.yaml

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

CHANGES.md

@@ -1,5 +1,25 @@
 # Change Log / Release Notes
 
+## 0.17.1 (September 3, 2021)
+
+### Enhancements
+
+  * Added custom cursor shapes for resizing and moving windows.
+
+  * Exported `cacheNumlockMask` and `mkGrabs` from `XMonad.Operations`.
+
+### Bug Fixes
+
+  * Fixed border color of windows with alpha channel. Now all windows have the
+    same opaque border color.
+
+  * Change the main loop to try to avoid [GHC bug 21708] on systems
+    running GHC 9.2 up to version 9.2.3. The issue has been fixed in
+    [GHC 9.2.4] and all later releases.
+
+[GHC bug 21708]: https://gitlab.haskell.org/ghc/ghc/-/issues/21708
+[GHC 9.2.4]: https://discourse.haskell.org/t/ghc-9-2-4-released/4851
+
 ## 0.17.0 (October 27, 2021)
 
 ### Enhancements
@@ -45,6 +65,9 @@
   * Added `withUnfocused` function to `XMonad.Operations`, allowing for `X`
     operations to be applied to unfocused windows.
 
+  * Added `willFloat` function to `XMonad.ManageHooks` to detect whether the
+    (about to be) managed window will be a floating window or not
+
 [these build scripts]: https://github.com/xmonad/xmonad-testing/tree/master/build-scripts
 
 ### Bug Fixes

CONTRIBUTING.md

@@ -70,8 +70,11 @@ Here are some tips for getting your changes merged into xmonad:
     and [xmonad][] have test-suites that you could run with
     `stack test` for example.
 
-  * Make sure you read the section on rebasing and squashing commits
-    below.
+  * When committing, try to follow existing practices.  For more
+    information on what good commit messages look like, see [How to
+    Write a Git Commit Message][commit-cbeams] and the [Kernel
+    documentation][commit-kernel] about committing logical changes
+    separately.
 
 ## Style Guidelines
 
@@ -83,7 +86,7 @@ as well!
     and provide a type signature; use Haddock syntax in the comments.
 
   * Follow the coding style of the module that you are making changes to
-    (`n` spaces for indentation, where to break long type signatures, …)
+    (`n` spaces for indentation, where to break long type signatures, …).
 
   * New code should not introduce any new warnings.  If you want to
     check this yourself before submitting a pull request, there is the
@@ -95,7 +98,7 @@ as well!
     enforced in our GitHub CI.
 
   * Partial functions are to be avoided: the window manager should not
-    crash, so do not call `error` or `undefined`
+    crash, so do not call `error` or `undefined`.
 
   * Any pure function added to the core should have QuickCheck
     properties precisely defining its behavior.
@@ -103,84 +106,15 @@ as well!
   * New modules should identify the author, and be submitted under the
     same license as xmonad (BSD3 license).
 
-## Rebasing and Squashing Commits
+## Keep rocking!
 
-Under no circumstances should you ever merge the master branch into
-your feature branch.  This makes it nearly impossible to review your
-changes and we *will not accept your PR* if you do this.
-
-Instead of merging you should rebase your changes on top of the master
-branch.  If a core team member asks you to "rebase your changes" this
-is what they are talking about.
-
-It's also helpful to squash all of your commits so that your pull
-request only contains a single commit.  Again, this makes it easier to
-review your changes and identify the changes later on in the Git
-history.
-
-### How to Rebase Your Changes
-
-The goal of rebasing is to bring recent changes from the master branch
-into your feature branch.  This often helps resolve conflicts where
-you have changed a file that also changed in a recently merged pull
-request (i.e. the `CHANGES.md` file).  Here is how you do that.
-
-  1. Make sure that you have a `git remote` configured for the main
-     repository.  I like to call this remote `upstream`:
-     ```shell
-     $ git remote add upstream https://github.com/xmonad/xmonad-contrib.git
-     ```
-
-  2. Pull from upstream and rewrite your changes on top of master.  For
-     this to work you should not have any modified files in your
-     working directory.  Run these commands from within your feature
-     branch (the branch you are asking to be merged):
-
-     ```shell
-     $ git fetch --all
-     $ git pull --rebase upstream master
-     ```
-
-  3. If the rebase was successful you can now push your feature branch
-     back to GitHub.  You need to force the push since your commits
-     have been rewritten and have new IDs:
-
-     ```shell
-     $ git push --force-with-lease
-     ```
-
-  4. Your pull request should now be conflict-free and only contain the
-     changes that you actually made.
-
-### How to Squash Commits
-
-The goal of squashing commits is to produce a clean Git history where
-each pull request contains just one commit.
-
-  1. Use `git log` to see how many commits you are including in your
-     pull request.  (If you've already submitted your pull request you
-     can see this in the GitHub interface.)
-
-  2. Rebase all of those commits into a single commit.  Assuming you
-     want to squash the last four (4) commits into a single commit:
-     ```shell
-     $ git rebase -i HEAD~4
-     ```
-
-  3. Git will open your editor and display the commits you are
-     rebasing with the word "pick" in front of them.
-
-  4. Leave the first listed commit as "pick" and change the remaining
-     commits from "pick" to "squash".
-
-  5. Save the file and exit your editor.  Git will create a new commit
-     and open your editor so you can modify the commit message.
-
-  6. If everything was successful you can push your changed history
-     back up to GitHub:
-     ```shell
-     $ git push --force-with-lease
-     ```
+xmonad is a passion project created and maintained by the community.
+We'd love for you to maintain your own contributed modules (approve
+changes from other contributors, review code, etc.).  However, before
+we'd be comfortable adding you to the [xmonad GitHub
+organization][xmonad-gh-org] we need to trust that you have sufficient
+knowledge of Haskell and git; and have a way of chatting with you ([IRC,
+Matrix, etc.][community]).
 
 [hlint]: https://github.com/ndmitchell/hlint
 [xmonad]: https://github.com/xmonad/xmonad
@@ -191,3 +125,7 @@ each pull request contains just one commit.
 [xmonad-doc-developing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
 [`#xmonad` IRC channel]: https://web.libera.chat/#xmonad
 [matrix channel]: https://matrix.to/#/#xmonad:matrix.org
+[commit-cbeams]: https://cbea.ms/git-commit/
+[commit-kernel]: https://www.kernel.org/doc/html/v4.10/process/submitting-patches.html#separate-your-changes
+[community]: https://xmonad.org/community.html
+[xmonad-gh-org]: https://github.com/xmonad

INSTALL.md

@@ -47,10 +47,21 @@ $ sudo dnf install \
 ``` console
 $ sudo pacman -S \
 > git \
+> xorg-server xorg-apps xorg-xinit xorg-xmessage \
 > libx11 libxft libxinerama libxrandr libxss \
 > pkgconf
 ```
 
+#### Void
+
+``` console
+$ sudo xbps-install \
+> git \
+> ncurses-libtinfo-libs ncurses-libtinfo-devel \
+> libX11-devel libXft-devel libXinerama-devel libXrandr-devel libXScrnSaver-devel \
+> pkg-config
+```
+
 ## Preparation
 
 We'll use the [XDG] directory specifications here, meaning our
@@ -90,8 +101,8 @@ This will give you the latest `HEAD`; if you want you can also check
 out a tagged release, e.g.:
 
 ``` console
-$ git clone --branch v0.15 https://github.com/xmonad/xmonad
-$ git clone --branch v0.16 https://github.com/xmonad/xmonad-contrib
+$ git clone --branch v0.17.1 https://github.com/xmonad/xmonad
+$ git clone --branch v0.17.1 https://github.com/xmonad/xmonad-contrib
 ```
 
 (Sources and binaries don't usually go into `~/.config`.  In our case,
@@ -199,7 +210,9 @@ Installing things is as easy as typing `stack install`.  This will
 install the correct version of GHC, as well as build all of the required
 packages (`stack build`) and then copy the relevant executables
 (`xmonad`, in our case) to `~/.local/bin`.  Make sure to add that
-directory to your `$PATH`!
+directory to your `$PATH`!  The command `which xmonad` should now return
+that executable.  In case it does not, check if you still have xmonad
+installed via your package manager and uninstall it.
 
 If you're getting build failures while building the `X11` package it may
 be that you don't have the required C libraries installed.  See
@@ -343,6 +356,15 @@ exec stack ghc --  \
 
 Don't forget to mark the file as `+x`: `chmod +x build`!
 
+Some example build scripts for `stack` and `cabal` are provided in the
+`xmonad-contrib` distribution. You can see those online in the
+[scripts/build][] directory. You might wish to use these if you have
+special dependencies for your `xmonad.hs`, especially with cabal as
+you must use a cabal file and often a `cabal.project` to specify them;
+`cabal install --lib` above generally isn't enough, and when it is
+it can be difficult to keep track of when you want to replicate your
+configuration on another system.
+
 #### Don't Recompile on Every Startup
 
 By default, xmonad always recompiles itself when a build script is used
@@ -374,3 +396,4 @@ executable will also be within that directory and not in
 [ghcup]: https://www.haskell.org/ghcup/
 [what xmonad would do]: https://github.com/xmonad/xmonad/blob/master/src/XMonad/Core.hs#L659-L667
 [Hackage]: https://hackage.haskell.org/
+[scripts/build]: https://github.com/xmonad/xmonad-contrib/blob/master/scripts/build

MAINTAINERS.md

@@ -2,7 +2,7 @@
 
 ## The XMonad Core Team
 
-  * Brandon S Allbery [GitHub][geekosaur], IRC: `geekosaur`
+  * Brandon S Allbery [GitHub][geekosaur], IRC: `geekosaur`, [GPG][gpg:geekosaur]
 
   * Brent Yorgey [GitHub][byorgey], IRC: `byorgey`
 
@@ -10,10 +10,10 @@
 
   * Sibi Prabakaran [GitHub][psibi], [Twitter][twitter:psibi], IRC: `sibi`
 
-  * slotThe [GitHub][slotThe], IRC: `Solid`
-
   * Tomáš Janoušek [GitHub][liskin], [Twitter][twitter:liskin], IRC: `liskin`, [GPG][gpg:liskin]
 
+  * Tony Zorman [GitHub][slotThe], IRC: `Solid`, [GPG][gpg:slotThe]
+
 [geekosaur]: https://github.com/geekosaur
 [byorgey]: https://github.com/byorgey
 [dmwit]: https://github.com/dmwit
@@ -21,7 +21,9 @@
 [liskin]: https://github.com/liskin
 [slotThe]: https://github.com/slotThe
 
+[gpg:geekosaur]: https://github.com/geekosaur.gpg
 [gpg:liskin]: https://github.com/liskin.gpg
+[gpg:slotThe]: https://github.com/slotThe.gpg
 
 [twitter:dmwit]: https://twitter.com/dmwit13
 [twitter:psibi]: https://twitter.com/psibi
@@ -71,38 +73,40 @@ When the time comes to release another version of xmonad and xmonad-contrib:
   2. Review documentation files and make sure they are accurate:
 
      - [`README.md`](README.md)
-     - [`CHANGES.md`](CHANGES.md)
+     - [`CHANGES.md`](CHANGES.md) (bump version, set date)
      - [`INSTALL.md`](INSTALL.md)
      - [`man/xmonad.1.markdown.in`](man/xmonad.1.markdown.in)
      - [haddocks](https://xmonad.github.io/xmonad-docs/)
 
      If the manpage changes, wait for the CI to rebuild the rendered outputs.
 
-  3. Make sure that `tested-with:` covers several recent releases of GHC, that
+  3. Update the website:
+
+     - Draft a [new release announcement][web-announce].
+     - Check install instructions, guided tour, keybindings cheat sheet, …
+
+  4. Make sure that `tested-with:` covers several recent releases of GHC, that
      `.github/workflows/haskell-ci.yml` had been updated to test all these GHC
      versions and that `.github/workflows/stack.yml` tests with several recent
      revisions of [Stackage][] LTS.
 
-  4. Create a release on GitHub:
-
-     - https://github.com/xmonad/xmonad/releases/new
-     - https://github.com/xmonad/xmonad-contrib/releases/new
-
-     CI will upload a release candidate to Hackage. Check again that
-     everything looks good. To publish a final release, run the CI workflow
-     once again with the correct version number:
+  5. Trigger the Haskell-CI workflow and fill in the candidate version number.
+     This will upload a release candidate to Hackage.
 
      - https://github.com/xmonad/xmonad/actions/workflows/haskell-ci.yml
      - https://github.com/xmonad/xmonad-contrib/actions/workflows/haskell-ci.yml
 
-     See [haskell-ci-hackage.patch][] for details about the release infrastructure.
+     Check that everything looks good. If not, push fixes and do another
+     candidate. When everything's ready, create a release on GitHub:
 
-  5. Update the website:
+     - https://github.com/xmonad/xmonad/releases/new
+     - https://github.com/xmonad/xmonad-contrib/releases/new
 
-     - Post a [new release announcement][web-announce]
-     - Check install instructions, guided tour, keybindings cheat sheet, …
+     CI will automatically upload the final release to Hackage.
 
-  7. Post announcement to:
+     See [haskell-ci-hackage.patch][] for details about the Hackage automation.
+
+  6. Post announcement to:
 
      - [xmonad.org website](https://github.com/xmonad/xmonad-web/tree/gh-pages/news/_posts)
      - [XMonad mailing list](https://mail.haskell.org/mailman/listinfo/xmonad)
@@ -111,13 +115,17 @@ When the time comes to release another version of xmonad and xmonad-contrib:
      - [Twitter](https://twitter.com/xmonad)
      - [Reddit](https://www.reddit.com/r/xmonad/)
 
-     See [old announcements][old-announce] for inspiration.
+     See [old announcements][old-announce] ([even older][older-announce]) for inspiration.
+
+  7. Bump version for development (add `.9`) and prepare fresh sections in
+     [`CHANGES.md`](CHANGES.md).
 
 [packdeps]: https://hackage.haskell.org/package/packdeps
 [Stackage]: https://www.stackage.org/
 [haskell-ci-hackage.patch]: .github/workflows/haskell-ci-hackage.patch
 [web-announce]: https://github.com/xmonad/xmonad-web/tree/gh-pages/news/_posts
-[old-announce]: https://github.com/xmonad/xmonad-web/tree/55614349421ebafaef4a47424fcb16efa80ff768
+[old-announce]: https://github.com/xmonad/xmonad-web/blob/gh-pages/news/_posts/2021-10-27-xmonad-0-17-0.md
+[older-announce]: https://github.com/xmonad/xmonad-web/tree/55614349421ebafaef4a47424fcb16efa80ff768
 
 ## Website and Other Accounts
 

README.md

@@ -1,35 +1,20 @@
 <p align="center">
-  <a href="https://xmonad.org/">
-    <img alt="XMonad logo" src="https://xmonad.org/images/logo-wrapped.svg" height=150>
-  </a>
+  <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">
-    <img alt="Hackage" src="https://img.shields.io/hackage/v/xmonad?logo=haskell">
-  </a>
-  <a href="https://github.com/xmonad/xmonad/blob/readme/LICENSE">
-    <img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad">
-  </a>
-  <a href="https://haskell.org/">
-    <img alt="Made in Haskell" src="https://img.shields.io/badge/Made%20in-Haskell-%235e5086?logo=haskell">
-  </a>
+  <a href="https://hackage.haskell.org/package/xmonad"><img alt="Hackage" src="https://img.shields.io/hackage/v/xmonad?logo=haskell"></a>
+  <a href="https://github.com/xmonad/xmonad/blob/readme/LICENSE"><img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad"></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/actions/workflows/stack.yml">
-    <img alt="Stack" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Stack?label=Stack&logo=githubactions&logoColor=white">
-  </a>
-  <a href="https://github.com/xmonad/xmonad/actions/workflows/haskell-ci.yml">
-    <img alt="Cabal" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Haskell-CI?label=Cabal&logo=githubactions&logoColor=white">
-  </a>
-  <a href="https://github.com/xmonad/xmonad/actions/workflows/nix.yml">
-    <img alt="Nix" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Nix?label=Nix&logo=githubactions&logoColor=white">
-  </a>
+  <a href="https://github.com/xmonad/xmonad/actions/workflows/stack.yml"><img alt="Stack" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Stack?label=Stack&logo=githubactions&logoColor=white"></a>
+  <a href="https://github.com/xmonad/xmonad/actions/workflows/haskell-ci.yml"><img alt="Cabal" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Haskell-CI?label=Cabal&logo=githubactions&logoColor=white"></a>
+  <a href="https://github.com/xmonad/xmonad/actions/workflows/nix.yml"><img alt="Nix" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Nix?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>
+  <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>
 
 # xmonad

TUTORIAL.md

@@ -54,7 +54,7 @@ in our case `M` will not necessarily mean Alt (also called `Meta`), but
 to Super instead (I will show you how to do this below).
 
 This guide should work for any GNU/Linux distribution and even for BSD
-folks.  Because debian-based distributions are still rather popular, we
+folks.  Because Debian-based distributions are still rather popular, we
 will give you the `apt` commands when it comes to installing software.
 If you use another distribution, just substitute the appropriate
 commands for your system.
@@ -187,8 +187,8 @@ example, but that will change soon enough so it's worth introducing it
 here as well.
 
 What if we wanted to add other keybindings?  Say you also want to bind
-`M-S-z` to lock your screen with the screensaver, `M-S-=` to take a
-snapshot of one window, and `M-]` to spawn Firefox.  This can be
+`M-S-z` to lock your screen with the screensaver, `M-C-s` to take a
+snapshot of one window, and `M-f` to spawn Firefox.  This can be
 achieved with the `additionalKeysP` function from the
 [XMonad.Util.EZConfig] module—luckily we already have it imported!  Our
 config file, starting with `main`, now looks like:
@@ -200,8 +200,8 @@ main = xmonad $ def
     }
   `additionalKeysP`
     [ ("M-S-z", spawn "xscreensaver-command -lock")
-    , ("M-S-=", unGrab *> spawn "scrot -s"        )
-    , ("M-]"  , spawn "firefox"                   )
+    , ("M-C-s", unGrab *> spawn "scrot -s"        )
+    , ("M-f"  , spawn "firefox"                   )
     ]
 ```
 
@@ -247,7 +247,7 @@ import XMonad.Layout.ThreeColumns
 to the top of our configuration file.  Most modules have a lot of
 accompanying text and usage examples in them—so while the type
 signatures may seem scary, don't be afraid to look up the
-[xmonad-contrib documentation] on hackage!
+[xmonad-contrib documentation] on Hackage!
 
 Next we just need to tell xmonad that we want to use that particular
 layout.  To do this, there is the `layoutHook`.  Let's use the default
@@ -313,8 +313,8 @@ main = xmonad $ def
     }
   `additionalKeysP`
     [ ("M-S-z", spawn "xscreensaver-command -lock")
-    , ("M-S-=", unGrab *> spawn "scrot -s"        )
-    , ("M-]"  , spawn "firefox"                   )
+    , ("M-C-s", unGrab *> spawn "scrot -s"        )
+    , ("M-f"  , spawn "firefox"                   )
     ]
 ```
 
@@ -396,8 +396,8 @@ main = xmonad $ ewmhFullscreen $ ewmh $ def
     }
   `additionalKeysP`
     [ ("M-S-z", spawn "xscreensaver-command -lock")
-    , ("M-S-=", unGrab *> spawn "scrot -s"        )
-    , ("M-]"  , spawn "firefox"                   )
+    , ("M-C-s", unGrab *> spawn "scrot -s"        )
+    , ("M-f"  , spawn "firefox"                   )
     ]
 ```
 
@@ -420,8 +420,8 @@ myConfig = def
     }
   `additionalKeysP`
     [ ("M-S-z", spawn "xscreensaver-command -lock")
-    , ("M-S-=", unGrab *> spawn "scrot -s"        )
-    , ("M-]"  , spawn "firefox"                   )
+    , ("M-C-s", unGrab *> spawn "scrot -s"        )
+    , ("M-f"  , spawn "firefox"                   )
     ]
 ```
 
@@ -592,14 +592,14 @@ Config { overrideRedirect = False
 ```
 
 First, we set the font to use for the bar, as well as the colors.  The
-position options are documented well on the [xmobar home page] or,
-alternatively, in the [quick-start.org] on GitHub.  The particular
-option of `TopW L 90` says to put the bar in the upper left of the
-screen, and make it consume 90% of the width of the screen (we need to
-leave a little bit of space for `trayer-srg`).  If you're up for it—and
-this really requires more shell-scripting than Haskell knowledge—you can
-also try to seamlessly embed trayer into xmobar by using
-[trayer-padding-icon.sh] and following the advice given in that thread.
+position options are documented well in xmobar's [quick-start.org].  The
+particular option of `TopW L 90` says to put the bar in the upper left
+of the screen, and make it consume 90% of the width of the screen (we
+need to leave a little bit of space for `trayer-srg`).  If you're up for
+it—and this really requires more shell-scripting than Haskell
+knowledge—you can also try to seamlessly embed trayer into xmobar by
+using [trayer-padding-icon.sh] and following the advice given in that
+thread.
 
 In the commands list you, well, define commands.  Commands are the
 pieces that generate the content to be displayed in your bar.  These
@@ -965,9 +965,9 @@ class name to float by defining the following manageHook:
 myManageHook = (className =? "Gimp" --> doFloat)
 ```
 
-Say we also want to float all dialogs.  This is easy with the `isDialog`
-function from [XMonad.Hooks.ManageHelpers] (which you should import) and
-a little modification to the `myManageHook` function:
+Say we also want to float all dialog windows.  This is easy with the
+`isDialog` function from [XMonad.Hooks.ManageHelpers] (which you should
+import) and a little modification to the `myManageHook` function:
 
 ``` haskell
 myManageHook :: ManageHook
@@ -989,8 +989,8 @@ myConfig = def
     }
   `additionalKeysP`
     [ ("M-S-z", spawn "xscreensaver-command -lock")
-    , ("M-S-=", unGrab *> spawn "scrot -s"        )
-    , ("M-]"  , spawn "firefox"                   )
+    , ("M-C-s", unGrab *> spawn "scrot -s"        )
+    , ("M-f"  , spawn "firefox"                   )
     ]
 ```
 
@@ -1032,8 +1032,8 @@ myConfig = def
     }
   `additionalKeysP`
     [ ("M-S-z", spawn "xscreensaver-command -lock")
-    , ("M-S-=", unGrab *> spawn "scrot -s"        )
-    , ("M-]"  , spawn "firefox"                   )
+    , ("M-C-s", unGrab *> spawn "scrot -s"        )
+    , ("M-f"  , spawn "firefox"                   )
     ]
 
 myManageHook :: ManageHook
@@ -1113,7 +1113,7 @@ Config { overrideRedirect = False
        }
 ```
 
-For an explanation of the battery commands used above, see xmobars
+For an explanation of the battery commands used above, see xmobar's
 [battery] documentation.
 
 You can also specify workspaces in the same way and feed them to xmobar
@@ -1121,13 +1121,15 @@ via the property (e.g. have `"<fn=1>\xf120</fn>"` as one of your
 workspace names).
 
 As an example how this would look like in a real configuration, you can
-look at [Liskin's], [slotThe's], or [TheMC47's] xmobar configuration.
-Do note that the last two are Haskell-based and thus may be a little
-hard to understand for newcomers.
+look at [Liskin's old][liskin-xmobarrc-old], [Liskin's current][liskin-xmobarrc],
+[slotThe's][slotThe-xmobarrc], or [TheMC47's][TheMC47-xmobarrc] xmobar
+configuration. Do note that the last three are Haskell-based and thus may
+be a little hard to understand for newcomers.
 
-[Liskin's]: https://github.com/liskin/dotfiles/blob/home/.xmobarrc
-[TheMC47's]: https://github.com/TheMC47/dotfiles/tree/master/xmobar/xmobarrc
-[slotThe's]: https://gitlab.com/slotThe/dotfiles/-/blob/master/xmobar/.config/xmobarrc/src/xmobarrc.hs
+[liskin-xmobarrc-old]: https://github.com/liskin/dotfiles/blob/75dfc057c33480ee9d3300d4d02fb79a986ef3a5/.xmobarrc
+[liskin-xmobarrc]: https://github.com/liskin/dotfiles/blob/home/.xmonad/xmobar.hs
+[TheMC47-xmobarrc]: https://github.com/TheMC47/dotfiles/tree/master/xmobar/xmobarrc
+[slotThe-xmobarrc]: https://gitlab.com/slotThe/dotfiles/-/blob/master/xmobar/.config/xmobarrc/src/xmobarrc.hs
 
 ### Renaming Layouts
 
@@ -1222,7 +1224,7 @@ either :)
 [log]: https://ircbrowse.tomsmeding.com/browse/lcxmonad
 [EWMH]: https://specifications.freedesktop.org/wm-spec/wm-spec-1.3.html
 [ICCCM]: https://tronche.com/gui/x/icccm/
-[webchat]: https://kiwiirc.com/nextclient/irc.libera.chat/?#xmonad
+[webchat]: https://web.libera.chat/#xmonad
 [about xmonad]: https://xmonad.org/about.html
 [shell variable]: https://www.shellscript.sh/variables1.html
 [xmonad-testing]: https://github.com/xmonad/xmonad-testing
@@ -1230,7 +1232,7 @@ either :)
 [xmonad guided tour]: https://xmonad.org/tour.html
 [xmonad mailing list]: https://mail.haskell.org/mailman/listinfo/xmonad
 [xmonad's GitHub page]: https://github.com/xmonad/xmonad
-[trayer-padding-icon.sh]: https://github.com/jaor/xmobar/issues/239#issuecomment-233206552
+[trayer-padding-icon.sh]: https://codeberg.org/xmobar/xmobar/issues/239#issuecomment-537931
 [xmonad-contrib documentation]: https://hackage.haskell.org/package/xmonad-contrib
 [GNU Image Manipulation Program]: https://www.gimp.org/
 [Basic Desktop Environment Integration]: https://wiki.haskell.org/Xmonad/Basic_Desktop_Environment_Integration
@@ -1251,14 +1253,13 @@ either :)
 [XMonad.Util.ClickableWorkspaces]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-ClickableWorkspaces.html
 
 [xmobar]: https://xmobar.org/
-[battery]: https://github.com/jaor/xmobar/blob/master/doc/plugins.org#batteryp-dirs-args-refreshrate
-[xmobar.hs]: https://github.com/jaor/xmobar/blob/master/examples/xmobar.hs
+[battery]: https://codeberg.org/xmobar/xmobar/src/branch/master/doc/plugins.org#batteryp-dirs-args-refreshrate
+[xmobar.hs]: https://codeberg.org/xmobar/xmobar/src/branch/master/etc/xmobar.hs
 [Wikipedia page]: https://en.wikipedia.org/wiki/ICAO_airport_code#Prefixes
-[quick-start.org]: https://github.com/jaor/xmobar/blob/master/doc/quick-start.org#configuration-options
+[quick-start.org]: https://codeberg.org/xmobar/xmobar/src/branch/master/doc/quick-start.org#configuration-options
 [jao's xmobar.hs]: https://codeberg.org/jao/xmobar-config
-[weather monitor]: https://github.com/jaor/xmobar/blob/master/doc/plugins.org#weather-monitors
-[xmobar home page]: https://xmobar.org/
-[xmobar's `Installation` section]: https://github.com/jaor/xmobar#installation
+[weather monitor]: https://codeberg.org/xmobar/xmobar/src/branch/master/doc/plugins.org#weather-monitors
+[xmobar's `Installation` section]: https://codeberg.org/xmobar/xmobar#installation
 
 [Haskell]: https://www.haskell.org/
 [trayer-srg]: https://github.com/sargon/trayer-srg

cabal.haskell-ci

@@ -5,6 +5,11 @@ apt:
   libxrandr-dev
   libxss-dev
 
+hlint: True
+hlint-job: 9.0.2
+hlint-yaml: .hlint.yaml
+hlint-version: ==3.4.*
+
 github-patches:
   .github/workflows/haskell-ci-hackage.patch
 

flake.nix

@@ -1,20 +1,67 @@
-# This file is maintained by @IvanMalison (github)
+# This file is maintained by @IvanMalison and @LSLeary (github)
+# See xmonad-contrib/NIX.md for an overview of module usage.
 {
   inputs = {
     flake-utils.url = github:numtide/flake-utils;
-    git-ignore-nix.url = github:IvanMalison/gitignore.nix/master;
+    git-ignore-nix.url = github:hercules-ci/gitignore.nix/master;
+    unstable.url = github:NixOS/nixpkgs/nixos-unstable;
   };
-  outputs = { self, flake-utils, nixpkgs, git-ignore-nix }:
+  outputs = { self, flake-utils, nixpkgs, unstable, git-ignore-nix }:
   let
-    overlay = final: prev: {
-      haskellPackages = prev.haskellPackages.override (old: {
-        overrides = prev.lib.composeExtensions (old.overrides or (_: _: {}))
-        (hself: hsuper: {
-          xmonad = hself.callCabal2nix "xmonad" (git-ignore-nix.gitIgnoreSource ./.) { };
-        });
-      });
-    };
+    hpath = { prefix ? null, compiler ? null }:
+      (if prefix == null then [] else [ prefix ]) ++
+      (if compiler == null
+       then [ "haskellPackages" ]
+       else [ "haskell" "packages" compiler ]
+      );
+    fromHOL = hol: comp: final: prev: with prev.lib; with attrsets;
+      setAttrByPath (hpath comp)
+        ((getAttrFromPath (hpath comp) prev).override (old: {
+          overrides = composeExtensions (old.overrides or (_: _: {}))
+            (hol final prev);
+        }));
+    hoverlay = final: prev: hself: hsuper:
+      with prev.haskell.lib.compose; {
+        xmonad = hself.callCabal2nix "xmonad"
+          (git-ignore-nix.lib.gitignoreSource ./.) { };
+      };
+    overlay = fromHOL hoverlay { };
     overlays = [ overlay ];
+    nixosModule = { config, pkgs, lib, ... }: with lib; with attrsets;
+      let
+        cfg = config.services.xserver.windowManager.xmonad.flake;
+        comp = { inherit (cfg) prefix compiler; };
+      in {
+        options = {
+          services.xserver.windowManager.xmonad.flake = with types; {
+            enable = mkEnableOption "flake";
+            prefix = mkOption {
+              default = null;
+              type = nullOr string;
+              example = literalExpression "\"unstable\"";
+              description = ''
+                Specify a nested alternative <literal>pkgs</literal> by attrName.
+              '';
+            };
+            compiler = mkOption {
+              default = null;
+              type = nullOr string;
+              example = literalExpression "\"ghc922\"";
+              description = ''
+                Which compiler to build xmonad with.
+                Must be an attribute of <literal>pkgs.haskell.packages</literal>.
+                Sets <option>xmonad.haskellPackages</option> to match.
+              '';
+            };
+          };
+        };
+        config = mkIf cfg.enable {
+          nixpkgs.overlays = [ (fromHOL hoverlay comp) ];
+          services.xserver.windowManager.xmonad.haskellPackages =
+            getAttrFromPath (hpath comp) pkgs;
+        };
+      };
+    nixosModules = [ nixosModule ];
   in flake-utils.lib.eachDefaultSystem (system:
   let pkgs = import nixpkgs { inherit system overlays; };
   in
@@ -23,5 +70,8 @@
       packages = p: [ p.xmonad ];
     };
     defaultPackage = pkgs.haskellPackages.xmonad;
-  }) // { inherit overlay overlays; } ;
+  }) // {
+    inherit hoverlay overlay overlays nixosModule nixosModules;
+    lib = { inherit hpath fromHOL; };
+  };
 }

man/xmonad.hs

@@ -123,7 +123,7 @@ myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $
     -- , ((modm              , xK_b     ), sendMessage ToggleStruts)
 
     -- Quit xmonad
-    , ((modm .|. shiftMask, xK_q     ), io (exitWith ExitSuccess))
+    , ((modm .|. shiftMask, xK_q     ), io exitSuccess)
 
     -- Restart xmonad
     , ((modm              , xK_q     ), spawn "xmonad --recompile; xmonad --restart")
@@ -154,18 +154,18 @@ myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $
 ------------------------------------------------------------------------
 -- Mouse bindings: default actions bound to mouse events
 --
-myMouseBindings (XConfig {XMonad.modMask = modm}) = M.fromList $
+myMouseBindings (XConfig {XMonad.modMask = modm}) = M.fromList
 
     -- mod-button1, Set the window to floating mode and move by dragging
-    [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w
-                                       >> windows W.shiftMaster))
+    [ ((modm, button1), \w -> focus w >> mouseMoveWindow w
+                                      >> windows W.shiftMaster)
 
     -- mod-button2, Raise the window to the top of the stack
-    , ((modm, button2), (\w -> focus w >> windows W.shiftMaster))
+    , ((modm, button2), \w -> focus w >> windows W.shiftMaster)
 
     -- mod-button3, Set the window to floating mode and resize by dragging
-    , ((modm, button3), (\w -> focus w >> mouseResizeWindow w
-                                       >> windows W.shiftMaster))
+    , ((modm, button3), \w -> focus w >> mouseResizeWindow w
+                                      >> windows W.shiftMaster)
 
     -- you may also bind events to the mouse scroll wheel (button4 and button5)
     ]

src/XMonad/Config.hs

@@ -218,7 +218,7 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
     , ((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 xmonad
+    , ((modMask .|. shiftMask, xK_q     ), io exitSuccess) -- %! Quit xmonad
     , ((modMask              , xK_q     ), spawn "if type xmonad; then xmonad --recompile && xmonad --restart; else xmessage xmonad not in \\$PATH: \"$PATH\"; fi") -- %! Restart xmonad
 
     , ((modMask .|. shiftMask, xK_slash ), helpCommand) -- %! Run xmessage with a summary of the default keybindings (useful for beginners)

src/XMonad/Core.hs

@@ -1,6 +1,11 @@
-{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,
-             MultiParamTypeClasses, TypeSynonymInstances, DeriveDataTypeable,
-             LambdaCase, NamedFieldPuns, DeriveTraversable #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -35,17 +40,18 @@ module XMonad.Core (
 import XMonad.StackSet hiding (modify)
 
 import Prelude
-import Control.Exception (fromException, try, bracket, bracket_, throw, finally, SomeException(..))
+import Control.Exception (fromException, try, bracket_, throw, finally, SomeException(..))
 import qualified Control.Exception as E
 import Control.Applicative ((<|>), empty)
 import Control.Monad.Fail
 import Control.Monad.State
 import Control.Monad.Reader
+import Control.Monad (void)
 import Data.Semigroup
 import Data.Traversable (for)
 import Data.Time.Clock (UTCTime)
 import Data.Default.Class
-import Data.List (isInfixOf)
+import System.Environment (lookupEnv)
 import System.FilePath
 import System.IO
 import System.Info
@@ -60,7 +66,7 @@ import System.Exit
 import Graphics.X11.Xlib
 import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event)
 import Data.Typeable
-import Data.List ((\\))
+import Data.List (isInfixOf, (\\))
 import Data.Maybe (isJust,fromMaybe)
 
 import qualified Data.Map as M
@@ -156,18 +162,13 @@ newtype ScreenDetail = SD { screenRect :: Rectangle }
 -- instantiated on 'XConf' and 'XState' automatically.
 --
 newtype X a = X (ReaderT XConf (StateT XState IO) a)
-    deriving (Functor, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf)
-
-instance Applicative X where
-  pure = return
-  (<*>) = ap
+    deriving (Functor, Applicative, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf)
 
 instance Semigroup a => Semigroup (X a) where
     (<>) = liftM2 (<>)
 
 instance (Monoid a) => Monoid (X a) where
-    mempty  = return mempty
-    mappend = liftM2 mappend
+    mempty = pure mempty
 
 instance Default a => Default (X a) where
     def = return def
@@ -177,14 +178,13 @@ newtype Query a = Query (ReaderT Window X a)
     deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO)
 
 runQuery :: Query a -> Window -> X a
-runQuery (Query m) w = runReaderT m w
+runQuery (Query m) = runReaderT m
 
 instance Semigroup a => Semigroup (Query a) where
     (<>) = liftM2 (<>)
 
 instance Monoid a => Monoid (Query a) where
-    mempty  = return mempty
-    mappend = liftM2 mappend
+    mempty = pure mempty
 
 instance Default a => Default (Query a) where
     def = return def
@@ -201,7 +201,7 @@ catchX job errcase = do
     st <- get
     c <- ask
     (a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of
-                        Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
+                        Just (_ :: ExitCode) -> throw e
                         _ -> do hPrint stderr e; runX c st errcase
     put s'
     return a
@@ -209,12 +209,12 @@ catchX job errcase = do
 -- | Execute the argument, catching all exceptions.  Either this function or
 -- 'catchX' should be used at all callsites of user customized code.
 userCode :: X a -> X (Maybe a)
-userCode a = catchX (Just `liftM` a) (return Nothing)
+userCode a = catchX (Just <$> a) (return Nothing)
 
 -- | Same as userCode but with a default argument to return instead of using
 -- Maybe, provided for convenience.
 userCodeDef :: a -> X a -> X a
-userCodeDef defValue a = fromMaybe defValue `liftM` userCode a
+userCodeDef defValue a = fromMaybe defValue <$> userCode a
 
 -- ---------------------------------------------------------------------
 -- Convenient wrappers to state
@@ -235,7 +235,7 @@ withWindowAttributes dpy win f = do
 
 -- | True if the given window is the root window
 isRoot :: Window -> X Bool
-isRoot w = (w==) <$> asks theRoot
+isRoot w = asks $ (w ==) . theRoot
 
 -- | Wrapper for the common case of atom internment
 getAtom :: String -> X Atom
@@ -437,7 +437,7 @@ catchIO f = io (f `E.catch` \(SomeException e) -> hPrint stderr e >> hFlush stde
 --
 -- Note this function assumes your locale uses utf8.
 spawn :: MonadIO m => String -> m ()
-spawn x = spawnPID x >> return ()
+spawn x = void $ spawnPID x
 
 -- | Like 'spawn', but returns the 'ProcessID' of the launched application
 spawnPID :: MonadIO m => String -> m ProcessID
@@ -458,7 +458,8 @@ xfork x = io . forkProcess . finally nullStdin $ do
 -- | Use @xmessage@ to show information to the user.
 xmessage :: MonadIO m => String -> m ()
 xmessage msg = void . xfork $ do
-    executeFile "xmessage" True
+    xmessageBin <- fromMaybe "xmessage" <$> liftIO (lookupEnv "XMONAD_XMESSAGE")
+    executeFile xmessageBin True
         [ "-default", "okay"
         , "-xrm", "*international:true"
         , "-xrm", "*fontSet:-*-fixed-medium-r-normal-*-18-*-*-*-*-*-*-*,-*-fixed-*-*-*-*-18-*-*-*-*-*-*-*,-*-*-*-*-*-*-18-*-*-*-*-*-*-*"
@@ -651,11 +652,12 @@ getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> r
 compile :: Directories -> Compile -> IO ExitCode
 compile dirs method =
     bracket_ uninstallSignalHandlers installSignalHandlers $
-        bracket (openFile (errFileName dirs) WriteMode) hClose $ \err -> do
+        withFile (errFileName dirs) WriteMode $ \err -> do
             let run = runProc (cfgDir dirs) err
             case method of
-                CompileGhc ->
-                    run "ghc" ghcArgs
+                CompileGhc -> do
+                    ghc <- fromMaybe "ghc" <$> lookupEnv "XMONAD_GHC"
+                    run ghc ghcArgs
                 CompileStackGhc stackYaml ->
                     run "stack" ["build", "--silent", "--stack-yaml", stackYaml] .&&.
                     run "stack" ("ghc" : "--stack-yaml" : stackYaml : "--" : ghcArgs)

src/XMonad/Layout.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable, LambdaCase, MultiWayIf #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
 
 -- --------------------------------------------------------------------------
 -- |
@@ -39,7 +41,7 @@ import Data.Maybe (fromMaybe)
 data Resize     = Shrink | Expand
 
 -- | Increase the number of clients in the master pane.
-data IncMasterN = IncMasterN !Int
+newtype IncMasterN = IncMasterN Int
 
 instance Message Resize
 instance Message IncMasterN
@@ -199,8 +201,8 @@ choose (Choose d l r) d' ml      mr = f lr
                     (CL, CR) -> (hide l'  , return r')
                     (CR, CL) -> (return l', hide r'  )
                     (_ , _ ) -> (return l', return r')
-    f (x,y)  = fmap Just $ liftM2 (Choose d') x y
-    hide x   = fmap (fromMaybe x) $ handle x Hide
+    f (x,y)  = Just <$> liftM2 (Choose d') x y
+    hide x   = fromMaybe x <$> handle x Hide
 
 instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
     runLayout (W.Workspace i (Choose CL l r) ms) =

src/XMonad/Main.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, NamedFieldPuns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Main
@@ -19,6 +21,7 @@ import System.Locale.SetLocale
 import qualified Control.Exception as E
 import Data.Bits
 import Data.List ((\\))
+import Data.Foldable (traverse_)
 import Data.Function
 import qualified Data.Map as M
 import qualified Data.Set as S
@@ -87,14 +90,14 @@ usage :: IO ()
 usage = do
     self <- getProgName
     putStr . unlines $
-        concat ["Usage: ", self, " [OPTION]"] :
-        "Options:" :
-        "  --help                       Print this message" :
-        "  --version                    Print the version number" :
-        "  --recompile                  Recompile your xmonad.hs" :
-        "  --replace                    Replace the running window manager with xmonad" :
-        "  --restart                    Request a running xmonad process to restart" :
-        []
+        [ "Usage: " <> self <> " [OPTION]"
+        , "Options:"
+        , "  --help                       Print this message"
+        , "  --version                    Print the version number"
+        , "  --recompile                  Recompile your xmonad.hs"
+        , "  --replace                    Replace the running window manager with xmonad"
+        , "  --restart                    Request a running xmonad process to restart"
+        ]
 
 -- | Build the xmonad configuration file with ghc, then execute it.
 -- If there are no errors, this function does not return.  An
@@ -193,12 +196,12 @@ launch initxmc drs = do
 
     xinesc <- getCleanedScreenInfo dpy
 
-    nbc    <- do v            <- initColor dpy $ normalBorderColor  xmc
-                 ~(Just nbc_) <- initColor dpy $ normalBorderColor Default.def
+    nbc    <- do v         <- initColor dpy $ normalBorderColor  xmc
+                 Just nbc_ <- initColor dpy $ normalBorderColor Default.def
                  return (fromMaybe nbc_ v)
 
     fbc    <- do v <- initColor dpy $ focusedBorderColor xmc
-                 ~(Just fbc_)  <- initColor dpy $ focusedBorderColor Default.def
+                 Just fbc_ <- initColor dpy $ focusedBorderColor Default.def
                  return (fromMaybe fbc_ v)
 
     hSetBuffering stdout NoBuffering
@@ -242,7 +245,7 @@ launch initxmc drs = do
             let extst = maybe M.empty extensibleState serializedSt
             modify (\s -> s {extensibleState = extst})
 
-            setNumlockMask
+            cacheNumlockMask
             grabKeys
             grabButtons
 
@@ -264,10 +267,11 @@ launch initxmc drs = do
             userCode $ startupHook initxmc
 
             rrData <- io $ xrrQueryExtension dpy
-            let rrUpdate = when (isJust rrData) . void . xrrUpdateConfiguration
 
             -- main loop, for all you HOF/recursion fans out there.
-            forever $ prehandle =<< io (nextEvent dpy e >> rrUpdate e >> getEvent e)
+            -- forever $ prehandle =<< io (nextEvent dpy e >> rrUpdate e >> getEvent e)
+            -- sadly, 9.2.{1,2,3} join points mishandle the above and trash the heap (see #389)
+            mainLoop dpy e rrData
 
     return ()
       where
@@ -278,6 +282,8 @@ launch initxmc drs = do
                       in local (\c -> c { mousePosition = mouse, currentEvent = Just e }) (handleWithHook e)
         evs = [ keyPress, keyRelease, enterNotify, leaveNotify
               , buttonPress, buttonRelease]
+        rrUpdate e r = when (isJust r) (void (xrrUpdateConfiguration e))
+        mainLoop d e r = io (nextEvent d e >> rrUpdate e r >> getEvent e) >>= prehandle >> mainLoop d e r
 
 
 -- | Runs handleEventHook from the configuration and runs the default handler
@@ -330,7 +336,7 @@ handle e@(DestroyWindowEvent {ev_window = w}) = do
 -- it is synthetic or we are not expecting an unmap notification from a window.
 handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
     e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
-    if (synthetic || e == 0)
+    if synthetic || e == 0
         then unmanage w
         else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) })
  where mpred 1 = Nothing
@@ -340,7 +346,7 @@ handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient
 handle e@(MappingNotifyEvent {}) = do
     io $ refreshKeyboardMapping e
     when (ev_request e `elem` [mappingKeyboard, mappingModifier]) $ do
-        setNumlockMask
+        cacheNumlockMask
         grabKeys
 
 -- handle button release, which may finish dragging.
@@ -428,7 +434,7 @@ handle event@(PropertyEvent { ev_event_type = t, ev_atom = a })
 
 handle e@ClientMessageEvent { ev_message_type = mt } = do
     a <- getAtom "XMONAD_RESTART"
-    if (mt == a)
+    if mt == a
         then restart "xmonad" True
         else broadcastMessage e
 
@@ -459,38 +465,14 @@ scan dpy rootw = do
         skip :: E.SomeException -> IO Bool
         skip _ = return False
 
-setNumlockMask :: X ()
-setNumlockMask = do
-    dpy <- asks display
-    ms <- io $ getModifierMapping dpy
-    xs <- sequence [ do
-                        ks <- io $ keycodeToKeysym dpy kc 0
-                        if ks == xK_Num_Lock
-                            then return (setBit 0 (fromIntegral m))
-                            else return (0 :: KeyMask)
-                        | (m, kcs) <- ms, kc <- kcs, kc /= 0]
-    modify (\s -> s { numberlockMask = foldr (.|.) 0 xs })
-
 -- | Grab the keys back
 grabKeys :: X ()
 grabKeys = do
     XConf { display = dpy, theRoot = rootw } <- ask
-    let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
-        (minCode, maxCode) = displayKeycodes dpy
-        allCodes = [fromIntegral minCode .. fromIntegral maxCode]
     io $ ungrabKey dpy anyKey anyModifier rootw
-    ks <- asks keyActions
-    -- build a map from keysyms to lists of keysyms (doing what
-    -- XGetKeyboardMapping would do if the X11 package bound it)
-    syms <- forM allCodes $ \code -> io (keycodeToKeysym dpy code 0)
-    let keysymMap' = M.fromListWith (++) (zip syms [[code] | code <- allCodes])
-    -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
-    -- want to grab those whenever someone accidentally uses def :: KeySym
-    let keysymMap = M.delete noSymbol keysymMap'
-    let keysymToKeycodes sym = M.findWithDefault [] sym keysymMap
-    forM_ (M.keys ks) $ \(mask,sym) ->
-         forM_ (keysymToKeycodes sym) $ \kc ->
-              mapM_ (grab kc . (mask .|.)) =<< extraModifiers
+    let grab :: (KeyMask, KeyCode) -> X ()
+        grab (km, kc) = io $ grabKey dpy kc km rootw True grabModeAsync grabModeAsync
+    traverse_ grab =<< mkGrabs =<< asks (M.keys . keyActions)
 
 -- | Grab the buttons
 grabButtons :: X ()
@@ -501,7 +483,7 @@ grabButtons = do
     io $ ungrabButton dpy anyButton anyModifier rootw
     ems <- extraModifiers
     ba <- asks buttonActions
-    mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)
+    mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys ba)
 
 -- | @replace@ to signals compliant window managers to exit.
 replace :: Display -> ScreenNumber -> Window -> IO ()

src/XMonad/ManageHook.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.ManageHook
@@ -8,7 +6,6 @@
 --
 -- Maintainer  :  spencerjanssen@gmail.com
 -- Stability   :  unstable
--- Portability :  not portable, uses cunning newtype deriving
 --
 -- An EDSL for ManageHooks
 --
@@ -27,7 +24,7 @@ import Control.Monad.Reader
 import Data.Maybe
 import Data.Monoid
 import qualified XMonad.StackSet as W
-import XMonad.Operations (floatLocation, reveal)
+import XMonad.Operations (floatLocation, reveal, isFixedSizeOrTransient)
 
 -- | Lift an 'X' action to a 'Query'.
 liftX :: X a -> Query a
@@ -61,11 +58,11 @@ infixr 3 <&&>, <||>
 
 -- | '&&' lifted to a 'Monad'.
 (<&&>) :: Monad m => m Bool -> m Bool -> m Bool
-(<&&>) x y = ifM x y (pure False)
+x <&&> y = ifM x y (pure False)
 
 -- | '||' lifted to a 'Monad'.
 (<||>) :: Monad m => m Bool -> m Bool -> m Bool
-(<||>) x y = ifM x (pure True) y
+x <||> y = ifM x (pure True) y
 
 -- | If-then-else lifted to a 'Monad'.
 ifM :: Monad m => m Bool -> m a -> m a -> m a
@@ -83,7 +80,8 @@ title = ask >>= \w -> liftX $ do
                           return $ if null l then "" else head l
     io $ bracket getProp (xFree . tp_value) extract `E.catch` \(SomeException _) -> return ""
 
--- | Return the application name.
+-- | Return the application name; i.e., the /first/ string returned by
+-- @WM_CLASS@.
 appName :: Query String
 appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClassHint d w)
 
@@ -91,14 +89,15 @@ appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClas
 resource :: Query String
 resource = appName
 
--- | Return the resource class.
+-- | Return the resource class; i.e., the /second/ string returned by
+-- @WM_CLASS@.
 className :: Query String
 className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getClassHint d w)
 
 -- | A query that can return an arbitrary X property of type 'String',
 --   identified by name.
 stringProperty :: String -> Query String
-stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe "") $ getStringProperty d w p)
+stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fromMaybe "" <$> getStringProperty d w p)
 
 getStringProperty :: Display -> Window -> String -> X (Maybe String)
 getStringProperty d w p = do
@@ -106,6 +105,10 @@ getStringProperty d w p = do
   md <- io $ getWindowProperty8 d a w
   return $ fmap (map (toEnum . fromIntegral)) md
 
+-- | Return whether the window will be a floating window or not
+willFloat :: Query Bool
+willFloat = ask >>= \w -> liftX $ withDisplay $ \d -> isFixedSizeOrTransient d w
+
 -- | Modify the 'WindowSet' with a pure function.
 doF :: (s -> s) -> Query (Endo s)
 doF = return . Endo

src/XMonad/Operations.hs

@@ -1,4 +1,10 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 -- --------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Operations
@@ -18,7 +24,7 @@ module XMonad.Operations (
     manage, unmanage, killWindow, kill, isClient,
     setInitialProperties, setWMState, setWindowBorderWithFallback,
     hide, reveal, tileWindow,
-    setTopFocus, focus,
+    setTopFocus, focus, isFixedSizeOrTransient,
 
     -- * Manage Windows
     windows, refresh, rescreen, modifyWindowSet, windowBracket, windowBracket_, clearEvents, getCleanedScreenInfo,
@@ -27,7 +33,7 @@ module XMonad.Operations (
     -- * Keyboard and Mouse
     cleanMask, extraModifiers,
     mouseDrag, mouseMoveWindow, mouseResizeWindow,
-    setButtonGrab, setFocusX,
+    setButtonGrab, setFocusX, cacheNumlockMask, mkGrabs,
 
     -- * Messages
     sendMessage, broadcastMessage, sendMessageWithNoRefresh,
@@ -57,7 +63,7 @@ import qualified XMonad.StackSet as W
 import Data.Maybe
 import Data.Monoid          (Endo(..),Any(..))
 import Data.List            (nub, (\\), find)
-import Data.Bits            ((.|.), (.&.), complement, testBit)
+import Data.Bits            ((.|.), (.&.), complement, setBit, testBit)
 import Data.Function        (on)
 import Data.Ratio
 import qualified Data.Map as M
@@ -66,6 +72,7 @@ import qualified Data.Set as S
 import Control.Arrow (second)
 import Control.Monad.Reader
 import Control.Monad.State
+import Control.Monad (void)
 import qualified Control.Exception as C
 
 import System.IO
@@ -78,6 +85,16 @@ import Graphics.X11.Xlib.Extras
 -- ---------------------------------------------------------------------
 -- Window manager operations
 
+-- | Detect whether a window has fixed size or is transient. This check
+-- can be used to determine whether the window should be floating or not
+--
+isFixedSizeOrTransient :: Display -> Window -> X Bool
+isFixedSizeOrTransient d w = do
+    sh <- io $ getWMNormalHints d w
+    let isFixedSize = isJust (sh_min_size sh) && sh_min_size sh == sh_max_size sh
+    isTransient <- isJust <$> io (getTransientForHint d w)
+    return (isFixedSize || isTransient)
+
 -- |
 -- Add a new window to be managed in the current workspace.
 -- Bring it into focus.
@@ -87,10 +104,8 @@ import Graphics.X11.Xlib.Extras
 --
 manage :: Window -> X ()
 manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
-    sh <- io $ getWMNormalHints d w
 
-    let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh
-    isTransient <- isJust <$> io (getTransientForHint d w)
+    shouldFloat <- isFixedSizeOrTransient d w
 
     rr <- snd `fmap` floatLocation w
     -- ensure that float windows don't go over the edge of the screen
@@ -98,8 +113,8 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
                                               = W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h
         adjust r = r
 
-        f ws | isFixedSize || isTransient = W.float w (adjust rr) . W.insertUp w . W.view i $ ws
-             | otherwise                  = W.insertUp w ws
+        f ws | shouldFloat = W.float w (adjust rr) . W.insertUp w . W.view i $ ws
+             | otherwise   = W.insertUp w ws
             where i = W.tag $ W.workspace $ W.current ws
 
     mh <- asks (manageHook . config)
@@ -128,7 +143,7 @@ killWindow w = withDisplay $ \d -> do
                 setEventType ev clientMessage
                 setClientMessageEvent ev w wmprot 32 wmdelt currentTime
                 sendEvent d w False noEventMask ev
-        else killClient d w >> return ()
+        else void (killClient d w)
 
 -- | Kill the currently focused client.
 kill :: X ()
@@ -179,7 +194,7 @@ windows f = do
 
         let m   = W.floating ws
             flt = [(fw, scaleRationalRect viewrect r)
-                    | fw <- filter (flip M.member m) (W.index this)
+                    | fw <- filter (`M.member` m) (W.index this)
                     , Just r <- [M.lookup fw m]]
             vs = flt ++ rs
 
@@ -205,7 +220,7 @@ windows f = do
     -- all windows that are no longer in the windowset are marked as
     -- withdrawn, it is important to do this after the above, otherwise 'hide'
     -- will overwrite withdrawnState with iconicState
-    mapM_ (flip setWMState withdrawnState) (W.allWindows old \\ W.allWindows ws)
+    mapM_ (`setWMState` withdrawnState) (W.allWindows old \\ W.allWindows ws)
 
     isMouseFocused <- asks mouseFocused
     unless isMouseFocused $ clearEvents enterWindowMask
@@ -221,8 +236,8 @@ windowBracket :: (a -> Bool) -> X a -> X a
 windowBracket p action = withWindowSet $ \old -> do
   a <- action
   when (p a) . withWindowSet $ \new -> do
-    modifyWindowSet $ \_ -> old
-    windows         $ \_ -> new
+    modifyWindowSet $ const old
+    windows         $ const new
   return a
 
 -- | Perform an @X@ action. If it returns @Any True@, unwind the
@@ -250,12 +265,11 @@ setWindowBorderWithFallback :: Display -> Window -> String -> Pixel -> X ()
 setWindowBorderWithFallback dpy w color basic = io $
     C.handle fallback $ do
       wa <- getWindowAttributes dpy w
-      pixel <- color_pixel . fst <$> allocNamedColor dpy (wa_colormap wa) color
+      pixel <- setPixelSolid . color_pixel . fst <$> allocNamedColor dpy (wa_colormap wa) color
       setWindowBorder dpy w pixel
   where
     fallback :: C.SomeException -> IO ()
-    fallback e = do hPrint stderr e >> hFlush stderr
-                    setWindowBorder dpy w basic
+    fallback _ = setWindowBorder dpy w basic
 
 -- | Hide a window by unmapping it and setting Iconified.
 hide :: Window -> X ()
@@ -342,15 +356,16 @@ getCleanedScreenInfo = io .  fmap nubScreens . getScreenInfo
 -- | The screen configuration may have changed (due to -- xrandr),
 -- update the state and refresh the screen, and reset the gap.
 rescreen :: X ()
-rescreen = do
-    xinesc <- withDisplay getCleanedScreenInfo
-
-    windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
-        let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs
-            (a:as)   = zipWith3 W.Screen xs [0..] $ map SD xinesc
-        in  ws { W.current = a
-               , W.visible = as
-               , W.hidden  = ys }
+rescreen = withDisplay getCleanedScreenInfo >>= \case
+    [] -> trace "getCleanedScreenInfo returned []"
+    xinesc:xinescs ->
+        windows $ \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 }
 
 -- ---------------------------------------------------------------------
 
@@ -409,7 +424,7 @@ setFocusX w = withWindowSet $ \ws -> do
     currevt <- asks currentEvent
     let inputHintSet = wmh_flags hints `testBit` inputHintBit
 
-    when ((inputHintSet && wmh_input hints) || (not inputHintSet)) $
+    when (inputHintSet && wmh_input hints || not inputHintSet) $
       io $ do setInputFocus dpy w revertToPointerRoot 0
     when (wmtf `elem` protocols) $
       io $ allocaXEvent $ \ev -> do
@@ -417,12 +432,46 @@ setFocusX w = withWindowSet $ \ws -> do
         setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt
         sendEvent dpy w False noEventMask ev
         where event_time ev =
-                if (ev_event_type ev) `elem` timedEvents then
+                if ev_event_type ev `elem` timedEvents then
                   ev_time ev
                 else
                   currentTime
               timedEvents = [ keyPress, keyRelease, buttonPress, buttonRelease, enterNotify, leaveNotify, selectionRequest ]
 
+cacheNumlockMask :: X ()
+cacheNumlockMask = do
+    dpy <- asks display
+    ms <- io $ getModifierMapping dpy
+    xs <- sequence [ do ks <- io $ keycodeToKeysym dpy kc 0
+                        if ks == xK_Num_Lock
+                            then return (setBit 0 (fromIntegral m))
+                            else return (0 :: KeyMask)
+                   | (m, kcs) <- ms, kc <- kcs, kc /= 0
+                   ]
+    modify (\s -> s { numberlockMask = foldr (.|.) 0 xs })
+
+-- | Given a list of keybindings, turn the given 'KeySym's into actual
+-- 'KeyCode's and prepare them for grabbing.
+mkGrabs :: [(KeyMask, KeySym)] -> X [(KeyMask, KeyCode)]
+mkGrabs ks = withDisplay $ \dpy -> do
+    let (minCode, maxCode) = displayKeycodes dpy
+        allCodes = [fromIntegral minCode .. fromIntegral maxCode]
+    -- build a map from keysyms to lists of keysyms (doing what
+    -- XGetKeyboardMapping would do if the X11 package bound it)
+    syms <- forM allCodes $ \code -> io (keycodeToKeysym dpy code 0)
+    let -- keycodeToKeysym returns noSymbol for all unbound keycodes,
+        -- and we don't want to grab those whenever someone accidentally
+        -- uses def :: KeySym
+        keysymMap = M.delete noSymbol $
+            M.fromListWith (++) (zip syms [[code] | code <- allCodes])
+        keysymToKeycodes sym = M.findWithDefault [] sym keysymMap
+    extraMods <- extraModifiers
+    pure [ (mask .|. extraMod, keycode)
+         | (mask, sym) <- ks
+         , keycode     <- keysymToKeycodes sym
+         , extraMod    <- extraMods
+         ]
+
 ------------------------------------------------------------------------
 -- Message handling
 
@@ -430,7 +479,7 @@ setFocusX w = withWindowSet $ \ws -> do
 -- layout the windows, in which case changes are handled through a refresh.
 sendMessage :: Message a => a -> X ()
 sendMessage a = windowBracket_ $ do
-    w <- W.workspace . W.current <$> gets windowset
+    w <- gets $ W.workspace . W.current . windowset
     ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
     whenJust ml' $ \l' ->
         modifyWindowSet $ \ws -> ws { W.current = (W.current ws)
@@ -465,9 +514,9 @@ updateLayout i ml = whenJust ml $ \l ->
 -- | Set the layout of the currently viewed workspace.
 setLayout :: Layout Window -> X ()
 setLayout l = do
-    ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset
+    ss@W.StackSet{ W.current = c@W.Screen{ W.workspace = ws }} <- gets windowset
     handleMessage (W.layout ws) (SomeMessage ReleaseResources)
-    windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }
+    windows $ const $ ss{ W.current = c{ W.workspace = ws{ W.layout = l } } }
 
 ------------------------------------------------------------------------
 -- Utilities
@@ -504,10 +553,14 @@ cleanMask km = do
     nlm <- gets numberlockMask
     return (complement (nlm .|. lockMask) .&. km)
 
+-- | Set the 'Pixel' alpha value to 255.
+setPixelSolid :: Pixel -> Pixel
+setPixelSolid p = p .|. 0xff000000
+
 -- | Get the 'Pixel' value for a named color.
 initColor :: Display -> String -> IO (Maybe Pixel)
 initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $
-    (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
+    Just . setPixelSolid . color_pixel . fst <$> allocNamedColor dpy colormap c
     where colormap = defaultColormap dpy (defaultScreen dpy)
 
 ------------------------------------------------------------------------
@@ -527,7 +580,7 @@ writeStateToFile = do
         maybeShow _ = Nothing
 
         wsData   = W.mapLayout show . windowset
-        extState = catMaybes . map maybeShow . M.toList . extensibleState
+        extState = mapMaybe maybeShow . M.toList . extensibleState
 
     path <- asks $ stateFileName . directories
     stateData <- gets (\s -> StateFile (wsData s) (extState s))
@@ -590,11 +643,10 @@ floatLocation w =
     catchX go $ do
       -- Fallback solution if `go' fails.  Which it might, since it
       -- calls `getWindowAttributes'.
-      sc <- W.current <$> gets windowset
+      sc <- gets $ W.current . windowset
       return (W.screen sc, W.RationalRect 0 0 1 1)
 
-  where fi x = fromIntegral x
-        go = withDisplay $ \d -> do
+  where go = withDisplay $ \d -> do
           ws <- gets windowset
           wa <- io $ getWindowAttributes d w
           let bw = (fromIntegral . wa_border_width) wa
@@ -620,6 +672,9 @@ floatLocation w =
 
           return (W.screen sc, rr)
 
+        fi :: (Integral a, Num b) => a -> b
+        fi = fromIntegral
+
 -- | Given a point, determine the screen (if any) that contains it.
 pointScreen :: Position -> Position
             -> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
@@ -650,14 +705,20 @@ float w = do
 
 -- | Accumulate mouse motion events
 mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
-mouseDrag f done = do
+mouseDrag = mouseDragCursor Nothing
+
+-- | Like 'mouseDrag', but with the ability to specify a custom cursor
+-- shape.
+mouseDragCursor :: Maybe Glyph -> (Position -> Position -> X ()) -> X () -> X ()
+mouseDragCursor cursorGlyph f done = do
     drag <- gets dragging
     case drag of
         Just _ -> return () -- error case? we're already dragging
         Nothing -> do
             XConf { theRoot = root, display = d } <- ask
-            io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
-                    grabModeAsync grabModeAsync none none currentTime
+            io $ do cursor <- maybe (pure none) (createFontCursor d) cursorGlyph
+                    grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
+                      grabModeAsync grabModeAsync none cursor currentTime
             modify $ \s -> s { dragging = Just (motion, cleanup) }
  where
     cleanup = do
@@ -675,7 +736,9 @@ mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do
     (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w
     let ox = fromIntegral ox'
         oy = fromIntegral oy'
-    mouseDrag (\ex ey -> do
+    mouseDragCursor
+              (Just xC_fleur)
+              (\ex ey -> do
                   io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
                                       (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
                   float w
@@ -688,12 +751,13 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
     wa <- io $ getWindowAttributes d w
     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
+    mouseDragCursor
+              (Just xC_bottom_right_corner)
+              (\ex ey -> do
                  io $ resizeWindow d w `uncurry`
                     applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
                                                ey - fromIntegral (wa_y wa))
                  float w)
-
               (float w)
 
 -- ---------------------------------------------------------------------
@@ -709,7 +773,7 @@ mkAdjust w = withDisplay $ \d -> liftIO $ do
     sh <- getWMNormalHints d w
     wa <- C.try $ getWindowAttributes d w
     case wa of
-         Left  err -> const (return id) (err :: C.SomeException)
+         Left (_ :: C.SomeException) -> return id
          Right wa' ->
             let bw = fromIntegral $ wa_border_width wa'
             in  return $ applySizeHints bw sh

src/XMonad/StackSet.hs

@@ -58,6 +58,8 @@ import Data.Foldable (foldr, toList)
 import Data.Maybe   (listToMaybe,isJust,fromMaybe)
 import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
 import Data.List ( (\\) )
+import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty (NonEmpty((:|)))
 import qualified Data.Map  as M (Map,insert,delete,empty)
 
 -- $intro
@@ -92,21 +94,20 @@ import qualified Data.Map  as M (Map,insert,delete,empty)
 --    resulting data structure will share as much of its components with
 --    the old structure as possible.
 --
---      Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"
+--      <https://mail.haskell.org/pipermail/haskell/2005-April/015769.html Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation">
 --
 -- We use the zipper to keep track of the focused workspace and the
 -- focused window on each workspace, allowing us to have correct focus
 -- by construction. We closely follow Huet's original implementation:
 --
---      G. Huet, /Functional Pearl: The Zipper/,
---      1997, J. Functional Programming 75(5):549-554.
--- and:
---      R. Hinze and J. Jeuring, /Functional Pearl: The Web/.
+--      <https://www.st.cs.uni-saarland.de/edu/seminare/2005/advanced-fp/docs/huet-zipper.pdf G. Huet, Functional Pearl: The Zipper; 1997, J. Functional Programming 75(5):549–554>
+--
+-- and
+--
+--      <https://dspace.library.uu.nl/handle/1874/2532 R. Hinze and J. Jeuring, Functional Pearl: Weaving a Web>
 --
 -- and Conor McBride's zipper differentiation paper.
--- Another good reference is:
---
---      The Zipper, Haskell wikibook
+-- Another good reference is: <https://wiki.haskell.org/Zipper The Zipper, Haskell wikibook>
 
 -- $xinerama
 -- Xinerama in X11 lets us view multiple virtual workspaces
@@ -208,10 +209,11 @@ abort x = error $ "xmonad: StackSet: " ++ x
 -- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
 --
 new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd
-new l wids m | not (null wids) && length m <= length wids && not (null m)
-  = StackSet cur visi unseen M.empty
-  where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids
-        (cur:visi)    = [ Screen i s sd |  (i, s, sd) <- zip3 seen [0..] m ]
+new l (wid:wids) (m:ms) | length ms <= length wids
+  = StackSet cur visi (map ws unseen) M.empty
+  where ws i = Workspace i l Nothing
+        (seen, unseen) = L.splitAt (length ms) wids
+        cur:visi = Screen (ws wid) 0 m : [ Screen (ws i) s sd | (i, s, sd) <- zip3 seen [1..] ms ]
                 -- now zip up visibles with their screen id
 new _ _ _ = abort "non-positive argument to StackSet.new"
 
@@ -238,7 +240,7 @@ view i s
 
     | otherwise = s -- not a member of the stackset
 
-  where equating f = \x y -> f x == f y
+  where equating f x y = f x == f y
 
     -- 'Catch'ing this might be hard. Relies on monotonically increasing
     -- workspace tags defined in 'new'
@@ -311,7 +313,7 @@ integrate :: Stack a -> [a]
 integrate (Stack x l r) = reverse l ++ x : r
 
 -- |
--- /O(n)/ Flatten a possibly empty stack into a list.
+-- /O(n)/. Flatten a possibly empty stack into a list.
 integrate' :: Maybe (Stack a) -> [a]
 integrate' = maybe [] integrate
 
@@ -343,32 +345,44 @@ filter p (Stack f ls rs) = case L.filter p (f:rs) of
 index :: StackSet i l a s sd -> [a]
 index = with [] integrate
 
--- |
--- /O(1), O(w) on the wrapping case/.
---
--- focusUp, focusDown. Move the window focus up or down the stack,
--- wrapping if we reach the end. The wrapping should model a 'cycle'
--- on the current stack. The 'master' window, and window order,
+-- | /O(1), O(w) on the wrapping case/. Move the window focus up the
+-- stack, wrapping if we reach the end. The wrapping should model a
+-- @cycle@ on the current stack. The @master@ window and window order
 -- are unaffected by movement of focus.
---
--- swapUp, swapDown, swap the neighbour in the stack ordering, wrapping
--- if we reach the end. Again the wrapping model should 'cycle' on
--- the current stack.
---
-focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd
+focusUp :: StackSet i l a s sd -> StackSet i l a s sd
 focusUp   = modify' focusUp'
+
+-- | /O(1), O(w) on the wrapping case/. Like 'focusUp', but move the
+-- window focus down the stack.
+focusDown :: StackSet i l a s sd -> StackSet i l a s sd
 focusDown = modify' focusDown'
 
+-- | /O(1), O(w) on the wrapping case/. Swap the upwards (left)
+-- neighbour in the stack ordering, wrapping if we reach the end. Much
+-- like for 'focusUp' and 'focusDown', the wrapping model should 'cycle'
+-- on the current stack.
+swapUp :: StackSet i l a s sd -> StackSet i l a s sd
 swapUp    = modify' swapUp'
+
+-- | /O(1), O(w) on the wrapping case/. Like 'swapUp', but for swapping
+-- the downwards (right) neighbour.
+swapDown :: StackSet i l a s sd -> StackSet i l a s sd
 swapDown  = modify' (reverseStack . swapUp' . reverseStack)
 
--- | Variants of 'focusUp' and 'focusDown' that work on a
+-- | A variant of 'focusUp' with the same asymptotics that works on a
 -- 'Stack' rather than an entire 'StackSet'.
-focusUp', focusDown' :: Stack a -> Stack a
+focusUp' :: Stack a -> Stack a
 focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)
-focusUp' (Stack t []     rs) = Stack x xs [] where (x:xs) = reverse (t:rs)
-focusDown'                   = reverseStack . focusUp' . reverseStack
+focusUp' (Stack t []     rs) = Stack x xs []
+  where (x :| xs) = NE.reverse (t :| rs)
 
+-- | A variant of 'focusDown' with the same asymptotics that works on a
+-- 'Stack' rather than an entire 'StackSet'.
+focusDown' :: Stack a -> Stack a
+focusDown' = reverseStack . focusUp' . reverseStack
+
+-- | A variant of 'spawUp' with the same asymptotics that works on a
+-- 'Stack' rather than an entire 'StackSet'.
 swapUp' :: Stack a -> Stack a
 swapUp'  (Stack t (l:ls) rs) = Stack t ls (l:rs)
 swapUp'  (Stack t []     rs) = Stack t (reverse rs) []
@@ -522,8 +536,8 @@ sink w s = s { floating = M.delete w (floating s) }
 -- Focus stays with the item moved.
 swapMaster :: StackSet i l a s sd -> StackSet i l a s sd
 swapMaster = modify' $ \c -> case c of
-    Stack _ [] _  -> c    -- already master.
-    Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls
+    Stack _ []     _  -> c    -- already master.
+    Stack t (l:ls) rs -> Stack t [] (xs ++ x : rs) where (x :| xs) = NE.reverse (l :| ls)
 
 -- natural! keep focus, move current to the top, move top to current.
 
@@ -539,8 +553,8 @@ shiftMaster = modify' $ \c -> case c of
 -- | /O(s)/. Set focus to the master window.
 focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
 focusMaster = modify' $ \c -> case c of
-    Stack _ [] _  -> c
-    Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls
+    Stack _ []     _  -> c
+    Stack t (l:ls) rs -> Stack x [] (xs ++ t : rs) where (x :| xs) = NE.reverse (l :| ls)
 
 --
 -- ---------------------------------------------------------------------

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-16.22
+resolver: lts-19.6
 
 packages:
 - ./

tests/Instances.hs

@@ -36,7 +36,7 @@ instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary l, Arbitrary sd)
       -- Pick a random window "number" in each workspace, to give focus.
       focus <- sequence [ if null windows
                           then return Nothing
-                          else liftM Just $ choose (0, length windows - 1)
+                          else Just <$> choose (0, length windows - 1)
                         | windows <- wsWindows ]
 
       let tags = [1 .. fromIntegral numWs]
@@ -80,7 +80,7 @@ newtype NonEmptyWindowsStackSet = NonEmptyWindowsStackSet T
 
 instance Arbitrary NonEmptyWindowsStackSet where
   arbitrary =
-    NonEmptyWindowsStackSet `fmap` (arbitrary `suchThat` (not . null . allWindows))
+    NonEmptyWindowsStackSet <$> (arbitrary `suchThat` (not . null . allWindows))
 
 instance Arbitrary Rectangle where
     arbitrary = Rectangle <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
@@ -99,7 +99,7 @@ newtype NonEmptyNubList a = NonEmptyNubList [a]
     deriving ( Eq, Ord, Show, Read )
 
 instance (Eq a, Arbitrary a) => Arbitrary (NonEmptyNubList a) where
-  arbitrary   = NonEmptyNubList `fmap` ((liftM nub arbitrary) `suchThat` (not . null))
+  arbitrary = NonEmptyNubList <$> ((nub <$> arbitrary) `suchThat` (not . null))
 
 
 
@@ -116,7 +116,7 @@ arbitraryTag :: T -> Gen Tag
 arbitraryTag x = do
   let ts = tags x
   -- There must be at least 1 workspace, thus at least 1 tag.
-  idx <- choose (0, (length ts) - 1)
+  idx <- choose (0, length ts - 1)
   return $ ts!!idx
 
 -- | Pull out an arbitrary window from a StackSet that is guaranteed to have a
@@ -136,5 +136,5 @@ arbitraryWindow :: NonEmptyWindowsStackSet -> Gen Window
 arbitraryWindow (NonEmptyWindowsStackSet x) = do
   let ws = allWindows x
   -- We know that there are at least 1 window in a NonEmptyWindowsStackSet.
-  idx <- choose(0, (length ws) - 1)
+  idx <- choose (0, length ws - 1)
   return $ ws!!idx

tests/Properties/Delete.hs

@@ -64,7 +64,7 @@ prop_delete_focus_not_end = do
        -- last one in the stack.
        `suchThat` \(x' :: T) ->
          let currWins = index x'
-         in length (currWins) >= 2 && peek x' /= Just (last currWins)
+         in length currWins >= 2 && peek x' /= Just (last currWins)
   -- This is safe, as we know there are >= 2 windows
   let Just n = peek x
   return $ peek (delete n x) == peek (focusDown x)

tests/Properties/Focus.hs

@@ -32,8 +32,8 @@ prop_focusWindow_master (NonNegative n) (x :: T) =
                    in index (focusWindow (s !! i) x) == index x
 
 -- shifting focus is trivially reversible
-prop_focus_left  (x :: T) = (focusUp  (focusDown x)) == x
-prop_focus_right (x :: T) = (focusDown (focusUp  x)) ==  x
+prop_focus_left  (x :: T) = focusUp  (focusDown x) == x
+prop_focus_right (x :: T) = focusDown (focusUp  x) == x
 
 -- focus master is idempotent
 prop_focusMaster_idem (x :: T) = focusMaster x == focusMaster (focusMaster x)
@@ -47,9 +47,9 @@ prop_focusWindow_works (NonNegative (n :: Int)) (x :: T) =
                    in (focus . fromJust . stack . workspace . current) (focusWindow (s !! i) x) == (s !! i)
 
 -- rotation through the height of a stack gets us back to the start
-prop_focus_all_l (x :: T) = (foldr (const focusUp) x [1..n]) == x
+prop_focus_all_l (x :: T) = foldr (const focusUp) x [1..n] == x
   where n = length (index x)
-prop_focus_all_r (x :: T) = (foldr (const focusDown) x [1..n]) == x
+prop_focus_all_r (x :: T) = foldr (const focusDown) x [1..n] == x
   where n = length (index x)
 
 -- prop_rotate_all (x :: T) = f (f x) == f x

tests/Properties/GreedyView.hs

@@ -35,7 +35,7 @@ prop_greedyView_local  (x :: T) = do
 -- greedyView is idempotent
 prop_greedyView_idem (x :: T) = do
   n <- arbitraryTag x
-  return $ greedyView n (greedyView n x) == (greedyView n x)
+  return $ greedyView n (greedyView n x) == greedyView n x
 
 -- greedyView is reversible, though shuffles the order of hidden/visible
 prop_greedyView_reversible (x :: T) = do

tests/Properties/Insert.hs

@@ -46,7 +46,7 @@ prop_insert_delete x = do
 
 -- inserting n elements increases current stack size by n
 prop_size_insert is (EmptyStackSet x) =
-        size (foldr insertUp x ws ) ==  (length ws)
+        size (foldr insertUp x ws) == length ws
   where
     ws   = nub is
     size = length . index

tests/Properties/Layout/Full.hs

@@ -29,6 +29,6 @@ prop_purelayout_full rect = do
 
 -- what happens when we send an IncMaster message to Full --- Nothing
 prop_sendmsg_full (NonNegative k) =
-         isNothing (Full `pureMessage` (SomeMessage (IncMasterN k)))
+         isNothing (Full `pureMessage` SomeMessage (IncMasterN k))
 
 prop_desc_full = description Full == show Full

tests/Properties/Layout/Tall.hs

@@ -29,12 +29,12 @@ prop_tile_non_overlap rect windows nmaster = noOverlaps (tile pct rect nmaster w
 
 -- splitting horizontally yields sensible results
 prop_split_horizontal (NonNegative n) x =
-      (noOverflows (+) (rect_x x) (rect_width x)) ==>
+      noOverflows (+) (rect_x x) (rect_width x) ==>
         sum (map rect_width xs) == rect_width x
      &&
-        all (== rect_height x) (map rect_height xs)
+        all (\s -> rect_height s == rect_height x) xs
      &&
-        (map rect_x xs) == (sort $ map rect_x xs)
+        map rect_x xs == sort (map rect_x xs)
 
     where
         xs = splitHorizontally n x
@@ -72,7 +72,7 @@ prop_shrink_tall (NonNegative n) (Positive delta) (NonNegative frac) =
         -- remaining fraction should shrink
     where
          l1                   = Tall n delta frac
-         Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage Shrink)
+         Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage Shrink
         --  pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
 
 
@@ -93,7 +93,7 @@ prop_expand_tall (NonNegative n)
     where
          frac                 = min 1 (n1 % d1)
          l1                   = Tall n delta frac
-         Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage Expand)
+         Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage Expand
         --  pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
 
 -- what happens when we send an IncMaster message to Tall
@@ -102,7 +102,7 @@ prop_incmaster_tall (NonNegative n) (Positive delta) (NonNegative frac)
        delta == delta'  && frac == frac' && n' == n + k
     where
          l1                   = Tall n delta frac
-         Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage (IncMasterN k))
+         Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage (IncMasterN k)
         --  pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
 
 

tests/Properties/Screen.hs

@@ -53,8 +53,8 @@ prop_aspect_hint_shrink hint (w,h) = case applyAspectHint hint (w,h) of
 -- the desired range
 prop_aspect_fits =
     forAll ((,,,) <$> pos <*> pos <*> pos <*> pos) $ \ (x,y,a,b) ->
-    let f v = applyAspectHint ((x, y+a), (x+b, y)) v
-    in  and [ noOverflows (*) x (y+a), noOverflows (*) (x+b) y ]
+    let f = applyAspectHint ((x, y+a), (x+b, y))
+    in  noOverflows (*) x (y+a) && noOverflows (*) (x+b) y
             ==> f (x,y) == (x,y)
 
   where pos = choose (0, 65535)

tests/Properties/Shift.hs

@@ -27,7 +27,7 @@ prop_shift_reversible (x :: T) = do
 -- shiftMaster
 
 -- focus/local/idempotent same as swapMaster:
-prop_shift_master_focus (x :: T) = peek x == (peek $ shiftMaster x)
+prop_shift_master_focus (x :: T) = peek x == peek (shiftMaster x)
 prop_shift_master_local (x :: T) = hidden_spaces x == hidden_spaces (shiftMaster x)
 prop_shift_master_idempotent (x :: T) = shiftMaster (shiftMaster x) == shiftMaster x
 -- ordering is constant modulo the focused window:
@@ -57,14 +57,14 @@ prop_shift_win_fix_current = do
   x <- arbitrary `suchThat` \(x' :: T) ->
          -- Invariant, otherWindows are NOT in the current workspace.
          let otherWindows = allWindows x' L.\\ index x'
-         in  length(tags x') >= 2 && length(otherWindows) >= 1
+         in  length (tags x') >= 2 && not (null otherWindows)
   -- Sadly we have to construct `otherWindows` again, for the actual StackSet
   -- that got chosen.
   let otherWindows = allWindows x L.\\ index x
   -- We know such tag must exists, due to the precondition
   n <- arbitraryTag x `suchThat` (/= currentTag x)
   -- we know length is >= 1, from above precondition
-  idx <- choose(0, length(otherWindows) - 1)
+  idx <- choose (0, length otherWindows - 1)
   let w = otherWindows !! idx
-  return $ (current $ x) == (current $ shiftWin n w x)
+  return $ current x == current (shiftWin n w x)
 

tests/Properties/Stack.hs

@@ -1,6 +1,10 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+
+#ifdef VERSION_quickcheck_classes
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+#endif
+
 module Properties.Stack where
 
 import Test.QuickCheck
@@ -24,7 +28,7 @@ import Test.QuickCheck.Classes (
 -- windows kept in the zipper
 prop_index_length (x :: T) =
     case stack . workspace . current $ x of
-        Nothing   -> length (index x) == 0
+        Nothing -> null (index x)
         Just it -> length (index x) == length (focus it : up it ++ down it)
 
 
@@ -43,7 +47,7 @@ prop_allWindowsMember (NonEmptyWindowsStackSet x) = do
       -- which is a key component in this test (together with member).
   let ws = allWindows x
   -- We know that there are at least 1 window in a NonEmptyWindowsStackSet.
-  idx <- choose(0, (length ws) - 1)
+  idx <- choose (0, length ws - 1)
   return $ member (ws!!idx) x
 
 
@@ -56,8 +60,8 @@ prop_filter_order (x :: T) =
 -- differentiate should return Nothing if the list is empty or Just stack, with
 -- the first element of the list is current, and the rest of the list is down.
 prop_differentiate xs =
-        if null xs then differentiate xs == Nothing
-                   else (differentiate xs) == Just (Stack (head xs) [] (tail xs))
+        if null xs then isNothing (differentiate xs)
+                   else differentiate xs == Just (Stack (head xs) [] (tail xs))
     where _ = xs :: [Int]
 
 

tests/Properties/StackSet.hs

@@ -58,7 +58,7 @@ invariant (s :: T) = and
 --  inBounds  = and [ w >=0 && w < size s | (w,sc) <- M.assocs (screens s) ]
 
 monotonic []       = True
-monotonic (x:[])   = True
+monotonic [x]      = True
 monotonic (x:y:zs) | x == y-1  = monotonic (y:zs)
                    | otherwise = False
 
@@ -126,7 +126,7 @@ prop_empty (EmptyStackSet x) =
 prop_empty_current (EmptyStackSet x) = currentTag x == head (tags x)
 
 -- no windows will be a member of an empty workspace
-prop_member_empty i (EmptyStackSet x) = member i x == False
+prop_member_empty i (EmptyStackSet x) = not (member i x)
 
 -- peek either yields nothing on the Empty workspace, or Just a valid window
 prop_member_peek (x :: T) =

tests/Properties/Swap.hs

@@ -11,8 +11,8 @@ import XMonad.StackSet hiding (filter)
 -- swapUp, swapDown, swapMaster: reordiring windows
 
 -- swap is trivially reversible
-prop_swap_left  (x :: T) = (swapUp  (swapDown x)) == x
-prop_swap_right (x :: T) = (swapDown (swapUp  x)) ==  x
+prop_swap_left  (x :: T) = swapUp  (swapDown x) == x
+prop_swap_right (x :: T) = swapDown (swapUp  x) ==  x
 -- TODO swap is reversible
 -- swap is reversible, but involves moving focus back the window with
 -- master on it. easy to do with a mouse...
@@ -26,12 +26,12 @@ prop_promote_reversible x b = (not . null . fromMaybe [] . flip index x . curren
 -}
 
 -- swap doesn't change focus
-prop_swap_master_focus (x :: T) = peek x == (peek $ swapMaster x)
+prop_swap_master_focus (x :: T) = peek x == peek (swapMaster x)
 --    = case peek x of
 --        Nothing -> True
 --        Just f  -> focus (stack (workspace $ current (swap x))) == f
-prop_swap_left_focus   (x :: T) = peek x == (peek $ swapUp   x)
-prop_swap_right_focus  (x :: T) = peek x == (peek $ swapDown  x)
+prop_swap_left_focus   (x :: T) = peek x == peek (swapUp   x)
+prop_swap_right_focus  (x :: T) = peek x == peek (swapDown  x)
 
 -- swap is local
 prop_swap_master_local (x :: T) = hidden_spaces x == hidden_spaces (swapMaster x)
@@ -39,9 +39,9 @@ prop_swap_left_local   (x :: T) = hidden_spaces x == hidden_spaces (swapUp   x)
 prop_swap_right_local  (x :: T) = hidden_spaces x == hidden_spaces (swapDown  x)
 
 -- rotation through the height of a stack gets us back to the start
-prop_swap_all_l (x :: T) = (foldr (const swapUp)  x [1..n]) == x
+prop_swap_all_l (x :: T) = foldr (const swapUp)  x [1..n] == x
   where n = length (index x)
-prop_swap_all_r (x :: T) = (foldr (const swapDown) x [1..n]) == x
+prop_swap_all_r (x :: T) = foldr (const swapDown) x [1..n] == x
   where n = length (index x)
 
 prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x

tests/Properties/View.hs

@@ -37,7 +37,7 @@ prop_view_local  (x :: T) = do
 -- view is idempotent
 prop_view_idem (x :: T) = do
     n <- arbitraryTag x
-    return $ view n (view n x) == (view n x)
+    return $ view n (view n x) == view n x
 
 -- view is reversible, though shuffles the order of hidden/visible
 prop_view_reversible (x :: T) = do

tests/Utils.hs

@@ -12,8 +12,8 @@ hidden_spaces x = map workspace (visible x) ++ hidden x
 -- normalise workspace list
 normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) }
     where
-        f = \a b -> tag (workspace a) `compare` tag (workspace b)
-        g = \a b -> tag a `compare` tag b
+        f a b = tag (workspace a) `compare` tag (workspace b)
+        g a b = tag a `compare` tag b
 
 
 noOverlaps []  = True

xmonad.cabal

@@ -1,5 +1,5 @@
 name:               xmonad
-version:            0.17.0
+version:            0.17.1
 synopsis:           A tiling window manager
 description:        xmonad is a tiling window manager for X. Windows are arranged
                     automatically to tile the screen without gaps or overlap, maximising
@@ -25,9 +25,9 @@ author:             Spencer Janssen, Don Stewart, Adam Vogt, David Roundy, Jason
                     Jens Petersen, Joey Hess, Jonne Ransijn, Josh Holland, Khudyakov Alexey,
                     Klaus Weidner, Michael G. Sloan, Mikkel Christiansen, Nicolas Dudebout,
                     Ondřej Súkup, Paul Hebble, Shachaf Ben-Kiki, Siim Põder, Tim McIver,
-                    Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion
+                    Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion, Tony Zorman
 maintainer:         xmonad@haskell.org
-tested-with:        GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1
+tested-with:        GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.2
 category:           System
 homepage:           http://xmonad.org
 bug-reports:        https://github.com/xmonad/xmonad/issues