Compare commits

..

No commits in common. "master" and "v0.17.0" have entirely different histories.

46 changed files with 950 additions and 1752 deletions

View File

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

View File

@ -10,7 +10,7 @@ jobs:
runs-on: ubuntu-latest runs-on: ubuntu-latest
steps: steps:
- name: Clone project - name: Clone project
uses: actions/checkout@v4 uses: actions/checkout@v2
- name: Install dependencies - name: Install dependencies
run: | run: |
@ -26,8 +26,8 @@ jobs:
- name: Commit/push if changed - name: Commit/push if changed
run: | run: |
set -ex set -ex
git config user.name 'github-actions[bot]' git config user.name github-actions
git config user.email '41898282+github-actions[bot]@users.noreply.github.com' git config user.email github-actions@github.com
git diff --quiet --exit-code && exit git diff --quiet --exit-code && exit
git commit -a -m 'man: Update' git commit -a -m 'man: Update'
git push git push

View File

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

View File

@ -8,9 +8,9 @@
# #
# For more information, see https://github.com/haskell-CI/haskell-ci # For more information, see https://github.com/haskell-CI/haskell-ci
# #
# version: 0.19.20250506 # version: 0.12
# #
# REGENDATA ("0.19.20250506",["github","cabal.project"]) # REGENDATA ("0.12",["github","cabal.project"])
# #
name: Haskell-CI name: Haskell-CI
on: on:
@ -22,116 +22,63 @@ on:
workflow_dispatch: workflow_dispatch:
inputs: inputs:
version: version:
description: candidate version (must match version in cabal file) # 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)
jobs: jobs:
linux: linux:
name: Haskell-CI - Linux - ${{ matrix.compiler }} name: Haskell-CI - Linux - ${{ matrix.compiler }}
runs-on: ubuntu-24.04 runs-on: ubuntu-18.04
timeout-minutes:
60
container: container:
image: buildpack-deps:jammy image: buildpack-deps:bionic
continue-on-error: ${{ matrix.allow-failure }} continue-on-error: ${{ matrix.allow-failure }}
strategy: strategy:
matrix: matrix:
include: include:
- compiler: ghc-9.12.2 - compiler: ghc-9.0.1
compilerKind: ghc
compilerVersion: 9.12.2
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.10.2
compilerKind: ghc
compilerVersion: 9.10.2
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.8.4
compilerKind: ghc
compilerVersion: 9.8.4
setup-method: ghcup
allow-failure: false allow-failure: false
upload: true upload: true
- compiler: ghc-9.6.7 - compiler: ghc-8.10.4
compilerKind: ghc
compilerVersion: 9.6.7
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.4.8
compilerKind: ghc
compilerVersion: 9.4.8
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.2.8
compilerKind: ghc
compilerVersion: 9.2.8
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.0.2
compilerKind: ghc
compilerVersion: 9.0.2
setup-method: ghcup
allow-failure: false
- compiler: ghc-8.10.7
compilerKind: ghc
compilerVersion: 8.10.7
setup-method: ghcup
allow-failure: false allow-failure: false
- compiler: ghc-8.8.4 - compiler: ghc-8.8.4
compilerKind: ghc
compilerVersion: 8.8.4
setup-method: ghcup
allow-failure: false allow-failure: false
- compiler: ghc-8.6.5 - compiler: ghc-8.6.5
compilerKind: ghc allow-failure: false
compilerVersion: 8.6.5 - compiler: ghc-8.4.4
setup-method: ghcup
allow-failure: false allow-failure: false
fail-fast: false fail-fast: false
steps: steps:
- name: apt-get install - name: apt
run: | run: |
apt-get update apt-get update
apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common
apt-get install -y libx11-dev libxext-dev libxinerama-dev libxrandr-dev libxss-dev apt-add-repository -y 'ppa:hvr/ghc'
- name: Install GHCup apt-get update
run: | apt-get install -y $CC cabal-install-3.4 libx11-dev libxext-dev libxinerama-dev libxrandr-dev libxss-dev
mkdir -p "$HOME/.ghcup/bin"
curl -sL https://downloads.haskell.org/ghcup/0.1.50.1/x86_64-linux-ghcup-0.1.50.1 > "$HOME/.ghcup/bin/ghcup"
chmod a+x "$HOME/.ghcup/bin/ghcup"
- name: Install cabal-install
run: |
"$HOME/.ghcup/bin/ghcup" install cabal 3.14.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
- name: Install GHC (GHCup)
if: matrix.setup-method == 'ghcup'
run: |
"$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
echo "HC=$HC" >> "$GITHUB_ENV"
echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
env: env:
HCKIND: ${{ matrix.compilerKind }} CC: ${{ matrix.compiler }}
HCNAME: ${{ matrix.compiler }}
HCVER: ${{ matrix.compilerVersion }}
- name: Set PATH and environment variables - name: Set PATH and environment variables
run: | run: |
echo "$HOME/.cabal/bin" >> $GITHUB_PATH echo "$HOME/.cabal/bin" >> $GITHUB_PATH
echo "LANG=C.UTF-8" >> "$GITHUB_ENV" echo "LANG=C.UTF-8" >> $GITHUB_ENV
echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV
echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$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
HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 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 "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV
echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV
echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV
echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "HEADHACKAGE=false" >> $GITHUB_ENV
echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCNAME --with-compiler=$HC" >> $GITHUB_ENV
echo "GHCJSARITH=0" >> $GITHUB_ENV
env: env:
HCKIND: ${{ matrix.compilerKind }} CC: ${{ matrix.compiler }}
HCNAME: ${{ matrix.compiler }}
HCVER: ${{ matrix.compilerVersion }}
- name: env - name: env
run: | run: |
env env
@ -154,10 +101,6 @@ jobs:
repository hackage.haskell.org repository hackage.haskell.org
url: http://hackage.haskell.org/ url: http://hackage.haskell.org/
EOF EOF
cat >> $CABAL_CONFIG <<EOF
program-default-options
ghc-options: $GHCJOBS +RTS -M3G -RTS
EOF
cat $CABAL_CONFIG cat $CABAL_CONFIG
- name: versions - name: versions
run: | run: |
@ -170,14 +113,14 @@ jobs:
- name: install cabal-plan - name: install cabal-plan
run: | run: |
mkdir -p $HOME/.cabal/bin mkdir -p $HOME/.cabal/bin
curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz
echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -
xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
rm -f cabal-plan.xz rm -f cabal-plan.xz
chmod a+x $HOME/.cabal/bin/cabal-plan chmod a+x $HOME/.cabal/bin/cabal-plan
cabal-plan --version cabal-plan --version
- name: checkout - name: checkout
uses: actions/checkout@v4 uses: actions/checkout@v2
with: with:
path: source path: source
- name: initial cabal.project for sdist - name: initial cabal.project for sdist
@ -196,8 +139,7 @@ jobs:
- name: generate cabal.project - name: generate cabal.project
run: | run: |
PKGDIR_xmonad="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/xmonad-[0-9.]*')" 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
touch cabal.project.local touch cabal.project.local
echo "packages: ${PKGDIR_xmonad}" >> cabal.project echo "packages: ${PKGDIR_xmonad}" >> cabal.project
@ -209,15 +151,15 @@ jobs:
package xmonad package xmonad
flags: +pedantic flags: +pedantic
EOF EOF
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(xmonad)$/; }' >> cabal.project.local $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(xmonad)$/; }' >> cabal.project.local
cat cabal.project cat cabal.project
cat cabal.project.local cat cabal.project.local
- name: dump install plan - name: dump install plan
run: | run: |
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
cabal-plan cabal-plan
- name: restore cache - name: cache
uses: actions/cache/restore@v4 uses: actions/cache@v2
with: with:
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
path: ~/.cabal/store path: ~/.cabal/store
@ -240,96 +182,67 @@ jobs:
cd ${PKGDIR_xmonad} || false cd ${PKGDIR_xmonad} || false
${CABAL} -vnormal check ${CABAL} -vnormal check
- name: haddock - name: haddock
run: |
$CABAL v2-haddock --disable-documentation $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
- name: haddock for hackage
if: matrix.upload
run: | run: |
$CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH --haddock-for-hackage --builddir $GITHUB_WORKSPACE/haddock all $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH --haddock-for-hackage --builddir $GITHUB_WORKSPACE/haddock all
- name: unconstrained build - name: unconstrained build
run: | run: |
rm -f cabal.project.local rm -f cabal.project.local
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
- name: save cache - name: upload artifacts (sdist)
if: always()
uses: actions/cache/save@v4
with:
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
path: ~/.cabal/store
# must be separate artifacts because GitHub Actions are still broken:
# https://github.com/actions/upload-artifact/issues/441
# https://github.com/actions/upload-artifact/issues/457
- name: upload artifact (sdist)
if: matrix.upload if: matrix.upload
uses: actions/upload-artifact@v4 uses: actions/upload-artifact@v2
with: with:
name: sdist
path: ${{ github.workspace }}/sdist/*.tar.gz path: ${{ github.workspace }}/sdist/*.tar.gz
- name: upload artifact (haddock) - name: upload artifacts (haddock)
if: matrix.upload if: matrix.upload
uses: actions/upload-artifact@v4 uses: actions/upload-artifact@v2
with: with:
name: haddock
path: ${{ github.workspace }}/haddock/*-docs.tar.gz path: ${{ github.workspace }}/haddock/*-docs.tar.gz
- name: hackage upload (candidate) - name: hackage upload (candidate)
if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''
shell: bash
run: |
set -ex
PACKAGE_VERSION="${PACKAGE_VERSION#v}"
res=$(
curl \
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \
--header "Accept: text/plain" \
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
--form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
https://hackage.haskell.org/packages/candidates/
)
[[ $res == 2?? ]] # TODO: --fail-with-body once curl 7.76.0 is available
res=$(
curl \
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \
-X PUT \
--header "Accept: text/plain" \
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
--header "Content-Type: application/x-tar" \
--header "Content-Encoding: gzip" \
--data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/candidate/docs
)
[[ $res == 2?? ]]
env:
HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
PACKAGE_NAME: ${{ github.event.repository.name }}
PACKAGE_VERSION: ${{ github.event.inputs.version }}
- name: hackage upload (release)
if: matrix.upload && github.event_name == 'release' if: matrix.upload && github.event_name == 'release'
shell: bash
run: | run: |
set -ex set -ex
PACKAGE_VERSION="${PACKAGE_VERSION#v}" PACKAGE_VERSION="${PACKAGE_VERSION#v}"
res=$( curl \
curl \ --silent --show-error --fail \
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \ --header "Accept: text/plain" \
--header "Accept: text/plain" \ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \ --form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
--form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \ https://hackage.haskell.org/packages/candidates/
https://hackage.haskell.org/packages/ curl \
) --silent --show-error --fail \
[[ $res == 2?? ]] # TODO: --fail-with-body once curl 7.76.0 is available -X PUT \
res=$( --header "Accept: text/plain" \
curl \ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \ --header "Content-Type: application/x-tar" \
-X PUT \ --header "Content-Encoding: gzip" \
--header "Accept: text/plain" \ --data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \ https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/candidate/docs
--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: env:
HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }} HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
PACKAGE_NAME: ${{ github.event.repository.name }} PACKAGE_NAME: ${{ github.event.repository.name }}
PACKAGE_VERSION: ${{ github.event.release.tag_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
env:
HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
PACKAGE_NAME: ${{ github.event.repository.name }}
PACKAGE_VERSION: ${{ github.event.inputs.version }}

View File

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

View File

@ -12,10 +12,14 @@ jobs:
contents: read contents: read
steps: steps:
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@v31 uses: cachix/install-nix-action@v13
with: with:
github_access_token: ${{ secrets.GITHUB_TOKEN }} install_url: https://nixos-nix-install-tests.cachix.org/serve/i6laym9jw3wg9mw6ncyrk6gjx4l34vvx/install
install_options: '--tarball-url-prefix https://nixos-nix-install-tests.cachix.org/serve'
extra_nix_config: |
experimental-features = nix-command flakes
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Clone project - name: Clone project
uses: actions/checkout@v4 uses: actions/checkout@v2
- name: Build - name: Build
run: nix build --print-build-logs run: nix build --print-build-logs

View File

@ -13,16 +13,16 @@ jobs:
steps: steps:
- name: Clone project - name: Clone project
uses: actions/checkout@v4 uses: actions/checkout@v2
- name: Setup Haskell - name: Setup Haskell
uses: haskell-actions/setup@v2 uses: haskell/actions/setup@v1
with: with:
# packdeps doesn't build with newer as of 2021-10 # packdeps doesn't build with newer as of 2021-10
ghc-version: '8.8' ghc-version: '8.8'
- name: Install packdeps - name: Install packdeps
run: | run: |
set -ex set -ex
cd # go somewhere without a cabal.project echo "$HOME/.cabal/bin" >> $GITHUB_PATH
cabal install packdeps cabal install packdeps
- name: Check package bounds (all) - name: Check package bounds (all)
continue-on-error: true continue-on-error: true
@ -38,11 +38,3 @@ jobs:
--preferred \ --preferred \
--exclude X11 \ --exclude X11 \
*.cabal *.cabal
workflow-keepalive:
if: github.event_name == 'schedule'
runs-on: ubuntu-latest
permissions:
actions: write
steps:
- uses: liskin/gh-workflow-keepalive@v1

View File

@ -12,23 +12,30 @@ jobs:
fail-fast: false fail-fast: false
matrix: matrix:
include: include:
- resolver: lts-14 # GHC 8.6 - resolver: lts-12
- resolver: lts-16 # GHC 8.8 ghc: 8.4.4
- resolver: lts-18 # GHC 8.10 - resolver: lts-14
- resolver: lts-19 # GHC 9.0 ghc: 8.6.5
- resolver: lts-20 # GHC 9.2 - resolver: lts-16
- resolver: lts-21 # GHC 9.4 ghc: 8.8.4
- resolver: lts-22 # GHC 9.6 - resolver: lts-17
- resolver: lts-23 # GHC 9.8 ghc: 8.10.4
- resolver: lts-18
ghc: 8.10.7
steps: steps:
- name: Clone project - name: Clone project
uses: actions/checkout@v4 uses: actions/checkout@v2
- name: Prepare apt sources
run: |
set -ex
sudo add-apt-repository -y ppa:hvr/ghc
sudo apt update -y
- name: Install C dependencies - name: Install C dependencies
run: | run: |
set -ex set -ex
sudo apt update -y
sudo apt install -y \ sudo apt install -y \
libx11-dev \ libx11-dev \
libxext-dev \ libxext-dev \
@ -37,23 +44,31 @@ jobs:
libxss-dev \ libxss-dev \
# #
- name: Install GHC
# use system ghc (if available) in stack, don't waste GH Actions cache space
continue-on-error: true
run: |
set -ex
sudo apt install -y ghc-${{ matrix.ghc }}
echo /opt/ghc/${{ matrix.ghc }}/bin >> $GITHUB_PATH
- name: Refresh caches once a month - name: Refresh caches once a month
id: cache-date id: cache-date
# GHA writes caches on the first miss and then never updates them again; # GHA writes caches on the first miss and then never updates them again;
# force updating the cache at least once a month. Additionally, the # force updating the cache at least once a month
# 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: | run: |
date +date=1-%Y-%m >> $GITHUB_OUTPUT echo "::set-output name=date::$(date +%Y-%m)"
- name: Cache Haskell package metadata - name: Cache Haskell package metadata
uses: actions/cache@v4 uses: actions/cache@v2
with: with:
path: ~/.stack/pantry path: ~/.stack/pantry
key: stack-pantry-${{ runner.os }}-${{ steps.cache-date.outputs.date }} key: stack-pantry-${{ runner.os }}-${{ steps.cache-date.outputs.date }}
restore-keys: |
stack-pantry-${{ runner.os }}-
- name: Cache Haskell dependencies - name: Cache Haskell dependencies
uses: actions/cache@v4 uses: actions/cache@v2
with: with:
path: | path: |
~/.stack/* ~/.stack/*
@ -63,6 +78,7 @@ jobs:
restore-keys: | 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 }}-${{ hashFiles('stack.yaml') }}-
stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}- stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-
stack-${{ runner.os }}-${{ matrix.resolver }}-
- name: Update hackage index - name: Update hackage index
# always update index to prevent the shared ~/.stack/pantry cache from being empty # always update index to prevent the shared ~/.stack/pantry cache from being empty

3
.gitignore vendored
View File

@ -27,6 +27,3 @@ tags
/cabal.sandbox.config /cabal.sandbox.config
/dist-newstyle/ /dist-newstyle/
/dist/ /dist/
# nix artifacts
result

View File

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

View File

@ -35,5 +35,4 @@ Valery V. Vorotyntsev <valery.vv@gmail.com>
Vanessa McHale <vamchale@gmail.com> <vanessa.mchale@reconfigure.io> Vanessa McHale <vamchale@gmail.com> <vanessa.mchale@reconfigure.io>
Wirt Wolff <wirtwolff@gmail.com> Wirt Wolff <wirtwolff@gmail.com>
Tony Zorman <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com> slotThe <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
Tony Zorman <soliditsallgood@mailbox.org>

View File

@ -1,86 +1,5 @@
# Change Log / Release Notes # Change Log / Release Notes
## _unreleased_
### Breaking Changes
* Use `cabal` for `--recompile` if there is a `.cabal` file in the config
directory and none of `build`, `stack.yaml`, `flake.nix`, nor `default.nix`
exist.
### Enhancements
### Bug Fixes
### Other
PR #404 (see last change in 0.17.1) has been reverted, because the affected
compilers are (hopefully) no longer being used.
All 9.0 releases of GHC, plus 9.2.1 and 9.2.2 have the join point bug.
Note that 9.0.x is known to also have GC issues and is officially deprecated,
and the only 9.2 release that should be used is 9.2.8. Additionally, GHC HQ
doesn't support releases before 9.6.6.
## 0.18.0 (February 3, 2024)
### Breaking Changes
* Dropped support for GHC 8.4.
### Enhancements
* Exported `sendRestart` and `sendReplace` from `XMonad.Operations`.
* Exported `buildLaunch` from `XMonad.Main`.
* `Tall` does not draw windows with zero area.
* `XMonad.Operations.floatLocation` now applies size hints. This means windows
will snap to these hints as soon as they're floated (mouse move, keybinding).
Previously that only happened on mouse resize.
* Recompilation now detects `flake.nix` and `default.nix` (can be a
symlink) and switches to using `nix build` as appropriate.
* Added `unGrab` to `XMonad.Operations`; this releases XMonad's passive
keyboard grab, so other applications (like `scrot`) can do their
thing.
### Bug Fixes
* Duplicated floats (e.g. from X.A.CopyToAll) no longer escape to inactive
screens.
## 0.17.2 (April 2, 2023)
### Bug Fixes
* Fixed the build with GHC 9.6.
## 0.17.1 (September 3, 2022)
### Enhancements
* Added custom cursor shapes for resizing and moving windows.
* Exported `cacheNumlockMask` and `mkGrabs` from `XMonad.Operations`.
* Added `willFloat` function to `XMonad.ManageHooks` to detect whether the
(about to be) managed window will be a floating window or not.
### 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) ## 0.17.0 (October 27, 2021)
### Enhancements ### Enhancements

View File

@ -70,11 +70,8 @@ Here are some tips for getting your changes merged into xmonad:
and [xmonad][] have test-suites that you could run with and [xmonad][] have test-suites that you could run with
`stack test` for example. `stack test` for example.
* When committing, try to follow existing practices. For more * Make sure you read the section on rebasing and squashing commits
information on what good commit messages look like, see [How to below.
Write a Git Commit Message][commit-cbeams] and the [Kernel
documentation][commit-kernel] about committing logical changes
separately.
## Style Guidelines ## Style Guidelines
@ -86,7 +83,7 @@ as well!
and provide a type signature; use Haddock syntax in the comments. and provide a type signature; use Haddock syntax in the comments.
* Follow the coding style of the module that you are making changes to * 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 * New code should not introduce any new warnings. If you want to
check this yourself before submitting a pull request, there is the check this yourself before submitting a pull request, there is the
@ -98,7 +95,7 @@ as well!
enforced in our GitHub CI. enforced in our GitHub CI.
* Partial functions are to be avoided: the window manager should not * 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 * Any pure function added to the core should have QuickCheck
properties precisely defining its behavior. properties precisely defining its behavior.
@ -106,15 +103,84 @@ as well!
* New modules should identify the author, and be submitted under the * New modules should identify the author, and be submitted under the
same license as xmonad (BSD3 license). same license as xmonad (BSD3 license).
## Keep rocking! ## Rebasing and Squashing Commits
xmonad is a passion project created and maintained by the community. Under no circumstances should you ever merge the master branch into
We'd love for you to maintain your own contributed modules (approve your feature branch. This makes it nearly impossible to review your
changes from other contributors, review code, etc.). However, before changes and we *will not accept your PR* if you do this.
we'd be comfortable adding you to the [xmonad GitHub
organization][xmonad-gh-org] we need to trust that you have sufficient Instead of merging you should rebase your changes on top of the master
knowledge of Haskell and git; and have a way of chatting with you ([IRC, branch. If a core team member asks you to "rebase your changes" this
Matrix, etc.][community]). 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
```
[hlint]: https://github.com/ndmitchell/hlint [hlint]: https://github.com/ndmitchell/hlint
[xmonad]: https://github.com/xmonad/xmonad [xmonad]: https://github.com/xmonad/xmonad
@ -125,7 +191,3 @@ Matrix, etc.][community]).
[xmonad-doc-developing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html [xmonad-doc-developing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
[`#xmonad` IRC channel]: https://web.libera.chat/#xmonad [`#xmonad` IRC channel]: https://web.libera.chat/#xmonad
[matrix channel]: https://matrix.to/#/#xmonad:matrix.org [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

View File

@ -47,21 +47,10 @@ $ sudo dnf install \
``` console ``` console
$ sudo pacman -S \ $ sudo pacman -S \
> git \ > git \
> xorg-server xorg-apps xorg-xinit xorg-xmessage \
> libx11 libxft libxinerama libxrandr libxss \ > libx11 libxft libxinerama libxrandr libxss \
> pkgconf > 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 ## Preparation
We'll use the [XDG] directory specifications here, meaning our We'll use the [XDG] directory specifications here, meaning our
@ -101,8 +90,8 @@ This will give you the latest `HEAD`; if you want you can also check
out a tagged release, e.g.: out a tagged release, e.g.:
``` console ``` console
$ git clone --branch v0.17.2 https://github.com/xmonad/xmonad $ git clone --branch v0.15 https://github.com/xmonad/xmonad
$ git clone --branch v0.17.1 https://github.com/xmonad/xmonad-contrib $ git clone --branch v0.16 https://github.com/xmonad/xmonad-contrib
``` ```
(Sources and binaries don't usually go into `~/.config`. In our case, (Sources and binaries don't usually go into `~/.config`. In our case,
@ -123,9 +112,7 @@ Unless you already know which one you prefer, use Stack, which is easier.
#### Install Stack #### Install Stack
Probably one of the best ways to get [stack] is to use [GHCup], which is the main Haskell installer according to language's official [website][GHCup] and community [survey]. GHCup is [widely available] and is considered less error prone than other installation options. The easiest way to get [stack] is probably via your system's package
You can also use your system's package
manager: manager:
``` console ``` console
@ -147,6 +134,9 @@ stack via its [documentation][stack]):
$ curl -sSL https://get.haskellstack.org/ | sh $ curl -sSL https://get.haskellstack.org/ | sh
``` ```
Yet another way would be via [ghcup]; this is similar to installers like
`rustup`, in case you prefer that.
#### Create a New Project #### Create a New Project
Let's create a stack project. Since we're already in the correct Let's create a stack project. Since we're already in the correct
@ -209,9 +199,7 @@ 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 install the correct version of GHC, as well as build all of the required
packages (`stack build`) and then copy the relevant executables packages (`stack build`) and then copy the relevant executables
(`xmonad`, in our case) to `~/.local/bin`. Make sure to add that (`xmonad`, in our case) to `~/.local/bin`. Make sure to add that
directory to your `$PATH`! The command `which xmonad` should now return directory to your `$PATH`!
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 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 be that you don't have the required C libraries installed. See
@ -221,9 +209,7 @@ be that you don't have the required C libraries installed. See
#### Install cabal-install #### Install cabal-install
Probably one of the best ways to get [cabal-install] is to use [GHCup], which is the main Haskell installer according to language's official [website][GHCup] and community [survey]. GHCup is [widely available] and is considered less error prone than other installation options. The easiest way to get [cabal-install] is probably via your system's package
You can also use your system's package
manager: manager:
``` console ``` console
@ -232,22 +218,22 @@ $ sudo dnf install cabal-install # Fedora
$ sudo pacman -S cabal-install # Arch $ sudo pacman -S cabal-install # Arch
``` ```
See also <https://www.haskell.org/cabal/#install-upgrade>. If your distribution does not package cabal-install, [ghcup][] is another
option. See also <https://www.haskell.org/cabal/#install-upgrade>.
#### Create a New Project #### Create a New Project
If you want to use `xmonad` or `xmonad-contrib` from git, you will need a Let's create a cabal project. Since we're already in the correct
`cabal.project` file. If you want to use both from [Hackage][], you should directory (`~/.config/xmonad`) with `xmonad` and `xmonad-contrib`
skip this step. subdirectories, we'll instruct cabal to use them. Create a file named
`cabal.project` containing:
Create a file named `cabal.project` containing:
``` ```
packages: */*.cabal packages: */*.cabal
``` ```
(If you do this step without using [git] checkouts, you will get an error from (If you skip this step, cabal will use the latest releases from [Hackage][]
cabal in the next step. Simply remove `cabal.project` and try again.) instead.)
#### Install Everything #### Install Everything
@ -256,7 +242,7 @@ libraries and then build the xmonad binary:
``` console ``` console
$ cabal update $ cabal update
$ cabal install --package-env=$HOME/.config/xmonad --lib base xmonad xmonad-contrib $ cabal install --package-env=$HOME/.config/xmonad --lib xmonad xmonad-contrib
$ cabal install --package-env=$HOME/.config/xmonad xmonad $ cabal install --package-env=$HOME/.config/xmonad xmonad
``` ```
@ -357,15 +343,6 @@ exec stack ghc -- \
Don't forget to mark the file as `+x`: `chmod +x build`! 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 #### Don't Recompile on Every Startup
By default, xmonad always recompiles itself when a build script is used By default, xmonad always recompiles itself when a build script is used
@ -394,9 +371,6 @@ executable will also be within that directory and not in
[git]: https://git-scm.com/ [git]: https://git-scm.com/
[stack]: https://docs.haskellstack.org/en/stable/README/ [stack]: https://docs.haskellstack.org/en/stable/README/
[cabal-install]: https://www.haskell.org/cabal/ [cabal-install]: https://www.haskell.org/cabal/
[GHCup]: https://www.haskell.org/ghcup/ [ghcup]: https://www.haskell.org/ghcup/
[survey]: https://taylor.fausak.me/2022/11/18/haskell-survey-results/
[widely available]: https://www.haskell.org/ghcup/install/#supported-platforms
[what xmonad would do]: https://github.com/xmonad/xmonad/blob/master/src/XMonad/Core.hs#L659-L667 [what xmonad would do]: https://github.com/xmonad/xmonad/blob/master/src/XMonad/Core.hs#L659-L667
[Hackage]: https://hackage.haskell.org/ [Hackage]: https://hackage.haskell.org/
[scripts/build]: https://github.com/xmonad/xmonad-contrib/blob/master/scripts/build

View File

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

View File

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

View File

@ -38,13 +38,13 @@ package manager, you will need to `xmonad --recompile` _every time_ a
Haskell dependency is updated—else xmonad may fail to start when you Haskell dependency is updated—else xmonad may fail to start when you
want to log in! want to log in!
We're going to assume xmonad version `>= 0.17.0` and xmonad-contrib We're going to assume xmonad version `0.17.0` and xmonad-contrib version
version `>= 0.17.0` here, though most of these steps should work with `0.17.0` here, though most of these steps should work with older
older versions as well. When we get to the relevant parts, will point versions as well. When we get to the relevant parts, will point you to
you to alternatives that work with at least xmonad version `0.15` and alternatives that work with at least xmonad version `0.15` and
xmonad-contrib version `0.16`. This will usually be accompanied by big xmonad-contrib version `0.16`. This will usually be accompanied by a
warning labels for the respective version bounds, so don't worry about big "_IF YOU ARE ON A VERSION `< 0.17.0`_", so don't worry about missing
missing it! it!
Throughout the tutorial we will use, for keybindings, a syntax very akin Throughout the tutorial we will use, for keybindings, a syntax very akin
to the [GNU Emacs conventions] for the same thing—so `C-x` means "hold to the [GNU Emacs conventions] for the same thing—so `C-x` means "hold
@ -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). 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 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. will give you the `apt` commands when it comes to installing software.
If you use another distribution, just substitute the appropriate If you use another distribution, just substitute the appropriate
commands for your system. commands for your system.
@ -77,11 +77,6 @@ a live xmonad session in some capacity. If you have set up your
`~/.xinitrc` as directed in the xmonad guided tour, you should be good `~/.xinitrc` as directed in the xmonad guided tour, you should be good
to go! If not, just smack an `exec xmonad` at the bottom of that file. to go! If not, just smack an `exec xmonad` at the bottom of that file.
In particular, it might be a good idea to set a wallpaper beforehand.
Otherwise, when switching workspaces or closing windows, you might start
seeing "shadows" of windows that were there before, unable to interact
with them.
## Installing Xmobar ## Installing Xmobar
What we need to do now—provided we want to use a bar at all—is to What we need to do now—provided we want to use a bar at all—is to
@ -113,8 +108,6 @@ utility modules we will use. At the very top of the file, write
import XMonad import XMonad
import XMonad.Util.EZConfig import XMonad.Util.EZConfig
-- NOTE: Only needed for versions < 0.18.0! For 0.18.0 and up, this is
-- already included in the XMonad import and will give you a warning!
import XMonad.Util.Ungrab import XMonad.Util.Ungrab
``` ```
@ -194,8 +187,8 @@ example, but that will change soon enough so it's worth introducing it
here as well. here as well.
What if we wanted to add other keybindings? Say you also want to bind 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-C-s` to take a `M-S-z` to lock your screen with the screensaver, `M-S-=` to take a
snapshot of one window, and `M-f` to spawn Firefox. This can be snapshot of one window, and `M-]` to spawn Firefox. This can be
achieved with the `additionalKeysP` function from the achieved with the `additionalKeysP` function from the
[XMonad.Util.EZConfig] module—luckily we already have it imported! Our [XMonad.Util.EZConfig] module—luckily we already have it imported! Our
config file, starting with `main`, now looks like: config file, starting with `main`, now looks like:
@ -207,8 +200,8 @@ main = xmonad $ def
} }
`additionalKeysP` `additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock") [ ("M-S-z", spawn "xscreensaver-command -lock")
, ("M-C-s", unGrab *> spawn "scrot -s" ) , ("M-S-=", unGrab *> spawn "scrot -s" )
, ("M-f" , spawn "firefox" ) , ("M-]" , spawn "firefox" )
] ]
``` ```
@ -254,7 +247,7 @@ import XMonad.Layout.ThreeColumns
to the top of our configuration file. Most modules have a lot of to the top of our configuration file. Most modules have a lot of
accompanying text and usage examples in them—so while the type accompanying text and usage examples in them—so while the type
signatures may seem scary, don't be afraid to look up the 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 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 layout. To do this, there is the `layoutHook`. Let's use the default
@ -270,7 +263,7 @@ myLayout = tiled ||| Mirror tiled ||| Full
``` ```
The so-called `where`-clause above simply consists of local declarations The so-called `where`-clause above simply consists of local declarations
that might clutter things up were they all declared at the top-level that might clutter things up where they all declared at the top-level
like this like this
``` haskell ``` haskell
@ -320,8 +313,8 @@ main = xmonad $ def
} }
`additionalKeysP` `additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock") [ ("M-S-z", spawn "xscreensaver-command -lock")
, ("M-C-s", unGrab *> spawn "scrot -s" ) , ("M-S-=", unGrab *> spawn "scrot -s" )
, ("M-f" , spawn "firefox" ) , ("M-]" , spawn "firefox" )
] ]
``` ```
@ -386,16 +379,12 @@ effect (and some applications, like chromium, will misbehave and need
some [Hacks] to make this work), we will also add the relevant function some [Hacks] to make this work), we will also add the relevant function
to get "proper" fullscreen behaviour here. to get "proper" fullscreen behaviour here.
---
_IF YOU ARE ON A VERSION `< 0.17.0`_: The `ewmhFullscreen` function does _IF YOU ARE ON A VERSION `< 0.17.0`_: The `ewmhFullscreen` function does
not exist in these versions. Instead of it, you can try to add not exist in these versions. Instead of it, you can try to add
`fullscreenEventHook` to your `handleEventHook` to achieve similar `fullscreenEventHook` to your `handleEventHook` to achieve similar
functionality (how to do this is explained in the documentation of functionality (how to do this is explained in the documentation of
[XMonad.Hooks.EwmhDesktops]). [XMonad.Hooks.EwmhDesktops]).
---
To use the two combinators, we compose them with the `xmonad` function To use the two combinators, we compose them with the `xmonad` function
in the following way: in the following way:
@ -407,8 +396,8 @@ main = xmonad $ ewmhFullscreen $ ewmh $ def
} }
`additionalKeysP` `additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock") [ ("M-S-z", spawn "xscreensaver-command -lock")
, ("M-C-s", unGrab *> spawn "scrot -s" ) , ("M-S-=", unGrab *> spawn "scrot -s" )
, ("M-f" , spawn "firefox" ) , ("M-]" , spawn "firefox" )
] ]
``` ```
@ -431,8 +420,8 @@ myConfig = def
} }
`additionalKeysP` `additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock") [ ("M-S-z", spawn "xscreensaver-command -lock")
, ("M-C-s", unGrab *> spawn "scrot -s" ) , ("M-S-=", unGrab *> spawn "scrot -s" )
, ("M-f" , spawn "firefox" ) , ("M-]" , spawn "firefox" )
] ]
``` ```
@ -441,7 +430,7 @@ Much better!
## Make XMonad and Xmobar Talk to Each Other ## Make XMonad and Xmobar Talk to Each Other
Onto the main dish. First, we have to import the necessary modules. Onto the main dish. First, we have to import the necessary modules.
Add the following to your list of imports Add the following to your list of imports:
``` haskell ``` haskell
import XMonad.Hooks.DynamicLog import XMonad.Hooks.DynamicLog
@ -449,27 +438,23 @@ import XMonad.Hooks.StatusBar
import XMonad.Hooks.StatusBar.PP import XMonad.Hooks.StatusBar.PP
``` ```
and replace your `main` function above with: _IF YOU ARE ON A VERSION `< 0.17.0`_: The `XMonad.Hooks.StatusBar` and
`XMonad.Hooks.StatusBar.PP` modules don't exist yet. You can find
everything you need in the `XMonad.Hooks.DynamicLog` module, so remove
these two imports.
Replace your `main` function above with:
``` haskell ``` haskell
main :: IO () main :: IO ()
main = xmonad $ ewmhFullscreen $ ewmh $ xmobarProp $ myConfig main = xmonad $ ewmhFullscreen $ ewmh $ xmobarProp $ myConfig
``` ```
--- _IF YOU ARE ON A VERSION `< 0.17.0`_: The `xmobarProp` function does not
exist in these versions. Instead of it, use `xmobar` via
_IF YOU ARE ON A VERSION `< 0.17.0`_: The `XMonad.Hooks.StatusBar` and `main = xmonad . ewmh =<< xmobar myConfig` and carefully read the part
`XMonad.Hooks.StatusBar.PP` modules don't exist yet. You can find about pipes later on (`xmobar` uses pipes to make xmobar talk to
everything you need in the `XMonad.Hooks.DynamicLog` module, so remove xmonad).
these two imports.
Further, the `xmobarProp` function does not exist in older versions.
Instead of it, use `xmobar` via `main = xmonad . ewmh =<< xmobar
myConfig` and carefully read the part about pipes later on (`xmobar`
uses pipes to make xmobar talk to xmonad). Do note the lack of
`ewmhFullscreen`, as explained above!
---
As a quick side-note, we could have also written As a quick side-note, we could have also written
@ -555,15 +540,11 @@ when things are not being read! For this reason we have to use
(this is useful, for example, for [XMonad.Util.ClickableWorkspaces], (this is useful, for example, for [XMonad.Util.ClickableWorkspaces],
which is a new feature in `0.17.0`). which is a new feature in `0.17.0`).
---
_IF YOU ARE ON A VERSION `< 0.17.0`_: As discussed above, the `xmobar` _IF YOU ARE ON A VERSION `< 0.17.0`_: As discussed above, the `xmobar`
function uses pipes, so you actually do want to use the `StdinReader`. function uses pipes, so you actually do want to use the `StdinReader`.
Simply replace _all_ occurences of `XMonadLog` with `StdinReader` Simply replace _all_ occurences of `XMonadLog` with `StdinReader`
below (don't forget the template!) below (don't forget the template!)
---
## Configuring Xmobar ## Configuring Xmobar
Now, before this will work, we have to configure xmobar. Here's a nice Now, before this will work, we have to configure xmobar. Here's a nice
@ -611,14 +592,14 @@ Config { overrideRedirect = False
``` ```
First, we set the font to use for the bar, as well as the colors. The First, we set the font to use for the bar, as well as the colors. The
position options are documented well in xmobar's [quick-start.org]. The position options are documented well on the [xmobar home page] or,
particular option of `TopW L 90` says to put the bar in the upper left alternatively, in the [quick-start.org] on GitHub. The particular
of the screen, and make it consume 90% of the width of the screen (we option of `TopW L 90` says to put the bar in the upper left of the
need to leave a little bit of space for `trayer-srg`). If you're up for screen, and make it consume 90% of the width of the screen (we need to
it—and this really requires more shell-scripting than Haskell leave a little bit of space for `trayer-srg`). If you're up for it—and
knowledge—you can also try to seamlessly embed trayer into xmobar by this really requires more shell-scripting than Haskell knowledge—you can
using [trayer-padding-icon.sh] and following the advice given in that also try to seamlessly embed trayer into xmobar by using
thread. [trayer-padding-icon.sh] and following the advice given in that thread.
In the commands list you, well, define commands. Commands are the In the commands list you, well, define commands. Commands are the
pieces that generate the content to be displayed in your bar. These pieces that generate the content to be displayed in your bar. These
@ -679,8 +660,6 @@ main = xmonad
$ myConfig $ myConfig
``` ```
---
_IF YOU ARE ON A VERSION `< 0.17.0`_: `xmobar` has a similar definition, _IF YOU ARE ON A VERSION `< 0.17.0`_: `xmobar` has a similar definition,
relying on `statusBar` alone: `xmobar = statusBar "xmobar" xmobarPP relying on `statusBar` alone: `xmobar = statusBar "xmobar" xmobarPP
toggleStrutsKey`. Sadly, the `defToggleStrutsKey` function is not yet toggleStrutsKey`. Sadly, the `defToggleStrutsKey` function is not yet
@ -689,6 +668,7 @@ _IF YOU ARE ON A VERSION `< 0.17.0`_: `xmobar` has a similar definition,
``` haskell ``` haskell
main :: IO () main :: IO ()
main = xmonad main = xmonad
. ewmhFullscreen
. ewmh . ewmh
=<< statusBar "xmobar" def toggleStrutsKey myConfig =<< statusBar "xmobar" def toggleStrutsKey myConfig
where where
@ -696,8 +676,6 @@ main = xmonad
toggleStrutsKey XConfig{ modMask = m } = (m, xK_b) toggleStrutsKey XConfig{ modMask = m } = (m, xK_b)
``` ```
---
The `defToggleStrutsKey` here is just the key with which you can toggle The `defToggleStrutsKey` here is just the key with which you can toggle
the bar; it is bound to `M-b`. If you want to change this, you can also the bar; it is bound to `M-b`. If you want to change this, you can also
define your own: define your own:
@ -794,8 +772,6 @@ myXmobarPP = def
lowWhite = xmobarColor "#bbbbbb" "" lowWhite = xmobarColor "#bbbbbb" ""
``` ```
---
_IF YOU ARE ON A VERSION `< 0.17`_: Both `logTitles` and `xmobarBorder` _IF YOU ARE ON A VERSION `< 0.17`_: Both `logTitles` and `xmobarBorder`
are not available yet, so you will have to remove them. As an are not available yet, so you will have to remove them. As an
alternative to `xmobarBorder`, a common way to "mark" the currently alternative to `xmobarBorder`, a common way to "mark" the currently
@ -803,8 +779,6 @@ _IF YOU ARE ON A VERSION `< 0.17`_: Both `logTitles` and `xmobarBorder`
`ppCurrent = wrap (blue "[") (blue "]")` and see if you like it. Also `ppCurrent = wrap (blue "[") (blue "]")` and see if you like it. Also
read the bit about `ppOrder` further down! read the bit about `ppOrder` further down!
---
That's a lot! But don't worry, take a deep breath and remind yourself That's a lot! But don't worry, take a deep breath and remind yourself
of what you read above in the documentation of the [PP record]. Even if of what you read above in the documentation of the [PP record]. Even if
you haven't read the documentation yet, most of the fields should be you haven't read the documentation yet, most of the fields should be
@ -908,10 +882,10 @@ apt-get install nm-applet feh xfce4-power-manager
First, configure xscreensaver how you like it with the First, configure xscreensaver how you like it with the
`xscreensaver-demo` command. Now, we will set these things up in `xscreensaver-demo` command. Now, we will set these things up in
`~/.xinitrc`. If you want to use XMonad with a desktop environment, see `~/.xinitrc` (we could also do most of this in xmonad's `startupHook`,
[Basic Desktop Environment Integration] for how to do this. For a but `~/.xinitrc` is perhaps more standard). If you want to use xmonad
version using XMonad's built in functionality instead, see the [next with a desktop environment, see [Basic Desktop Environment Integration]
section][using-the-startupHook]. for how to do this.
Your `~/.xinitrc` may wind up looking like this: Your `~/.xinitrc` may wind up looking like this:
@ -959,38 +933,6 @@ Mission accomplished!
Of course substitute the wallpaper for one of your own. If you like the Of course substitute the wallpaper for one of your own. If you like the
one used above, you can find it [here](https://i.imgur.com/9MQHuZx.png). one used above, you can find it [here](https://i.imgur.com/9MQHuZx.png).
### Using the `startupHook`
Instead of the `.xinitrc` file, one can also use XMonad's built in
`startupHook` in order to auto start programs. The
[XMonad.Util.SpawnOnce] library is perfect for this use case, allowing
programs to start only once, and not with every invocation of `M-q`!
This requires but a small change in `myConfig`:
``` haskell
-- import XMonad.Util.SpawnOnce (spawnOnce)
myConfig = def
{ modMask = mod4Mask -- Rebind Mod to the Super key
, layoutHook = myLayout -- Use custom layouts
, startupHook = myStartupHook
}
`additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock")
, ("M-C-s", unGrab *> spawn "scrot -s" )
, ("M-f" , spawn "firefox" )
]
myStartupHook :: X ()
myStartupHook = do
spawnOnce "trayer --edge top --align right --SetDockType true \
\--SetPartialStrut true --expand true --width 10 \
\--transparent true --tint 0x5f5f5f --height 18"
spawnOnce "feh --bg-fill --no-fehbg ~/.wallpapers/haskell-red-noise.png"
-- … and so on …
```
## Final Touches ## Final Touches
There may be some programs that you don't want xmonad to tile. The There may be some programs that you don't want xmonad to tile. The
@ -1023,9 +965,9 @@ class name to float by defining the following manageHook:
myManageHook = (className =? "Gimp" --> doFloat) myManageHook = (className =? "Gimp" --> doFloat)
``` ```
Say we also want to float all dialog windows. This is easy with the Say we also want to float all dialogs. This is easy with the `isDialog`
`isDialog` function from [XMonad.Hooks.ManageHelpers] (which you should function from [XMonad.Hooks.ManageHelpers] (which you should import) and
import) and a little modification to the `myManageHook` function: a little modification to the `myManageHook` function:
``` haskell ``` haskell
myManageHook :: ManageHook myManageHook :: ManageHook
@ -1047,8 +989,8 @@ myConfig = def
} }
`additionalKeysP` `additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock") [ ("M-S-z", spawn "xscreensaver-command -lock")
, ("M-C-s", unGrab *> spawn "scrot -s" ) , ("M-S-=", unGrab *> spawn "scrot -s" )
, ("M-f" , spawn "firefox" ) , ("M-]" , spawn "firefox" )
] ]
``` ```
@ -1068,9 +1010,6 @@ import XMonad.Hooks.StatusBar.PP
import XMonad.Util.EZConfig import XMonad.Util.EZConfig
import XMonad.Util.Loggers import XMonad.Util.Loggers
-- NOTE: Importing XMonad.Util.Ungrab is only necessary for versions
-- < 0.18.0! For 0.18.0 and up, this is already included in the
-- XMonad import and will generate a warning instead!
import XMonad.Util.Ungrab import XMonad.Util.Ungrab
import XMonad.Layout.Magnifier import XMonad.Layout.Magnifier
@ -1093,8 +1032,8 @@ myConfig = def
} }
`additionalKeysP` `additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock") [ ("M-S-z", spawn "xscreensaver-command -lock")
, ("M-C-s", unGrab *> spawn "scrot -s" ) , ("M-S-=", unGrab *> spawn "scrot -s" )
, ("M-f" , spawn "firefox" ) , ("M-]" , spawn "firefox" )
] ]
myManageHook :: ManageHook myManageHook :: ManageHook
@ -1174,7 +1113,7 @@ Config { overrideRedirect = False
} }
``` ```
For an explanation of the battery commands used above, see xmobar's For an explanation of the battery commands used above, see xmobars
[battery] documentation. [battery] documentation.
You can also specify workspaces in the same way and feed them to xmobar You can also specify workspaces in the same way and feed them to xmobar
@ -1182,15 +1121,13 @@ via the property (e.g. have `"<fn=1>\xf120</fn>"` as one of your
workspace names). workspace names).
As an example how this would look like in a real configuration, you can As an example how this would look like in a real configuration, you can
look at [Liskin's old][liskin-xmobarrc-old], [Liskin's current][liskin-xmobarrc], look at [Liskin's], [slotThe's], or [TheMC47's] xmobar configuration.
[slotThe's][slotThe-xmobarrc], or [TheMC47's][TheMC47-xmobarrc] xmobar Do note that the last two are Haskell-based and thus may be a little
configuration. Do note that the last three are Haskell-based and thus may hard to understand for newcomers.
be a little hard to understand for newcomers.
[liskin-xmobarrc-old]: https://github.com/liskin/dotfiles/blob/75dfc057c33480ee9d3300d4d02fb79a986ef3a5/.xmobarrc [Liskin's]: https://github.com/liskin/dotfiles/blob/home/.xmobarrc
[liskin-xmobarrc]: https://github.com/liskin/dotfiles/blob/home/.xmonad/xmobar.hs [TheMC47's]: https://github.com/TheMC47/dotfiles/tree/master/xmobar/xmobarrc
[TheMC47-xmobarrc]: https://github.com/TheMC47/dotfiles/tree/master/xmobar/xmobarrc [slotThe's]: https://gitlab.com/slotThe/dotfiles/-/blob/master/xmobar/.config/xmobarrc/src/xmobarrc.hs
[slotThe-xmobarrc]: https://gitlab.com/slotThe/dotfiles/-/blob/master/xmobar/.config/xmobarrc/src/xmobarrc.hs
### Renaming Layouts ### Renaming Layouts
@ -1285,7 +1222,7 @@ either :)
[log]: https://ircbrowse.tomsmeding.com/browse/lcxmonad [log]: https://ircbrowse.tomsmeding.com/browse/lcxmonad
[EWMH]: https://specifications.freedesktop.org/wm-spec/wm-spec-1.3.html [EWMH]: https://specifications.freedesktop.org/wm-spec/wm-spec-1.3.html
[ICCCM]: https://tronche.com/gui/x/icccm/ [ICCCM]: https://tronche.com/gui/x/icccm/
[webchat]: https://web.libera.chat/#xmonad [webchat]: https://kiwiirc.com/nextclient/irc.libera.chat/?#xmonad
[about xmonad]: https://xmonad.org/about.html [about xmonad]: https://xmonad.org/about.html
[shell variable]: https://www.shellscript.sh/variables1.html [shell variable]: https://www.shellscript.sh/variables1.html
[xmonad-testing]: https://github.com/xmonad/xmonad-testing [xmonad-testing]: https://github.com/xmonad/xmonad-testing
@ -1293,35 +1230,35 @@ either :)
[xmonad guided tour]: https://xmonad.org/tour.html [xmonad guided tour]: https://xmonad.org/tour.html
[xmonad mailing list]: https://mail.haskell.org/mailman/listinfo/xmonad [xmonad mailing list]: https://mail.haskell.org/mailman/listinfo/xmonad
[xmonad's GitHub page]: https://github.com/xmonad/xmonad [xmonad's GitHub page]: https://github.com/xmonad/xmonad
[trayer-padding-icon.sh]: https://codeberg.org/xmobar/xmobar/issues/239#issuecomment-537931 [trayer-padding-icon.sh]: https://github.com/jaor/xmobar/issues/239#issuecomment-233206552
[xmonad-contrib documentation]: https://hackage.haskell.org/package/xmonad-contrib [xmonad-contrib documentation]: https://hackage.haskell.org/package/xmonad-contrib
[GNU Image Manipulation Program]: https://www.gimp.org/ [GNU Image Manipulation Program]: https://www.gimp.org/
[Basic Desktop Environment Integration]: https://wiki.haskell.org/Xmonad/Basic_Desktop_Environment_Integration [Basic Desktop Environment Integration]: https://wiki.haskell.org/Xmonad/Basic_Desktop_Environment_Integration
[Hacks]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-Hacks.html [Hacks]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-Hacks.html
[INSTALL.md]: INSTALL.md
[PP record]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Hooks-DynamicLog.html#t:PP [PP record]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Hooks-DynamicLog.html#t:PP
[INSTALL.md]: INSTALL.md
[XMonad.Config]: https://github.com/xmonad/xmonad/blob/master/src/XMonad/Config.hs [XMonad.Config]: https://github.com/xmonad/xmonad/blob/master/src/XMonad/Config.hs
[XMonad.ManageHook]: https://xmonad.github.io/xmonad-docs/xmonad/XMonad-ManageHook.html
[XMonad.Util.Loggers]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-Loggers.html
[XMonad.Util.EZConfig]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-EZConfig.html
[XMonad.Layout.Renamed]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-Renamed.html
[XMonad.Layout.Magnifier]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-Magnifier.html
[XMonad.Doc.Contributing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Configuring.html [XMonad.Doc.Contributing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Configuring.html
[XMonad.Hooks.EwmhDesktops]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Hooks-EwmhDesktops.html [XMonad.Hooks.EwmhDesktops]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Hooks-EwmhDesktops.html
[XMonad.Hooks.ManageHelpers]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Hooks-ManageHelpers.html
[XMonad.Layout.Magnifier]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-Magnifier.html
[XMonad.Layout.Renamed]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-Renamed.html
[XMonad.Layout.ThreeColumns]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-ThreeColumns.html [XMonad.Layout.ThreeColumns]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Layout-ThreeColumns.html
[XMonad.ManageHook]: https://xmonad.github.io/xmonad-docs/xmonad/XMonad-ManageHook.html [XMonad.Hooks.ManageHelpers]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Hooks-ManageHelpers.html
[XMonad.Util.ClickableWorkspaces]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-ClickableWorkspaces.html [XMonad.Util.ClickableWorkspaces]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-ClickableWorkspaces.html
[XMonad.Util.EZConfig]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-EZConfig.html
[XMonad.Util.Loggers]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-Loggers.html
[XMonad.Util.SpawnOnce]: https://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Util-SpawnOnce.html
[xmobar]: https://codeberg.org/xmobar/xmobar [xmobar]: https://xmobar.org/
[battery]: https://codeberg.org/xmobar/xmobar/src/branch/master/doc/plugins.org#batteryp-dirs-args-refreshrate [battery]: https://github.com/jaor/xmobar/blob/master/doc/plugins.org#batteryp-dirs-args-refreshrate
[xmobar.hs]: https://codeberg.org/xmobar/xmobar/src/branch/master/etc/xmobar.hs [xmobar.hs]: https://github.com/jaor/xmobar/blob/master/examples/xmobar.hs
[Wikipedia page]: https://en.wikipedia.org/wiki/ICAO_airport_code#Prefixes [Wikipedia page]: https://en.wikipedia.org/wiki/ICAO_airport_code#Prefixes
[quick-start.org]: https://codeberg.org/xmobar/xmobar/src/branch/master/doc/quick-start.org#configuration-options [quick-start.org]: https://github.com/jaor/xmobar/blob/master/doc/quick-start.org#configuration-options
[jao's xmobar.hs]: https://codeberg.org/jao/xmobar-config [jao's xmobar.hs]: https://codeberg.org/jao/xmobar-config
[weather monitor]: https://codeberg.org/xmobar/xmobar/src/branch/master/doc/plugins.org#weather-monitors [weather monitor]: https://github.com/jaor/xmobar/blob/master/doc/plugins.org#weather-monitors
[xmobar's `Installation` section]: https://codeberg.org/xmobar/xmobar#installation [xmobar home page]: https://xmobar.org/
[xmobar's `Installation` section]: https://github.com/jaor/xmobar#installation
[Haskell]: https://www.haskell.org/ [Haskell]: https://www.haskell.org/
[trayer-srg]: https://github.com/sargon/trayer-srg [trayer-srg]: https://github.com/sargon/trayer-srg

View File

@ -12,6 +12,3 @@ raw-project
optimization: False optimization: False
package xmonad package xmonad
flags: +pedantic flags: +pedantic
-- avoid --haddock-all which overwrites *-docs.tar.gz with tests docs
haddock-components: libs

109
flake.nix
View File

@ -1,106 +1,27 @@
# This file is maintained by @IvanMalison and @LSLeary (github) # This file is maintained by @IvanMalison (github)
# See xmonad-contrib/NIX.md for an overview of module usage.
{ {
inputs = { inputs = {
flake-utils.url = "github:numtide/flake-utils"; flake-utils.url = github:numtide/flake-utils;
git-ignore-nix.url = "github:hercules-ci/gitignore.nix/master"; git-ignore-nix.url = github:IvanMalison/gitignore.nix/master;
unstable.url = "github:NixOS/nixpkgs/nixos-unstable";
}; };
outputs = { self, flake-utils, nixpkgs, unstable, git-ignore-nix }: outputs = { self, flake-utils, nixpkgs, git-ignore-nix }:
let let
hpath = { prefix ? null, compiler ? null }: overlay = final: prev: {
(if prefix == null then [] else [ prefix ]) ++ haskellPackages = prev.haskellPackages.override (old: {
(if compiler == null overrides = prev.lib.composeExtensions (old.overrides or (_: _: {}))
then [ "haskellPackages" ] (hself: hsuper: {
else [ "haskell" "packages" compiler ] xmonad = hself.callCabal2nix "xmonad" (git-ignore-nix.gitIgnoreSource ./.) { };
);
fromHOL = hol: comp: final: prev: with prev.lib; with attrsets;
let
path = hpath comp;
root = head path;
branch = tail path;
hpkgs' = (getAttrFromPath path prev).override (old: {
overrides = composeExtensions (old.overrides or (_: _: {}))
(hol final prev);
}); });
in { });
${root} = recursiveUpdate prev.${root} (setAttrByPath branch hpkgs'); };
};
hoverlay = final: prev: hself: hsuper:
with prev.haskell.lib.compose; {
xmonad = hself.callCabal2nix "xmonad"
(git-ignore-nix.lib.gitignoreSource ./.) { };
};
defComp = if builtins.pathExists ./comp.nix
then import ./comp.nix
else { };
overlay = fromHOL hoverlay defComp;
overlays = [ overlay ]; 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 str;
example = literalExpression "\"unstable\"";
description = ''
Specify a nested alternative <literal>pkgs</literal> by attrName.
'';
};
compiler = mkOption {
default = null;
type = nullOr str;
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: in flake-utils.lib.eachDefaultSystem (system:
let pkgs = import nixpkgs { inherit system overlays; }; let pkgs = import nixpkgs { inherit system overlays; };
hpkg = pkgs.lib.attrsets.getAttrFromPath (hpath defComp) pkgs;
modifyDevShell =
if builtins.pathExists ./develop.nix
then import ./develop.nix
else _: x: x;
in in
rec { rec {
devShell = hpkg.shellFor (modifyDevShell pkgs { devShell = pkgs.haskellPackages.shellFor {
packages = p: [ p.xmonad ]; packages = p: [ p.xmonad ];
}); };
defaultPackage = hpkg.xmonad; defaultPackage = pkgs.haskellPackages.xmonad;
# An auxiliary NixOS module that modernises the standard xmonad NixOS module }) // { inherit overlay overlays; } ;
# and wrapper script used, replacing them with versions from unstable.
# Currently, due to the NIX_GHC --> XMONAD_GHC env var change, this is
# necessary in order for Mod-q recompilation to work out-of-the-box.
modernise =
let
xmonadModFile = "services/x11/window-managers/xmonad.nix";
unpkgs = import unstable { inherit system; };
replaceWrapper = _: _:
{ xmonad-with-packages = unpkgs.xmonad-with-packages; };
in {
disabledModules = [ xmonadModFile ];
imports = [ (unstable + "/nixos/modules/" + xmonadModFile) ];
nixpkgs.overlays = [ replaceWrapper ];
};
}) // {
inherit hoverlay overlay overlays nixosModule nixosModules;
lib = { inherit hpath fromHOL; };
};
} }

View File

@ -1,24 +1,10 @@
.\" Automatically generated by Pandoc 3.1.3 .\" Automatically generated by Pandoc 2.5
.\" .\"
.\" Define V font for inline verbatim, using C font in formats
.\" that render this, and otherwise B font.
.ie "\f[CB]x\f[]"x" \{\
. ftr V B
. ftr VI BI
. ftr VB B
. ftr VBI BI
.\}
.el \{\
. ftr V CR
. ftr VI CI
. ftr VB CB
. ftr VBI CBI
.\}
.TH "XMONAD" "1" "27 October 2021" "Tiling Window Manager" "" .TH "XMONAD" "1" "27 October 2021" "Tiling Window Manager" ""
.hy .hy
.SH Name .SH Name
.PP .PP
xmonad - Tiling Window Manager xmonad \- Tiling Window Manager
.SH Description .SH Description
.PP .PP
\f[I]xmonad\f[R] is a minimalist tiling window manager for X, written in \f[I]xmonad\f[R] is a minimalist tiling window manager for X, written in
@ -50,27 +36,27 @@ featureful window manager in less than 1200 lines of code, with an
emphasis on correctness and robustness. emphasis on correctness and robustness.
Internal properties of the window manager are checked using a Internal properties of the window manager are checked using a
combination of static guarantees provided by the type system, and combination of static guarantees provided by the type system, and
type-based automated testing. type\-based automated testing.
A benefit of this is that the code is simple to understand, and easy to A benefit of this is that the code is simple to understand, and easy to
modify. modify.
.SH Usage .SH Usage
.PP .PP
\f[I]xmonad\f[R] places each window into a \[lq]workspace\[rq]. \f[I]xmonad\f[R] places each window into a \[lq]workspace\[rq].
Each workspace can have any number of windows, which you can cycle Each workspace can have any number of windows, which you can cycle
though with mod-j and mod-k. though with mod\-j and mod\-k.
Windows are either displayed full screen, tiled horizontally, or tiled Windows are either displayed full screen, tiled horizontally, or tiled
vertically. vertically.
You can toggle the layout mode with mod-space, which will cycle through You can toggle the layout mode with mod\-space, which will cycle through
the available modes. the available modes.
.PP .PP
You can switch to workspace N with mod-N. You can switch to workspace N with mod\-N.
For example, to switch to workspace 5, you would press mod-5. For example, to switch to workspace 5, you would press mod\-5.
Similarly, you can move the current window to another workspace with Similarly, you can move the current window to another workspace with
mod-shift-N. mod\-shift\-N.
.PP .PP
When running with multiple monitors (Xinerama), each screen has exactly When running with multiple monitors (Xinerama), each screen has exactly
1 workspace visible. 1 workspace visible.
mod-{w,e,r} switch the focus between screens, while shift-mod-{w,e,r} mod\-{w,e,r} switch the focus between screens, while shift\-mod\-{w,e,r}
move the current window to that screen. move the current window to that screen.
When \f[I]xmonad\f[R] starts, workspace 1 is on screen 1, workspace 2 is When \f[I]xmonad\f[R] starts, workspace 1 is on screen 1, workspace 2 is
on screen 2, etc. on screen 2, etc.
@ -81,115 +67,115 @@ and visible workspaces are swapped.
xmonad has several flags which you may pass to the executable. xmonad has several flags which you may pass to the executable.
These flags are: These flags are:
.TP .TP
\[en]recompile .B \[en]recompile
Recompiles your \f[I]xmonad.hs\f[R] configuration Recompiles your \f[I]xmonad.hs\f[R] configuration
.TP .TP
\[en]restart .B \[en]restart
Causes the currently running \f[I]xmonad\f[R] process to restart Causes the currently running \f[I]xmonad\f[R] process to restart
.TP .TP
\[en]replace .B \[en]replace
Replace the current window manager with xmonad Replace the current window manager with xmonad
.TP .TP
\[en]version .B \[en]version
Display version of \f[I]xmonad\f[R] Display version of \f[I]xmonad\f[R]
.TP .TP
\[en]verbose-version .B \[en]verbose\-version
Display detailed version of \f[I]xmonad\f[R] Display detailed version of \f[I]xmonad\f[R]
.SS Default keyboard bindings .SS Default keyboard bindings
.TP .TP
mod-shift-return .B mod\-shift\-return
Launch terminal Launch terminal
.TP .TP
mod-p .B mod\-p
Launch dmenu Launch dmenu
.TP .TP
mod-shift-p .B mod\-shift\-p
Launch gmrun Launch gmrun
.TP .TP
mod-shift-c .B mod\-shift\-c
Close the focused window Close the focused window
.TP .TP
mod-space .B mod\-space
Rotate through the available layout algorithms Rotate through the available layout algorithms
.TP .TP
mod-shift-space .B mod\-shift\-space
Reset the layouts on the current workspace to default Reset the layouts on the current workspace to default
.TP .TP
mod-n .B mod\-n
Resize viewed windows to the correct size Resize viewed windows to the correct size
.TP .TP
mod-tab .B mod\-tab
Move focus to the next window Move focus to the next window
.TP .TP
mod-shift-tab .B mod\-shift\-tab
Move focus to the previous window Move focus to the previous window
.TP .TP
mod-j .B mod\-j
Move focus to the next window Move focus to the next window
.TP .TP
mod-k .B mod\-k
Move focus to the previous window Move focus to the previous window
.TP .TP
mod-m .B mod\-m
Move focus to the master window Move focus to the master window
.TP .TP
mod-return .B mod\-return
Swap the focused window and the master window Swap the focused window and the master window
.TP .TP
mod-shift-j .B mod\-shift\-j
Swap the focused window with the next window Swap the focused window with the next window
.TP .TP
mod-shift-k .B mod\-shift\-k
Swap the focused window with the previous window Swap the focused window with the previous window
.TP .TP
mod-h .B mod\-h
Shrink the master area Shrink the master area
.TP .TP
mod-l .B mod\-l
Expand the master area Expand the master area
.TP .TP
mod-t .B mod\-t
Push window back into tiling Push window back into tiling
.TP .TP
mod-comma .B mod\-comma
Increment the number of windows in the master area Increment the number of windows in the master area
.TP .TP
mod-period .B mod\-period
Deincrement the number of windows in the master area Deincrement the number of windows in the master area
.TP .TP
mod-shift-q .B mod\-shift\-q
Quit xmonad Quit xmonad
.TP .TP
mod-q .B mod\-q
Restart xmonad Restart xmonad
.TP .TP
mod-shift-slash .B mod\-shift\-slash
Run xmessage with a summary of the default keybindings (useful for Run xmessage with a summary of the default keybindings (useful for
beginners) beginners)
.TP .TP
mod-question .B mod\-question
Run xmessage with a summary of the default keybindings (useful for Run xmessage with a summary of the default keybindings (useful for
beginners) beginners)
.TP .TP
mod-[1..9] .B mod\-[1..9]
Switch to workspace N Switch to workspace N
.TP .TP
mod-shift-[1..9] .B mod\-shift\-[1..9]
Move client to workspace N Move client to workspace N
.TP .TP
mod-{w,e,r} .B mod\-{w,e,r}
Switch to physical/Xinerama screens 1, 2, or 3 Switch to physical/Xinerama screens 1, 2, or 3
.TP .TP
mod-shift-{w,e,r} .B mod\-shift\-{w,e,r}
Move client to screen 1, 2, or 3 Move client to screen 1, 2, or 3
.TP .TP
mod-button1 .B mod\-button1
Set the window to floating mode and move by dragging Set the window to floating mode and move by dragging
.TP .TP
mod-button2 .B mod\-button2
Raise the window to the top of the stack Raise the window to the top of the stack
.TP .TP
mod-button3 .B mod\-button3
Set the window to floating mode and resize by dragging Set the window to floating mode and resize by dragging
.SH Examples .SH Examples
.PP .PP
@ -202,26 +188,27 @@ exec xmonad
.SH Customization .SH Customization
.PP .PP
xmonad is customized in your \f[I]xmonad.hs\f[R], and then restarted xmonad is customized in your \f[I]xmonad.hs\f[R], and then restarted
with mod-q. with mod\-q.
You can choose where your configuration file lives by You can choose where your configuration file lives by
.IP "1." 3 .IP "1." 3
Setting \f[V]XMONAD_DATA_DIR,\f[R] \f[V]XMONAD_CONFIG_DIR\f[R], and Setting \f[C]XMONAD_DATA_DIR,\f[R] \f[C]XMONAD_CONFIG_DIR\f[R], and
\f[V]XMONAD_CACHE_DIR\f[R]; \f[I]xmonad.hs\f[R] is then expected to be \f[C]XMONAD_CACHE_DIR\f[R]; \f[I]xmonad.hs\f[R] is then expected to be
in \f[V]XMONAD_CONFIG_DIR\f[R]. in \f[C]XMONAD_CONFIG_DIR\f[R].
.IP "2." 3 .IP "2." 3
Creating \f[I]xmonad.hs\f[R] in \f[I]\[ti]/.xmonad\f[R]. Creating \f[I]xmonad.hs\f[R] in \f[I]\[ti]/.xmonad\f[R].
.IP "3." 3 .IP "3." 3
Creating \f[I]xmonad.hs\f[R] in \f[V]XDG_CONFIG_HOME\f[R]. Creating \f[I]xmonad.hs\f[R] in \f[C]XDG_CONFIG_HOME\f[R].
Note that, in this case, xmonad will use \f[V]XDG_DATA_HOME\f[R] and Note that, in this case, xmonad will use \f[C]XDG_DATA_HOME\f[R] and
\f[V]XDG_CACHE_HOME\f[R] for its data and cache directory respectively. \f[C]XDG_CACHE_HOME\f[R] for its data and cache directory respectively.
.PP .PP
You can find many extensions to the core feature set in the xmonad- You can find many extensions to the core feature set in the xmonad\-
contrib package, available through your package manager or from contrib package, available through your package manager or from
xmonad.org (https://xmonad.org). xmonad.org (https://xmonad.org).
.SS Modular Configuration .SS Modular Configuration
.PP .PP
As of \f[I]xmonad-0.9\f[R], any additional Haskell modules may be placed As of \f[I]xmonad\-0.9\f[R], any additional Haskell modules may be
in \f[I]\[ti]/.xmonad/lib/\f[R] are available in GHC\[cq]s searchpath. placed in \f[I]\[ti]/.xmonad/lib/\f[R] are available in GHC\[cq]s
searchpath.
Hierarchical modules are supported: for example, the file Hierarchical modules are supported: for example, the file
\f[I]\[ti]/.xmonad/lib/XMonad/Stack/MyAdditions.hs\f[R] could contain: \f[I]\[ti]/.xmonad/lib/XMonad/Stack/MyAdditions.hs\f[R] could contain:
.IP .IP
@ -233,7 +220,7 @@ module XMonad.Stack.MyAdditions (function1) where
.fi .fi
.PP .PP
Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that
module was contained within xmonad or xmonad-contrib. module was contained within xmonad or xmonad\-contrib.
.SH Bugs .SH Bugs
.PP .PP
Probably. Probably.

View File

@ -7,227 +7,74 @@
<meta name="author" content="" /> <meta name="author" content="" />
<meta name="dcterms.date" content="2021-10-27" /> <meta name="dcterms.date" content="2021-10-27" />
<title>XMONAD(1) Tiling Window Manager</title> <title>XMONAD(1) Tiling Window Manager</title>
<style> <style type="text/css">
html { code{white-space: pre-wrap;}
color: #1a1a1a; span.smallcaps{font-variant: small-caps;}
background-color: #fdfdfd; span.underline{text-decoration: underline;}
} div.column{display: inline-block; vertical-align: top; width: 50%;}
body { </style>
margin: 0 auto; <style type="text/css">
max-width: 36em; a.sourceLine { display: inline-block; line-height: 1.25; }
padding-left: 50px; a.sourceLine { pointer-events: none; color: inherit; text-decoration: inherit; }
padding-right: 50px; a.sourceLine:empty { height: 1.2em; }
padding-top: 50px; .sourceCode { overflow: visible; }
padding-bottom: 50px; code.sourceCode { white-space: pre; position: relative; }
hyphens: auto; div.sourceCode { margin: 1em 0; }
overflow-wrap: break-word; pre.sourceCode { margin: 0; }
text-rendering: optimizeLegibility; @media screen {
font-kerning: normal; div.sourceCode { overflow: auto; }
} }
@media (max-width: 600px) { @media print {
body { code.sourceCode { white-space: pre-wrap; }
font-size: 0.9em; a.sourceLine { text-indent: -1em; padding-left: 1em; }
padding: 12px; }
} pre.numberSource a.sourceLine
h1 { { position: relative; left: -4em; }
font-size: 1.8em; pre.numberSource a.sourceLine::before
} { content: attr(title);
} position: relative; left: -1em; text-align: right; vertical-align: baseline;
@media print { border: none; pointer-events: all; display: inline-block;
html { -webkit-touch-callout: none; -webkit-user-select: none;
background-color: white; -khtml-user-select: none; -moz-user-select: none;
} -ms-user-select: none; user-select: none;
body { padding: 0 4px; width: 4em;
background-color: transparent; color: #aaaaaa;
color: black; }
font-size: 12pt; pre.numberSource { margin-left: 3em; border-left: 1px solid #aaaaaa; padding-left: 4px; }
} div.sourceCode
p, h2, h3 { { }
orphans: 3; @media screen {
widows: 3; a.sourceLine::before { text-decoration: underline; }
} }
h2, h3, h4 { code span.al { color: #ff0000; font-weight: bold; } /* Alert */
page-break-after: avoid; code span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
} code span.at { color: #7d9029; } /* Attribute */
} code span.bn { color: #40a070; } /* BaseN */
p { code span.bu { } /* BuiltIn */
margin: 1em 0; code span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
} code span.ch { color: #4070a0; } /* Char */
a { code span.cn { color: #880000; } /* Constant */
color: #1a1a1a; code span.co { color: #60a0b0; font-style: italic; } /* Comment */
} code span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
a:visited { code span.do { color: #ba2121; font-style: italic; } /* Documentation */
color: #1a1a1a; code span.dt { color: #902000; } /* DataType */
} code span.dv { color: #40a070; } /* DecVal */
img { code span.er { color: #ff0000; font-weight: bold; } /* Error */
max-width: 100%; code span.ex { } /* Extension */
} code span.fl { color: #40a070; } /* Float */
h1, h2, h3, h4, h5, h6 { code span.fu { color: #06287e; } /* Function */
margin-top: 1.4em; code span.im { } /* Import */
} code span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
h5, h6 { code span.kw { color: #007020; font-weight: bold; } /* Keyword */
font-size: 1em; code span.op { color: #666666; } /* Operator */
font-style: italic; code span.ot { color: #007020; } /* Other */
} code span.pp { color: #bc7a00; } /* Preprocessor */
h6 { code span.sc { color: #4070a0; } /* SpecialChar */
font-weight: normal; code span.ss { color: #bb6688; } /* SpecialString */
} code span.st { color: #4070a0; } /* String */
ol, ul { code span.va { color: #19177c; } /* Variable */
padding-left: 1.7em; code span.vs { color: #4070a0; } /* VerbatimString */
margin-top: 1em; code span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
}
li > ol, li > ul {
margin-top: 0;
}
blockquote {
margin: 1em 0 1em 1.7em;
padding-left: 1em;
border-left: 2px solid #e6e6e6;
color: #606060;
}
code {
font-family: Menlo, Monaco, Consolas, 'Lucida Console', monospace;
font-size: 85%;
margin: 0;
hyphens: manual;
}
pre {
margin: 1em 0;
overflow: auto;
}
pre code {
padding: 0;
overflow: visible;
overflow-wrap: normal;
}
.sourceCode {
background-color: transparent;
overflow: visible;
}
hr {
background-color: #1a1a1a;
border: none;
height: 1px;
margin: 1em 0;
}
table {
margin: 1em 0;
border-collapse: collapse;
width: 100%;
overflow-x: auto;
display: block;
font-variant-numeric: lining-nums tabular-nums;
}
table caption {
margin-bottom: 0.75em;
}
tbody {
margin-top: 0.5em;
border-top: 1px solid #1a1a1a;
border-bottom: 1px solid #1a1a1a;
}
th {
border-top: 1px solid #1a1a1a;
padding: 0.25em 0.5em 0.25em 0.5em;
}
td {
padding: 0.125em 0.5em 0.25em 0.5em;
}
header {
margin-bottom: 4em;
text-align: center;
}
#TOC li {
list-style: none;
}
#TOC ul {
padding-left: 1.3em;
}
#TOC > ul {
padding-left: 0;
}
#TOC a:not(:hover) {
text-decoration: none;
}
code{white-space: pre-wrap;}
span.smallcaps{font-variant: small-caps;}
div.columns{display: flex; gap: min(4vw, 1.5em);}
div.column{flex: auto; overflow-x: auto;}
div.hanging-indent{margin-left: 1.5em; text-indent: -1.5em;}
/* The extra [class] is a hack that increases specificity enough to
override a similar rule in reveal.js */
ul.task-list[class]{list-style: none;}
ul.task-list li input[type="checkbox"] {
font-size: inherit;
width: 0.8em;
margin: 0 0.8em 0.2em -1.6em;
vertical-align: middle;
}
.display.math{display: block; text-align: center; margin: 0.5rem auto;}
/* CSS for syntax highlighting */
pre > code.sourceCode { white-space: pre; position: relative; }
pre > code.sourceCode > span { line-height: 1.25; }
pre > code.sourceCode > span:empty { height: 1.2em; }
.sourceCode { overflow: visible; }
code.sourceCode > span { color: inherit; text-decoration: inherit; }
div.sourceCode { margin: 1em 0; }
pre.sourceCode { margin: 0; }
@media screen {
div.sourceCode { overflow: auto; }
}
@media print {
pre > code.sourceCode { white-space: pre-wrap; }
pre > code.sourceCode > span { text-indent: -5em; padding-left: 5em; }
}
pre.numberSource code
{ counter-reset: source-line 0; }
pre.numberSource code > span
{ position: relative; left: -4em; counter-increment: source-line; }
pre.numberSource code > span > a:first-child::before
{ content: counter(source-line);
position: relative; left: -1em; text-align: right; vertical-align: baseline;
border: none; display: inline-block;
-webkit-touch-callout: none; -webkit-user-select: none;
-khtml-user-select: none; -moz-user-select: none;
-ms-user-select: none; user-select: none;
padding: 0 4px; width: 4em;
color: #aaaaaa;
}
pre.numberSource { margin-left: 3em; border-left: 1px solid #aaaaaa; padding-left: 4px; }
div.sourceCode
{ }
@media screen {
pre > code.sourceCode > span > a:first-child::before { text-decoration: underline; }
}
code span.al { color: #ff0000; font-weight: bold; } /* Alert */
code span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
code span.at { color: #7d9029; } /* Attribute */
code span.bn { color: #40a070; } /* BaseN */
code span.bu { color: #008000; } /* BuiltIn */
code span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
code span.ch { color: #4070a0; } /* Char */
code span.cn { color: #880000; } /* Constant */
code span.co { color: #60a0b0; font-style: italic; } /* Comment */
code span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
code span.do { color: #ba2121; font-style: italic; } /* Documentation */
code span.dt { color: #902000; } /* DataType */
code span.dv { color: #40a070; } /* DecVal */
code span.er { color: #ff0000; font-weight: bold; } /* Error */
code span.ex { } /* Extension */
code span.fl { color: #40a070; } /* Float */
code span.fu { color: #06287e; } /* Function */
code span.im { color: #008000; font-weight: bold; } /* Import */
code span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
code span.kw { color: #007020; font-weight: bold; } /* Keyword */
code span.op { color: #666666; } /* Operator */
code span.ot { color: #007020; } /* Other */
code span.pp { color: #bc7a00; } /* Preprocessor */
code span.sc { color: #4070a0; } /* SpecialChar */
code span.ss { color: #bb6688; } /* SpecialString */
code span.st { color: #4070a0; } /* String */
code span.va { color: #19177c; } /* Variable */
code span.vs { color: #4070a0; } /* VerbatimString */
code span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
</style> </style>
</head> </head>
<body> <body>
@ -236,255 +83,165 @@
<p class="author"></p> <p class="author"></p>
<p class="date">27 October 2021</p> <p class="date">27 October 2021</p>
</header> </header>
<nav id="TOC" role="doc-toc"> <nav id="TOC">
<ul> <ul>
<li><a href="#name" id="toc-name">Name</a></li> <li><a href="#name">Name</a></li>
<li><a href="#description" id="toc-description">Description</a></li> <li><a href="#description">Description</a></li>
<li><a href="#usage" id="toc-usage">Usage</a> <li><a href="#usage">Usage</a><ul>
<ul> <li><a href="#flags">Flags</a></li>
<li><a href="#flags" id="toc-flags">Flags</a></li> <li><a href="#default-keyboard-bindings">Default keyboard bindings</a></li>
<li><a href="#default-keyboard-bindings"
id="toc-default-keyboard-bindings">Default keyboard bindings</a></li>
</ul></li> </ul></li>
<li><a href="#examples" id="toc-examples">Examples</a></li> <li><a href="#examples">Examples</a></li>
<li><a href="#customization" id="toc-customization">Customization</a> <li><a href="#customization">Customization</a><ul>
<ul> <li><a href="#modular-configuration">Modular Configuration</a></li>
<li><a href="#modular-configuration"
id="toc-modular-configuration">Modular Configuration</a></li>
</ul></li> </ul></li>
<li><a href="#bugs" id="toc-bugs">Bugs</a></li> <li><a href="#bugs">Bugs</a></li>
</ul> </ul>
</nav> </nav>
<h1 id="name">Name</h1> <h1 id="name">Name</h1>
<p>xmonad - Tiling Window Manager</p> <p>xmonad - Tiling Window Manager</p>
<h1 id="description">Description</h1> <h1 id="description">Description</h1>
<p><em>xmonad</em> is a minimalist tiling window manager for X, written <p><em>xmonad</em> is a minimalist tiling window manager for X, written in Haskell. Windows are managed using automatic layout algorithms, which can be dynamically reconfigured. At any time windows are arranged so as to maximize the use of screen real estate. All features of the window manager are accessible purely from the keyboard: a mouse is entirely optional. <em>xmonad</em> is configured in Haskell, and custom layout algorithms may be implemented by the user in config files. A principle of <em>xmonad</em> is predictability: the user should know in advance precisely the window arrangement that will result from any action.</p>
in Haskell. Windows are managed using automatic layout algorithms, which <p>By default, <em>xmonad</em> provides three layout algorithms: tall, wide and fullscreen. In tall or wide mode, windows are tiled and arranged to prevent overlap and maximize screen use. Sets of windows are grouped together on virtual screens, and each screen retains its own layout, which may be reconfigured dynamically. Multiple physical monitors are supported via Xinerama, allowing simultaneous display of a number of screens.</p>
can be dynamically reconfigured. At any time windows are arranged so as <p>By utilizing the expressivity of a modern functional language with a rich static type system, <em>xmonad</em> provides a complete, featureful window manager in less than 1200 lines of code, with an emphasis on correctness and robustness. Internal properties of the window manager are checked using a combination of static guarantees provided by the type system, and type-based automated testing. A benefit of this is that the code is simple to understand, and easy to modify.</p>
to maximize the use of screen real estate. All features of the window
manager are accessible purely from the keyboard: a mouse is entirely
optional. <em>xmonad</em> is configured in Haskell, and custom layout
algorithms may be implemented by the user in config files. A principle
of <em>xmonad</em> is predictability: the user should know in advance
precisely the window arrangement that will result from any action.</p>
<p>By default, <em>xmonad</em> provides three layout algorithms: tall,
wide and fullscreen. In tall or wide mode, windows are tiled and
arranged to prevent overlap and maximize screen use. Sets of windows are
grouped together on virtual screens, and each screen retains its own
layout, which may be reconfigured dynamically. Multiple physical
monitors are supported via Xinerama, allowing simultaneous display of a
number of screens.</p>
<p>By utilizing the expressivity of a modern functional language with a
rich static type system, <em>xmonad</em> provides a complete, featureful
window manager in less than 1200 lines of code, with an emphasis on
correctness and robustness. Internal properties of the window manager
are checked using a combination of static guarantees provided by the
type system, and type-based automated testing. A benefit of this is that
the code is simple to understand, and easy to modify.</p>
<h1 id="usage">Usage</h1> <h1 id="usage">Usage</h1>
<p><em>xmonad</em> places each window into a “workspace”. Each workspace <p><em>xmonad</em> places each window into a “workspace”. Each workspace can have any number of windows, which you can cycle though with mod-j and mod-k. Windows are either displayed full screen, tiled horizontally, or tiled vertically. You can toggle the layout mode with mod-space, which will cycle through the available modes.</p>
can have any number of windows, which you can cycle though with mod-j <p>You can switch to workspace N with mod-N. For example, to switch to workspace 5, you would press mod-5. Similarly, you can move the current window to another workspace with mod-shift-N.</p>
and mod-k. Windows are either displayed full screen, tiled horizontally, <p>When running with multiple monitors (Xinerama), each screen has exactly 1 workspace visible. mod-{w,e,r} switch the focus between screens, while shift-mod-{w,e,r} move the current window to that screen. When <em>xmonad</em> starts, workspace 1 is on screen 1, workspace 2 is on screen 2, etc. When switching workspaces to one that is already visible, the current and visible workspaces are swapped.</p>
or tiled vertically. You can toggle the layout mode with mod-space,
which will cycle through the available modes.</p>
<p>You can switch to workspace N with mod-N. For example, to switch to
workspace 5, you would press mod-5. Similarly, you can move the current
window to another workspace with mod-shift-N.</p>
<p>When running with multiple monitors (Xinerama), each screen has
exactly 1 workspace visible. mod-{w,e,r} switch the focus between
screens, while shift-mod-{w,e,r} move the current window to that screen.
When <em>xmonad</em> starts, workspace 1 is on screen 1, workspace 2 is
on screen 2, etc. When switching workspaces to one that is already
visible, the current and visible workspaces are swapped.</p>
<h2 id="flags">Flags</h2> <h2 id="flags">Flags</h2>
<p>xmonad has several flags which you may pass to the executable. These <p>xmonad has several flags which you may pass to the executable. These flags are:</p>
flags are:</p>
<dl> <dl>
<dt>recompile</dt> <dt>recompile</dt>
<dd> <dd>Recompiles your <em>xmonad.hs</em> configuration
Recompiles your <em>xmonad.hs</em> configuration
</dd> </dd>
<dt>restart</dt> <dt>restart</dt>
<dd> <dd>Causes the currently running <em>xmonad</em> process to restart
Causes the currently running <em>xmonad</em> process to restart
</dd> </dd>
<dt>replace</dt> <dt>replace</dt>
<dd> <dd>Replace the current window manager with xmonad
Replace the current window manager with xmonad
</dd> </dd>
<dt>version</dt> <dt>version</dt>
<dd> <dd>Display version of <em>xmonad</em>
Display version of <em>xmonad</em>
</dd> </dd>
<dt>verbose-version</dt> <dt>verbose-version</dt>
<dd> <dd>Display detailed version of <em>xmonad</em>
Display detailed version of <em>xmonad</em>
</dd> </dd>
</dl> </dl>
<h2 id="default-keyboard-bindings">Default keyboard bindings</h2> <h2 id="default-keyboard-bindings">Default keyboard bindings</h2>
<dl> <dl>
<dt>mod-shift-return</dt> <dt>mod-shift-return</dt>
<dd> <dd>Launch terminal
Launch terminal
</dd> </dd>
<dt>mod-p</dt> <dt>mod-p</dt>
<dd> <dd>Launch dmenu
Launch dmenu
</dd> </dd>
<dt>mod-shift-p</dt> <dt>mod-shift-p</dt>
<dd> <dd>Launch gmrun
Launch gmrun
</dd> </dd>
<dt>mod-shift-c</dt> <dt>mod-shift-c</dt>
<dd> <dd>Close the focused window
Close the focused window
</dd> </dd>
<dt>mod-space</dt> <dt>mod-space</dt>
<dd> <dd>Rotate through the available layout algorithms
Rotate through the available layout algorithms
</dd> </dd>
<dt>mod-shift-space</dt> <dt>mod-shift-space</dt>
<dd> <dd>Reset the layouts on the current workspace to default
Reset the layouts on the current workspace to default
</dd> </dd>
<dt>mod-n</dt> <dt>mod-n</dt>
<dd> <dd>Resize viewed windows to the correct size
Resize viewed windows to the correct size
</dd> </dd>
<dt>mod-tab</dt> <dt>mod-tab</dt>
<dd> <dd>Move focus to the next window
Move focus to the next window
</dd> </dd>
<dt>mod-shift-tab</dt> <dt>mod-shift-tab</dt>
<dd> <dd>Move focus to the previous window
Move focus to the previous window
</dd> </dd>
<dt>mod-j</dt> <dt>mod-j</dt>
<dd> <dd>Move focus to the next window
Move focus to the next window
</dd> </dd>
<dt>mod-k</dt> <dt>mod-k</dt>
<dd> <dd>Move focus to the previous window
Move focus to the previous window
</dd> </dd>
<dt>mod-m</dt> <dt>mod-m</dt>
<dd> <dd>Move focus to the master window
Move focus to the master window
</dd> </dd>
<dt>mod-return</dt> <dt>mod-return</dt>
<dd> <dd>Swap the focused window and the master window
Swap the focused window and the master window
</dd> </dd>
<dt>mod-shift-j</dt> <dt>mod-shift-j</dt>
<dd> <dd>Swap the focused window with the next window
Swap the focused window with the next window
</dd> </dd>
<dt>mod-shift-k</dt> <dt>mod-shift-k</dt>
<dd> <dd>Swap the focused window with the previous window
Swap the focused window with the previous window
</dd> </dd>
<dt>mod-h</dt> <dt>mod-h</dt>
<dd> <dd>Shrink the master area
Shrink the master area
</dd> </dd>
<dt>mod-l</dt> <dt>mod-l</dt>
<dd> <dd>Expand the master area
Expand the master area
</dd> </dd>
<dt>mod-t</dt> <dt>mod-t</dt>
<dd> <dd>Push window back into tiling
Push window back into tiling
</dd> </dd>
<dt>mod-comma</dt> <dt>mod-comma</dt>
<dd> <dd>Increment the number of windows in the master area
Increment the number of windows in the master area
</dd> </dd>
<dt>mod-period</dt> <dt>mod-period</dt>
<dd> <dd>Deincrement the number of windows in the master area
Deincrement the number of windows in the master area
</dd> </dd>
<dt>mod-shift-q</dt> <dt>mod-shift-q</dt>
<dd> <dd>Quit xmonad
Quit xmonad
</dd> </dd>
<dt>mod-q</dt> <dt>mod-q</dt>
<dd> <dd>Restart xmonad
Restart xmonad
</dd> </dd>
<dt>mod-shift-slash</dt> <dt>mod-shift-slash</dt>
<dd> <dd>Run xmessage with a summary of the default keybindings (useful for beginners)
Run xmessage with a summary of the default keybindings (useful for
beginners)
</dd> </dd>
<dt>mod-question</dt> <dt>mod-question</dt>
<dd> <dd>Run xmessage with a summary of the default keybindings (useful for beginners)
Run xmessage with a summary of the default keybindings (useful for
beginners)
</dd> </dd>
<dt>mod-[1..9]</dt> <dt>mod-[1..9]</dt>
<dd> <dd>Switch to workspace N
Switch to workspace N
</dd> </dd>
<dt>mod-shift-[1..9]</dt> <dt>mod-shift-[1..9]</dt>
<dd> <dd>Move client to workspace N
Move client to workspace N
</dd> </dd>
<dt>mod-{w,e,r}</dt> <dt>mod-{w,e,r}</dt>
<dd> <dd>Switch to physical/Xinerama screens 1, 2, or 3
Switch to physical/Xinerama screens 1, 2, or 3
</dd> </dd>
<dt>mod-shift-{w,e,r}</dt> <dt>mod-shift-{w,e,r}</dt>
<dd> <dd>Move client to screen 1, 2, or 3
Move client to screen 1, 2, or 3
</dd> </dd>
<dt>mod-button1</dt> <dt>mod-button1</dt>
<dd> <dd>Set the window to floating mode and move by dragging
Set the window to floating mode and move by dragging
</dd> </dd>
<dt>mod-button2</dt> <dt>mod-button2</dt>
<dd> <dd>Raise the window to the top of the stack
Raise the window to the top of the stack
</dd> </dd>
<dt>mod-button3</dt> <dt>mod-button3</dt>
<dd> <dd>Set the window to floating mode and resize by dragging
Set the window to floating mode and resize by dragging
</dd> </dd>
</dl> </dl>
<h1 id="examples">Examples</h1> <h1 id="examples">Examples</h1>
<p>To use xmonad as your window manager add to your <em>~/.xinitrc</em> <p>To use xmonad as your window manager add to your <em>~/.xinitrc</em> file:</p>
file:</p>
<blockquote> <blockquote>
<p>exec xmonad</p> <p>exec xmonad</p>
</blockquote> </blockquote>
<h1 id="customization">Customization</h1> <h1 id="customization">Customization</h1>
<p>xmonad is customized in your <em>xmonad.hs</em>, and then restarted <p>xmonad is customized in your <em>xmonad.hs</em>, and then restarted with mod-q. You can choose where your configuration file lives by</p>
with mod-q. You can choose where your configuration file lives by</p>
<ol type="1"> <ol type="1">
<li>Setting <code>XMONAD_DATA_DIR,</code> <li>Setting <code>XMONAD_DATA_DIR,</code> <code>XMONAD_CONFIG_DIR</code>, and <code>XMONAD_CACHE_DIR</code>; <em>xmonad.hs</em> is then expected to be in <code>XMONAD_CONFIG_DIR</code>.</li>
<code>XMONAD_CONFIG_DIR</code>, and <code>XMONAD_CACHE_DIR</code>;
<em>xmonad.hs</em> is then expected to be in
<code>XMONAD_CONFIG_DIR</code>.</li>
<li>Creating <em>xmonad.hs</em> in <em>~/.xmonad</em>.</li> <li>Creating <em>xmonad.hs</em> in <em>~/.xmonad</em>.</li>
<li>Creating <em>xmonad.hs</em> in <code>XDG_CONFIG_HOME</code>. Note <li>Creating <em>xmonad.hs</em> in <code>XDG_CONFIG_HOME</code>. Note that, in this case, xmonad will use <code>XDG_DATA_HOME</code> and <code>XDG_CACHE_HOME</code> for its data and cache directory respectively.</li>
that, in this case, xmonad will use <code>XDG_DATA_HOME</code> and
<code>XDG_CACHE_HOME</code> for its data and cache directory
respectively.</li>
</ol> </ol>
<p>You can find many extensions to the core feature set in the xmonad- <p>You can find many extensions to the core feature set in the xmonad- contrib package, available through your package manager or from <a href="https://xmonad.org">xmonad.org</a>.</p>
contrib package, available through your package manager or from <a
href="https://xmonad.org">xmonad.org</a>.</p>
<h2 id="modular-configuration">Modular Configuration</h2> <h2 id="modular-configuration">Modular Configuration</h2>
<p>As of <em>xmonad-0.9</em>, any additional Haskell modules may be <p>As of <em>xmonad-0.9</em>, any additional Haskell modules may be placed in <em>~/.xmonad/lib/</em> are available in GHCs searchpath. Hierarchical modules are supported: for example, the file <em>~/.xmonad/lib/XMonad/Stack/MyAdditions.hs</em> could contain:</p>
placed in <em>~/.xmonad/lib/</em> are available in GHCs searchpath. <div class="sourceCode" id="cb1"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb1-1" title="1"><span class="kw">module</span> <span class="dt">XMonad.Stack.MyAdditions</span> (function1) <span class="kw">where</span></a>
Hierarchical modules are supported: for example, the file <a class="sourceLine" id="cb1-2" title="2"> function1 <span class="ot">=</span> <span class="fu">error</span> <span class="st">&quot;function1: Not implemented yet!&quot;</span></a></code></pre></div>
<em>~/.xmonad/lib/XMonad/Stack/MyAdditions.hs</em> could contain:</p> <p>Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that module was contained within xmonad or xmonad-contrib.</p>
<div class="sourceCode" id="cb1"><pre
class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb1-1"><a href="#cb1-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">XMonad.Stack.MyAdditions</span> (function1) <span class="kw">where</span></span>
<span id="cb1-2"><a href="#cb1-2" aria-hidden="true" tabindex="-1"></a> function1 <span class="ot">=</span> <span class="fu">error</span> <span class="st">&quot;function1: Not implemented yet!&quot;</span></span></code></pre></div>
<p>Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that
module was contained within xmonad or xmonad-contrib.</p>
<h1 id="bugs">Bugs</h1> <h1 id="bugs">Bugs</h1>
<p>Probably. If you find any, please report them to the <a <p>Probably. If you find any, please report them to the <a href="https://github.com/xmonad/xmonad/issues">bugtracker</a></p>
href="https://github.com/xmonad/xmonad/issues">bugtracker</a></p>
</body> </body>
</html> </html>

View File

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

View File

@ -1,6 +1,5 @@
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Config -- Module : XMonad.Config
@ -219,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 , ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
-- quit, or restart -- quit, or restart
, ((modMask .|. shiftMask, xK_q ), io exitSuccess) -- %! Quit xmonad , ((modMask .|. shiftMask, xK_q ), io (exitWith 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 , 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) , ((modMask .|. shiftMask, xK_slash ), helpCommand) -- %! Run xmessage with a summary of the default keybindings (useful for beginners)

View File

@ -1,14 +1,6 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,
{-# LANGUAGE DeriveTraversable #-} MultiParamTypeClasses, TypeSynonymInstances, DeriveDataTypeable,
{-# LANGUAGE ExistentialQuantification #-} LambdaCase, NamedFieldPuns, DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ViewPatterns #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
@ -34,7 +26,7 @@ module XMonad.Core (
StateExtension(..), ExtensionClass(..), ConfExtension(..), StateExtension(..), ExtensionClass(..), ConfExtension(..),
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers, runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
withDisplay, withWindowSet, isRoot, runOnWorkspaces, withDisplay, withWindowSet, isRoot, runOnWorkspaces,
getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX, ifM, getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX,
getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName, binFileName, getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName, binFileName,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes, atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes,
ManageHook, Query(..), runQuery, Directories'(..), Directories, getDirectories, ManageHook, Query(..), runQuery, Directories'(..), Directories, getDirectories,
@ -43,21 +35,17 @@ module XMonad.Core (
import XMonad.StackSet hiding (modify) import XMonad.StackSet hiding (modify)
import Prelude import Prelude
import Control.Exception (fromException, try, bracket_, throw, finally, SomeException(..)) import Control.Exception (fromException, try, bracket, bracket_, throw, finally, SomeException(..))
import qualified Control.Exception as E import qualified Control.Exception as E
import Control.Applicative ((<|>), empty) import Control.Applicative ((<|>), empty)
import Control.Monad.Fail import Control.Monad.Fail
import Control.Monad.Fix (fix)
import Control.Monad.State import Control.Monad.State
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad (filterM, guard, void, when)
import Data.Char (isSpace)
import Data.Semigroup import Data.Semigroup
import Data.Traversable (for) import Data.Traversable (for)
import Data.Time.Clock (UTCTime) import Data.Time.Clock (UTCTime)
import Data.Default.Class import Data.Default.Class
import System.Environment (lookupEnv) import Data.List (isInfixOf)
import Data.List (isInfixOf, intercalate, (\\))
import System.FilePath import System.FilePath
import System.IO import System.IO
import System.Info import System.Info
@ -72,8 +60,8 @@ import System.Exit
import Graphics.X11.Xlib import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event) import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event)
import Data.Typeable import Data.Typeable
import Data.List ((\\))
import Data.Maybe (isJust,fromMaybe) import Data.Maybe (isJust,fromMaybe)
import Data.Monoid (Ap(..))
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
@ -168,8 +156,18 @@ newtype ScreenDetail = SD { screenRect :: Rectangle }
-- instantiated on 'XConf' and 'XState' automatically. -- instantiated on 'XConf' and 'XState' automatically.
-- --
newtype X a = X (ReaderT XConf (StateT XState IO) a) newtype X a = X (ReaderT XConf (StateT XState IO) a)
deriving (Functor, Applicative, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf) deriving (Functor, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf)
deriving (Semigroup, Monoid) via Ap X a
instance Applicative X where
pure = return
(<*>) = ap
instance Semigroup a => Semigroup (X a) where
(<>) = liftM2 (<>)
instance (Monoid a) => Monoid (X a) where
mempty = return mempty
mappend = liftM2 mappend
instance Default a => Default (X a) where instance Default a => Default (X a) where
def = return def def = return def
@ -177,10 +175,16 @@ instance Default a => Default (X a) where
type ManageHook = Query (Endo WindowSet) type ManageHook = Query (Endo WindowSet)
newtype Query a = Query (ReaderT Window X a) newtype Query a = Query (ReaderT Window X a)
deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO) deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO)
deriving (Semigroup, Monoid) via Ap Query a
runQuery :: Query a -> Window -> X a runQuery :: Query a -> Window -> X a
runQuery (Query m) = runReaderT m runQuery (Query m) w = runReaderT m w
instance Semigroup a => Semigroup (Query a) where
(<>) = liftM2 (<>)
instance Monoid a => Monoid (Query a) where
mempty = return mempty
mappend = liftM2 mappend
instance Default a => Default (Query a) where instance Default a => Default (Query a) where
def = return def def = return def
@ -197,7 +201,7 @@ catchX job errcase = do
st <- get st <- get
c <- ask c <- ask
(a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of (a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of
Just (_ :: ExitCode) -> throw e Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
_ -> do hPrint stderr e; runX c st errcase _ -> do hPrint stderr e; runX c st errcase
put s' put s'
return a return a
@ -205,12 +209,12 @@ catchX job errcase = do
-- | Execute the argument, catching all exceptions. Either this function or -- | Execute the argument, catching all exceptions. Either this function or
-- 'catchX' should be used at all callsites of user customized code. -- 'catchX' should be used at all callsites of user customized code.
userCode :: X a -> X (Maybe a) userCode :: X a -> X (Maybe a)
userCode a = catchX (Just <$> a) (return Nothing) userCode a = catchX (Just `liftM` a) (return Nothing)
-- | Same as userCode but with a default argument to return instead of using -- | Same as userCode but with a default argument to return instead of using
-- Maybe, provided for convenience. -- Maybe, provided for convenience.
userCodeDef :: a -> X a -> X a userCodeDef :: a -> X a -> X a
userCodeDef defValue a = fromMaybe defValue <$> userCode a userCodeDef defValue a = fromMaybe defValue `liftM` userCode a
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Convenient wrappers to state -- Convenient wrappers to state
@ -231,7 +235,7 @@ withWindowAttributes dpy win f = do
-- | True if the given window is the root window -- | True if the given window is the root window
isRoot :: Window -> X Bool isRoot :: Window -> X Bool
isRoot w = asks $ (w ==) . theRoot isRoot w = (w==) <$> asks theRoot
-- | Wrapper for the common case of atom internment -- | Wrapper for the common case of atom internment
getAtom :: String -> X Atom getAtom :: String -> X Atom
@ -417,13 +421,9 @@ data StateExtension =
data ConfExtension = forall a. Typeable a => ConfExtension a data ConfExtension = forall a. Typeable a => ConfExtension a
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- General utilities -- | General utilities
--
-- | If-then-else lifted to a 'Monad'. -- Lift an 'IO' action into the 'X' monad
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM mb t f = mb >>= \b -> if b then t else f
-- | Lift an 'IO' action into the 'X' monad
io :: MonadIO m => IO a -> m a io :: MonadIO m => IO a -> m a
io = liftIO io = liftIO
@ -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. -- Note this function assumes your locale uses utf8.
spawn :: MonadIO m => String -> m () spawn :: MonadIO m => String -> m ()
spawn x = void $ spawnPID x spawn x = spawnPID x >> return ()
-- | Like 'spawn', but returns the 'ProcessID' of the launched application -- | Like 'spawn', but returns the 'ProcessID' of the launched application
spawnPID :: MonadIO m => String -> m ProcessID spawnPID :: MonadIO m => String -> m ProcessID
@ -451,19 +451,14 @@ xfork x = io . forkProcess . finally nullStdin $ do
x x
where where
nullStdin = do nullStdin = do
#if MIN_VERSION_unix(2,8,0)
fd <- openFd "/dev/null" ReadOnly defaultFileFlags
#else
fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
#endif
dupTo fd stdInput dupTo fd stdInput
closeFd fd closeFd fd
-- | Use @xmessage@ to show information to the user. -- | Use @xmessage@ to show information to the user.
xmessage :: MonadIO m => String -> m () xmessage :: MonadIO m => String -> m ()
xmessage msg = void . xfork $ do xmessage msg = void . xfork $ do
xmessageBin <- fromMaybe "xmessage" <$> liftIO (lookupEnv "XMONAD_XMESSAGE") executeFile "xmessage" True
executeFile xmessageBin True
[ "-default", "okay" [ "-default", "okay"
, "-xrm", "*international:true" , "-xrm", "*international:true"
, "-xrm", "*fontSet:-*-fixed-medium-r-normal-*-18-*-*-*-*-*-*-*,-*-fixed-*-*-*-*-18-*-*-*-*-*-*-*,-*-*-*-*-*-*-18-*-*-*-*-*-*-*" , "-xrm", "*fontSet:-*-fixed-medium-r-normal-*-18-*-*-*-*-*-*-*,-*-fixed-*-*-*-*-18-*-*-*-*-*-*-*,-*-*-*-*-*-*-18-*-*-*-*-*-*-*"
@ -582,32 +577,21 @@ srcFileName, libFileName :: Directories -> FilePath
srcFileName Directories{ cfgDir } = cfgDir </> "xmonad.hs" srcFileName Directories{ cfgDir } = cfgDir </> "xmonad.hs"
libFileName Directories{ cfgDir } = cfgDir </> "lib" libFileName Directories{ cfgDir } = cfgDir </> "lib"
buildScriptFileName, stackYamlFileName, nixFlakeFileName, nixDefaultFileName :: Directories -> FilePath buildScriptFileName, stackYamlFileName :: Directories -> FilePath
buildScriptFileName Directories{ cfgDir } = cfgDir </> "build" buildScriptFileName Directories{ cfgDir } = cfgDir </> "build"
stackYamlFileName Directories{ cfgDir } = cfgDir </> "stack.yaml" stackYamlFileName Directories{ cfgDir } = cfgDir </> "stack.yaml"
nixFlakeFileName Directories{ cfgDir } = cfgDir </> "flake.nix"
nixDefaultFileName Directories{ cfgDir } = cfgDir </> "default.nix"
-- | Compilation method for xmonad configuration. -- | Compilation method for xmonad configuration.
data Compile data Compile = CompileGhc | CompileStackGhc FilePath | CompileScript FilePath
= CompileGhc
| CompileCabal
| CompileStackGhc FilePath
| CompileNixFlake
| CompileNixDefault
| CompileScript FilePath
deriving (Show) deriving (Show)
-- | Detect compilation method by looking for known file names in xmonad -- | Detect compilation method by looking for known file names in xmonad
-- configuration directory. -- configuration directory.
detectCompile :: Directories -> IO Compile detectCompile :: Directories -> IO Compile
detectCompile dirs = detectCompile dirs = tryScript <|> tryStack <|> useGhc
tryScript <|> tryStack <|> tryNixFlake <|> tryNixDefault <|> tryCabal <|> useGhc
where where
buildScript = buildScriptFileName dirs buildScript = buildScriptFileName dirs
stackYaml = stackYamlFileName dirs stackYaml = stackYamlFileName dirs
flakeNix = nixFlakeFileName dirs
defaultNix = nixDefaultFileName dirs
tryScript = do tryScript = do
guard =<< doesFileExist buildScript guard =<< doesFileExist buildScript
@ -621,58 +605,18 @@ detectCompile dirs =
trace $ "Suggested resolution to use it: chmod u+x " <> show buildScript trace $ "Suggested resolution to use it: chmod u+x " <> show buildScript
empty empty
tryNixFlake = do
guard =<< doesFileExist flakeNix
canonNixFlake <- canonicalizePath flakeNix
trace $ "XMonad will use nix flake at " <> show canonNixFlake <> " to recompile"
pure CompileNixFlake
tryNixDefault = do
guard =<< doesFileExist defaultNix
canonNixDefault <- canonicalizePath defaultNix
trace $ "XMonad will use nix file at " <> show canonNixDefault <> " to recompile"
pure CompileNixDefault
tryStack = do tryStack = do
guard =<< doesFileExist stackYaml guard =<< doesFileExist stackYaml
canonStackYaml <- canonicalizePath stackYaml canonStackYaml <- canonicalizePath stackYaml
trace $ "XMonad will use stack ghc --stack-yaml " <> show canonStackYaml <> " to recompile." trace $ "XMonad will use stack ghc --stack-yaml " <> show canonStackYaml <> " to recompile."
pure $ CompileStackGhc canonStackYaml pure $ CompileStackGhc canonStackYaml
tryCabal = let cwd = cfgDir dirs in listCabalFiles cwd >>= \ case
[] -> do
empty
[name] -> do
trace $ "XMonad will use " <> show name <> " to recompile."
pure CompileCabal
_ : _ : _ -> do
trace $ "XMonad will not use cabal, because there are multiple cabal files in " <> show cwd <> "."
empty
useGhc = do useGhc = do
trace $ "XMonad will use ghc to recompile, because none of " trace $ "XMonad will use ghc to recompile, because neither "
<> intercalate ", " <> show buildScript <> " nor " <> show stackYaml <> " exists."
[ show buildScript
, show stackYaml
, show flakeNix
, show defaultNix
] <> " nor a suitable .cabal file exist."
pure CompileGhc pure CompileGhc
listCabalFiles :: FilePath -> IO [FilePath] isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False)
listCabalFiles dir = map (dir </>) . Prelude.filter isCabalFile <$> listFiles dir
isCabalFile :: FilePath -> Bool
isCabalFile file = case splitExtension file of
(name, ".cabal") -> not (null name)
_ -> False
listFiles :: FilePath -> IO [FilePath]
listFiles dir = getDirectoryContents dir >>= filterM (doesFileExist . (dir </>))
-- | Determine whether or not the file found at the provided filepath is executable.
isExecutable :: FilePath -> IO Bool
isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False)
-- | Should we recompile xmonad configuration? Is it newer than the compiled -- | Should we recompile xmonad configuration? Is it newer than the compiled
-- binary? -- binary?
@ -691,15 +635,12 @@ shouldCompile dirs CompileGhc = do
cs <- prep <$> E.catch (getDirectoryContents t) (\(SomeException _) -> return []) cs <- prep <$> E.catch (getDirectoryContents t) (\(SomeException _) -> return [])
ds <- filterM doesDirectoryExist cs ds <- filterM doesDirectoryExist cs
concat . ((cs \\ ds):) <$> mapM allFiles ds concat . ((cs \\ ds):) <$> mapM allFiles ds
shouldCompile _ CompileCabal = return True
shouldCompile dirs CompileStackGhc{} = do shouldCompile dirs CompileStackGhc{} = do
stackYamlT <- getModTime (stackYamlFileName dirs) stackYamlT <- getModTime (stackYamlFileName dirs)
binT <- getModTime (binFileName dirs) binT <- getModTime (binFileName dirs)
if binT < stackYamlT if binT < stackYamlT
then True <$ trace "XMonad recompiling because some files have changed." then True <$ trace "XMonad recompiling because some files have changed."
else shouldCompile dirs CompileGhc else shouldCompile dirs CompileGhc
shouldCompile _dirs CompileNixFlake{} = True <$ trace "XMonad recompiling because flake recompilation is being used."
shouldCompile _dirs CompileNixDefault{} = True <$ trace "XMonad recompiling because nix recompilation is being used."
shouldCompile _dirs CompileScript{} = shouldCompile _dirs CompileScript{} =
True <$ trace "XMonad recompiling because a custom build script is being used." True <$ trace "XMonad recompiling because a custom build script is being used."
@ -710,32 +651,17 @@ getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> r
compile :: Directories -> Compile -> IO ExitCode compile :: Directories -> Compile -> IO ExitCode
compile dirs method = compile dirs method =
bracket_ uninstallSignalHandlers installSignalHandlers $ bracket_ uninstallSignalHandlers installSignalHandlers $
withFile (errFileName dirs) WriteMode $ \err -> do bracket (openFile (errFileName dirs) WriteMode) hClose $ \err -> do
let run = runProc err let run = runProc (cfgDir dirs) err
case method of case method of
CompileGhc -> do CompileGhc ->
ghc <- fromMaybe "ghc" <$> lookupEnv "XMONAD_GHC" run "ghc" ghcArgs
run ghc ghcArgs
CompileCabal -> run "cabal" ["build"] .&&. copyBinary
where
copyBinary :: IO ExitCode
copyBinary = readProc err "cabal" ["-v0", "list-bin", "."] >>= \ case
Left status -> return status
Right (trim -> path) -> copyBinaryFrom path
CompileStackGhc stackYaml -> CompileStackGhc stackYaml ->
run "stack" ["build", "--silent", "--stack-yaml", stackYaml] .&&. run "stack" ["build", "--silent", "--stack-yaml", stackYaml] .&&.
run "stack" ("ghc" : "--stack-yaml" : stackYaml : "--" : ghcArgs) run "stack" ("ghc" : "--stack-yaml" : stackYaml : "--" : ghcArgs)
CompileNixFlake ->
run "nix" ["build"] >>= andCopyFromResultDir
CompileNixDefault ->
run "nix-build" [] >>= andCopyFromResultDir
CompileScript script -> CompileScript script ->
run script [binFileName dirs] run script [binFileName dirs]
where where
cwd :: FilePath
cwd = cfgDir dirs
ghcArgs :: [String]
ghcArgs = [ "--make" ghcArgs = [ "--make"
, "xmonad.hs" , "xmonad.hs"
, "-i" -- only look in @lib@ , "-i" -- only look in @lib@
@ -747,51 +673,13 @@ compile dirs method =
, "-o", binFileName dirs , "-o", binFileName dirs
] ]
andCopyFromResultDir :: ExitCode -> IO ExitCode
andCopyFromResultDir exitCode = do
if exitCode == ExitSuccess then copyFromResultDir else return exitCode
findM :: (Monad m, Foldable t) => (a -> m Bool) -> t a -> m (Maybe a)
findM p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
catchAny :: IO a -> (SomeException -> IO a) -> IO a
catchAny = E.catch
copyFromResultDir :: IO ExitCode
copyFromResultDir = do
let binaryDirectory = cfgDir dirs </> "result" </> "bin"
binFiles <- map (binaryDirectory </>) <$> catchAny (listDirectory binaryDirectory) (\_ -> return [])
mfilepath <- findM isExecutable binFiles
case mfilepath of
Just filepath -> copyBinaryFrom filepath
Nothing -> return $ ExitFailure 1
copyBinaryFrom :: FilePath -> IO ExitCode
copyBinaryFrom filepath = copyFile filepath (binFileName dirs) >> return ExitSuccess
-- waitForProcess =<< System.Process.runProcess, but without closing the err handle -- waitForProcess =<< System.Process.runProcess, but without closing the err handle
runProc :: Handle -> String -> [String] -> IO ExitCode runProc cwd err exe args = do
runProc err exe args = do
(Nothing, Nothing, Nothing, h) <- createProcess_ "runProc" =<< mkProc err exe args
waitForProcess h
readProc :: Handle -> String -> [String] -> IO (Either ExitCode String)
readProc err exe args = do
spec <- mkProc err exe args
(Nothing, Just out, Nothing, h) <- createProcess_ "readProc" spec{ std_out = CreatePipe }
result <- hGetContents out
hPutStr err result >> hFlush err
waitForProcess h >>= \ case
ExitSuccess -> return $ Right result
status -> return $ Left status
mkProc :: Handle -> FilePath -> [FilePath] -> IO CreateProcess
mkProc err exe args = do
hPutStrLn err $ unwords $ "$" : exe : args hPutStrLn err $ unwords $ "$" : exe : args
hFlush err hFlush err
return (proc exe args){ cwd = Just cwd, std_err = UseHandle err } (_, _, _, h) <- createProcess_ "runProc" (proc exe args){ cwd = Just cwd, std_err = UseHandle err }
waitForProcess h
(.&&.) :: Monad m => m ExitCode -> m ExitCode -> m ExitCode
cmd1 .&&. cmd2 = cmd1 >>= \case cmd1 .&&. cmd2 = cmd1 >>= \case
ExitSuccess -> cmd2 ExitSuccess -> cmd2
e -> pure e e -> pure e
@ -891,6 +779,3 @@ uninstallSignalHandlers = io $ do
installHandler openEndedPipe Default Nothing installHandler openEndedPipe Default Nothing
installHandler sigCHLD Default Nothing installHandler sigCHLD Default Nothing
return () return ()
trim :: String -> String
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace

View File

@ -1,6 +1,4 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable, LambdaCase, MultiWayIf #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- | -- |
@ -41,7 +39,7 @@ import Data.Maybe (fromMaybe)
data Resize = Shrink | Expand data Resize = Shrink | Expand
-- | Increase the number of clients in the master pane. -- | Increase the number of clients in the master pane.
newtype IncMasterN = IncMasterN Int data IncMasterN = IncMasterN !Int
instance Message Resize instance Message Resize
instance Message IncMasterN instance Message IncMasterN
@ -62,13 +60,9 @@ data Tall a = Tall { tallNMaster :: !Int -- ^ The default number o
-- a nice pure layout, lots of properties for the layout, and its messages, in Properties.hs -- a nice pure layout, lots of properties for the layout, and its messages, in Properties.hs
instance LayoutClass Tall a where instance LayoutClass Tall a where
pureLayout (Tall nmaster _ frac) r s pureLayout (Tall nmaster _ frac) r s = zip ws rs
| frac == 0 = drop nmaster layout
| frac == 1 = take nmaster layout
| otherwise = layout
where ws = W.integrate s where ws = W.integrate s
rs = tile frac r nmaster (length ws) rs = tile frac r nmaster (length ws)
layout = zip ws rs
pureMessage (Tall nmaster delta frac) m = pureMessage (Tall nmaster delta frac) m =
msum [fmap resize (fromMessage m) msum [fmap resize (fromMessage m)
@ -205,8 +199,8 @@ choose (Choose d l r) d' ml mr = f lr
(CL, CR) -> (hide l' , return r') (CL, CR) -> (hide l' , return r')
(CR, CL) -> (return l', hide r' ) (CR, CL) -> (return l', hide r' )
(_ , _ ) -> (return l', return r') (_ , _ ) -> (return l', return r')
f (x,y) = Just <$> liftM2 (Choose d') x y f (x,y) = fmap Just $ liftM2 (Choose d') x y
hide x = fromMaybe x <$> handle x Hide hide x = fmap (fromMaybe x) $ handle x Hide
instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
runLayout (W.Workspace i (Choose CL l r) ms) = runLayout (W.Workspace i (Choose CL l r) ms) =

View File

@ -1,6 +1,4 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, NamedFieldPuns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Main -- Module : XMonad.Main
@ -15,18 +13,17 @@
-- --
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonad.Main (xmonad, buildLaunch, launch) where module XMonad.Main (xmonad, launch) where
import System.Locale.SetLocale import System.Locale.SetLocale
import qualified Control.Exception as E import qualified Control.Exception as E
import Data.Bits import Data.Bits
import Data.List ((\\)) import Data.List ((\\))
import Data.Foldable (traverse_) import Data.Function
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.State import Control.Monad.State
import Control.Monad (filterM, guard, unless, void, when, forever)
import Data.Maybe (fromMaybe, isJust) import Data.Maybe (fromMaybe, isJust)
import Data.Monoid (getAll) import Data.Monoid (getAll)
@ -90,14 +87,14 @@ usage :: IO ()
usage = do usage = do
self <- getProgName self <- getProgName
putStr . unlines $ putStr . unlines $
[ "Usage: " <> self <> " [OPTION]" concat ["Usage: ", self, " [OPTION]"] :
, "Options:" "Options:" :
, " --help Print this message" " --help Print this message" :
, " --version Print the version number" " --version Print the version number" :
, " --recompile Recompile your xmonad.hs" " --recompile Recompile your xmonad.hs" :
, " --replace Replace the running window manager with xmonad" " --replace Replace the running window manager with xmonad" :
, " --restart Request a running xmonad process to restart" " --restart Request a running xmonad process to restart" :
] []
-- | Build the xmonad configuration file with ghc, then execute it. -- | Build the xmonad configuration file with ghc, then execute it.
-- If there are no errors, this function does not return. An -- If there are no errors, this function does not return. An
@ -131,6 +128,25 @@ buildLaunch dirs = do
args <- getArgs args <- getArgs
executeFile bin False args Nothing executeFile bin False args Nothing
sendRestart :: IO ()
sendRestart = do
dpy <- openDisplay ""
rw <- rootWindow dpy $ defaultScreen dpy
xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent' e rw xmonad_restart 32 []
sendEvent dpy rw False structureNotifyMask e
sync dpy False
-- | a wrapper for 'replace'
sendReplace :: IO ()
sendReplace = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
replace dpy dflt rootw
-- | Entry point into xmonad for custom builds. -- | Entry point into xmonad for custom builds.
-- --
-- This function isn't meant to be called by the typical xmonad user -- This function isn't meant to be called by the typical xmonad user
@ -177,12 +193,12 @@ launch initxmc drs = do
xinesc <- getCleanedScreenInfo dpy xinesc <- getCleanedScreenInfo dpy
nbc <- do v <- initColor dpy $ normalBorderColor xmc nbc <- do v <- initColor dpy $ normalBorderColor xmc
Just nbc_ <- initColor dpy $ normalBorderColor Default.def ~(Just nbc_) <- initColor dpy $ normalBorderColor Default.def
return (fromMaybe nbc_ v) return (fromMaybe nbc_ v)
fbc <- do v <- initColor dpy $ focusedBorderColor xmc 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) return (fromMaybe fbc_ v)
hSetBuffering stdout NoBuffering hSetBuffering stdout NoBuffering
@ -226,7 +242,7 @@ launch initxmc drs = do
let extst = maybe M.empty extensibleState serializedSt let extst = maybe M.empty extensibleState serializedSt
modify (\s -> s {extensibleState = extst}) modify (\s -> s {extensibleState = extst})
cacheNumlockMask setNumlockMask
grabKeys grabKeys
grabButtons grabButtons
@ -314,7 +330,7 @@ handle e@(DestroyWindowEvent {ev_window = w}) = do
-- it is synthetic or we are not expecting an unmap notification from a window. -- 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 handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap) e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
if synthetic || e == 0 if (synthetic || e == 0)
then unmanage w then unmanage w
else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) }) else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) })
where mpred 1 = Nothing where mpred 1 = Nothing
@ -324,7 +340,7 @@ handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient
handle e@(MappingNotifyEvent {}) = do handle e@(MappingNotifyEvent {}) = do
io $ refreshKeyboardMapping e io $ refreshKeyboardMapping e
when (ev_request e `elem` [mappingKeyboard, mappingModifier]) $ do when (ev_request e `elem` [mappingKeyboard, mappingModifier]) $ do
cacheNumlockMask setNumlockMask
grabKeys grabKeys
-- handle button release, which may finish dragging. -- handle button release, which may finish dragging.
@ -412,7 +428,7 @@ handle event@(PropertyEvent { ev_event_type = t, ev_atom = a })
handle e@ClientMessageEvent { ev_message_type = mt } = do handle e@ClientMessageEvent { ev_message_type = mt } = do
a <- getAtom "XMONAD_RESTART" a <- getAtom "XMONAD_RESTART"
if mt == a if (mt == a)
then restart "xmonad" True then restart "xmonad" True
else broadcastMessage e else broadcastMessage e
@ -443,14 +459,38 @@ scan dpy rootw = do
skip :: E.SomeException -> IO Bool skip :: E.SomeException -> IO Bool
skip _ = return False 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 -- | Grab the keys back
grabKeys :: X () grabKeys :: X ()
grabKeys = do grabKeys = do
XConf { display = dpy, theRoot = rootw } <- ask 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 io $ ungrabKey dpy anyKey anyModifier rootw
let grab :: (KeyMask, KeyCode) -> X () ks <- asks keyActions
grab (km, kc) = io $ grabKey dpy kc km rootw True grabModeAsync grabModeAsync -- build a map from keysyms to lists of keysyms (doing what
traverse_ grab =<< mkGrabs =<< asks (M.keys . keyActions) -- 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
-- | Grab the buttons -- | Grab the buttons
grabButtons :: X () grabButtons :: X ()
@ -461,4 +501,37 @@ grabButtons = do
io $ ungrabButton dpy anyButton anyModifier rootw io $ ungrabButton dpy anyButton anyModifier rootw
ems <- extraModifiers ems <- extraModifiers
ba <- asks buttonActions 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 ()
replace dpy dflt rootw = do
-- check for other WM
wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False
currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom
when (currentWmSnOwner /= 0) $ do
-- prepare to receive destroyNotify for old WM
selectInput dpy currentWmSnOwner structureNotifyMask
-- create off-screen window
netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do
set_override_redirect attributes True
set_event_mask attributes propertyChangeMask
let screen = defaultScreenOfDisplay dpy
visual = defaultVisualOfScreen screen
attrmask = cWOverrideRedirect .|. cWEventMask
createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes
-- try to acquire wmSnAtom, this should signal the old WM to terminate
xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime
-- SKIPPED: check if we acquired the selection
-- SKIPPED: send client message indicating that we are now the WM
-- wait for old WM to go away
fix $ \again -> do
evt <- allocaXEvent $ \event -> do
windowEvent dpy currentWmSnOwner structureNotifyMask event
get_EventType event
when (evt /= destroyNotify) again

View File

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

View File

@ -1,10 +1,4 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Operations -- Module : XMonad.Operations
@ -24,7 +18,7 @@ module XMonad.Operations (
manage, unmanage, killWindow, kill, isClient, manage, unmanage, killWindow, kill, isClient,
setInitialProperties, setWMState, setWindowBorderWithFallback, setInitialProperties, setWMState, setWindowBorderWithFallback,
hide, reveal, tileWindow, hide, reveal, tileWindow,
setTopFocus, focus, isFixedSizeOrTransient, setTopFocus, focus,
-- * Manage Windows -- * Manage Windows
windows, refresh, rescreen, modifyWindowSet, windowBracket, windowBracket_, clearEvents, getCleanedScreenInfo, windows, refresh, rescreen, modifyWindowSet, windowBracket, windowBracket_, clearEvents, getCleanedScreenInfo,
@ -33,11 +27,10 @@ module XMonad.Operations (
-- * Keyboard and Mouse -- * Keyboard and Mouse
cleanMask, extraModifiers, cleanMask, extraModifiers,
mouseDrag, mouseMoveWindow, mouseResizeWindow, mouseDrag, mouseMoveWindow, mouseResizeWindow,
setButtonGrab, setFocusX, cacheNumlockMask, mkGrabs, unGrab, setButtonGrab, setFocusX,
-- * Messages -- * Messages
sendMessage, broadcastMessage, sendMessageWithNoRefresh, sendMessage, broadcastMessage, sendMessageWithNoRefresh,
sendRestart, sendReplace,
-- * Save and Restore State -- * Save and Restore State
StateFile (..), writeStateToFile, readStateFile, restart, StateFile (..), writeStateToFile, readStateFile, restart,
@ -64,17 +57,15 @@ import qualified XMonad.StackSet as W
import Data.Maybe import Data.Maybe
import Data.Monoid (Endo(..),Any(..)) import Data.Monoid (Endo(..),Any(..))
import Data.List (nub, (\\), find) import Data.List (nub, (\\), find)
import Data.Bits ((.|.), (.&.), complement, setBit, testBit) import Data.Bits ((.|.), (.&.), complement, testBit)
import Data.Function (on) import Data.Function (on)
import Data.Ratio import Data.Ratio
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Control.Arrow (second) import Control.Arrow (second)
import Control.Monad.Fix (fix)
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.State import Control.Monad.State
import Control.Monad (forM, forM_, guard, join, unless, void, when)
import qualified Control.Exception as C import qualified Control.Exception as C
import System.IO import System.IO
@ -87,16 +78,6 @@ import Graphics.X11.Xlib.Extras
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Window manager operations -- 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. -- Add a new window to be managed in the current workspace.
-- Bring it into focus. -- Bring it into focus.
@ -106,8 +87,10 @@ isFixedSizeOrTransient d w = do
-- --
manage :: Window -> X () manage :: Window -> X ()
manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
sh <- io $ getWMNormalHints d w
shouldFloat <- isFixedSizeOrTransient d w let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh
isTransient <- isJust <$> io (getTransientForHint d w)
rr <- snd `fmap` floatLocation w rr <- snd `fmap` floatLocation w
-- ensure that float windows don't go over the edge of the screen -- ensure that float windows don't go over the edge of the screen
@ -115,8 +98,8 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
= W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h = W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h
adjust r = r adjust r = r
f ws | shouldFloat = W.float w (adjust rr) . W.insertUp w . W.view i $ ws f ws | isFixedSize || isTransient = W.float w (adjust rr) . W.insertUp w . W.view i $ ws
| otherwise = W.insertUp w ws | otherwise = W.insertUp w ws
where i = W.tag $ W.workspace $ W.current ws where i = W.tag $ W.workspace $ W.current ws
mh <- asks (manageHook . config) mh <- asks (manageHook . config)
@ -145,7 +128,7 @@ killWindow w = withDisplay $ \d -> do
setEventType ev clientMessage setEventType ev clientMessage
setClientMessageEvent ev w wmprot 32 wmdelt currentTime setClientMessageEvent ev w wmprot 32 wmdelt currentTime
sendEvent d w False noEventMask ev sendEvent d w False noEventMask ev
else void (killClient d w) else killClient d w >> return ()
-- | Kill the currently focused client. -- | Kill the currently focused client.
kill :: X () kill :: X ()
@ -196,8 +179,7 @@ windows f = do
let m = W.floating ws let m = W.floating ws
flt = [(fw, scaleRationalRect viewrect r) flt = [(fw, scaleRationalRect viewrect r)
| fw <- filter (`M.member` m) (W.index this) | fw <- filter (flip M.member m) (W.index this)
, fw `notElem` vis
, Just r <- [M.lookup fw m]] , Just r <- [M.lookup fw m]]
vs = flt ++ rs vs = flt ++ rs
@ -223,7 +205,7 @@ windows f = do
-- all windows that are no longer in the windowset are marked as -- all windows that are no longer in the windowset are marked as
-- withdrawn, it is important to do this after the above, otherwise 'hide' -- withdrawn, it is important to do this after the above, otherwise 'hide'
-- will overwrite withdrawnState with iconicState -- will overwrite withdrawnState with iconicState
mapM_ (`setWMState` withdrawnState) (W.allWindows old \\ W.allWindows ws) mapM_ (flip setWMState withdrawnState) (W.allWindows old \\ W.allWindows ws)
isMouseFocused <- asks mouseFocused isMouseFocused <- asks mouseFocused
unless isMouseFocused $ clearEvents enterWindowMask unless isMouseFocused $ clearEvents enterWindowMask
@ -239,8 +221,8 @@ windowBracket :: (a -> Bool) -> X a -> X a
windowBracket p action = withWindowSet $ \old -> do windowBracket p action = withWindowSet $ \old -> do
a <- action a <- action
when (p a) . withWindowSet $ \new -> do when (p a) . withWindowSet $ \new -> do
modifyWindowSet $ const old modifyWindowSet $ \_ -> old
windows $ const new windows $ \_ -> new
return a return a
-- | Perform an @X@ action. If it returns @Any True@, unwind the -- | Perform an @X@ action. If it returns @Any True@, unwind the
@ -268,11 +250,12 @@ setWindowBorderWithFallback :: Display -> Window -> String -> Pixel -> X ()
setWindowBorderWithFallback dpy w color basic = io $ setWindowBorderWithFallback dpy w color basic = io $
C.handle fallback $ do C.handle fallback $ do
wa <- getWindowAttributes dpy w wa <- getWindowAttributes dpy w
pixel <- setPixelSolid . color_pixel . fst <$> allocNamedColor dpy (wa_colormap wa) color pixel <- color_pixel . fst <$> allocNamedColor dpy (wa_colormap wa) color
setWindowBorder dpy w pixel setWindowBorder dpy w pixel
where where
fallback :: C.SomeException -> IO () fallback :: C.SomeException -> IO ()
fallback _ = setWindowBorder dpy w basic fallback e = do hPrint stderr e >> hFlush stderr
setWindowBorder dpy w basic
-- | Hide a window by unmapping it and setting Iconified. -- | Hide a window by unmapping it and setting Iconified.
hide :: Window -> X () hide :: Window -> X ()
@ -359,16 +342,15 @@ getCleanedScreenInfo = io . fmap nubScreens . getScreenInfo
-- | The screen configuration may have changed (due to -- xrandr), -- | The screen configuration may have changed (due to -- xrandr),
-- update the state and refresh the screen, and reset the gap. -- update the state and refresh the screen, and reset the gap.
rescreen :: X () rescreen :: X ()
rescreen = withDisplay getCleanedScreenInfo >>= \case rescreen = do
[] -> trace "getCleanedScreenInfo returned []" xinesc <- withDisplay getCleanedScreenInfo
xinesc:xinescs ->
windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } -> windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
let (xs, ys) = splitAt (length xinescs) (map W.workspace vs ++ hs) let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs
a = W.Screen (W.workspace v) 0 (SD xinesc) (a:as) = zipWith3 W.Screen xs [0..] $ map SD xinesc
as = zipWith3 W.Screen xs [1..] $ map SD xinescs in ws { W.current = a
in ws { W.current = a , W.visible = as
, W.visible = as , W.hidden = ys }
, W.hidden = ys }
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
@ -427,7 +409,7 @@ setFocusX w = withWindowSet $ \ws -> do
currevt <- asks currentEvent currevt <- asks currentEvent
let inputHintSet = wmh_flags hints `testBit` inputHintBit 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 io $ do setInputFocus dpy w revertToPointerRoot 0
when (wmtf `elem` protocols) $ when (wmtf `elem` protocols) $
io $ allocaXEvent $ \ev -> do io $ allocaXEvent $ \ev -> do
@ -435,68 +417,12 @@ setFocusX w = withWindowSet $ \ws -> do
setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt
sendEvent dpy w False noEventMask ev sendEvent dpy w False noEventMask ev
where event_time ev = where event_time ev =
if ev_event_type ev `elem` timedEvents then if (ev_event_type ev) `elem` timedEvents then
ev_time ev ev_time ev
else else
currentTime currentTime
timedEvents = [ keyPress, keyRelease, buttonPress, buttonRelease, enterNotify, leaveNotify, selectionRequest ] 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
]
-- | Release XMonad's keyboard grab, so other grabbers can do their thing.
--
-- Start a keyboard action with this if it is going to run something
-- that needs to do a keyboard, pointer, or server grab. For example,
--
-- > , ((modm .|. controlMask, xK_p), unGrab >> spawn "scrot")
--
-- (Other examples are certain screen lockers and "gksu".)
-- This avoids needing to insert a pause/sleep before running the
-- command.
--
-- XMonad retains the keyboard grab during key actions because if they
-- use a submap, they need the keyboard to be grabbed, and if they had
-- to assert their own grab then the asynchronous nature of X11 allows
-- race conditions between XMonad, other clients, and the X server that
-- would cause keys to sometimes be "leaked" to the focused window.
unGrab :: X ()
unGrab = withDisplay $ \d -> io $ do
ungrabKeyboard d currentTime
ungrabPointer d currentTime
sync d False
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Message handling -- Message handling
@ -504,7 +430,7 @@ unGrab = withDisplay $ \d -> io $ do
-- layout the windows, in which case changes are handled through a refresh. -- layout the windows, in which case changes are handled through a refresh.
sendMessage :: Message a => a -> X () sendMessage :: Message a => a -> X ()
sendMessage a = windowBracket_ $ do sendMessage a = windowBracket_ $ do
w <- gets $ W.workspace . W.current . windowset w <- W.workspace . W.current <$> gets windowset
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
whenJust ml' $ \l' -> whenJust ml' $ \l' ->
modifyWindowSet $ \ws -> ws { W.current = (W.current ws) modifyWindowSet $ \ws -> ws { W.current = (W.current ws)
@ -539,62 +465,9 @@ updateLayout i ml = whenJust ml $ \l ->
-- | Set the layout of the currently viewed workspace. -- | Set the layout of the currently viewed workspace.
setLayout :: Layout Window -> X () setLayout :: Layout Window -> X ()
setLayout l = do 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) 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 } } }
-- | Signal xmonad to restart itself.
sendRestart :: IO ()
sendRestart = do
dpy <- openDisplay ""
rw <- rootWindow dpy $ defaultScreen dpy
xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent' e rw xmonad_restart 32 []
sendEvent dpy rw False structureNotifyMask e
sync dpy False
-- | Signal compliant window managers to exit.
sendReplace :: IO ()
sendReplace = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
replace dpy dflt rootw
-- | Signal compliant window managers to exit.
replace :: Display -> ScreenNumber -> Window -> IO ()
replace dpy dflt rootw = do
-- check for other WM
wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False
currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom
when (currentWmSnOwner /= 0) $ do
-- prepare to receive destroyNotify for old WM
selectInput dpy currentWmSnOwner structureNotifyMask
-- create off-screen window
netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do
set_override_redirect attributes True
set_event_mask attributes propertyChangeMask
let screen = defaultScreenOfDisplay dpy
visual = defaultVisualOfScreen screen
attrmask = cWOverrideRedirect .|. cWEventMask
createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes
-- try to acquire wmSnAtom, this should signal the old WM to terminate
xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime
-- SKIPPED: check if we acquired the selection
-- SKIPPED: send client message indicating that we are now the WM
-- wait for old WM to go away
fix $ \again -> do
evt <- allocaXEvent $ \event -> do
windowEvent dpy currentWmSnOwner structureNotifyMask event
get_EventType event
when (evt /= destroyNotify) again
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Utilities -- Utilities
@ -631,14 +504,10 @@ cleanMask km = do
nlm <- gets numberlockMask nlm <- gets numberlockMask
return (complement (nlm .|. lockMask) .&. km) 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. -- | Get the 'Pixel' value for a named color.
initColor :: Display -> String -> IO (Maybe Pixel) initColor :: Display -> String -> IO (Maybe Pixel)
initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $ initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $
Just . setPixelSolid . color_pixel . fst <$> allocNamedColor dpy colormap c (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
where colormap = defaultColormap dpy (defaultScreen dpy) where colormap = defaultColormap dpy (defaultScreen dpy)
------------------------------------------------------------------------ ------------------------------------------------------------------------
@ -658,7 +527,7 @@ writeStateToFile = do
maybeShow _ = Nothing maybeShow _ = Nothing
wsData = W.mapLayout show . windowset wsData = W.mapLayout show . windowset
extState = mapMaybe maybeShow . M.toList . extensibleState extState = catMaybes . map maybeShow . M.toList . extensibleState
path <- asks $ stateFileName . directories path <- asks $ stateFileName . directories
stateData <- gets (\s -> StateFile (wsData s) (extState s)) stateData <- gets (\s -> StateFile (wsData s) (extState s))
@ -721,12 +590,12 @@ floatLocation w =
catchX go $ do catchX go $ do
-- Fallback solution if `go' fails. Which it might, since it -- Fallback solution if `go' fails. Which it might, since it
-- calls `getWindowAttributes'. -- calls `getWindowAttributes'.
sc <- gets $ W.current . windowset sc <- W.current <$> gets windowset
return (W.screen sc, W.RationalRect 0 0 1 1) return (W.screen sc, W.RationalRect 0 0 1 1)
where go = withDisplay $ \d -> do where fi x = fromIntegral x
go = withDisplay $ \d -> do
ws <- gets windowset ws <- gets windowset
sh <- io $ getWMNormalHints d w
wa <- io $ getWindowAttributes d w wa <- io $ getWindowAttributes d w
let bw = (fromIntegral . wa_border_width) wa let bw = (fromIntegral . wa_border_width) wa
point_sc <- pointScreen (fi $ wa_x wa) (fi $ wa_y wa) point_sc <- pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
@ -741,20 +610,16 @@ floatLocation w =
sr = screenRect . W.screenDetail $ sc sr = screenRect . W.screenDetail $ sc
x = (fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr) x = (fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr)
y = (fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr) y = (fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr)
(width, height) = applySizeHintsContents sh (wa_width wa, wa_height wa) width = fi (wa_width wa + bw*2) % fi (rect_width sr)
rwidth = fi (width + bw*2) % fi (rect_width sr) height = fi (wa_height wa + bw*2) % fi (rect_height sr)
rheight = fi (height + bw*2) % fi (rect_height sr)
-- adjust x/y of unmanaged windows if we ignored or didn't get pointScreen, -- adjust x/y of unmanaged windows if we ignored or didn't get pointScreen,
-- it might be out of bounds otherwise -- it might be out of bounds otherwise
rr = if managed || point_sc `sr_eq` Just sc rr = if managed || point_sc `sr_eq` Just sc
then W.RationalRect x y rwidth rheight then W.RationalRect x y width height
else W.RationalRect (0.5 - rwidth/2) (0.5 - rheight/2) rwidth rheight else W.RationalRect (0.5 - width/2) (0.5 - height/2) width height
return (W.screen sc, rr) 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. -- | Given a point, determine the screen (if any) that contains it.
pointScreen :: Position -> Position pointScreen :: Position -> Position
-> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)) -> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
@ -785,20 +650,14 @@ float w = do
-- | Accumulate mouse motion events -- | Accumulate mouse motion events
mouseDrag :: (Position -> Position -> X ()) -> X () -> X () mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
mouseDrag = mouseDragCursor Nothing mouseDrag f done = do
-- | 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 drag <- gets dragging
case drag of case drag of
Just _ -> return () -- error case? we're already dragging Just _ -> return () -- error case? we're already dragging
Nothing -> do Nothing -> do
XConf { theRoot = root, display = d } <- ask XConf { theRoot = root, display = d } <- ask
io $ do cursor <- maybe (pure none) (createFontCursor d) cursorGlyph io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
grabPointer d root False (buttonReleaseMask .|. pointerMotionMask) grabModeAsync grabModeAsync none none currentTime
grabModeAsync grabModeAsync none cursor currentTime
modify $ \s -> s { dragging = Just (motion, cleanup) } modify $ \s -> s { dragging = Just (motion, cleanup) }
where where
cleanup = do cleanup = do
@ -816,9 +675,7 @@ mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do
(_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w
let ox = fromIntegral ox' let ox = fromIntegral ox'
oy = fromIntegral oy' oy = fromIntegral oy'
mouseDragCursor mouseDrag (\ex ey -> do
(Just xC_fleur)
(\ex ey -> do
io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox))) io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
(fromIntegral (fromIntegral (wa_y wa) + (ey - oy))) (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
float w float w
@ -831,13 +688,12 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
wa <- io $ getWindowAttributes d w wa <- io $ getWindowAttributes d w
sh <- io $ getWMNormalHints d w sh <- io $ getWMNormalHints d w
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
mouseDragCursor mouseDrag (\ex ey -> do
(Just xC_bottom_right_corner)
(\ex ey -> do
io $ resizeWindow d w `uncurry` io $ resizeWindow d w `uncurry`
applySizeHintsContents sh (ex - fromIntegral (wa_x wa), applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
ey - fromIntegral (wa_y wa)) ey - fromIntegral (wa_y wa))
float w) float w)
(float w) (float w)
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
@ -853,7 +709,7 @@ mkAdjust w = withDisplay $ \d -> liftIO $ do
sh <- getWMNormalHints d w sh <- getWMNormalHints d w
wa <- C.try $ getWindowAttributes d w wa <- C.try $ getWindowAttributes d w
case wa of case wa of
Left (_ :: C.SomeException) -> return id Left err -> const (return id) (err :: C.SomeException)
Right wa' -> Right wa' ->
let bw = fromIntegral $ wa_border_width wa' let bw = fromIntegral $ wa_border_width wa'
in return $ applySizeHints bw sh in return $ applySizeHints bw sh

View File

@ -58,8 +58,6 @@ import Data.Foldable (foldr, toList)
import Data.Maybe (listToMaybe,isJust,fromMaybe) import Data.Maybe (listToMaybe,isJust,fromMaybe)
import qualified Data.List as L (deleteBy,find,splitAt,filter,nub) import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
import Data.List ( (\\) ) 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) import qualified Data.Map as M (Map,insert,delete,empty)
-- $intro -- $intro
@ -94,23 +92,21 @@ import qualified Data.Map as M (Map,insert,delete,empty)
-- resulting data structure will share as much of its components with -- resulting data structure will share as much of its components with
-- the old structure as possible. -- the old structure as possible.
-- --
-- <https://mail.haskell.org/pipermail/haskell/2005-April/015769.html Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"> -- Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"
-- --
-- We use the zipper to keep track of the focused workspace and the -- We use the zipper to keep track of the focused workspace and the
-- focused window on each workspace, allowing us to have correct focus -- focused window on each workspace, allowing us to have correct focus
-- by construction. We closely follow Huet's original implementation: -- by construction. We closely follow Huet's original implementation:
-- --
-- <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):549554> -- G. Huet, /Functional Pearl: The Zipper/,
-- 1997, J. Functional Programming 75(5):549-554.
-- and:
-- R. Hinze and J. Jeuring, /Functional Pearl: The Web/.
-- --
-- and -- and Conor McBride's zipper differentiation paper.
-- Another good reference is:
-- --
-- <https://dspace.library.uu.nl/handle/1874/2532 R. Hinze and J. Jeuring, Functional Pearl: Weaving a Web> -- The Zipper, Haskell wikibook
--
-- and
--
-- <http://strictlypositive.org/diff.pdf Conor McBride, The Derivative of a Regular Type is its Type of One-Hole Contexts>.
--
-- Another good reference is: <https://wiki.haskell.org/Zipper The Zipper, Haskell wikibook>
-- $xinerama -- $xinerama
-- Xinerama in X11 lets us view multiple virtual workspaces -- Xinerama in X11 lets us view multiple virtual workspaces
@ -212,11 +208,10 @@ abort x = error $ "xmonad: StackSet: " ++ x
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0. -- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
-- --
new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd
new l (wid:wids) (m:ms) | length ms <= length wids new l wids m | not (null wids) && length m <= length wids && not (null m)
= StackSet cur visi (map ws unseen) M.empty = StackSet cur visi unseen M.empty
where ws i = Workspace i l Nothing where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids
(seen, unseen) = L.splitAt (length ms) wids (cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ]
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 -- now zip up visibles with their screen id
new _ _ _ = abort "non-positive argument to StackSet.new" new _ _ _ = abort "non-positive argument to StackSet.new"
@ -243,7 +238,7 @@ view i s
| otherwise = s -- not a member of the stackset | 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 -- 'Catch'ing this might be hard. Relies on monotonically increasing
-- workspace tags defined in 'new' -- workspace tags defined in 'new'
@ -316,7 +311,7 @@ integrate :: Stack a -> [a]
integrate (Stack x l r) = reverse l ++ x : r 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 (Stack a) -> [a]
integrate' = maybe [] integrate integrate' = maybe [] integrate
@ -348,44 +343,32 @@ filter p (Stack f ls rs) = case L.filter p (f:rs) of
index :: StackSet i l a s sd -> [a] index :: StackSet i l a s sd -> [a]
index = with [] integrate index = with [] integrate
-- | /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 -- /O(1), O(w) on the wrapping case/.
-- @cycle@ on the current stack. The @master@ window and window order --
-- 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,
-- are unaffected by movement of focus. -- are unaffected by movement of focus.
focusUp :: StackSet i l a s sd -> StackSet i l a s sd --
-- 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 = modify' focusUp' 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' 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' 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) swapDown = modify' (reverseStack . swapUp' . reverseStack)
-- | A variant of 'focusUp' with the same asymptotics that works on a -- | Variants of 'focusUp' and 'focusDown' that work on a
-- 'Stack' rather than an entire 'StackSet'. -- 'Stack' rather than an entire 'StackSet'.
focusUp' :: Stack a -> Stack a focusUp', focusDown' :: Stack a -> Stack a
focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs) focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)
focusUp' (Stack t [] rs) = Stack x xs [] focusUp' (Stack t [] rs) = Stack x xs [] where (x:xs) = reverse (t:rs)
where (x :| xs) = NE.reverse (t :| rs) focusDown' = reverseStack . focusUp' . reverseStack
-- | 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 a -> Stack a
swapUp' (Stack t (l:ls) rs) = Stack t ls (l:rs) swapUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)
swapUp' (Stack t [] rs) = Stack t (reverse rs) [] swapUp' (Stack t [] rs) = Stack t (reverse rs) []
@ -539,8 +522,8 @@ sink w s = s { floating = M.delete w (floating s) }
-- Focus stays with the item moved. -- Focus stays with the item moved.
swapMaster :: StackSet i l a s sd -> StackSet i l a s sd swapMaster :: StackSet i l a s sd -> StackSet i l a s sd
swapMaster = modify' $ \c -> case c of swapMaster = modify' $ \c -> case c of
Stack _ [] _ -> c -- already master. Stack _ [] _ -> c -- already master.
Stack t (l:ls) rs -> Stack t [] (xs ++ x : rs) where (x :| xs) = NE.reverse (l :| ls) Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls
-- natural! keep focus, move current to the top, move top to current. -- natural! keep focus, move current to the top, move top to current.
@ -556,8 +539,8 @@ shiftMaster = modify' $ \c -> case c of
-- | /O(s)/. Set focus to the master window. -- | /O(s)/. Set focus to the master window.
focusMaster :: StackSet i l a s sd -> StackSet i l a s sd focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
focusMaster = modify' $ \c -> case c of focusMaster = modify' $ \c -> case c of
Stack _ [] _ -> c Stack _ [] _ -> c
Stack t (l:ls) rs -> Stack x [] (xs ++ t : rs) where (x :| xs) = NE.reverse (l :| ls) Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls
-- --
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------

View File

@ -1,4 +1,4 @@
resolver: lts-21.12 resolver: lts-16.22
packages: packages:
- ./ - ./
@ -6,6 +6,13 @@ packages:
extra-deps: extra-deps:
- X11-1.10 - X11-1.10
flags:
xmonad:
# stack doesn't support automatic flags
# https://cabal.readthedocs.io/en/latest/cabal-package.html#resolution-of-conditions-and-flags
# https://github.com/commercialhaskell/stack/issues/1313#issuecomment-157259270
quickcheck-classes: false
nix: nix:
packages: packages:
- zlib - zlib

View File

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

View File

@ -166,16 +166,11 @@ tests =
-- tall layout -- tall layout
,("tile 1 window fullsize", property prop_tile_fullscreen) ,("tile 1 window fullsize", property prop_tile_fullscreen)
,("tile max ratio", property prop_tile_max_ratio)
,("tile min ratio", property prop_tile_min_ratio)
,("tiles never overlap", property prop_tile_non_overlap) ,("tiles never overlap", property prop_tile_non_overlap)
,("split horizontal", property prop_split_horizontal) ,("split horizontal", property prop_split_horizontal)
,("split vertical", property prop_split_vertical) ,("split vertical", property prop_split_vertical)
,("pure layout tall", property prop_purelayout_tall) ,("pure layout tall", property prop_purelayout_tall)
{- Following two test cases should be automatically generated by QuickCheck ideally, but it fails. -}
,("pure layout tall: ratio = 0", property (\n d rect -> prop_purelayout_tall n d 0 rect))
,("pure layout tall: ratio = 1", property (\n d rect -> prop_purelayout_tall n d 1 rect))
,("send shrink tall", property prop_shrink_tall) ,("send shrink tall", property prop_shrink_tall)
,("send expand tall", property prop_expand_tall) ,("send expand tall", property prop_expand_tall)
,("send incmaster tall", property prop_incmaster_tall) ,("send incmaster tall", property prop_incmaster_tall)

View File

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

View File

@ -32,8 +32,8 @@ prop_focusWindow_master (NonNegative n) (x :: T) =
in index (focusWindow (s !! i) x) == index x in index (focusWindow (s !! i) x) == index x
-- shifting focus is trivially reversible -- shifting focus is trivially reversible
prop_focus_left (x :: T) = focusUp (focusDown x) == x prop_focus_left (x :: T) = (focusUp (focusDown x)) == x
prop_focus_right (x :: T) = focusDown (focusUp x) == x prop_focus_right (x :: T) = (focusDown (focusUp x)) == x
-- focus master is idempotent -- focus master is idempotent
prop_focusMaster_idem (x :: T) = focusMaster x == focusMaster (focusMaster x) 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) 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 -- 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) 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) where n = length (index x)
-- prop_rotate_all (x :: T) = f (f x) == f x -- prop_rotate_all (x :: T) = f (f x) == f x

View File

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

View File

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

View File

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

View File

@ -11,9 +11,8 @@ import XMonad.Layout
import Graphics.X11.Xlib.Types (Rectangle(..)) import Graphics.X11.Xlib.Types (Rectangle(..))
import Control.Applicative
import Data.List (sort)
import Data.Maybe import Data.Maybe
import Data.List (sort)
import Data.Ratio import Data.Ratio
------------------------------------------------------------------------ ------------------------------------------------------------------------
@ -28,30 +27,14 @@ prop_tile_non_overlap rect windows nmaster = noOverlaps (tile pct rect nmaster w
where _ = rect :: Rectangle where _ = rect :: Rectangle
pct = 3 % 100 pct = 3 % 100
-- with a ratio of 1, no stack windows are drawn of there is at least
-- one master window around.
prop_tile_max_ratio = extremeRatio 1 drop
-- with a ratio of 0, no master windows are drawn at all if there are
-- any stack windows around.
prop_tile_min_ratio = extremeRatio 0 take
extremeRatio amount getRects rect = do
w@(NonNegative windows) <- arbitrary `suchThat` (> NonNegative 0)
NonNegative nmaster <- arbitrary `suchThat` (< w)
let tiled = tile amount rect nmaster windows
pure $ if nmaster == 0
then prop_tile_non_overlap rect windows nmaster
else all ((== 0) . rect_width) $ getRects nmaster tiled
-- splitting horizontally yields sensible results -- splitting horizontally yields sensible results
prop_split_horizontal (NonNegative n) x = 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 sum (map rect_width xs) == rect_width x
&& &&
all (\s -> rect_height s == rect_height x) xs all (== rect_height x) (map rect_height xs)
&& &&
map rect_x xs == sort (map rect_x xs) (map rect_x xs) == (sort $ map rect_x xs)
where where
xs = splitHorizontally n x xs = splitHorizontally n x
@ -66,20 +49,13 @@ prop_split_vertical (r :: Rational) x =
-- pureLayout works. -- pureLayout works.
prop_purelayout_tall n d r rect = do prop_purelayout_tall n r1 r2 rect = do
x <- (arbitrary :: Gen T) `suchThat` (isJust . peek) x <- (arbitrary :: Gen T) `suchThat` (isJust . peek)
let layout = Tall n d r let layout = Tall n r1 r2
st = fromJust . stack . workspace . current $ x st = fromJust . stack . workspace . current $ x
ts = pureLayout layout rect st ts = pureLayout layout rect st
ntotal = length (index x)
return $ return $
(if r == 0 then length ts == length (index x)
-- (<=) for Bool is the logical implication
(0 <= n && n <= ntotal) <= (length ts == ntotal - n)
else if r == 1 then
(0 <= n && n <= ntotal) <= (length ts == n)
else
length ts == ntotal)
&& &&
noOverlaps (map snd ts) noOverlaps (map snd ts)
&& &&
@ -96,7 +72,7 @@ prop_shrink_tall (NonNegative n) (Positive delta) (NonNegative frac) =
-- remaining fraction should shrink -- remaining fraction should shrink
where where
l1 = Tall n delta frac 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) -- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
@ -117,7 +93,7 @@ prop_expand_tall (NonNegative n)
where where
frac = min 1 (n1 % d1) frac = min 1 (n1 % d1)
l1 = Tall n delta frac 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) -- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
-- what happens when we send an IncMaster message to Tall -- what happens when we send an IncMaster message to Tall
@ -126,7 +102,7 @@ prop_incmaster_tall (NonNegative n) (Positive delta) (NonNegative frac)
delta == delta' && frac == frac' && n' == n + k delta == delta' && frac == frac' && n' == n + k
where where
l1 = Tall n delta frac 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) -- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)

View File

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

View File

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

View File

@ -1,6 +1,6 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Properties.Stack where module Properties.Stack where
import Test.QuickCheck import Test.QuickCheck
@ -11,18 +11,20 @@ import qualified XMonad.StackSet as S (filter)
import Data.Maybe import Data.Maybe
#ifdef VERSION_quickcheck_classes
import Data.Proxy import Data.Proxy
import Test.QuickCheck.Classes ( import Test.QuickCheck.Classes (
Laws (lawsTypeclass, lawsProperties), Proxy1 (Proxy1), Laws (lawsTypeclass, lawsProperties), Proxy1 (Proxy1),
foldableLaws, traversableLaws, foldableLaws, traversableLaws,
) )
#endif
-- The list returned by index should be the same length as the actual -- The list returned by index should be the same length as the actual
-- windows kept in the zipper -- windows kept in the zipper
prop_index_length (x :: T) = prop_index_length (x :: T) =
case stack . workspace . current $ x of case stack . workspace . current $ x of
Nothing -> null (index x) Nothing -> length (index x) == 0
Just it -> length (index x) == length (focus it : up it ++ down it) Just it -> length (index x) == length (focus it : up it ++ down it)
@ -41,7 +43,7 @@ prop_allWindowsMember (NonEmptyWindowsStackSet x) = do
-- which is a key component in this test (together with member). -- which is a key component in this test (together with member).
let ws = allWindows x let ws = allWindows x
-- We know that there are at least 1 window in a NonEmptyWindowsStackSet. -- 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 return $ member (ws!!idx) x
@ -54,11 +56,12 @@ prop_filter_order (x :: T) =
-- differentiate should return Nothing if the list is empty or Just stack, with -- 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. -- the first element of the list is current, and the rest of the list is down.
prop_differentiate xs = prop_differentiate xs =
if null xs then isNothing (differentiate xs) if null xs then differentiate xs == Nothing
else differentiate xs == Just (Stack (head xs) [] (tail xs)) else (differentiate xs) == Just (Stack (head xs) [] (tail xs))
where _ = xs :: [Int] where _ = xs :: [Int]
#ifdef VERSION_quickcheck_classes
-- Check type class laws of 'Data.Foldable.Foldable' and 'Data.Traversable.Traversable'. -- Check type class laws of 'Data.Foldable.Foldable' and 'Data.Traversable.Traversable'.
newtype TestStack a = TestStack (Stack a) newtype TestStack a = TestStack (Stack a)
deriving (Eq, Read, Show, Foldable, Functor) deriving (Eq, Read, Show, Foldable, Functor)
@ -75,3 +78,6 @@ prop_laws_Stack = format (foldableLaws p) <> format (traversableLaws p)
p = Proxy :: Proxy TestStack p = Proxy :: Proxy TestStack
format laws = [ ("Stack: " <> lawsTypeclass laws <> ": " <> name, prop) format laws = [ ("Stack: " <> lawsTypeclass laws <> ": " <> name, prop)
| (name, prop) <- lawsProperties laws ] | (name, prop) <- lawsProperties laws ]
#else
prop_laws_Stack = []
#endif

View File

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

View File

@ -11,8 +11,8 @@ import XMonad.StackSet hiding (filter)
-- swapUp, swapDown, swapMaster: reordiring windows -- swapUp, swapDown, swapMaster: reordiring windows
-- swap is trivially reversible -- swap is trivially reversible
prop_swap_left (x :: T) = swapUp (swapDown x) == x prop_swap_left (x :: T) = (swapUp (swapDown x)) == x
prop_swap_right (x :: T) = swapDown (swapUp x) == x prop_swap_right (x :: T) = (swapDown (swapUp x)) == x
-- TODO swap is reversible -- TODO swap is reversible
-- swap is reversible, but involves moving focus back the window with -- swap is reversible, but involves moving focus back the window with
-- master on it. easy to do with a mouse... -- 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 -- 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 -- = case peek x of
-- Nothing -> True -- Nothing -> True
-- Just f -> focus (stack (workspace $ current (swap x))) == f -- Just f -> focus (stack (workspace $ current (swap x))) == f
prop_swap_left_focus (x :: T) = peek x == peek (swapUp x) prop_swap_left_focus (x :: T) = peek x == (peek $ swapUp x)
prop_swap_right_focus (x :: T) = peek x == peek (swapDown x) prop_swap_right_focus (x :: T) = peek x == (peek $ swapDown x)
-- swap is local -- swap is local
prop_swap_master_local (x :: T) = hidden_spaces x == hidden_spaces (swapMaster x) 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) 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 -- 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) 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) where n = length (index x)
prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x

View File

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

View File

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

View File

@ -1,5 +1,5 @@
name: xmonad name: xmonad
version: 0.18.0.9 version: 0.17.0
synopsis: A tiling window manager synopsis: A tiling window manager
description: xmonad is a tiling window manager for X. Windows are arranged description: xmonad is a tiling window manager for X. Windows are arranged
automatically to tile the screen without gaps or overlap, maximising 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, Jens Petersen, Joey Hess, Jonne Ransijn, Josh Holland, Khudyakov Alexey,
Klaus Weidner, Michael G. Sloan, Mikkel Christiansen, Nicolas Dudebout, Klaus Weidner, Michael G. Sloan, Mikkel Christiansen, Nicolas Dudebout,
Ondřej Súkup, Paul Hebble, Shachaf Ben-Kiki, Siim Põder, Tim McIver, Ondřej Súkup, Paul Hebble, Shachaf Ben-Kiki, Siim Põder, Tim McIver,
Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion, Tony Zorman Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion
maintainer: xmonad@haskell.org maintainer: xmonad@haskell.org
tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.7 || == 9.8.4 || == 9.10.2 || == 9.12.2 tested-with: GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1
category: System category: System
homepage: http://xmonad.org homepage: http://xmonad.org
bug-reports: https://github.com/xmonad/xmonad/issues bug-reports: https://github.com/xmonad/xmonad/issues
@ -54,6 +54,8 @@ flag pedantic
default: False default: False
manual: True manual: True
flag quickcheck-classes
library library
exposed-modules: XMonad exposed-modules: XMonad
XMonad.Config XMonad.Config
@ -65,7 +67,7 @@ library
XMonad.StackSet XMonad.StackSet
other-modules: Paths_xmonad other-modules: Paths_xmonad
hs-source-dirs: src hs-source-dirs: src
build-depends: base >= 4.12 && < 5 build-depends: base >= 4.11 && < 5
, X11 >= 1.10 && < 1.11 , X11 >= 1.10 && < 1.11
, containers , containers
, data-default-class , data-default-class
@ -81,7 +83,7 @@ library
default-language: Haskell2010 default-language: Haskell2010
-- Keep this in sync with the oldest version in 'tested-with' -- Keep this in sync with the oldest version in 'tested-with'
if impl(ghc > 8.6.5) if impl(ghc > 8.4.4)
ghc-options: -Wno-unused-imports ghc-options: -Wno-unused-imports
if flag(pedantic) if flag(pedantic)
@ -94,7 +96,7 @@ executable xmonad
default-language: Haskell2010 default-language: Haskell2010
-- Keep this in sync with the oldest version in 'tested-with' -- Keep this in sync with the oldest version in 'tested-with'
if impl(ghc > 8.6.5) if impl(ghc > 8.4.4)
ghc-options: -Wno-unused-imports ghc-options: -Wno-unused-imports
if flag(pedantic) if flag(pedantic)
@ -123,14 +125,15 @@ test-suite properties
hs-source-dirs: tests hs-source-dirs: tests
build-depends: base build-depends: base
, QuickCheck >= 2 , QuickCheck >= 2
, quickcheck-classes >= 0.4.3
, X11 , X11
, containers , containers
, xmonad , xmonad
default-language: Haskell2010 default-language: Haskell2010
if impl(ghc > 9.8) if flag(quickcheck-classes) && impl(ghc > 8.5)
ghc-options: -Wno-x-partial -- no quickcheck-classes in LTS-12
-- GHC 8.4 and lower needs too much boilerplate (Eq1, Show1, …)
build-depends: quickcheck-classes >= 0.4.3
if flag(pedantic) if flag(pedantic)
ghc-options: -Werror ghc-options: -Werror