Pad and use hyperlinks

Fixes #434

.cirrus.yml

@@ -12,9 +12,12 @@ task:
     GITHUB_WORKSPACE: ${CIRRUS_WORKING_DIR}
     JSON_VERSION: "0.0.7"
     CIRRUS_CLONE_SUBMODULES: true
+    AWS_ACCESS_KEY_ID: ENCRYPTED[3e99c4ac040871f213abd616ec66952d954dc289cdd97772f88e58a74d08a2250133437780fe98b7aedf7ef1fb32f5eb]
+    AWS_SECRET_ACCESS_KEY: ENCRYPTED[5910cfd77a922ff7fc06eeb6a6b9f79d4867863e541f06eb2c4cfecae0613650e3e0588373fa8d9249d295d76cf9cb3b]
+    S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
   install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake
   script:
     - bash .github/scripts/build.sh
     - bash .github/scripts/test.sh
   binaries_artifacts:
-    path: "out/x86_64-portbld-freebsd-ghcup-*"
+    path: "out/*"

.github/scripts/build.sh

@@ -3,60 +3,74 @@
 set -eux
 
 . .github/scripts/prereq.sh
+. .github/scripts/common.sh
 
-if ! command -v ghcup && [ "${RUNNER_OS}" != "FreeBSD" ] ; then
+
-	find "$GHCUP_INSTALL_BASE_PREFIX"
+# ensure ghcup
-	mkdir -p "$GHCUP_BIN"
+if ! command -v ghcup ; then
-	mkdir -p "$GHCUP_BIN"/../cache
+	install_ghcup
-	curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
 fi
 
+# ensure cabal-cache
+if ! cabal-cache version ; then
+	download_cabal_cache "$HOME/.local/bin/cabal-cache"
+fi
+
+# ensure ghc
 if [ "${RUNNER_OS}" != "FreeBSD" ] ; then
-	ghcup install ghc --set --isolate="$HOME/.local"     --force "$GHC_VER"
+	if [ "${DISTRO}" != "Debian" ] ; then # ! armv7 or aarch64 linux
-	ghcup install cabal     --isolate="$HOME/.local/bin" --force "$CABAL_VER"
+		if ! "ghc-${GHC_VER}" --numeric-version ; then
+			ghcup -v install ghc --set --force "$GHC_VER"
+		fi
+		if [ "$(cabal --numeric-version || true)" != "${CABAL_VER}" ] ; then
+			ghcup -v install cabal --force "$CABAL_VER"
+		fi
+		ghc --version
+		cabal --version
+		GHC="ghc-${GHC_VER}"
+	else
+		if [ "$(cabal --numeric-version || true)" != "${CABAL_VER}" ] ; then
+			ghcup -v install cabal --force "$CABAL_VER"
+		fi
+		cabal --version
+		GHC="ghc"
+	fi
+else
 	ghc --version
 	cabal --version
-	GHC="ghc-${GHC_VER}"
-else
 	GHC="ghc"
 fi
 
-git describe --all
+git_describe
 
-ecabal() {
-	cabal "$@"
-}
 
 # build
 ecabal update
 
-
 if [ "${RUNNER_OS}" = "Linux" ] ; then
 	if [ "${ARCH}" = "32" ] ; then
-		ecabal build -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui
+		build_with_cache -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui --enable-tests
 	elif [ "${ARCH}" = "64" ] ; then
-		ecabal build -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui
+		build_with_cache -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui --enable-tests
 	else
-		ecabal build -w "${GHC}" -ftui
+		build_with_cache -w "${GHC}" -ftui --enable-tests
 	fi
 elif [ "${RUNNER_OS}" = "FreeBSD" ] ; then
-	ecabal build -w "${GHC}" --ghc-options='-split-sections' --constraint="zlib +bundled-c-zlib" --constraint="zip +disable-zstd" -ftui
+	build_with_cache -w "${GHC}" --ghc-options='-split-sections' --constraint="zlib +bundled-c-zlib" --constraint="zip +disable-zstd" -ftui --enable-tests
 elif [ "${RUNNER_OS}" = "Windows" ] ; then
-	ecabal build -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static"
+	build_with_cache -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" --enable-tests
 else
-	ecabal build -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui
+	build_with_cache -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui --enable-tests
 fi
 
-mkdir out
+
-binary=$(ecabal new-exec -w "${GHC}" --verbose=0 --offline sh -- -c 'command -v ghcup')
+# set up artifacts
+mkdir -p out
+binary=$(cabal list-bin ghcup)
+binary_test=$(cabal list-bin ghcup-test)
 ver=$("${binary}" --numeric-version)
-if [ "${RUNNER_OS}" = "macOS" ] ; then
+strip_binary "${binary}"
-	strip "${binary}"
-else
-	if [ "${RUNNER_OS}" != "Windows" ] ; then
-		strip -s "${binary}"
-	fi
-fi
 cp "${binary}" "out/${ARTIFACT}-${ver}"
+cp "${binary_test}" "out/test-${ARTIFACT}-${ver}"
 cp ./dist-newstyle/cache/plan.json "out/${ARTIFACT}.plan.json"
 

.github/scripts/common.sh

@@ -0,0 +1,172 @@
+#!/bin/sh
+
+if [ "${RUNNER_OS}" = "Windows" ] ; then
+	ext=".exe"
+else
+	ext=''
+fi
+
+ecabal() {
+	cabal "$@"
+}
+
+sync_from_retry() {
+	if [ "${RUNNER_OS}" != "Windows" ] ; then
+		cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
+	else
+		cabal_store_path="${CABAL_DIR}/store"
+	fi
+
+    sync_from || { sleep 9 ; rm -rf "${cabal_store_path:?}"/* ; sync_from || { sleep 20 ; rm -rf "${cabal_store_path:?}"/* ; sync_from ; } }
+}
+
+sync_from() {
+	if [ "${RUNNER_OS}" != "Windows" ] ; then
+		cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
+	fi
+
+	cabal-cache sync-from-archive \
+		--host-name-override=${S3_HOST} \
+		--host-port-override=443 \
+		--host-ssl-override=True \
+		--region us-west-2 \
+		$([ "${RUNNER_OS}" != "Windows" ] && echo --store-path="$cabal_store_path") \
+		--archive-uri "s3://ghcup-hs/${RUNNER_OS}-${ARCH}-${DISTRO}"
+}
+
+sync_to_retry() {
+    sync_to || { sleep 9 ; sync_to || { sleep 20 ; sync_to ; } }
+}
+
+sync_to() {
+	if [ "${RUNNER_OS}" != "Windows" ] ; then
+		cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
+	fi
+
+	cabal-cache sync-to-archive \
+		--host-name-override=${S3_HOST} \
+		--host-port-override=443 \
+		--host-ssl-override=True \
+		--region us-west-2 \
+		$([ "${RUNNER_OS}" != "Windows" ] && echo --store-path="$cabal_store_path") \
+		--archive-uri "s3://ghcup-hs/${RUNNER_OS}-${ARCH}-${DISTRO}"
+}
+
+raw_eghcup() {
+	"$GHCUP_BIN/ghcup${ext}" -v -c "$@"
+}
+
+eghcup() {
+	if [ "${OS}" = "Windows" ] ; then
+		"$GHCUP_BIN/ghcup${ext}" -c -s "file:/$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$@"
+	else
+		"$GHCUP_BIN/ghcup${ext}" -c -s "file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$@"
+	fi
+}
+
+sha_sum() {
+	if [ "${OS}" = "FreeBSD" ] ; then
+		sha256 "$@"
+	else
+		sha256sum "$@"
+	fi
+
+}
+
+git_describe() {
+	git config --global --get-all safe.directory | grep '^\*$' || git config --global --add safe.directory "*"
+	git describe --always
+}
+
+download_cabal_cache() {
+	(
+	set -e
+	dest="$HOME/.local/bin/cabal-cache"
+    url=""
+	exe=""
+	cd /tmp
+	case "${RUNNER_OS}" in
+		"Linux")
+			case "${ARCH}" in
+				"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/i386-linux-cabal-cache
+					;;
+				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-linux-cabal-cache
+					;;
+				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/aarch64-linux-cabal-cache
+					;;
+				"ARM") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/armv7-linux-cabal-cache
+					;;
+			esac
+			;;
+		"FreeBSD")
+			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-portbld-freebsd-cabal-cache
+			;;
+		"Windows")
+			exe=".exe"
+			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-mingw64-cabal-cache
+			;;
+		"macOS")
+			case "${ARCH}" in
+				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/aarch64-apple-darwin-cabal-cache
+					;;
+				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-apple-darwin-cabal-cache
+					;;
+			esac
+			;;
+	esac
+
+	if [ -n "${url}" ] ; then
+		case "${url##*.}" in
+			"gz")
+				curl -L -o - "${url}" | gunzip > cabal-cache${exe}
+				;;
+			*)
+				curl -o cabal-cache${exe} -L "${url}"
+				;;
+		esac
+		sha_sum cabal-cache${exe}
+		mv "cabal-cache${exe}" "${dest}${exe}"
+		chmod +x "${dest}${exe}"
+	fi
+    )
+}
+
+build_with_cache() {
+	ecabal configure "$@"
+	ecabal build --dependencies-only "$@" --dry-run
+	sync_from_retry
+	ecabal build --dependencies-only "$@" || sync_to_retry
+	sync_to_retry
+	ecabal build "$@"
+	sync_to_retry
+}
+
+install_ghcup() {
+	find "$GHCUP_INSTALL_BASE_PREFIX"
+	mkdir -p "$GHCUP_BIN"
+	mkdir -p "$GHCUP_BIN"/../cache
+
+	if [ "${RUNNER_OS}" = "FreeBSD" ] ; then
+		curl -o ghcup https://downloads.haskell.org/ghcup/tmp/x86_64-portbld-freebsd-ghcup-0.1.18.1
+		chmod +x ghcup
+		mv ghcup "$HOME/.local/bin/ghcup"
+	else
+		curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
+	fi
+}
+
+strip_binary() {
+	(
+	set -e
+	local binary=$1
+	case "$(uname -s)" in
+		"Darwin"|"darwin")
+			;;
+		MSYS_*|MINGW*)
+			;;
+		*)
+			strip -s "${binary}"
+		   ;;
+   esac
+	)
+}

.github/scripts/hls.sh

@@ -3,35 +3,13 @@
 set -eux
 
 . .github/scripts/prereq.sh
+. .github/scripts/common.sh
 
 mkdir -p "$CI_PROJECT_DIR"/.local/bin
 
 ### build
 
-ecabal() {
-	cabal "$@"
-}
 
-raw_eghcup() {
-	"$GHCUP_BIN/ghcup${ext}" -v -c "$@"
-}
-
-eghcup() {
-	if [ "${OS}" = "Windows" ] ; then
-		"$GHCUP_BIN/ghcup${ext}" -v -c -s file:/$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
-	else
-		"$GHCUP_BIN/ghcup${ext}" -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
-	fi
-}
-
-sha_sum() {
-	if [ "${OS}" = "FreeBSD" ] ; then
-		sha256 "$@"
-	else
-		sha256sum "$@"
-	fi
-
-}
 
 if [ "${OS}" = "Windows" ] ; then
 	GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
@@ -42,11 +20,6 @@ fi
 rm -rf "${GHCUP_DIR}"
 mkdir -p "${GHCUP_BIN}"
 
-if [ "${OS}" = "Windows" ] ; then
-	ext=".exe"
-else
-	ext=''
-fi
 ls -lah out
 find out
 cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
@@ -58,18 +31,41 @@ eghcup --version
 sha_sum "$GHCUP_BIN/ghcup${ext}"
 sha_sum "$(raw_eghcup --offline whereis ghcup)"
 
-git describe --always
+git_describe
 
 eghcup install ghc "${GHC_VERSION}"
 eghcup install cabal
 
 ecabal update
 
+if ! command -v cabal-cache ; then
+	download_cabal_cache "$HOME/.local/bin/cabal-cache"
+fi
+
+if ! cabal-cache version ; then
+	build_cabal_cache "$HOME/.local/bin"
+fi
+
+
 eghcup debug-info
 
-eghcup compile hls -j $(nproc) -g ${HLS_TARGET_VERSION} --ghc ${GHC_VERSION}
+(
+	cd /tmp
+	git clone --depth 1 --branch "${HLS_TARGET_VERSION}" \
+		https://github.com/haskell/haskell-language-server.git \
+		"haskell-language-server-${HLS_TARGET_VERSION}"
+	cd "haskell-language-server-${HLS_TARGET_VERSION}/"
+	ecabal configure -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)"
+	ecabal build --dependencies-only -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)" --dry-run
+	sync_from_retry
+	ecabal build --dependencies-only -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)" || sync_to
+	sync_to_retry
+)
 
-[ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]
+eghcup -v compile hls -j "$(nproc)" -g "${HLS_TARGET_VERSION}" --ghc "${GHC_VERSION}"
+
+[ "$($(eghcup whereis hls "${HLS_TARGET_VERSION}") --numeric-version)" = "${HLS_TARGET_VERSION}" ] ||
+	[ "$($(eghcup whereis hls "${HLS_TARGET_VERSION}") --numeric-version | sed 's/.0$//')" = "${HLS_TARGET_VERSION}" ]
 
 # nuke
 eghcup nuke

.github/scripts/prereq.sh

@@ -4,6 +4,7 @@ mkdir -p "$HOME"/.local/bin
 
 export OS="$RUNNER_OS"
 export PATH="$HOME/.local/bin:$PATH"
+: "${APT_GET:=apt-get}"
 
 if [ "${RUNNER_OS}" = "Windows" ] ; then
 	# on windows use pwd to get unix style path
@@ -12,6 +13,7 @@ if [ "${RUNNER_OS}" = "Windows" ] ; then
     export GHCUP_INSTALL_BASE_PREFIX="/c"
     export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin"
     export PATH="$GHCUP_BIN:$PATH"
+	export CABAL_DIR="C:\\Users\\runneradmin\\AppData\\Roaming\\cabal"
 else
 	export CI_PROJECT_DIR="${GITHUB_WORKSPACE}"
     export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
@@ -23,41 +25,19 @@ fi
 
 if [ "${RUNNER_OS}" = "Linux" ] ; then
 	if [ "${DISTRO}" = "Alpine" ] ; then
-          apk add --no-cache \
+		:
-            curl \
-            gcc \
-            g++ \
-            binutils \
-            binutils-gold \
-            bsd-compat-headers \
-            gmp-dev \
-            ncurses-dev \
-            libffi-dev \
-            make \
-            xz \
-            tar \
-            perl \
-            bash \
-            diffutils \
-            git
-
-          apk add --no-cache \
-            zlib \
-            zlib-dev \
-            zlib-static \
-            bzip2 \
-            bzip2-dev \
-            bzip2-static \
-            gmp \
-            gmp-dev \
-            openssl-dev \
-            openssl-libs-static \
-            xz \
-            xz-dev \
-            ncurses-static
 	elif [ "${DISTRO}" = "Ubuntu" ] ; then
-		sudo apt-get update -y
+		export DEBIAN_FRONTEND=noninteractive
-		sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential
+		export TZ=Asia/Singapore
+		if [ "${ARCH}" = "ARM64" ] || [ "${ARCH}" = "ARM" ] ; then
+			:
+		else
+			${APT_GET} install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
+		fi
+	elif [ "${DISTRO}" = "Debian" ] ; then
+		export DEBIAN_FRONTEND=noninteractive
+		export TZ=Asia/Singapore
+		${APT_GET} install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip
 	fi
 elif [ "${RUNNER_OS}" = "macOS" ] ; then
 	if ! command -v brew ; then
@@ -72,5 +52,15 @@ elif [ "${RUNNER_OS}" = "macOS" ] ; then
 	if ! command -v realpath ; then
 		brew install coreutils
 	fi
+
+    if [ "${ARCH}" = "ARM64" ] ; then
+		brew install llvm@11 autoconf automake
+		export PATH="$HOME/.brew/opt/llvm@11/bin:$PATH"
+		export CC="$HOME/.brew/opt/llvm@11/bin/clang"
+		export CXX="$HOME/.brew/opt/llvm@11/bin/clang++"
+		export LD=ld
+		export AR="$HOME/.brew/opt/llvm@11/bin/llvm-ar"
+		export RANLIB="$HOME/.brew/opt/llvm@11/bin/llvm-ranlib"
+	fi
 fi
 

.github/scripts/test.sh

@@ -3,31 +3,8 @@
 set -eux
 
 . .github/scripts/prereq.sh
+. .github/scripts/common.sh
 
-ecabal() {
-	cabal "$@"
-}
-
-raw_eghcup() {
-	"$GHCUP_BIN/ghcup${ext}" -v -c "$@"
-}
-
-eghcup() {
-	if [ "${OS}" = "Windows" ] ; then
-		"$GHCUP_BIN/ghcup${ext}" -v -c -s file:/$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
-	else
-		"$GHCUP_BIN/ghcup${ext}" -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
-	fi
-}
-
-sha_sum() {
-	if [ "${OS}" = "FreeBSD" ] ; then
-		sha256 "$@"
-	else
-		sha256sum "$@"
-	fi
-
-}
 
 if [ "${OS}" = "Windows" ] ; then
 	GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
@@ -35,28 +12,26 @@ else
 	GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
 fi
 
-git describe --always
+git_describe
-
 
 rm -rf "${GHCUP_DIR}"
 mkdir -p "${GHCUP_BIN}"
 
-if [ "${OS}" = "Windows" ] ; then
-	ext=".exe"
-else
-	ext=''
-fi
-ls -lah out
-find out
 cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
+cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}"
 chmod +x "$GHCUP_BIN/ghcup${ext}"
-echo "$PATH"
+chmod +x "ghcup-test${ext}"
 
 "$GHCUP_BIN/ghcup${ext}" --version
 eghcup --version
 sha_sum "$GHCUP_BIN/ghcup${ext}"
 sha_sum "$(raw_eghcup --offline whereis ghcup)"
 
+### Haskell test suite
+
+./ghcup-test${ext}
+rm ghcup-test${ext}
+
 ### manual cli based testing
 
 eghcup --numeric-version
@@ -116,6 +91,10 @@ fi
 
 
 if [ "${OS}" = "macOS" ] && [ "${ARCH}" = "ARM64" ] ; then
+	# missing bindists
+	echo
+elif [ "${OS}" = "FreeBSD" ] ; then
+	# not enough space
 	echo
 else
 	# test installing new ghc doesn't mess with currently set GHC

.github/workflows/bootstrap.yaml

@@ -18,7 +18,9 @@ jobs:
       BOOTSTRAP_HASKELL_CABAL_VERSION: 3.6.2.0
       BOOTSTRAP_HASKELL_GHC_VERSION: 8.10.7
       BOOTSTRAP_HASKELL_NONINTERACTIVE: yes
+      ARCH: 64
       JSON_VERSION: "0.0.7"
+      APT_GET: "sudo apt-get"
     strategy:
       matrix:
         include:

.github/workflows/cache.yaml

@@ -0,0 +1,37 @@
+name: Cache eviction
+
+on:
+  workflow_dispatch:
+    inputs:
+      key:
+        description: Which cache to evict
+        required: true
+        default: '/'
+        type: choice
+        options:
+        - FreeBSD-64-na
+        - Linux-32-Alpine
+        - Linux-64-Alpine
+        - Linux-64-Ubuntu
+        - Linux-ARM-Ubuntu
+        - Linux-ARM64-Ubuntu
+        - Windows-64-na
+        - macOS-64-na
+        - macOS-ARM64-na
+        - /
+jobs:
+  evict:
+    runs-on: ubuntu-latest
+
+    steps:
+    - name: Remove from S3
+      uses: vitorsgomes/s3-rm-action@master
+      with:
+        args: --recursive
+      env:
+        AWS_S3_ENDPOINT: ${{ secrets.S3_HOST }}
+        AWS_S3_BUCKET: ghcup-hs
+        AWS_REGION: us-west-2
+        AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
+        AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
+        PATH_TO_DELETE: ${{ github.event.inputs.key }}

.github/workflows/docker.yaml

@@ -0,0 +1,68 @@
+name: Docker image builds
+
+on:
+  workflow_dispatch:
+  schedule:
+    - cron: '0 0 * * *'
+
+jobs:
+  docker-alpine:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout
+        uses: actions/checkout@v3
+      - name: Set up QEMU
+        uses: docker/setup-qemu-action@v2
+      - name: Set up Docker Buildx
+        uses: docker/setup-buildx-action@v2
+      - name: Login to Docker Hub
+        uses: docker/login-action@v2
+        with:
+          username: ${{ secrets.DOCKERHUB_USERNAME }}
+          password: ${{ secrets.DOCKERHUB_TOKEN }}
+      - name: Build and push (alpine 32bit)
+        uses: docker/build-push-action@v3
+        with:
+          context: ./docker/alpine32
+          push: true
+          tags: hasufell/i386-alpine-haskell:3.12
+          platforms: linux/i386
+      - name: Build and push (alpine 64bit)
+        uses: docker/build-push-action@v3
+        with:
+          context: ./docker/alpine64
+          push: true
+          tags: hasufell/alpine-haskell:3.12
+          platforms: linux/amd64
+
+  docker-arm:
+    runs-on: [self-hosted, Linux, aarch64]
+    steps:
+      - uses: docker://arm64v8/ubuntu:focal
+        name: Cleanup
+        with:
+          args: rm -rf .ghcup/ cabal/ dist-newstyle/ out/
+
+      - name: Checkout
+        uses: actions/checkout@v3
+      - name: Set up Docker Buildx
+        uses: docker/setup-buildx-action@v2
+      - name: Login to Docker Hub
+        uses: docker/login-action@v2
+        with:
+          username: ${{ secrets.DOCKERHUB_USERNAME }}
+          password: ${{ secrets.DOCKERHUB_TOKEN }}
+      - name: Build and push (arm64v8)
+        uses: docker/build-push-action@v3
+        with:
+          context: ./docker/arm64v8/
+          push: true
+          tags: hasufell/arm64v8-ubuntu-haskell:focal
+          platforms: linux/arm64
+      - name: Build and push (arm32v7)
+        uses: docker/build-push-action@v3
+        with:
+          context: ./docker/arm32v7
+          push: true
+          tags: hasufell/arm32v7-ubuntu-haskell:focal
+          platforms: linux/arm

.github/workflows/release.yaml

@@ -9,17 +9,21 @@ on:
   pull_request:
     branches:
       - master
+  schedule:
+    - cron: '0 2 * * *'
 
 jobs:
-  build:
+  build-linux:
-    name: Build binary
+    name: Build linux binary
     runs-on: ${{ matrix.os }}
     env:
       CABAL_VER: 3.6.2.0
-      CACHE_VER: 1
-      MACOSX_DEPLOYMENT_TARGET: 10.13
       JSON_VERSION: "0.0.7"
+      AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
+      AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
+      S3_HOST: ${{ secrets.S3_HOST }}
     strategy:
+      fail-fast: true
       matrix:
         include:
           - os: ubuntu-latest
@@ -30,6 +34,136 @@ jobs:
             ARTIFACT: "x86_64-linux-ghcup"
             GHC_VER: 8.10.7
             ARCH: 64
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+        with:
+          submodules: 'true'
+
+      - if: matrix.ARCH == '32'
+        name: Run build (32 bit linux)
+        uses: docker://hasufell/i386-alpine-haskell:3.12
+        with:
+          args: sh .github/scripts/build.sh
+        env:
+          ARTIFACT: ${{ matrix.ARTIFACT }}
+          ARCH: ${{ matrix.ARCH }}
+          GHC_VER: ${{ matrix.GHC_VER }}
+          DISTRO: Alpine
+          AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
+          AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
+          S3_HOST: ${{ env.S3_HOST }}
+
+      - if: matrix.ARCH == '64'
+        name: Run build (64 bit linux)
+        uses: docker://hasufell/alpine-haskell:3.12
+        with:
+          args: sh .github/scripts/build.sh
+        env:
+          ARTIFACT: ${{ matrix.ARTIFACT }}
+          ARCH: ${{ matrix.ARCH }}
+          GHC_VER: ${{ matrix.GHC_VER }}
+          DISTRO: Alpine
+          AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
+          AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
+          S3_HOST: ${{ env.S3_HOST }}
+
+      - if: always()
+        name: Upload artifact
+        uses: actions/upload-artifact@v3
+        with:
+          name: artifacts
+          path: |
+            ./out/*
+
+
+  build-arm:
+    name: Build ARM binary
+    runs-on: ${{ matrix.os }}
+    env:
+      CABAL_VER: 3.6.2.0
+      JSON_VERSION: "0.0.7"
+      AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
+      AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
+      S3_HOST: ${{ secrets.S3_HOST }}
+    strategy:
+      fail-fast: true
+      matrix:
+        include:
+          - os: [self-hosted, Linux, aarch64]
+            ARTIFACT: "armv7-linux-ghcup"
+            GHC_VER: 8.10.7
+            ARCH: ARM
+          - os: [self-hosted, Linux, aarch64]
+            ARTIFACT: "aarch64-linux-ghcup"
+            GHC_VER: 8.10.7
+            ARCH: ARM64
+    steps:
+      - uses: docker://arm64v8/ubuntu:focal
+        name: Cleanup (aarch64 linux)
+        with:
+          args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
+
+      - name: git config
+        run: |
+          git config --global --get-all safe.directory | grep '^\*$' || git config --global --add safe.directory "*"
+        shell: bash
+
+      - name: Checkout code
+        uses: actions/checkout@v3
+        with:
+          submodules: 'true'
+
+      - if: matrix.ARCH == 'ARM'
+        uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
+        name: Run build (armv7 linux)
+        with:
+          args: sh .github/scripts/build.sh
+        env:
+          ARTIFACT: ${{ matrix.ARTIFACT }}
+          ARCH: ${{ matrix.ARCH }}
+          GHC_VER: ${{ matrix.GHC_VER }}
+          DISTRO: Ubuntu
+          AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
+          AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
+          S3_HOST: ${{ env.S3_HOST }}
+
+      - if: matrix.ARCH == 'ARM64'
+        uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
+        name: Run build (aarch64 linux)
+        with:
+          args: sh .github/scripts/build.sh
+        env:
+          ARTIFACT: ${{ matrix.ARTIFACT }}
+          ARCH: ${{ matrix.ARCH }}
+          GHC_VER: ${{ matrix.GHC_VER }}
+          DISTRO: Ubuntu
+          AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
+          AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
+          S3_HOST: ${{ env.S3_HOST }}
+
+      - if: always()
+        name: Upload artifact
+        uses: actions/upload-artifact@v3
+        with:
+          name: artifacts
+          path: |
+            ./out/*
+
+  build-macwin:
+    name: Build binary (Mac/Win)
+    runs-on: ${{ matrix.os }}
+    env:
+      CABAL_VER: 3.6.2.0
+      MACOSX_DEPLOYMENT_TARGET: 10.13
+      JSON_VERSION: "0.0.7"
+      AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
+      AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
+      S3_HOST: ${{ secrets.S3_HOST }}
+    strategy:
+      fail-fast: false
+      matrix:
+        include:
           - os: [self-hosted, macOS, aarch64]
             ARTIFACT: "aarch64-apple-darwin-ghcup"
             GHC_VER: 9.2.5
@@ -48,36 +182,17 @@ jobs:
         with:
           submodules: 'true'
 
-      - if: matrix.ARCH == '32' && runner.os == 'Linux'
+      - name: Run build (windows/mac)
-        name: Run build (32 bit linux)
-        uses: docker://i386/alpine:3.12
-        with:
-          args: sh .github/scripts/build.sh
-        env:
-          ARTIFACT: ${{ matrix.ARTIFACT }}
-          ARCH: ${{ matrix.ARCH }}
-          GHC_VER: ${{ matrix.GHC_VER }}
-          DISTRO: Alpine
-
-      - if: matrix.ARCH == '64' && runner.os == 'Linux'
-        name: Run build (64 bit linux)
-        uses: docker://alpine:3.12
-        with:
-          args: sh .github/scripts/build.sh
-        env:
-          ARTIFACT: ${{ matrix.ARTIFACT }}
-          ARCH: ${{ matrix.ARCH }}
-          GHC_VER: ${{ matrix.GHC_VER }}
-          DISTRO: Alpine
-
-      - if: runner.os != 'Linux'
-        name: Run build (windows/mac)
         run: bash .github/scripts/build.sh
         env:
           ARTIFACT: ${{ matrix.ARTIFACT }}
           ARCH: ${{ matrix.ARCH }}
           GHC_VER: ${{ matrix.GHC_VER }}
           DISTRO: na
+          AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
+          AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
+          S3_HOST: ${{ env.S3_HOST }}
+          HOMEBREW_CHANGE_ARCH_TO_ARM: 1
 
       - if: always()
         name: Upload artifact
@@ -87,14 +202,13 @@ jobs:
           path: |
             ./out/*
 
-  test:
+
-    name: Test
+  test-linux:
-    needs: build
+    name: Test linux
+    needs: "build-linux"
     runs-on: ${{ matrix.os }}
     env:
       CABAL_VER: 3.6.2.0
-      CACHE_VER: 1
-      MACOSX_DEPLOYMENT_TARGET: 10.13
       JSON_VERSION: "0.0.7"
     strategy:
       matrix:
@@ -114,6 +228,136 @@ jobs:
             GHC_VER: 8.10.7
             ARCH: 64
             DISTRO: Ubuntu
+
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+        with:
+          submodules: 'true'
+
+      - uses: actions/download-artifact@v3
+        with:
+          name: artifacts
+          path: ./out
+
+      - if: matrix.ARCH == '32' && matrix.DISTRO == 'Alpine'
+        name: Run test (32 bit linux Alpine)
+        uses: docker://hasufell/i386-alpine-haskell:3.12
+        with:
+          args: sh .github/scripts/test.sh
+        env:
+          ARTIFACT: ${{ matrix.ARTIFACT }}
+          ARCH: ${{ matrix.ARCH }}
+          GHC_VER: ${{ matrix.GHC_VER }}
+          DISTRO: ${{ matrix.DISTRO }}
+
+      - if: matrix.ARCH == '64' && matrix.DISTRO == 'Alpine'
+        name: Run test (64 bit linux Alpine)
+        uses: docker://hasufell/alpine-haskell:3.12
+        with:
+          args: sh .github/scripts/test.sh
+        env:
+          ARTIFACT: ${{ matrix.ARTIFACT }}
+          ARCH: ${{ matrix.ARCH }}
+          GHC_VER: ${{ matrix.GHC_VER }}
+          DISTRO: ${{ matrix.DISTRO }}
+
+      - if: matrix.DISTRO != 'Alpine'
+        name: Run test (64 bit linux)
+        run: sh .github/scripts/test.sh
+        env:
+          ARTIFACT: ${{ matrix.ARTIFACT }}
+          ARCH: ${{ matrix.ARCH }}
+          GHC_VER: ${{ matrix.GHC_VER }}
+          DISTRO: ${{ matrix.DISTRO }}
+          APT_GET: "sudo apt-get"
+
+      - if: failure()
+        name: Upload artifact
+        uses: actions/upload-artifact@v3
+        with:
+          name: testfiles
+          path: |
+            ./test/golden/unix/GHCupInfo*json
+
+  test-arm:
+    name: Test ARM
+    needs: "build-arm"
+    runs-on: ${{ matrix.os }}
+    env:
+      CABAL_VER: 3.6.2.0
+      JSON_VERSION: "0.0.7"
+    strategy:
+      matrix:
+        include:
+          - os: [self-hosted, Linux, aarch64]
+            ARTIFACT: "armv7-linux-ghcup"
+            GHC_VER: 8.10.7
+            ARCH: ARM
+            DISTRO: Ubuntu
+          - os: [self-hosted, Linux, aarch64]
+            ARTIFACT: "aarch64-linux-ghcup"
+            GHC_VER: 8.10.7
+            ARCH: ARM64
+            DISTRO: Ubuntu
+
+    steps:
+      - uses: docker://arm64v8/ubuntu:focal
+        name: Cleanup (aarch64 linux)
+        with:
+          args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
+
+      - name: Checkout code
+        uses: actions/checkout@v3
+        with:
+          submodules: 'true'
+
+      - uses: actions/download-artifact@v3
+        with:
+          name: artifacts
+          path: ./out
+
+      - if: matrix.ARCH == 'ARM'
+        uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
+        name: Run test (armv7 linux)
+        with:
+          args: sh .github/scripts/test.sh
+        env:
+          ARTIFACT: ${{ matrix.ARTIFACT }}
+          ARCH: ${{ matrix.ARCH }}
+          GHC_VER: ${{ matrix.GHC_VER }}
+          DISTRO: Ubuntu
+
+      - if: matrix.ARCH == 'ARM64'
+        uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
+        name: Run test (aarch64 linux)
+        with:
+          args: sh .github/scripts/test.sh
+        env:
+          ARTIFACT: ${{ matrix.ARTIFACT }}
+          ARCH: ${{ matrix.ARCH }}
+          GHC_VER: ${{ matrix.GHC_VER }}
+          DISTRO: Ubuntu
+
+      - if: failure()
+        name: Upload artifact
+        uses: actions/upload-artifact@v3
+        with:
+          name: testfiles
+          path: |
+            ./test/golden/unix/GHCupInfo*json
+
+  test-macwin:
+    name: Test Mac/Win
+    needs: "build-macwin"
+    runs-on: ${{ matrix.os }}
+    env:
+      CABAL_VER: 3.6.2.0
+      MACOSX_DEPLOYMENT_TARGET: 10.13
+      JSON_VERSION: "0.0.7"
+    strategy:
+      matrix:
+        include:
           - os: [self-hosted, macOS, aarch64]
             ARTIFACT: "aarch64-apple-darwin-ghcup"
             GHC_VER: 9.2.5
@@ -129,6 +373,7 @@ jobs:
             GHC_VER: 8.10.7
             ARCH: 64
             DISTRO: na
+
     steps:
       - name: Checkout code
         uses: actions/checkout@v3
@@ -140,48 +385,33 @@ jobs:
           name: artifacts
           path: ./out
 
-      - if: matrix.ARCH == '32' && runner.os == 'Linux' && matrix.DISTRO == 'Alpine'
+      - name: Run test (windows/mac)
-        name: Run build (32 bit linux Alpine)
-        uses: docker://i386/alpine:3.12
-        with:
-          args: sh .github/scripts/test.sh
-        env:
-          ARTIFACT: ${{ matrix.ARTIFACT }}
-          ARCH: ${{ matrix.ARCH }}
-          GHC_VER: ${{ matrix.GHC_VER }}
-          DISTRO: ${{ matrix.DISTRO }}
-
-      - if: matrix.ARCH == '64' && runner.os == 'Linux' && matrix.DISTRO == 'Alpine'
-        name: Run build (64 bit linux Alpine)
-        uses: docker://alpine:3.12
-        with:
-          args: sh .github/scripts/test.sh
-        env:
-          ARTIFACT: ${{ matrix.ARTIFACT }}
-          ARCH: ${{ matrix.ARCH }}
-          GHC_VER: ${{ matrix.GHC_VER }}
-          DISTRO: ${{ matrix.DISTRO }}
-
-      - if: runner.os == 'Linux' && matrix.DISTRO != 'Alpine'
-        name: Run build (64 bit linux)
-        run: sh .github/scripts/test.sh
-        env:
-          ARTIFACT: ${{ matrix.ARTIFACT }}
-          ARCH: ${{ matrix.ARCH }}
-          GHC_VER: ${{ matrix.GHC_VER }}
-          DISTRO: ${{ matrix.DISTRO }}
-
-      - if: runner.os != 'Linux'
-        name: Run build (windows/mac)
         run: bash .github/scripts/test.sh
         env:
           ARTIFACT: ${{ matrix.ARTIFACT }}
           ARCH: ${{ matrix.ARCH }}
           GHC_VER: ${{ matrix.GHC_VER }}
           DISTRO: ${{ matrix.DISTRO }}
+          HOMEBREW_CHANGE_ARCH_TO_ARM: 1
+
+      - if: failure() && runner.os == 'Windows'
+        name: Upload artifact
+        uses: actions/upload-artifact@v3
+        with:
+          name: testfiles
+          path: |
+            ./test/golden/windows/GHCupInfo*json
+
+      - if: failure() && runner.os != 'Windows'
+        name: Upload artifact
+        uses: actions/upload-artifact@v3
+        with:
+          name: testfiles
+          path: |
+            ./test/golden/unix/GHCupInfo*json
   hls:
     name: hls
-    needs: build
+    needs: build-linux
     runs-on: ubuntu-latest
     env:
       GHC_VERSION: "8.10.7"
@@ -190,6 +420,10 @@ jobs:
       JSON_VERSION: "0.0.7"
       ARTIFACT: "x86_64-linux-ghcup"
       DISTRO: Ubuntu
+      ARCH: 64
+      AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
+      AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
+      S3_HOST: ${{ secrets.S3_HOST }}
     steps:
       - name: Checkout code
         uses: actions/checkout@v3
@@ -203,10 +437,12 @@ jobs:
 
       - name: Run hls build
         run: sh .github/scripts/hls.sh
+        env:
+          APT_GET: "sudo apt-get"
 
   release:
     name: release
-    needs: [build, test, hls]
+    needs: ["test-linux", "test-arm", "test-macwin", "hls"]
     runs-on: ubuntu-latest
     if: startsWith(github.ref, 'refs/tags/v')
     steps:

README.md

@@ -6,7 +6,7 @@
 [![Join the chat at https://gitter.im/haskell/ghcup](https://badges.gitter.im/haskell/ghcup.svg)](https://gitter.im/haskell/ghcup?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
 <a href="https://opencollective.com/ghcup#category-CONTRIBUTE"><img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" alt="Donate" width="150"></a>
 
-GHCup is an installer for the general purpose language [Haskell](https://www.haskell.org/).
+GHCup is the main installer for the general purpose language [Haskell](https://www.haskell.org/).
 
 Visit the [documentation](https://www.haskell.org/ghcup/) for installation instructions.
 

app/ghcup/BrickMain.hs

@@ -13,6 +13,7 @@ import           GHCup.Errors
 import           GHCup.Types.Optics ( getDirs )
 import           GHCup.Types         hiding ( LeanAppState(..) )
 import           GHCup.Utils
+import           GHCup.OptParse.Common (logGHCPostRm)
 import           GHCup.Prelude ( decUTF8Safe )
 import           GHCup.Prelude.File
 import           GHCup.Prelude.Logger
@@ -433,6 +434,7 @@ install' _ (_, ListResult {..}) = do
               , BuildFailed
               , TagNotFound
               , DigestError
+              , ContentLengthError
               , GPGError
               , DownloadFailed
               , DirNotEmpty
@@ -485,7 +487,7 @@ install' _ (_, ListResult {..}) = do
             pure $ Right ()
           VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
           VLeft (V NoUpdate) -> pure $ Right ()
-          VLeft e -> pure $ Left $ prettyShow e <> "\n"
+          VLeft e -> pure $ Left $ prettyHFError e <> "\n"
             <> "Also check the logs in ~/.ghcup/logs"
 
 
@@ -522,7 +524,7 @@ set' bs input@(_, ListResult {..}) = do
                       logInfo "Setting now..."
                       set' bs input
 
-                PromptNo -> pure $ Left (prettyShow e)
+                PromptNo -> pure $ Left (prettyHFError e)
               where
                 userPrompt = L.toStrict . B.toLazyText . B.fromString $
                   "This Version of "
@@ -530,7 +532,7 @@ set' bs input@(_, ListResult {..}) = do
                   <> " you are trying to set is not installed.\n"
                   <> "Would you like to install it first? [Y/N]: "
 
-            _ -> pure $ Left (prettyShow e)
+            _ -> pure $ Left (prettyHFError e)
 
 
 
@@ -554,10 +556,11 @@ del' _ (_, ListResult {..}) = do
     )
     >>= \case
           VRight vi -> do
+            logGHCPostRm (mkTVer lVer)
             forM_ (_viPostRemove =<< vi) $ \msg ->
               logInfo msg
             pure $ Right ()
-          VLeft  e -> pure $ Left (prettyShow e)
+          VLeft  e -> pure $ Left (prettyHFError e)
 
 
 changelog' :: (MonadReader AppState m, MonadIO m)
@@ -577,7 +580,7 @@ changelog' _ (_, ListResult {..}) = do
             Windows -> "start"
       exec cmd [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing >>= \case
         Right _ -> pure $ Right ()
-        Left  e -> pure $ Left $ prettyShow e
+        Left  e -> pure $ Left $ prettyHFError e
 
 
 settings' :: IORef AppState
@@ -630,12 +633,12 @@ getGHCupInfo = do
 
   r <-
     flip runReaderT settings
-    . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
+    . runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
     $ liftE getDownloadsF
 
   case r of
     VRight a -> pure $ Right a
-    VLeft  e -> pure $ Left (prettyShow e)
+    VLeft  e -> pure $ Left (prettyHFError e)
 
 
 getAppData :: Maybe GHCupInfo

app/ghcup/GHCup/OptParse.hs

@@ -67,13 +67,13 @@ import           URI.ByteString
 import qualified Data.ByteString.UTF8          as UTF8
 
 
-
 data Options = Options
   {
   -- global options
     optVerbose     :: Maybe Bool
   , optCache       :: Maybe Bool
   , optMetaCache   :: Maybe Integer
+  , optMetaMode    :: Maybe MetaMode
   , optPlatform    :: Maybe PlatformRequest
   , optUrlSource   :: Maybe URI
   , optNoVerify    :: Maybe Bool
@@ -108,6 +108,7 @@ data Command
   | Prefetch PrefetchCommand
   | GC GCOptions
   | Run RunOptions
+  | PrintAppErrors
 
 
 
@@ -116,7 +117,8 @@ opts =
   Options
     <$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
     <*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
-    <*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
+    <*> optional (option auto (long "metadata-caching" <> metavar "SEC" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable"))
+    <*> optional (option auto (long "metadata-fetching-mode" <> metavar "<Strict|Lax>" <> help "Whether to fail on metadata download failure (Strict) or fall back to cached version (Lax (default))"))
     <*> optional
       (option
         (eitherReader platformParser)
@@ -340,3 +342,10 @@ com =
            <> commandGroup "Nuclear Commands:"
            <> hidden
           )
+     <|> subparser
+          (command
+              "print-app-errors"
+               (info (pure PrintAppErrors <**> helper)
+                     (progDesc ""))
+           <> internal
+          )

app/ghcup/GHCup/OptParse/ChangeLog.hs

@@ -12,6 +12,7 @@ module GHCup.OptParse.ChangeLog where
 
 
 import           GHCup.Types
+import           GHCup.Errors
 import           GHCup.OptParse.Common
 import           GHCup.Prelude
 import           GHCup.Prelude.Logger
@@ -148,6 +149,6 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
                  Nothing
               >>= \case
                     Right _ -> pure ExitSuccess
-                    Left  e -> logError (T.pack $ prettyShow e)
+                    Left  e -> logError (T.pack $ prettyHFError e)
                       >> pure (ExitFailure 13)
         else liftIO $ putStrLn uri' >> pure ExitSuccess

app/ghcup/GHCup/OptParse/Common.hs

@@ -25,6 +25,7 @@ import           Control.DeepSeq
 import           Control.Concurrent
 import           Control.Concurrent.Async
 import           Control.Exception.Safe
+import           Control.Monad.Identity (Identity(..))
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
 #endif
@@ -64,6 +65,7 @@ import qualified Text.Megaparsec               as MP
 import qualified System.FilePath.Posix         as FP
 import GHCup.Version
 import Control.Exception (evaluate)
+import qualified Cabal.Config            as CC
 
 
     -------------
@@ -789,3 +791,12 @@ checkForUpdates = do
   pure $ catMaybes (ghcup:otherTools)
  where
   forMM a f = fmap join $ forM a f
+
+
+logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
+logGHCPostRm ghcVer = do
+  cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store")
+    (runIdentity . CC.cfgStoreDir <$> CC.readConfig)
+  let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
+  logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir
+

app/ghcup/GHCup/OptParse/Compile.hs

@@ -40,7 +40,6 @@ import           Options.Applicative     hiding ( style )
 import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import           URI.ByteString          hiding ( uriParser )
 import qualified Data.Text                     as T
@@ -420,6 +419,7 @@ hlsCompileOpts =
 type GHCEffects = '[ AlreadyInstalled
                   , BuildFailed
                   , DigestError
+                  , ContentLengthError
                   , GPGError
                   , DownloadFailed
                   , GHCupSetError
@@ -443,6 +443,7 @@ type GHCEffects = '[ AlreadyInstalled
 type HLSEffects = '[ AlreadyInstalled
                   , BuildFailed
                   , DigestError
+                  , ContentLengthError
                   , GPGError
                   , DownloadFailed
                   , GHCupSetError
@@ -544,14 +545,14 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
                 pure ExitSuccess
               VLeft err@(V (BuildFailed tmpdir _)) -> do
                 case keepDirs settings of
-                  Never -> runLogger $ logError $ T.pack $ prettyShow err
+                  Never -> runLogger $ logError $ T.pack $ prettyHFError err
-                  _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
+                  _ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
                         "Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory "
                         <> T.pack tmpdir <> " for more clues." <> "\n" <>
                         "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
                 pure $ ExitFailure 9
               VLeft e -> do
-                runLogger $ logError $ T.pack $ prettyShow e
+                runLogger $ logError $ T.pack $ prettyHFError e
                 pure $ ExitFailure 9
     (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
       runLogger $ logError "Hadrian cross compile support is not yet implemented!"
@@ -606,12 +607,12 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
                 pure $ ExitFailure 3
               VLeft err@(V (BuildFailed tmpdir _)) -> do
                 case keepDirs settings of
-                  Never -> runLogger $ logError $ T.pack $ prettyShow err
+                  Never -> runLogger $ logError $ T.pack $ prettyHFError err
-                  _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
+                  _ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
                         "Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory "
                         <> T.pack tmpdir <> " for more clues." <> "\n" <>
                         "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
                 pure $ ExitFailure 9
               VLeft e -> do
-                runLogger $ logError $ T.pack $ prettyShow e
+                runLogger $ logError $ T.pack $ prettyHFError e
                 pure $ ExitFailure 9

app/ghcup/GHCup/OptParse/Config.hs

@@ -59,7 +59,7 @@ data ConfigCommand
     --[ Parsers ]--
     ---------------
 
-          
+
 configP :: Parser ConfigCommand
 configP = subparser
       (  command "init" initP
@@ -124,6 +124,7 @@ updateSettings :: UserSettings -> Settings -> Settings
 updateSettings UserSettings{..} Settings{..} =
    let cache'      = fromMaybe cache uCache
        metaCache'  = fromMaybe metaCache uMetaCache
+       metaMode'   = fromMaybe metaMode uMetaMode
        noVerify'   = fromMaybe noVerify uNoVerify
        keepDirs'   = fromMaybe keepDirs uKeepDirs
        downloader' = fromMaybe downloader uDownloader
@@ -132,7 +133,7 @@ updateSettings UserSettings{..} Settings{..} =
        noNetwork'  = fromMaybe noNetwork uNoNetwork
        gpgSetting' = fromMaybe gpgSetting uGPGSetting
        platformOverride' = uPlatformOverride <|> platformOverride
-   in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
+   in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
 
 
 
@@ -188,9 +189,15 @@ config configCommand settings keybindings runLogger = case configCommand of
       AddSource xs -> do
         doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
         pure ExitSuccess
-      _ -> do
+      GHCupURL -> do
         doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
         pure ExitSuccess
+      OwnSource xs -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (xs <> [Right uri]) })
+        pure ExitSuccess
+      OwnSpec spec -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource ([Left spec, Right uri]) })
+        pure ExitSuccess
 
  where
   doConfig :: MonadIO m => UserSettings -> m ()

app/ghcup/GHCup/OptParse/DInfo.hs

@@ -115,5 +115,5 @@ dinfo runAppState runLogger = do
             liftIO $ putStrLn $ prettyDebugInfo di
             pure ExitSuccess
           VLeft e -> do
-            runLogger $ logError $ T.pack $ prettyShow e
+            runLogger $ logError $ T.pack $ prettyHFError e
             pure $ ExitFailure 8

app/ghcup/GHCup/OptParse/GC.hs

@@ -27,7 +27,6 @@ import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
@@ -139,5 +138,5 @@ gc GCOptions{..} runAppState runLogger = runGC runAppState (do
             VRight _ -> do
                   pure ExitSuccess
             VLeft e -> do
-              runLogger $ logError $ T.pack $ prettyShow e
+              runLogger $ logError $ T.pack $ prettyHFError e
               pure $ ExitFailure 27

app/ghcup/GHCup/OptParse/Install.hs

@@ -38,7 +38,6 @@ import           Options.Applicative     hiding ( style )
 import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           URI.ByteString          hiding ( uriParser )
 
 import qualified Data.Text                     as T
@@ -243,6 +242,7 @@ type InstallEffects = '[ AlreadyInstalled
                        , BuildFailed
                        , TagNotFound
                        , DigestError
+                       , ContentLengthError
                        , GPGError
                        , DownloadFailed
                        , TarDirDoesNotExist
@@ -271,6 +271,7 @@ type InstallGHCEffects = '[ AlreadyInstalled
                           , BuildFailed
                           , CopyError
                           , DigestError
+                          , ContentLengthError
                           , DirNotEmpty
                           , DownloadFailed
                           , FileAlreadyExistsError
@@ -332,7 +333,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
          runInstGHC s'{ settings = settings {noVerify = True}} $ do
            (v, vi) <- liftE $ fromVersion instVer GHC
            liftE $ runBothE' (installGHCBindist
-                       (DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
+                       (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing)
                        (_tvVersion v)
                        (maybe GHCupInternal IsolateDir isolateDir)
                        forceInstall
@@ -349,10 +350,10 @@ install installCommand settings getAppState' runLogger = case installCommand of
                 pure ExitSuccess
 
               VLeft e@(V (AlreadyInstalled _ _)) -> do
-                runLogger $ logWarn $ T.pack $ prettyShow e
+                runLogger $ logWarn $ T.pack $ prettyHFError e
                 pure ExitSuccess
               VLeft e@(V (AlreadyInstalled _ _)) -> do
-                runLogger $ logWarn $ T.pack $ prettyShow e
+                runLogger $ logWarn $ T.pack $ prettyHFError e
                 pure ExitSuccess
 
               VLeft (V (DirNotEmpty fp)) -> do
@@ -366,22 +367,22 @@ install installCommand settings getAppState' runLogger = case installCommand of
 
               VLeft err@(V (BuildFailed tmpdir _)) -> do
                 case keepDirs settings of
-                  Never -> runLogger (logError $ T.pack $ prettyShow err)
+                  Never -> runLogger (logError $ T.pack $ prettyHFError err)
-                  _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
+                  _ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
                     "Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
                     "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
                 pure $ ExitFailure 3
               VLeft err@(V (BuildFailed tmpdir _)) -> do
                 case keepDirs settings of
-                  Never -> runLogger (logError $ T.pack $ prettyShow err)
+                  Never -> runLogger (logError $ T.pack $ prettyHFError err)
-                  _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
+                  _ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
                     "Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
                     "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
                 pure $ ExitFailure 3
 
               VLeft e -> do
                 runLogger $ do
-                  logError $ T.pack $ prettyShow e
+                  logError $ T.pack $ prettyHFError e
                   logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
                 pure $ ExitFailure 3
 
@@ -402,7 +403,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
          runInstTool s'{ settings = settings { noVerify = True}} $ do
            (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
            liftE $ runBothE' (installCabalBindist
-                                      (DownloadInfo uri Nothing "")
+                                      (DownloadInfo uri Nothing "" Nothing)
                                       v
                                       (maybe GHCupInternal IsolateDir isolateDir)
                                       forceInstall
@@ -416,14 +417,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
                 runLogger $ logInfo msg
               pure ExitSuccess
             VLeft e@(V (AlreadyInstalled _ _)) -> do
-              runLogger $ logWarn $ T.pack $ prettyShow e
+              runLogger $ logWarn $ T.pack $ prettyHFError e
               pure ExitSuccess
             VLeft (V (FileAlreadyExistsError fp)) -> do
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
             VLeft e@(V (AlreadyInstalled _ _)) -> do
-              runLogger $ logWarn $ T.pack $ prettyShow e
+              runLogger $ logWarn $ T.pack $ prettyHFError e
               pure ExitSuccess
             VLeft (V (FileAlreadyExistsError fp)) -> do
               runLogger $ logWarn $
@@ -431,7 +432,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
               pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
-                logError $ T.pack $ prettyShow e
+                logError $ T.pack $ prettyHFError e
                 logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
               pure $ ExitFailure 4
 
@@ -452,7 +453,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
            (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
            -- TODO: support legacy
            liftE $ runBothE' (installHLSBindist
-                                      (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
+                                      (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing)
                                       v
                                       (maybe GHCupInternal IsolateDir isolateDir)
                                       forceInstall
@@ -466,14 +467,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
                 runLogger $ logInfo msg
               pure ExitSuccess
             VLeft e@(V (AlreadyInstalled _ _)) -> do
-              runLogger $ logWarn $ T.pack $ prettyShow e
+              runLogger $ logWarn $ T.pack $ prettyHFError e
               pure ExitSuccess
             VLeft (V (FileAlreadyExistsError fp)) -> do
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
             VLeft e@(V (AlreadyInstalled _ _)) -> do
-              runLogger $ logWarn $ T.pack $ prettyShow e
+              runLogger $ logWarn $ T.pack $ prettyHFError e
               pure ExitSuccess
             VLeft (V (FileAlreadyExistsError fp)) -> do
               runLogger $ logWarn $
@@ -481,7 +482,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
               pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
-                logError $ T.pack $ prettyShow e
+                logError $ T.pack $ prettyHFError e
                 logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
               pure $ ExitFailure 4
 
@@ -501,7 +502,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
           runInstTool s'{ settings = settings { noVerify = True}} $ do
             (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
             liftE $ runBothE' (installStackBindist
-                                       (DownloadInfo uri Nothing "")
+                                       (DownloadInfo uri Nothing "" Nothing)
                                        v
                                        (maybe GHCupInternal IsolateDir isolateDir)
                                        forceInstall
@@ -515,14 +516,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
                 runLogger $ logInfo msg
               pure ExitSuccess
             VLeft e@(V (AlreadyInstalled _ _)) -> do
-              runLogger $ logWarn $ T.pack $ prettyShow e
+              runLogger $ logWarn $ T.pack $ prettyHFError e
               pure ExitSuccess
             VLeft (V (FileAlreadyExistsError fp)) -> do
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
             VLeft e@(V (AlreadyInstalled _ _)) -> do
-              runLogger $ logWarn $ T.pack $ prettyShow e
+              runLogger $ logWarn $ T.pack $ prettyHFError e
               pure ExitSuccess
             VLeft (V (FileAlreadyExistsError fp)) -> do
               runLogger $ logWarn $
@@ -530,6 +531,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
               pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
-                logError $ T.pack $ prettyShow e
+                logError $ T.pack $ prettyHFError e
                 logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
               pure $ ExitFailure 4

app/ghcup/GHCup/OptParse/Nuke.hs

@@ -26,7 +26,6 @@ import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
@@ -95,5 +94,5 @@ nuke appState runLogger = do
                       pure ExitSuccess
 
                 VLeft e -> do
-                  runLogger $ logError $ T.pack $ prettyShow e
+                  runLogger $ logError $ T.pack $ prettyHFError e
                   pure $ ExitFailure 15

app/ghcup/GHCup/OptParse/Prefetch.hs

@@ -30,7 +30,6 @@ import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
@@ -153,6 +152,7 @@ type PrefetchEffects = '[ TagNotFound
                         , NoToolVersionSet
                         , NoDownload
                         , DigestError
+                        , ContentLengthError
                         , GPGError
                         , DownloadFailed
                         , JSONError
@@ -215,5 +215,5 @@ prefetch prefetchCommand runAppState runLogger =
                 VRight _ -> do
                       pure ExitSuccess
                 VLeft e -> do
-                  runLogger $ logError $ T.pack $ prettyShow e
+                  runLogger $ logError $ T.pack $ prettyHFError e
                   pure $ ExitFailure 15

app/ghcup/GHCup/OptParse/Rm.hs

@@ -34,7 +34,6 @@ import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
@@ -175,11 +174,11 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              forM_ (_viPostRemove =<< vi) $ \msg ->
+              runLogger $ logGHCPostRm ghcVer
-                runLogger $ logInfo msg
+              postRmLog vi
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyShow e
+              runLogger $ logError $ T.pack $ prettyHFError e
               pure $ ExitFailure 7
 
   rmCabal' tv =
@@ -191,11 +190,10 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              forM_ (_viPostRemove =<< vi) $ \msg ->
+              postRmLog vi
-                runLogger $ logInfo msg
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyShow e
+              runLogger $ logError $ T.pack $ prettyHFError e
               pure $ ExitFailure 15
 
   rmHLS' tv =
@@ -207,11 +205,10 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              forM_ (_viPostRemove =<< vi) $ \msg ->
+              postRmLog vi
-                runLogger $ logInfo msg
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyShow e
+              runLogger $ logError $ T.pack $ prettyHFError e
               pure $ ExitFailure 15
 
   rmStack' tv =
@@ -223,10 +220,12 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              forM_ (_viPostRemove =<< vi) $ \msg ->
+              postRmLog vi
-                runLogger $ logInfo msg
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyShow e
+              runLogger $ logError $ T.pack $ prettyHFError e
               pure $ ExitFailure 15
 
+  postRmLog vi =
+    forM_ (_viPostRemove =<< vi) $ \msg ->
+      runLogger $ logInfo msg

app/ghcup/GHCup/OptParse/Run.hs

@@ -40,7 +40,6 @@ import           Prelude                 hiding ( appendFile )
 import           System.FilePath
 import           System.Environment
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Map.Strict               as Map
 import qualified Data.Text                     as T
@@ -177,6 +176,7 @@ type RunEffects = '[ AlreadyInstalled
                    , BuildFailed
                    , TagNotFound
                    , DigestError
+                   , ContentLengthError
                    , GPGError
                    , DownloadFailed
                    , TarDirDoesNotExist
@@ -265,11 +265,11 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                case r' of
                  VRight _ -> pure ExitSuccess
                  VLeft e -> do
-                   runLogger $ logError $ T.pack $ prettyShow e
+                   runLogger $ logError $ T.pack $ prettyHFError e
                    pure $ ExitFailure 28
 #endif
          VLeft e -> do
-           runLogger $ logError $ T.pack $ prettyShow e
+           runLogger $ logError $ T.pack $ prettyHFError e
            pure $ ExitFailure 27
 
   where
@@ -343,6 +343,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                               , DownloadFailed
                               , DirNotEmpty
                               , DigestError
+                              , ContentLengthError
                               , BuildFailed
                               , ArchiveResult
                               , AlreadyInstalled

app/ghcup/GHCup/OptParse/Set.hs

@@ -35,7 +35,6 @@ import           Options.Applicative     hiding ( style )
 import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import Data.Bifunctor (second)
@@ -286,7 +285,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
                     "GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
               pure ExitSuccess
             VLeft e -> do
-              runLogger $ logError $ T.pack $ prettyShow e
+              runLogger $ logError $ T.pack $ prettyHFError e
               pure $ ExitFailure 5
 
 
@@ -307,7 +306,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
                     "Cabal " <> prettyVer (_tvVersion v) <> " successfully set as default version"
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyShow e
+              runLogger $ logError $ T.pack $ prettyHFError e
               pure $ ExitFailure 14
 
   setHLS' :: SetOptions
@@ -327,7 +326,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
                     "HLS " <> prettyVer (_tvVersion v) <> " successfully set as default version"
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyShow e
+              runLogger $ logError $ T.pack $ prettyHFError e
               pure $ ExitFailure 14
 
 
@@ -348,5 +347,5 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
                     "Stack " <> prettyVer (_tvVersion v) <> " successfully set as default version"
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyShow e
+              runLogger $ logError $ T.pack $ prettyHFError e
               pure $ ExitFailure 14

app/ghcup/GHCup/OptParse/ToolRequirements.hs

@@ -23,7 +23,6 @@ import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
@@ -118,5 +117,5 @@ toolRequirements ToolReqOpts{..} runAppState runLogger = runToolRequirements run
     >>= \case
           VRight _ -> pure ExitSuccess
           VLeft  e -> do
-            runLogger $ logError $ T.pack $ prettyShow e
+            runLogger $ logError $ T.pack $ prettyHFError e
             pure $ ExitFailure 12

app/ghcup/GHCup/OptParse/UnSet.hs

@@ -31,7 +31,6 @@ import           Options.Applicative     hiding ( style )
 import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
@@ -189,7 +188,7 @@ unset unsetCommand runLeanAppState runLogger = case unsetCommand of
                 runLogger $ logInfo "GHC successfully unset"
                 pure ExitSuccess
               VLeft  e -> do
-                runLogger $ logError $ T.pack $ prettyShow e
+                runLogger $ logError $ T.pack $ prettyHFError e
                 pure $ ExitFailure 14
   (UnsetCabal (UnsetOptions _)) -> do
     void $ runLeanAppState (VRight <$> unsetCabal)

app/ghcup/GHCup/OptParse/Upgrade.hs

@@ -28,7 +28,6 @@ import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
@@ -88,6 +87,7 @@ upgradeOptsP =
 
 
 type UpgradeEffects = '[ DigestError
+                       , ContentLengthError
                        , GPGError
                        , NoDownload
                        , NoUpdate
@@ -151,5 +151,5 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
         runLogger $ logWarn "No GHCup update available"
         pure ExitSuccess
       VLeft e -> do
-        runLogger $ logError $ T.pack $ prettyShow e
+        runLogger $ logError $ T.pack $ prettyHFError e
         pure $ ExitFailure 11

app/ghcup/GHCup/OptParse/Whereis.hs

@@ -34,7 +34,6 @@ import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
 import           System.Environment
 import           System.Exit
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
@@ -288,7 +287,7 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
                 liftIO $ putStr r
                 pure ExitSuccess
               VLeft e -> do
-                runLogger $ logError $ T.pack $ prettyShow e
+                runLogger $ logError $ T.pack $ prettyHFError e
                 pure $ ExitFailure 30
     (WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
       runLeanWhereIs leanAppstate (do
@@ -302,7 +301,7 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
                 liftIO $ putStr r
                 pure ExitSuccess
               VLeft e -> do
-                runLogger $ logError $ T.pack $ prettyShow e
+                runLogger $ logError $ T.pack $ prettyHFError e
                 pure $ ExitFailure 30
 
     (WhereisTool tool whereVer, WhereisOptions{..}) -> do
@@ -318,7 +317,7 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
                 liftIO $ putStr r
                 pure ExitSuccess
               VLeft e -> do
-                runLogger $ logError $ T.pack $ prettyShow e
+                runLogger $ logError $ T.pack $ prettyHFError e
                 pure $ ExitFailure 30
 
     (WhereisBaseDir, _) -> do

app/ghcup/Main.hs

@@ -79,6 +79,7 @@ toSettings options = do
    mergeConf Options{..} UserSettings{..} noColor =
      let cache       = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
          metaCache   = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
+         metaMode    = fromMaybe (fromMaybe (Types.metaMode defaultSettings) uMetaMode) optMetaMode
          noVerify    = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
          verbose     = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
          keepDirs    = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
@@ -161,7 +162,7 @@ ENV variables:
   * GHCUP_INSTALL_BASE_PREFIX: the base of ghcup (default: $HOME)
   * GHCUP_USE_XDG_DIRS: set to anything to use XDG style directories
 
-Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
+Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
 
   customExecParser
       (prefs showHelpOnError)
@@ -205,19 +206,19 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                                           VRight r -> pure r
                                           VLeft e -> do
                                             runLogger
-                                              (logError $ T.pack $ prettyShow e)
+                                              (logError $ T.pack $ prettyHFError e)
                                             exitWith (ExitFailure 2)
 
                 ghcupInfo <-
                   ( flip runReaderT leanAppstate
-                    . runE @'[DigestError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
+                    . runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
                     $ liftE getDownloadsF
                     )
                     >>= \case
                           VRight r -> pure r
                           VLeft  e -> do
                             runLogger
-                              (logError $ T.pack $ prettyShow e)
+                              (logError $ T.pack $ prettyHFError e)
                             exitWith (ExitFailure 2)
                 let s' = AppState settings dirs keybindings ghcupInfo pfreq loggerConfig
 
@@ -253,7 +254,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                                         logWarn ("New "
                                           <> T.pack (prettyShow t)
                                           <> " version available. "
-                                          <> "To upgrade, run 'ghcup install "
+                                          <> "If you want to install this latest version, run 'ghcup install "
                                           <> T.pack (prettyShow t)
                                           <> " "
                                           <> prettyVer l
@@ -265,7 +266,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   VRight _ -> pure ()
                   VLeft e -> do
                     runLogger
-                      (logError $ T.pack $ prettyShow e)
+                      (logError $ T.pack $ prettyHFError e)
                     exitWith (ExitFailure 30)
                 pure s'
 
@@ -310,6 +311,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             Prefetch pfCom             -> prefetch pfCom runAppState runLogger
             GC gcOpts                  -> gc gcOpts runAppState runLogger
             Run runCommand             -> run runCommand appState leanAppstate runLogger
+            PrintAppErrors             -> putStrLn allHFError >> pure ExitSuccess
 
           case res of
             ExitSuccess        -> pure ()

cbits/dirutils.h

@@ -1,6 +1,7 @@
 #ifndef POSIXPATHS_CBITS_DIRUTILS_H
 #define POSIXPATHS_CBITS_DIRUTILS_H
 
+#include <HsFFI.h>
 #include <stdlib.h>
 #include <dirent.h>
 #include <sys/types.h>

data/config.yaml

@@ -40,6 +40,12 @@ key-bindings:
 # of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'.
 meta-cache: 300 # in seconds
 
+# When trying to download ghcup metadata, this option decides what to do
+# when the download fails:
+#   1. Lax: use existing ~/.ghcup/cache/ghcup-<ver>.yaml as fallback (default)
+#   2. Strict: fail hard
+meta-mode: Lax # Strict | Lax
+
 # Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
 # check the 'URLSource' type in the code.
 url-source:

docker/alpine32/Dockerfile

@@ -0,0 +1,71 @@
+FROM i386/alpine:3.12
+
+ENV LANG C.UTF-8
+
+RUN apk add --no-cache \
+            curl \
+            gcc \
+            g++ \
+            binutils \
+            binutils-gold \
+			coreutils \
+            bsd-compat-headers \
+            gmp-dev \
+            ncurses-dev \
+            libffi-dev \
+            make \
+            xz \
+            tar \
+            perl \
+            bash \
+            diffutils \
+            git \
+			gzip \
+			gnupg && \
+    apk add --no-cache \
+            zlib \
+            zlib-dev \
+            zlib-static \
+            bzip2 \
+            bzip2-dev \
+            bzip2-static \
+            gmp \
+            gmp-dev \
+            openssl-dev \
+            openssl-libs-static \
+            xz \
+            xz-dev \
+            ncurses-static
+
+ARG GHCUP_VERSION=0.1.18.0
+ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
+
+# install ghcup
+RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/i386-linux-ghcup-$GHCUP_VERSION && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS.sig && \
+    gpg --verify SHA256SUMS.sig SHA256SUMS && \
+    sha256sum -c --ignore-missing SHA256SUMS && \
+    mv i386-linux-ghcup-$GHCUP_VERSION /usr/bin/ghcup && \
+    chmod +x /usr/bin/ghcup && \
+    rm -rf SHA256SUMS SHA256SUMS.sig
+
+ARG GHC=8.10.7
+ARG CABAL_INSTALL=3.6.2.0
+ARG STACK=2.9.1
+
+ENV GHCUP_CURL_OPTS="--silent"
+ENV NO_COLOR=1
+
+# install haskell toolchain
+RUN ghcup config set gpg-setting GPGStrict && \
+	ghcup --verbose install ghc   --isolate=/usr     --force ${GHC} && \
+	ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
+	find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
+	rm -r "/usr/share/doc/ghc-${GHC}" && \
+	rm -rf /tmp/ghcup* && \
+	ghcup gc -p -s -c -t
+
+ENV PATH /root/.cabal/bin:/root/.ghcup:/root/.local/bin:$PATH
+

docker/alpine64/Dockerfile

@@ -0,0 +1,71 @@
+FROM alpine:3.12
+
+ENV LANG C.UTF-8
+
+RUN apk add --no-cache \
+            curl \
+            gcc \
+            g++ \
+            binutils \
+            binutils-gold \
+			coreutils \
+            bsd-compat-headers \
+            gmp-dev \
+            ncurses-dev \
+            libffi-dev \
+            make \
+            xz \
+            tar \
+            perl \
+            bash \
+            diffutils \
+            git \
+			gzip \
+			gnupg && \
+    apk add --no-cache \
+            zlib \
+            zlib-dev \
+            zlib-static \
+            bzip2 \
+            bzip2-dev \
+            bzip2-static \
+            gmp \
+            gmp-dev \
+            openssl-dev \
+            openssl-libs-static \
+            xz \
+            xz-dev \
+            ncurses-static
+
+ARG GHCUP_VERSION=0.1.18.0
+ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
+
+# install ghcup
+RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/x86_64-linux-ghcup-$GHCUP_VERSION && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS.sig && \
+    gpg --verify SHA256SUMS.sig SHA256SUMS && \
+    sha256sum -c --ignore-missing SHA256SUMS && \
+    mv x86_64-linux-ghcup-$GHCUP_VERSION /usr/bin/ghcup && \
+    chmod +x /usr/bin/ghcup && \
+    rm -rf SHA256SUMS SHA256SUMS.sig
+
+ARG GHC=8.10.7
+ARG CABAL_INSTALL=3.6.2.0
+ARG STACK=2.9.1
+
+ENV GHCUP_CURL_OPTS="--silent"
+ENV NO_COLOR=1
+
+# install haskell toolchain
+RUN ghcup config set gpg-setting GPGStrict && \
+	ghcup --verbose install ghc   --isolate=/usr     --force ${GHC} && \
+	ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
+	find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
+	rm -r "/usr/share/doc/ghc-${GHC}" && \
+	rm -rf /tmp/ghcup* && \
+	ghcup gc -p -s -c -t
+
+ENV PATH /root/.cabal/bin:/root/.ghcup:/root/.local/bin:$PATH
+

docker/arm32v7/Dockerfile

@@ -0,0 +1,64 @@
+FROM arm32v7/ubuntu:focal
+
+ENV LANG C.UTF-8
+ENV DEBIAN_FRONTEND=noninteractive
+ENV TZ=Asia/Singapore
+
+COPY update_opt.sh /usr/bin/update_opt.sh
+RUN chmod +x /usr/bin/update_opt.sh
+
+RUN apt-get update && \
+    apt-get install -y --no-install-recommends \
+        ca-certificates \
+        curl \
+        dirmngr \
+        g++ \
+        git \
+        gnupg \
+        libsqlite3-dev \
+        libtinfo-dev \
+        libgmp-dev \
+        make \
+        netbase \
+        openssh-client \
+        xz-utils \
+        zlib1g-dev \
+		libnuma-dev libgmp10 libssl-dev liblzma-dev libbz2-dev wget lsb-release software-properties-common apt-transport-https gcc autoconf automake build-essential gzip patchelf tree \
+		llvm-9 clang-9 && \
+    rm -rf /var/lib/apt/lists/*
+
+RUN update_opt.sh 9 1
+
+ARG GHCUP_VERSION=0.1.17.8
+ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
+
+# install ghcup
+RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/armv7-linux-ghcup-$GHCUP_VERSION && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS.sig && \
+    gpg --verify SHA256SUMS.sig SHA256SUMS && \
+    sha256sum -c --ignore-missing SHA256SUMS && \
+    mv armv7-linux-ghcup-$GHCUP_VERSION /usr/bin/ghcup && \
+    chmod +x /usr/bin/ghcup && \
+    rm -rf SHA256SUMS SHA256SUMS.sig
+
+ARG GHC=8.10.7
+ARG CABAL_INSTALL=3.6.2.0
+ARG STACK=2.9.1
+
+ENV GHCUP_CURL_OPTS="--silent"
+ENV NO_COLOR=1
+
+# install haskell toolchain
+RUN ghcup config set gpg-setting GPGStrict && \
+	ghcup --verbose install ghc   --isolate=/usr     --force ${GHC} && \
+	ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
+	find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
+	rm -r "/usr/share/doc/ghc-${GHC}" && \
+	rm -rf /tmp/ghcup* && \
+	ghcup gc -p -s -c -t
+
+ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
+
+CMD ["ghci"]

docker/arm32v7/update_opt.sh

@@ -0,0 +1,36 @@
+#!/bin/bash
+# update_alternatives.sh
+
+update_alternatives() {
+    local version=${1}
+    local priority=${2}
+    local master=${3}
+    local slaves=${4}
+    local path=${5}
+    local cmdln
+
+    cmdln="--verbose --install ${path}${master} ${master} ${path}${master}-${version} ${priority}"
+    for slave in ${slaves}; do
+        cmdln="${cmdln} --slave ${path}${slave} ${slave} ${path}${slave}-${version}"
+    done
+    update-alternatives ${cmdln}
+}
+
+if [[ ${#} -ne 2 ]]; then
+    echo usage: "${0}" clang_version priority
+    exit 1
+fi
+
+version=${1}
+priority=${2}
+path="/usr/bin/"
+
+master="llvm-config"
+slaves="llvm-addr2line llvm-ar llvm-as llvm-bcanalyzer llvm-bitcode-strip llvm-cat llvm-cfi-verify llvm-cov llvm-c-test llvm-cvtres llvm-cxxdump llvm-cxxfilt llvm-cxxmap llvm-debuginfod llvm-debuginfod-find llvm-diff llvm-dis llvm-dlltool llvm-dwarfdump llvm-dwarfutil llvm-dwp llvm-exegesis llvm-extract llvm-gsymutil llvm-ifs llvm-install-name-tool llvm-jitlink llvm-jitlink-executor llvm-lib llvm-libtool-darwin llvm-link llvm-lipo llvm-lto llvm-lto2 llvm-mc llvm-mca llvm-ml llvm-modextract llvm-mt llvm-nm llvm-objcopy llvm-objdump llvm-omp-device-info llvm-opt-report llvm-otool llvm-pdbutil llvm-PerfectShuffle llvm-profdata llvm-profgen llvm-ranlib llvm-rc llvm-readelf llvm-readobj llvm-reduce llvm-remark-size-diff llvm-rtdyld llvm-sim llvm-size llvm-split llvm-stress llvm-strings llvm-strip llvm-symbolizer llvm-tapi-diff llvm-tblgen llvm-tli-checker llvm-undname llvm-windres llvm-xray"
+
+update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"
+
+master="clang"
+slaves="analyze-build asan_symbolize bugpoint c-index-test clang++ clang-apply-replacements clang-change-namespace clang-check clang-cl clang-cpp clangd clang-doc clang-extdef-mapping clang-format clang-format-diff clang-include-fixer clang-linker-wrapper clang-move clang-nvlink-wrapper clang-offload-bundler clang-offload-packager clang-offload-wrapper clang-pseudo clang-query clang-refactor clang-rename clang-reorder-fields clang-repl clang-scan-deps clang-tidy count diagtool dsymutil FileCheck find-all-symbols git-clang-format hmaptool hwasan_symbolize intercept-build ld64.lld ld.lld llc lld lldb lldb-argdumper lldb-instr lldb-server lldb-vscode lld-link lli lli-child-target modularize not obj2yaml opt pp-trace run-clang-tidy sancov sanstats scan-build scan-build-py scan-view split-file UnicodeNameMappingGenerator verify-uselistorder wasm-ld yaml2obj yaml-bench"
+
+update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"

docker/arm64v8/Dockerfile

@@ -0,0 +1,64 @@
+FROM arm64v8/ubuntu:focal
+
+ENV LANG C.UTF-8
+ENV DEBIAN_FRONTEND=noninteractive
+ENV TZ=Asia/Singapore
+
+COPY update_opt.sh /usr/bin/update_opt.sh
+RUN chmod +x /usr/bin/update_opt.sh
+
+RUN apt-get update && \
+    apt-get install -y --no-install-recommends \
+        ca-certificates \
+        curl \
+        dirmngr \
+        g++ \
+        git \
+        gnupg \
+        libsqlite3-dev \
+        libtinfo-dev \
+        libgmp-dev \
+        make \
+        netbase \
+        openssh-client \
+        xz-utils \
+        zlib1g-dev \
+		libnuma-dev libgmp10 libssl-dev liblzma-dev libbz2-dev wget lsb-release software-properties-common apt-transport-https gcc autoconf automake build-essential gzip patchelf tree \
+		llvm-9 clang-9 && \
+    rm -rf /var/lib/apt/lists/*
+
+RUN update_opt.sh 9 1
+
+ARG GHCUP_VERSION=0.1.18.0
+ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
+
+# install ghcup
+RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/aarch64-linux-ghcup-$GHCUP_VERSION && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS && \
+    curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS.sig && \
+    gpg --verify SHA256SUMS.sig SHA256SUMS && \
+    sha256sum -c --ignore-missing SHA256SUMS && \
+    mv aarch64-linux-ghcup-$GHCUP_VERSION /usr/bin/ghcup && \
+    chmod +x /usr/bin/ghcup && \
+    rm -rf SHA256SUMS SHA256SUMS.sig
+
+ARG GHC=8.10.7
+ARG CABAL_INSTALL=3.6.2.0
+ARG STACK=2.9.1
+
+ENV GHCUP_CURL_OPTS="--silent"
+ENV NO_COLOR=1
+
+# install haskell toolchain
+RUN ghcup config set gpg-setting GPGStrict && \
+	ghcup --verbose install ghc   --isolate=/usr     --force ${GHC} && \
+	ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
+	find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
+	rm -r "/usr/share/doc/ghc-${GHC}" && \
+	rm -rf /tmp/ghcup* && \
+	ghcup gc -p -s -c -t
+
+ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
+
+CMD ["ghci"]

docker/arm64v8/update_opt.sh

@@ -0,0 +1,36 @@
+#!/bin/bash
+# update_alternatives.sh
+
+update_alternatives() {
+    local version=${1}
+    local priority=${2}
+    local master=${3}
+    local slaves=${4}
+    local path=${5}
+    local cmdln
+
+    cmdln="--verbose --install ${path}${master} ${master} ${path}${master}-${version} ${priority}"
+    for slave in ${slaves}; do
+        cmdln="${cmdln} --slave ${path}${slave} ${slave} ${path}${slave}-${version}"
+    done
+    update-alternatives ${cmdln}
+}
+
+if [[ ${#} -ne 2 ]]; then
+    echo usage: "${0}" clang_version priority
+    exit 1
+fi
+
+version=${1}
+priority=${2}
+path="/usr/bin/"
+
+master="llvm-config"
+slaves="llvm-addr2line llvm-ar llvm-as llvm-bcanalyzer llvm-bitcode-strip llvm-cat llvm-cfi-verify llvm-cov llvm-c-test llvm-cvtres llvm-cxxdump llvm-cxxfilt llvm-cxxmap llvm-debuginfod llvm-debuginfod-find llvm-diff llvm-dis llvm-dlltool llvm-dwarfdump llvm-dwarfutil llvm-dwp llvm-exegesis llvm-extract llvm-gsymutil llvm-ifs llvm-install-name-tool llvm-jitlink llvm-jitlink-executor llvm-lib llvm-libtool-darwin llvm-link llvm-lipo llvm-lto llvm-lto2 llvm-mc llvm-mca llvm-ml llvm-modextract llvm-mt llvm-nm llvm-objcopy llvm-objdump llvm-omp-device-info llvm-opt-report llvm-otool llvm-pdbutil llvm-PerfectShuffle llvm-profdata llvm-profgen llvm-ranlib llvm-rc llvm-readelf llvm-readobj llvm-reduce llvm-remark-size-diff llvm-rtdyld llvm-sim llvm-size llvm-split llvm-stress llvm-strings llvm-strip llvm-symbolizer llvm-tapi-diff llvm-tblgen llvm-tli-checker llvm-undname llvm-windres llvm-xray"
+
+update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"
+
+master="clang"
+slaves="analyze-build asan_symbolize bugpoint c-index-test clang++ clang-apply-replacements clang-change-namespace clang-check clang-cl clang-cpp clangd clang-doc clang-extdef-mapping clang-format clang-format-diff clang-include-fixer clang-linker-wrapper clang-move clang-nvlink-wrapper clang-offload-bundler clang-offload-packager clang-offload-wrapper clang-pseudo clang-query clang-refactor clang-rename clang-reorder-fields clang-repl clang-scan-deps clang-tidy count diagtool dsymutil FileCheck find-all-symbols git-clang-format hmaptool hwasan_symbolize intercept-build ld64.lld ld.lld llc lld lldb lldb-argdumper lldb-instr lldb-server lldb-vscode lld-link lli lli-child-target modularize not obj2yaml opt pp-trace run-clang-tidy sancov sanstats scan-build scan-build-py scan-view split-file UnicodeNameMappingGenerator verify-uselistorder wasm-ld yaml2obj yaml-bench"
+
+update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"

docs/about.md

@@ -42,8 +42,8 @@ All you wanted to know about GHCup.
 
 ## How to help
 
-* if you want to contribute code or documentation, check out the [issue tracker](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues) and the [Development guide](./dev.md)
+* if you want to contribute code or documentation, check out the [issue tracker](https://github.com/haskell/ghcup-hs/issues) and the [Development guide](./dev.md)
-* if you want to propose features or write user feedback, feel free to [open a ticket](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/new?issue)
+* if you want to propose features or write user feedback, feel free to [open a ticket](https://github.com/haskell/ghcup-hs/issues/new)
 * if you want to donate to the project, visit our [opencollective](https://opencollective.com/ghcup#category-CONTRIBUTE) page
 
 ## Design goals
@@ -155,6 +155,11 @@ Windows 7 and Powershell 2.0 aren't well supported at the moment, also see:
 
 ## FAQ
 
+### Is ghcup really the main installer?
+
+This is based on the Haskell survey results from 2022, which show that more
+than half of survey participants use GHCup: https://taylor.fausak.me/2022/11/18/haskell-survey-results/
+
 ### Why reimplement stack?
 
 GHCup is not a reimplementation of stack. The only common part is automatic installation of GHC,

docs/dev.md

@@ -69,9 +69,9 @@ Head over to: [https://github.com/haskell/ghcup-metadata#adding-a-new-ghc-versio
 
 ### Adding a new CLI command
 
-An example illustration on how to deal with [optparse-applicative](https://hackage.haskell.org/package/optparse-applicative) can be seen here: [https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26](https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26)
+An example illustration on how to deal with [optparse-applicative](https://hackage.haskell.org/package/optparse-applicative) can be seen here: [https://github.com/haskell/ghcup-hs/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26](https://github.com/haskell/ghcup-hs/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26)
 
-Every subcommand now lives in its own module under [GHCup.OptParse.MyCommand](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/app/ghcup/GHCup/OptParse).
+Every subcommand now lives in its own module under [GHCup.OptParse.MyCommand](https://github.com/haskell/ghcup-hs/tree/master/app/ghcup/GHCup/OptParse).
 
 ## Major refactors
 

docs/guide.md

@@ -50,7 +50,7 @@ For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man`
 
 ## Shell-completion
 
-Shell completions are in [scripts/shell-completions](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/shell-completions) directory of this repository.
+Shell completions are in [scripts/shell-completions](https://github.com/haskell/ghcup-hs/tree/master/scripts/shell-completions) directory of this repository.
 
 For bash: install `shell-completions/bash`
 as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
@@ -67,7 +67,7 @@ and make sure your bashrc sources the startup script
 # Configuration
 
 A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
-explaining all possible configurations can be found in this repo: [config.yaml](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/data/config.yaml).
+explaining all possible configurations can be found in this repo: [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml).
 
 Partial configuration is fine. Command line options always override the config file settings.
 
@@ -97,6 +97,10 @@ This is the complete list of env variables that change GHCup behavior:
 * `GHCUP_SKIP_UPDATE_CHECK`: Skip the (possibly annoying) update check when you run a command
 * `CC`/`LD` etc.: full environment is passed to the build system when compiling GHC via GHCup
 
+On windows, there's additionally:
+
+* `GHCUP_MSYS2`: Has to point to the root of an existing MSYS2 installation (when installed by GHCup, that's e.g. `C:\ghcup\msys64`). GHCup bootstrap takes care of this usually.
+
 ### XDG support
 
 To enable XDG style directories, set the environment variable `GHCUP_USE_XDG_DIRS` to anything.
@@ -147,7 +151,7 @@ url-source:
   OwnSource: "https://some-url/ghcup-0.0.6.yaml"
 ```
 
-See [config.yaml](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/data/config.yaml)
+See [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml)
 for more options.
 
 Alternatively you can do it via a cli switch:
@@ -198,15 +202,59 @@ url-source:
   - "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
 ```
 
+## Stack integration
+
+Stack manages GHC versions internally by default. In order to make it use ghcup installed
+GHC versions there are two strategies.
+
+### Strategy 1: System GHC (works on all stack versions)
+
+You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
+run the following commands:
+
+```sh
+stack config set install-ghc false --global
+stack config set system-ghc  true  --global
+```
+
+### Strategy 2: Stack hooks (new, recommended)
+
+Since stack 2.9.1 you can customize the installation logic of GHC completely, see [https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation](https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation).
+
+We can use this to simply invoke ghcup whenever stack is trying to install/discover a GHC versions. This
+is done via placing a shell script at `~/.stack/hooks/ghc-install.sh` and making it executable.
+
+The ghcup bootstrap script asks you during installation whether you want to install this shell script. You can also
+install/update it manually like so:
+
+```sh
+mkdir -p ~/.stack/hooks/
+curl https://raw.githubusercontent.com/haskell/ghcup-hs/master/scripts/hooks/stack/ghc-install.sh \
+  > ~/.stack/hooks/ghc-install.sh
+chmod +x ~/.stack/hooks/ghc-install.sh
+# hooks are only run when 'system-ghc: false'
+stack config set system-ghc false --global
+```
+
+By default, when the hook fails for whatever reason, stack will fall back to its own installation logic. To disable
+this, run `stack config set install-ghc false --global`.
+
+### Windows
+
+On windows, you may find the following config options useful too:
+`skip-msys`, `extra-path`, `extra-include-dirs`, `extra-lib-dirs`.
+
+Also check out: [https://docs.haskellstack.org/en/stable/yaml_configuration](https://docs.haskellstack.org/en/stable/yaml_configuration)
+
 # More on installation
 
 ## Customisation of the installation scripts
 
 The scripts offered to install GHCup are available here:
 
-* [bootstrap-haskell](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
+* [bootstrap-haskell](https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
   for Unix-like operating systems
-* [bootstrap-haskell.ps1](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
+* [bootstrap-haskell.ps1](https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1)
   for Windows (PowerShell). This will, in turn, run the final bootstrap script
   (by default, that for the Unix-like operating systems).
 
@@ -270,7 +318,7 @@ Compiling from source is supported for both source tarballs and arbitrary git re
 for a list of all available options.
 
 If you need to overwrite the existing `build.mk`, check the default files
-in [data/build_mk](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/data/build_mk), copy them somewhere, adjust them and
+in [data/build_mk](https://github.com/haskell/ghcup-hs/tree/master/data/build_mk), copy them somewhere, adjust them and
 pass `--config path/to/build.mk` to `ghcup compile ghc`.
 Common `build.mk` options are explained [here](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/using#build-configuration).
 
@@ -383,9 +431,11 @@ non-interactively, as below. The paramaters to the PowerShell script are
 specified positionally, after `-ArgumentList`:
 
 ```ps
-Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
+$ErrorActionPreference = 'Stop';Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;try { Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\" } catch { Write-Error $_ }
 ```
 
+`$ErrorActionPreference = 'Stop'` here acts like `set -e` and stops execution if ghcup installation fails.
+
 On linux/darwin/freebsd, run the following on your runner:
 
 ```sh
@@ -467,11 +517,11 @@ to download ghcup.
 
 There are two known workarounds:
 
-1. Tell curl to ignore certificate errors (dangerous): `curl -k https://gitlab.haskell.org/haskell/ghcup-hs/-/raw/master/scripts/bootstrap/bootstrap-haskell | GHCUP_CURL_OPTS="-k" sh`
+1. Tell curl to ignore certificate errors (dangerous): `curl -k https://raw.githubusercontent.com/haskell/ghcup-hs/master/scripts/bootstrap/bootstrap-haskell | GHCUP_CURL_OPTS="-k" sh`
-2. Try to use wget instead: `wget -O /dev/stdout https://gitlab.haskell.org/haskell/ghcup-hs/-/raw/master/scripts/bootstrap/bootstrap-haskell | BOOTSTRAP_HASKELL_DOWNLOADER=wget sh`
+2. Try to use wget instead: `wget -O /dev/stdout https://raw.githubusercontent.com/haskell/ghcup-hs/master/scripts/bootstrap/bootstrap-haskell | BOOTSTRAP_HASKELL_DOWNLOADER=wget sh`
 
 On windows, you can disable curl like so:
 
 ```pwsh
-Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true,$false,$false,$false,$false,$false,$false,"","","","",$true
+Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;try { Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true,$false,$false,$false,$false,$false,$false,"","","","",$true } catch { Write-Error $_ }
 ```

docs/index.md

@@ -13,7 +13,7 @@ hide:
   <h1>GHCup</h1>
 </section>
 
-<p class="ghcup-intro">GHCup is an installer for the general purpose language <a href="https://www.haskell.org">Haskell</a>.</p>
+<p class="ghcup-intro">GHCup is the main installer for the general purpose language <a href="https://www.haskell.org">Haskell</a>.</p>
 
 <div class="text-center main-buttons">
 <a href="install/" class="btn btn-primary" role="button">Installation</a>
@@ -35,7 +35,7 @@ hide:
       <span>
       </span>
 	<div class="footer">
-		<a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
+		<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
 	</div>
     </div>
 
@@ -45,13 +45,13 @@ hide:
 
       <div class="command-button">
 	    <pre>
-          <span class="ghcup-command" id="ghcup-command-windows">Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true
+          <span class="ghcup-command" id="ghcup-command-windows">Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072; try { Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true } catch { Write-Error $_ }
           </span>
         </pre>
         <button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
       </div>
 	<div class="footer">
-		<a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
+		<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
 	</div>
     </div>
 </section>
@@ -77,7 +77,7 @@ hide:
   </span>
    or
    <span>
-     <a href="https://gitlab.haskell.org/haskell/ghcup-hs/issues">
+     <a href="https://github.com/haskell/ghcup-hs/issues">
        report a bug
        <img src="Octicons-bug.svg" alt="" />
      </a>

docs/install.md

@@ -19,12 +19,12 @@ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
 For Windows, run this in a PowerShell session:
 
 ```psh
-Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true
+Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072; try { Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true } catch { Write-Error $_ }
 ```
 
 There's also a [youtube video](https://www.youtube.com/watch?v=bB4fmQiUYPw) explaining installation on windows.
 
-If you want to know what these scripts do, check out the [source code at the repository](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
+If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
 
 ### Which versions get installed?
 
@@ -48,6 +48,10 @@ The following distro packages are required: `build-essential curl libffi-dev lib
 
 The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
 
+### Linux Mageia
+
+The following distro packages are required: `curl gcc gcc-c++ gmp libffi-devel libffi7 libgmp-devel libgmp10 make libncurses-devel libncurses5 xz perl`
+
 ### Linux CentOS
 
 The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
@@ -56,6 +60,10 @@ The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncur
 
 The following distro packages are required: `binutils-gold curl gcc g++ gmp-dev libc-dev libffi-dev make musl-dev ncurses-dev perl tar xz`
 
+### Linux VoidLinux
+
+The following distro packages are required: `gcc gmp curl coreutils xz ncurses make ncurses-libtinfo-libs perl tar`
+
 ### Linux (generic)
 
 You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages.
@@ -260,7 +268,7 @@ On Linux, some users have reported an issue when VSCode is not launched from a t
 ## Get help
 
 * [Libera IRC chat on #haskell-ghcup or #haskell](https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup)
-* [GHCup issue tracker](https://gitlab.haskell.org/haskell/ghcup-hs/issues)
+* [GHCup issue tracker](https://github.com/haskell/ghcup-hs/issues/new)
 * [Matrix](https://app.element.io/#/room/#haskell-tooling:matrix.org)
 * [Discord](https://discord.gg/pKYf3zDQU7)
 

docs/steps.md

@@ -343,7 +343,7 @@ To learn Haskell, try any of those:
 * [https://github.com/haskell/haskell-language-server](https://github.com/haskell/haskell-language-server)
 * [https://github.com/haskell/cabal](https://github.com/haskell/cabal)
 * [https://github.com/commercialhaskell/stack](https://github.com/commercialhaskell/stack)
-* [https://gitlab.haskell.org/haskell/ghcup-hs](https://gitlab.haskell.org/haskell/ghcup-hs)
+* [https://github.com/haskell/ghcup-hs](https://github.com/haskell/ghcup-hs)
 * [https://github.com/jgm/pandoc](https://github.com/jgm/pandoc)
 * [https://github.com/simonmichael/hledger](https://github.com/simonmichael/hledger)
 * [https://github.com/koalaman/shellcheck](https://github.com/koalaman/shellcheck)

ghcup.cabal

@@ -6,8 +6,8 @@ license-file:       LICENSE
 copyright:          Julian Ospald 2020
 maintainer:         hasufell@posteo.de
 author:             Julian Ospald
-homepage:           https://gitlab.haskell.org/haskell/ghcup-hs
+homepage:           https://github.com/haskell/ghcup-hs
-bug-reports:        https://gitlab.haskell.org/haskell/ghcup-hs/issues
+bug-reports:        https://github.com/haskell/ghcup-hs/issues/
 synopsis:           ghc toolchain installer
 description:
   A rewrite of the shell script ghcup, for providing
@@ -25,11 +25,14 @@ extra-source-files:
   cbits/dirutils.h
   data/build_mk/cross
   data/build_mk/default
-  test/golden/GHCupInfo.json
+  test/golden/unix/GHCupInfo.json
+  test/golden/windows/GHCupInfo.json
+  test/data/file
+  test/data/dir/.keep
 
 source-repository head
   type:     git
-  location: https://gitlab.haskell.org/haskell/ghcup-hs.git
+  location: https://github.com/haskell/ghcup-hs.git
 
 flag tui
   description:
@@ -180,9 +183,10 @@ library
     other-modules:
       GHCup.Prelude.File.Posix
       GHCup.Prelude.File.Posix.Foreign
-      GHCup.Prelude.File.Posix.Traversals
       GHCup.Prelude.Posix
       GHCup.Prelude.Process.Posix
+    exposed-modules:
+      GHCup.Prelude.File.Posix.Traversals
 
     include-dirs:     cbits
     includes:         dirutils.h
@@ -243,6 +247,7 @@ executable ghcup
     , base                  >=4.12     && <5
     , bytestring            >=0.10     && <0.12
     , cabal-plan            ^>=0.7.2
+    , cabal-install-parsers >=0.4.5
     , containers            ^>=0.6
     , deepseq               ^>=1.4
     , directory             ^>=1.3.6.0
@@ -301,6 +306,7 @@ test-suite ghcup-test
     GHCup.ArbitraryTypes
     GHCup.Types.JSONSpec
     GHCup.Utils.FileSpec
+    GHCup.Prelude.File.Posix.TraversalsSpec
     Spec
 
   default-language:   Haskell2010
@@ -324,7 +330,7 @@ test-suite ghcup-test
     , filepath                  ^>=1.4.2.1
     , generic-arbitrary         >=0.1.0   && <0.2.1 || >=0.2.2 && <0.3
     , ghcup
-    , hspec                     >=2.7.10  && <2.10
+    , hspec                     >=2.7.10  && <2.11
     , hspec-golden-aeson        ^>=0.9
     , QuickCheck                ^>=2.14.1
     , quickcheck-arbitrary-adt  ^>=0.3.1.0
@@ -332,3 +338,9 @@ test-suite ghcup-test
     , text                      ^>=1.2.4.0
     , uri-bytestring            ^>=0.3.2.2
     , versions                  >=4.0.1   && <5.1
+
+  if os(windows)
+    cpp-options: -DIS_WINDOWS
+  else
+    build-depends:
+      , unix             ^>=2.7

lib/GHCup.hs

@@ -78,7 +78,6 @@ import           Text.Regex.Posix
 
 import qualified Data.Text                     as T
 import qualified Streamly.Prelude              as S
-import Text.PrettyPrint.HughesPJClass (prettyShow)
 
 
 
@@ -106,6 +105,7 @@ fetchToolBindist :: ( MonadFail m
                  -> Maybe FilePath
                  -> Excepts
                       '[ DigestError
+                       , ContentLengthError
                        , GPGError
                        , DownloadFailed
                        , NoDownload
@@ -288,6 +288,7 @@ upgradeGHCup :: ( MonadMask m
              -> Excepts
                   '[ CopyError
                    , DigestError
+                   , ContentLengthError
                    , GPGError
                    , GPGError
                    , DownloadFailed
@@ -308,7 +309,7 @@ upgradeGHCup mtarget force' fatal = do
   dli   <- liftE $ getDownloadInfo GHCup latestVer
   tmp   <- fromGHCupPath <$> lift withGHCupTmpDir
   let fn = "ghcup" <> exeExt
-  p <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmp (Just fn) False
+  p <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) tmp (Just fn) False
   let destDir = takeDirectory destFile
       destFile = fromMaybe (binDir </> fn) mtarget
   lift $ logDebug $ "mkdir -p " <> T.pack destDir
@@ -326,7 +327,7 @@ upgradeGHCup mtarget force' fatal = do
     Just pa
       | fatal -> throwE (ToolShadowed GHCup pa destFile latestVer)
       | otherwise ->
-        lift $ logWarn $ T.pack $ prettyShow (ToolShadowed GHCup pa destFile latestVer)
+        lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed GHCup pa destFile latestVer)
 
   pure latestVer
 

lib/GHCup/Cabal.hs

@@ -50,7 +50,6 @@ import           System.FilePath
 import           System.IO.Error
 
 import qualified Data.Text                     as T
-import Text.PrettyPrint.HughesPJClass (prettyShow)
 
 
 
@@ -81,6 +80,7 @@ installCabalBindist :: ( MonadMask m
                          '[ AlreadyInstalled
                           , CopyError
                           , DigestError
+                          , ContentLengthError
                           , GPGError
                           , DownloadFailed
                           , NoDownload
@@ -184,6 +184,7 @@ installCabalBin :: ( MonadMask m
                      '[ AlreadyInstalled
                       , CopyError
                       , DigestError
+                      , ContentLengthError
                       , GPGError
                       , DownloadFailed
                       , NoDownload
@@ -233,7 +234,7 @@ setCabal ver = do
 
   liftIO (isShadowed cabalbin) >>= \case
     Nothing -> pure ()
-    Just pa -> lift $ logWarn $ T.pack $ prettyShow (ToolShadowed Cabal pa cabalbin ver)
+    Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Cabal pa cabalbin ver)
 
   pure ()
 

lib/GHCup/Download.hs

@@ -75,7 +75,6 @@ import           System.Exit
 import           System.FilePath
 import           System.IO.Error
 import           System.IO.Temp
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           URI.ByteString
 
 import qualified Crypto.Hash.SHA256            as SHA256
@@ -114,7 +113,7 @@ getDownloadsF :: ( FromJSONKey Tool
                  , MonadMask m
                  )
               => Excepts
-                   '[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
+                   '[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
                    m
                    GHCupInfo
 getDownloadsF = do
@@ -162,17 +161,21 @@ getBase :: ( MonadReader env m
            , MonadMask m
            )
         => URI
-        -> Excepts '[GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
+        -> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m GHCupInfo
 getBase uri = do
-  Settings { noNetwork, downloader } <- lift getSettings
+  Settings { noNetwork, downloader, metaMode } <- lift getSettings
 
   -- try to download yaml... usually this writes it into cache dir,
   -- but in some cases not (e.g. when using file://), so we honour
   -- the return filepath, if any
   mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
            then pure Nothing
-           else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
+           else handleIO (\e -> case metaMode of
-               . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
+                                  Strict -> throwIO e
+                                  Lax -> lift (warnCache (displayException e) downloader) >> pure Nothing)
+               . catchE @_ @_ @'[DownloadFailed] (\e@(DownloadFailed _) -> case metaMode of
+                   Strict -> throwE e
+                   Lax -> lift (warnCache (prettyHFError e) downloader) >> pure Nothing)
                . fmap Just
                . smartDl
                $ uri
@@ -184,7 +187,7 @@ getBase uri = do
   liftE
     . onE_ (onError actualYaml)
     . lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
-    . liftIO 
+    . liftIO
     . Y.decodeFileEither
     $ actualYaml
  where
@@ -229,6 +232,7 @@ getBase uri = do
           -> Excepts
                '[ DownloadFailed
                 , DigestError
+                , ContentLengthError
                 , GPGError
                 ]
                m1
@@ -242,7 +246,7 @@ getBase uri = do
     Settings { metaCache } <- lift getSettings
 
        -- for local files, let's short-circuit and ignore access time
-    if | scheme == "file" -> liftE $ download uri' Nothing Nothing (fromGHCupPath cacheDir) Nothing True
+    if | scheme == "file" -> liftE $ download uri' Nothing Nothing Nothing (fromGHCupPath cacheDir) Nothing True
        | e -> do
           accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file
           let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime
@@ -258,7 +262,7 @@ getBase uri = do
    where
     dlWithMod modTime json_file = do
       let (dir, fn) = splitFileName json_file
-      f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing dir (Just fn) True
+      f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing dir (Just fn) True
       liftIO $ setModificationTime f modTime
       liftIO $ setAccessTime f modTime
       pure f
@@ -324,13 +328,14 @@ download :: ( MonadReader env m
          => URI
          -> Maybe URI         -- ^ URI for gpg sig
          -> Maybe T.Text      -- ^ expected hash
+         -> Maybe Integer     -- ^ expected content length
          -> FilePath          -- ^ destination dir (ignored for file:// scheme)
          -> Maybe FilePath    -- ^ optional filename
          -> Bool              -- ^ whether to read an write etags
-         -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
+         -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
-download uri gpgUri eDigest dest mfn etags
+download uri gpgUri eDigest eCSize dest mfn etags
-  | scheme == "https" = dl
+  | scheme == "https" = liftE dl
-  | scheme == "http"  = dl
+  | scheme == "http"  = liftE dl
   | scheme == "file"  = do
       let destFile' = T.unpack . decUTF8Safe $ view pathL' uri
       lift $ logDebug $ "using local file: " <> T.pack destFile'
@@ -351,7 +356,7 @@ download uri gpgUri eDigest dest mfn etags
     -- download
     flip onException
          (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile))
-     $ catchAllE @_ @'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme, DigestError] @'[DigestError, DownloadFailed, GPGError]
+     $ catchAllE @_ @'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme, DigestError, ContentLengthError] @'[DigestError, ContentLengthError, DownloadFailed, GPGError]
           (\e' -> do
             lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile)
             case e' of
@@ -386,7 +391,7 @@ download uri gpgUri eDigest dest mfn etags
                   liftE $ flip onException
                        (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile))
                    $ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
-                        (\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyShow (GPGError e))
+                        (\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyHFError (GPGError e))
                         ) $ do
                       o' <- liftIO getGpgOpts
                       lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') gpgUri' <> " as file " <> T.pack gpgDestFile
@@ -401,19 +406,37 @@ download uri gpgUri eDigest dest mfn etags
                         CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
                 _ -> pure ()
 
+              forM_ eCSize  (liftE . flip checkCSize  baseDestFile)
               forM_ eDigest (liftE . flip checkDigest baseDestFile)
     pure baseDestFile
 
-  curlDL :: (MonadCatch m, MonadMask m, MonadIO m) => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
+  curlDL :: ( MonadCatch m
+            , MonadMask m
+            , MonadIO m
+            )
+         => [String]
+         -> FilePath
+         -> URI
+         -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
   curlDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
     let destFileTemp = tmpFile destFile
     flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
       liftE $ lEM @_ @'[ProcessError] $ exec "curl"
-        (o' ++ ["-fL", "-o", destFileTemp, T.unpack uri']) Nothing Nothing
+        (o' ++ ["-fL", "-o", destFileTemp, T.unpack uri']
+            ++ maybe [] (\s -> ["--max-filesize", show s]) eCSize
+        ) Nothing Nothing
       liftIO $ renameFile destFileTemp destFile
 
-  curlEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
+  curlEtagsDL :: ( MonadReader env m
-              => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
+                 , HasLog env
+                 , MonadCatch m
+                 , MonadMask m
+                 , MonadIO m
+                 )
+              => [String]
+              -> FilePath
+              -> URI
+              -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
   curlEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
     let destFileTemp = tmpFile destFile
     dh <- liftIO $ emptySystemTempFile "curl-header"
@@ -440,7 +463,14 @@ download uri gpgUri eDigest dest mfn etags
 
         lift $ writeEtags destFile (parseEtags headers)
 
-  wgetDL :: (MonadCatch m, MonadMask m, MonadIO m) => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
+  wgetDL :: ( MonadCatch m
+            , MonadMask m
+            , MonadIO m
+            )
+         => [String]
+         -> FilePath
+         -> URI
+         -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
   wgetDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
     let destFileTemp = tmpFile destFile
     flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
@@ -449,8 +479,16 @@ download uri gpgUri eDigest dest mfn etags
       liftIO $ renameFile destFileTemp destFile
 
 
-  wgetEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
+  wgetEtagsDL :: ( MonadReader env m
-              => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
+                 , HasLog env
+                 , MonadCatch m
+                 , MonadMask m
+                 , MonadIO m
+                 )
+              => [String]
+              -> FilePath
+              -> URI
+              -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
   wgetEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
     let destFileTemp = tmpFile destFile
     flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
@@ -471,7 +509,10 @@ download uri gpgUri eDigest dest mfn etags
           | otherwise -> throwE (NonZeroExit i' "wget" opts)
 
 #if defined(INTERNAL_DOWNLOADER)
-  internalDL :: (MonadCatch m, MonadMask m, MonadIO m)
+  internalDL :: ( MonadCatch m
+                , MonadMask m
+                , MonadIO m
+                )
              => FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
   internalDL destFile uri' = do
     let destFileTemp = tmpFile destFile
@@ -481,11 +522,16 @@ download uri gpgUri eDigest dest mfn etags
                  @'[DownloadFailed]
             (\e@(HTTPNotModified _) ->
               throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
-        $ downloadToFile https host fullPath port destFileTemp mempty
+        $ downloadToFile https host fullPath port destFileTemp mempty eCSize
       liftIO $ renameFile destFileTemp destFile
 
 
-  internalEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
+  internalEtagsDL :: ( MonadReader env m
+                     , HasLog env
+                     , MonadCatch m
+                     , MonadMask m
+                     , MonadIO m
+                     )
                   => FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
   internalEtagsDL destFile uri' = do
     let destFileTemp = tmpFile destFile
@@ -497,7 +543,7 @@ download uri gpgUri eDigest dest mfn etags
       liftE
         $ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
         $ do
-          r <- downloadToFile https host fullPath port destFileTemp addHeaders
+          r <- downloadToFile https host fullPath port destFileTemp addHeaders eCSize
           liftIO $ renameFile destFileTemp destFile
           lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
 #endif
@@ -505,7 +551,7 @@ download uri gpgUri eDigest dest mfn etags
 
   -- Manage to find a file we can write the body into.
   getDestFile :: Monad m => URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
-  getDestFile uri' mfn' = 
+  getDestFile uri' mfn' =
     let path = view pathL' uri'
     in case mfn' of
         Just fn -> pure (dest </> fn)
@@ -574,14 +620,14 @@ downloadCached :: ( MonadReader env m
                   )
                => DownloadInfo
                -> Maybe FilePath  -- ^ optional filename
-               -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
+               -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
 downloadCached dli mfn = do
   Settings{ cache } <- lift getSettings
   case cache of
     True -> downloadCached' dli mfn Nothing
     False -> do
       tmp <- lift withGHCupTmpDir
-      liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (fromGHCupPath tmp) mfn False
+      liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) mfn False
 
 
 downloadCached' :: ( MonadReader env m
@@ -596,7 +642,7 @@ downloadCached' :: ( MonadReader env m
                 => DownloadInfo
                 -> Maybe FilePath  -- ^ optional filename
                 -> Maybe FilePath  -- ^ optional destination dir (default: cacheDir)
-                -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
+                -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
 downloadCached' dli mfn mDestDir = do
   Dirs { cacheDir } <- lift getDirs
   let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
@@ -605,9 +651,10 @@ downloadCached' dli mfn mDestDir = do
   fileExists <- liftIO $ doesFileExist cachfile
   if
     | fileExists -> do
+      forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
       liftE $ checkDigest (view dlHash dli) cachfile
       pure cachfile
-    | otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) destDir mfn False
+    | otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir mfn False
 
 
 
@@ -638,6 +685,25 @@ checkDigest eDigest file = do
     cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
     when ((cDigest /= eDigest) && verify) $ throwE (DigestError file cDigest eDigest)
 
+checkCSize :: ( MonadReader env m
+              , HasDirs env
+              , HasSettings env
+              , MonadIO m
+              , MonadThrow m
+              , HasLog env
+              )
+           => Integer
+           -> FilePath
+           -> Excepts '[ContentLengthError] m ()
+checkCSize eCSize file = do
+  Settings{ noVerify } <- lift getSettings
+  let verify = not noVerify
+  when verify $ do
+    let p' = takeFileName file
+    lift $ logInfo $ "verifying content length of: " <> T.pack p'
+    cSize <- liftIO $ getFileSize file
+    when ((eCSize /= cSize) && verify) $ throwE (ContentLengthError (Just file) (Just cSize) eCSize)
+
 
 -- | Get additional curl args from env. This is an undocumented option.
 getCurlOpts :: IO [String]

lib/GHCup/Download/IOStreams.hs

@@ -17,14 +17,12 @@ import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.Reader
 import           Data.ByteString                ( ByteString )
-import           Data.ByteString.Builder
 import           Data.CaseInsensitive           ( CI, original, mk )
 import           Data.IORef
 import           Data.Maybe
 import           Data.Text.Read
 import           Haskus.Utils.Variant.Excepts
 import           Network.Http.Client     hiding ( URL )
-import           Optics
 import           Prelude                 hiding ( abs
                                                 , readFile
                                                 , writeFile
@@ -33,7 +31,6 @@ import           System.ProgressBar
 import           URI.ByteString
 
 import qualified Data.ByteString               as BS
-import qualified Data.ByteString.Lazy          as L
 import qualified Data.Map.Strict               as M
 import qualified System.IO.Streams             as Streams
 
@@ -46,27 +43,6 @@ import qualified System.IO.Streams             as Streams
     ----------------------------
 
 
--- | Load the result of this download into memory at once.
-downloadBS' :: MonadIO m
-            => Bool             -- ^ https?
-            -> ByteString       -- ^ host (e.g. "www.example.com")
-            -> ByteString       -- ^ path (e.g. "/my/file") including query
-            -> Maybe Int        -- ^ optional port (e.g. 3000)
-            -> Excepts
-                 '[ HTTPStatusError
-                  , URIParseError
-                  , UnsupportedScheme
-                  , NoLocationHeader
-                  , TooManyRedirs
-                  ]
-                 m
-                 L.ByteString
-downloadBS' https host path port = do
-  bref <- liftIO $ newIORef (mempty :: Builder)
-  let stepper bs = modifyIORef bref (<> byteString bs)
-  void $ downloadInternal False https host path port stepper (pure ()) mempty
-  liftIO (readIORef bref <&> toLazyByteString)
-
 
 downloadToFile :: (MonadMask m, MonadIO m)
                => Bool             -- ^ https?
@@ -75,8 +51,9 @@ downloadToFile :: (MonadMask m, MonadIO m)
                -> Maybe Int        -- ^ optional port (e.g. 3000)
                -> FilePath         -- ^ destination file to create and write to
                -> M.Map (CI ByteString) ByteString -- ^ additional headers
+               -> Maybe Integer    -- ^ expected content length
                -> Excepts '[DownloadFailed, HTTPNotModified] m Response
-downloadToFile https host fullPath port destFile addHeaders = do
+downloadToFile https host fullPath port destFile addHeaders eCSize = do
   let stepper = BS.appendFile destFile
       setup = BS.writeFile destFile mempty
   catchAllE (\case
@@ -84,7 +61,7 @@ downloadToFile https host fullPath port destFile addHeaders = do
                 | i == 304
                 , Just e <- M.lookup (mk "etag") headers -> throwE $ HTTPNotModified (decUTF8Safe e)
               v -> throwE $ DownloadFailed v
-            ) $ downloadInternal True https host fullPath port stepper setup addHeaders
+            ) $ downloadInternal True https host fullPath port stepper setup addHeaders eCSize
 
 
 downloadInternal :: MonadIO m
@@ -96,19 +73,21 @@ downloadInternal :: MonadIO m
                  -> (ByteString -> IO a)   -- ^ the consuming step function
                  -> IO a                   -- ^ setup action
                  -> M.Map (CI ByteString) ByteString -- ^ additional headers
+                 -> Maybe Integer
                  -> Excepts
                       '[ HTTPStatusError
                        , URIParseError
                        , UnsupportedScheme
                        , NoLocationHeader
                        , TooManyRedirs
+                       , ContentLengthError
                        ]
                       m
                       Response
 downloadInternal = go (5 :: Int)
 
  where
-  go redirs progressBar https host path port consumer setup addHeaders = do
+  go redirs progressBar https host path port consumer setup addHeaders eCSize = do
     r <- liftIO $ withConnection' https host port action
     veitherToExcepts r >>= \case
       Right r' ->
@@ -138,25 +117,39 @@ downloadInternal = go (5 :: Int)
     followRedirectURL bs = case parseURI strictURIParserOptions bs of
       Right uri' -> do
         (https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
-        go (redirs - 1) progressBar https' host' fullPath' port' consumer setup addHeaders
+        go (redirs - 1) progressBar https' host' fullPath' port' consumer setup addHeaders eCSize
       Left e -> throwE e
 
     downloadStream r i' = do
       void setup
       let size = case getHeader r "Content-Length" of
             Just x' -> case decimal $ decUTF8Safe x' of
-              Left  _       -> 0
+              Left  _       -> Nothing
-              Right (r', _) -> r'
+              Right (r', _) -> Just r'
-            Nothing -> 0
+            Nothing -> Nothing
 
-      (mpb :: Maybe (ProgressBar ())) <- if progressBar
+      forM_ size $ \s -> forM_ eCSize $ \es -> when (es /= s) $ throwIO (ContentLengthError Nothing (Just s) es)
-        then Just <$> newProgressBar defStyle 10 (Progress 0 size ())
+      let size' = eCSize <|> size
-        else pure Nothing
+
+      (mpb :: Maybe (ProgressBar ())) <- case (progressBar, size') of
+        (True, Just size'') -> Just <$> newProgressBar defStyle 10 (Progress 0 (fromInteger size'') ())
+        _ -> pure Nothing
+
+      ior <- liftIO $ newIORef 0
 
       outStream <- liftIO $ Streams.makeOutputStream
         (\case
           Just bs -> do
-            forM_ mpb $ \pb -> incProgress pb (BS.length bs)
+            let len = BS.length bs
+            forM_ mpb $ \pb -> incProgress pb len
+
+            -- check we don't exceed size
+            forM_ size' $ \s -> do
+              cs <- readIORef ior
+              when ((cs + toInteger len) > s) $ throwIO (ContentLengthError Nothing (Just (cs + toInteger len)) s)
+
+            modifyIORef ior (+ toInteger len)
+
             void $ consumer bs
           Nothing -> pure ()
         )

lib/GHCup/Errors.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeOperators           #-}
 {-# LANGUAGE FlexibleInstances           #-}
+{-# LANGUAGE RankNTypes           #-}
 
 {-|
 Module      : GHCup.Errors
@@ -34,9 +35,150 @@ import           URI.ByteString
 
 import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
+import           Data.Data (Proxy(..))
 
 
 
+allHFError :: String
+allHFError = unlines allErrors
+ where
+  format p = "GHCup-" <> show (eBase p) <> " " <>  eDesc p
+  format'' e p = "GHCup-" <> show (eNum e) <> " " <>  eDesc p
+  format' e  _ = "GHCup-" <> show (eNum e) <> " " <>  prettyShow e
+  format''' e  _ str' = "GHCup-" <> show (eNum e) <> " " <>  str'
+  allErrors =
+    [ "# low level errors (1 to 500)"
+    , let proxy = Proxy :: Proxy NoCompatiblePlatform in format proxy
+    , let proxy = Proxy :: Proxy NoDownload in format proxy
+    , let proxy = Proxy :: Proxy NoUpdate in format proxy
+    , let proxy = Proxy :: Proxy DistroNotFound in format proxy
+    , let proxy = Proxy :: Proxy UnknownArchive in format proxy
+    , let proxy = Proxy :: Proxy UnsupportedScheme in format proxy
+    , let proxy = Proxy :: Proxy CopyError in format proxy
+    , let proxy = Proxy :: Proxy MergeFileTreeError in format proxy
+    , let proxy = Proxy :: Proxy TagNotFound in format proxy
+    , let proxy = Proxy :: Proxy NextVerNotFound in format proxy
+    , let proxy = Proxy :: Proxy AlreadyInstalled in format proxy
+    , let proxy = Proxy :: Proxy DirNotEmpty in format proxy
+    , let proxy = Proxy :: Proxy NotInstalled in format proxy
+    , let proxy = Proxy :: Proxy UninstallFailed in format proxy
+    , let proxy = Proxy :: Proxy NotFoundInPATH in format proxy
+    , let proxy = Proxy :: Proxy JSONError in format proxy
+    , let proxy = Proxy :: Proxy FileDoesNotExistError in format proxy
+    , let proxy = Proxy :: Proxy FileAlreadyExistsError in format proxy
+    , let proxy = Proxy :: Proxy TarDirDoesNotExist in format proxy
+    , let proxy = Proxy :: Proxy DigestError in format proxy
+    , let proxy = Proxy :: Proxy GPGError in format proxy
+    , let proxy = Proxy :: Proxy HTTPStatusError in format proxy
+    , let proxy = Proxy :: Proxy MalformedHeaders in format proxy
+    , let proxy = Proxy :: Proxy HTTPNotModified in format proxy
+    , let proxy = Proxy :: Proxy NoLocationHeader in format proxy
+    , let proxy = Proxy :: Proxy TooManyRedirs in format proxy
+    , let proxy = Proxy :: Proxy PatchFailed in format proxy
+    , let proxy = Proxy :: Proxy NoToolRequirements in format proxy
+    , let proxy = Proxy :: Proxy InvalidBuildConfig in format proxy
+    , let proxy = Proxy :: Proxy NoToolVersionSet in format proxy
+    , let proxy = Proxy :: Proxy NoNetwork in format proxy
+    , let proxy = Proxy :: Proxy HadrianNotFound in format proxy
+    , let proxy = Proxy :: Proxy ToolShadowed in format proxy
+    , let proxy = Proxy :: Proxy ContentLengthError in format proxy
+    , ""
+    , "# high level errors (5000+)"
+    , let proxy = Proxy :: Proxy DownloadFailed in format proxy
+    , let proxy = Proxy :: Proxy InstallSetError in format proxy
+    , let proxy = Proxy :: Proxy BuildFailed in format proxy
+    , let proxy = Proxy :: Proxy GHCupSetError in format proxy
+    , ""
+    , "# true exceptions (500+)"
+    , let proxy = Proxy :: Proxy ParseError in format proxy
+    , let proxy = Proxy :: Proxy UnexpectedListLength in format proxy
+    , let proxy = Proxy :: Proxy NoUrlBase in format proxy
+    , ""
+    , "# orphans (800+)"
+    , let proxy = Proxy :: Proxy URIParseError in format proxy
+    , let proxy = Proxy :: Proxy URIParseError
+          e     = MalformedScheme MissingColon
+      in format' e proxy
+    , let proxy = Proxy :: Proxy URIParseError
+          e     = MalformedUserInfo
+      in format' e proxy
+    , let proxy = Proxy :: Proxy URIParseError
+          e     = MalformedQuery
+      in format' e proxy
+    , let proxy = Proxy :: Proxy URIParseError
+          e     = MalformedFragment
+      in format' e proxy
+    , let proxy = Proxy :: Proxy URIParseError
+          e     = MalformedHost
+      in format' e proxy
+    , let proxy = Proxy :: Proxy URIParseError
+          e     = MalformedPort
+      in format' e proxy
+    , let proxy = Proxy :: Proxy URIParseError
+          e     = MalformedPath
+      in format' e proxy
+    , let proxy = Proxy :: Proxy URIParseError
+          e     = OtherError ""
+      in format'' e proxy
+    , let proxy = Proxy :: Proxy ArchiveResult in format proxy
+    , let proxy = Proxy :: Proxy ArchiveResult
+          e     = ArchiveFatal
+      in format' e proxy
+    , let proxy = Proxy :: Proxy ArchiveResult
+          e     = ArchiveFailed
+      in format' e proxy
+    , let proxy = Proxy :: Proxy ArchiveResult
+          e     = ArchiveWarn
+      in format' e proxy
+    , let proxy = Proxy :: Proxy ArchiveResult
+          e     = ArchiveRetry
+      in format' e proxy
+    , let proxy = Proxy :: Proxy ArchiveResult
+          e     = ArchiveOk
+      in format' e proxy
+    , let proxy = Proxy :: Proxy ArchiveResult
+          e     = ArchiveEOF
+      in format' e proxy
+
+    , let proxy = Proxy :: Proxy ProcessError in format proxy
+    , let proxy = Proxy :: Proxy ProcessError
+          e     = NonZeroExit 0 "" []
+      in format''' e proxy "A process returned a non-zero exit code."
+    , let proxy = Proxy :: Proxy ProcessError
+          e     = PTerminated "" []
+      in format''' e proxy "A process terminated prematurely."
+    , let proxy = Proxy :: Proxy ProcessError
+          e     = PStopped "" []
+      in format''' e proxy "A process stopped prematurely."
+    , let proxy = Proxy :: Proxy ProcessError
+          e     = NoSuchPid "" []
+      in format''' e proxy "Could not find PID for this process."
+    ]
+
+
+prettyHFError :: (Pretty e, HFErrorProject e) => e -> String
+prettyHFError e =
+  let errorCode = "GHCup-" <> padIntAndShow (eNum e)
+  in ("[" <> linkEscapeCode errorCode  (hfErrorLink errorCode) <> "] ") <> prettyShow e
+ where
+  linkEscapeCode linkText link = "\ESC]8;;" <> link <> "\ESC\\" <> linkText <> "\ESC]8;;\ESC\\"
+  hfErrorLink errorCode = "https://errors.haskell.org/messages/" <> errorCode
+  padIntAndShow i
+    | i < 10    = "0000" <> show i
+    | i < 100   = "000"  <> show i
+    | i < 1000  = "00"   <> show i
+    | i < 10000 = "0"    <> show i
+    | otherwise =           show i
+
+class HFErrorProject a where
+  eNum :: a -> Int
+  eNum _ = eBase (Proxy :: Proxy a)
+
+  eBase :: Proxy a -> Int
+
+  eDesc :: Proxy a -> String
+
+
     ------------------------
     --[ Low-level errors ]--
     ------------------------
@@ -51,20 +193,32 @@ instance Pretty NoCompatiblePlatform where
   pPrint (NoCompatiblePlatform str') =
     text ("Could not find a compatible platform. Got: " ++ str')
 
+instance HFErrorProject NoCompatiblePlatform where
+  eBase _ = 1
+  eDesc _ = "No compatible platform could be found"
+
 -- | Unable to find a download for the requested version/distro.
 data NoDownload = NoDownload
   deriving Show
 
 instance Pretty NoDownload where
   pPrint NoDownload =
-    text "Unable to find a download for the requested version/distro."
+    text (eDesc (Proxy :: Proxy NoDownload))
+
+instance HFErrorProject NoDownload where
+  eBase _ = 10
+  eDesc _ = "Unable to find a download for the requested version/distro."
 
 -- | No update available or necessary.
 data NoUpdate = NoUpdate
   deriving Show
 
 instance Pretty NoUpdate where
-  pPrint NoUpdate = text "No update available or necessary."
+  pPrint NoUpdate = text (eDesc (Proxy :: Proxy NoUpdate))
+
+instance HFErrorProject NoUpdate where
+  eBase _ = 20
+  eDesc _ = "No update available or necessary."
 
 -- | The Architecture is unknown and unsupported.
 data NoCompatibleArch = NoCompatibleArch String
@@ -74,13 +228,21 @@ instance Pretty NoCompatibleArch where
   pPrint (NoCompatibleArch arch) =
     text ("The Architecture is unknown or unsupported. Got: " ++ arch)
 
+instance HFErrorProject NoCompatibleArch where
+  eBase _ = 30
+  eDesc _ = "The Architecture is unknown and unsupported"
+
 -- | Unable to figure out the distribution of the host.
 data DistroNotFound = DistroNotFound
   deriving Show
 
 instance Pretty DistroNotFound where
   pPrint DistroNotFound =
-    text "Unable to figure out the distribution of the host."
+    text (eDesc (Proxy :: Proxy DistroNotFound))
+
+instance HFErrorProject DistroNotFound where
+  eBase _ = 40
+  eDesc _ = "Unable to figure out the distribution of the host"
 
 -- | The archive format is unknown. We don't know how to extract it.
 data UnknownArchive = UnknownArchive FilePath
@@ -90,12 +252,21 @@ instance Pretty UnknownArchive where
   pPrint (UnknownArchive file) =
     text $ "The archive format is unknown. We don't know how to extract the file " <> file
 
+instance HFErrorProject UnknownArchive where
+  eBase _ = 50
+  eDesc _ = "The archive format is unknown. We don't know how to extract it."
+
 -- | The scheme is not supported (such as ftp).
 data UnsupportedScheme = UnsupportedScheme
   deriving Show
 
 instance Pretty UnsupportedScheme where
-  pPrint UnsupportedScheme = text "The scheme is not supported (such as ftp)."
+  pPrint UnsupportedScheme =
+    text (eDesc (Proxy :: Proxy UnsupportedScheme))
+
+instance HFErrorProject UnsupportedScheme where
+  eBase _ = 60
+  eDesc _ = "The scheme is not supported (such as ftp)."
 
 -- | Unable to copy a file.
 data CopyError = CopyError String
@@ -105,6 +276,10 @@ instance Pretty CopyError where
   pPrint (CopyError reason) =
     text ("Unable to copy a file. Reason was: " ++ reason)
 
+instance HFErrorProject CopyError where
+  eBase _ = 70
+  eDesc _ = "Unable to copy a file."
+
 -- | Unable to merge file trees.
 data MergeFileTreeError = MergeFileTreeError IOException FilePath FilePath
   deriving Show
@@ -114,6 +289,10 @@ instance Pretty MergeFileTreeError where
     text "Failed to merge file tree from" <+> text from <+> text "to" <+> text to <+> text "\nexception was:" <+> text (displayException e)
      <+> text "\n...you may need to delete" <+> text to <+> text "manually. Make sure it's gone."
 
+instance HFErrorProject MergeFileTreeError where
+  eBase _ = 80
+  eDesc _ = "Unable to merge file trees during installation"
+
 -- | Unable to find a tag of a tool.
 data TagNotFound = TagNotFound Tag Tool
   deriving Show
@@ -122,6 +301,10 @@ instance Pretty TagNotFound where
   pPrint (TagNotFound tag tool) =
     text "Unable to find tag" <+> pPrint tag <+> text "of tool" <+> pPrint tool
 
+instance HFErrorProject TagNotFound where
+  eBase _ = 90
+  eDesc _ = "Unable to find a tag of a tool"
+
 -- | Unable to find the next version of a tool (the one after the currently
 -- set one).
 data NextVerNotFound = NextVerNotFound Tool
@@ -131,6 +314,10 @@ instance Pretty NextVerNotFound where
   pPrint (NextVerNotFound tool) =
     text "Unable to find next (the one after the currently set one) version of tool" <+> pPrint tool
 
+instance HFErrorProject NextVerNotFound where
+  eBase _ = 100
+  eDesc _ = "Unable to find the next version of a tool (the one after the currently set one)"
+
 -- | The tool (such as GHC) is already installed with that version.
 data AlreadyInstalled = AlreadyInstalled Tool Version
   deriving Show
@@ -140,6 +327,9 @@ instance Pretty AlreadyInstalled where
     (pPrint tool <> text "-" <> pPrint ver') <+> text "is already installed;"
     <+> text "if you really want to reinstall it, you may want to run 'ghcup install" <+> pPrint tool <+> text "--force" <+> (pPrint ver' <> text "'")
 
+instance HFErrorProject AlreadyInstalled where
+  eBase _ = 110
+  eDesc _ = "The tool (such as GHC) is already installed with that version"
 
 -- | The Directory is supposed to be empty, but wasn't.
 data DirNotEmpty = DirNotEmpty {path :: FilePath}
@@ -149,6 +339,10 @@ instance Pretty DirNotEmpty where
   pPrint (DirNotEmpty path) = do
     text $ "The directory was expected to be empty, but isn't: " <> path
 
+instance HFErrorProject DirNotEmpty where
+  eBase _ = 120
+  eDesc _ = "The Directory is supposed to be empty, but wasn't"
+
 -- | The tool is not installed. Some operations rely on a tool
 -- to be installed (such as setting the current GHC version).
 data NotInstalled = NotInstalled Tool GHCTargetVersion
@@ -158,6 +352,10 @@ instance Pretty NotInstalled where
   pPrint (NotInstalled tool ver) =
     text "The version" <+> pPrint ver <+> text "of the tool" <+> pPrint tool <+> text "is not installed."
 
+instance HFErrorProject NotInstalled where
+  eBase _ = 130
+  eDesc _ = "The required tool is not installed"
+
 data UninstallFailed = UninstallFailed FilePath [FilePath]
   deriving Show
 
@@ -165,6 +363,10 @@ instance Pretty UninstallFailed where
   pPrint (UninstallFailed dir files) =
     text "The following files survived uninstallation: " <+> pPrint files <+> text "...consider removing" <+> pPrint dir <+> text "manually."
 
+instance HFErrorProject UninstallFailed where
+  eBase _ = 140
+  eDesc _ = "Uninstallation failed with leftover files"
+
 -- | An executable was expected to be in PATH, but was not found.
 data NotFoundInPATH = NotFoundInPATH FilePath
   deriving Show
@@ -175,6 +377,10 @@ instance Pretty NotFoundInPATH where
   pPrint (NotFoundInPATH exe) =
     text $ "The exe " <> exe <> " was not found in PATH."
 
+instance HFErrorProject NotFoundInPATH where
+  eBase _ = 150
+  eDesc _ = "An executable was expected to be in PATH, but was not found"
+
 -- | JSON decoding failed.
 data JSONError = JSONDecodeError String
   deriving Show
@@ -183,6 +389,10 @@ instance Pretty JSONError where
   pPrint (JSONDecodeError err) =
     text $ "JSON decoding failed with: " <> err
 
+instance HFErrorProject JSONError where
+  eBase _ = 160
+  eDesc _ = "JSON decoding failed"
+
 -- | A file that is supposed to exist does not exist
 -- (e.g. when we use file scheme to "download" something).
 data FileDoesNotExistError = FileDoesNotExistError FilePath
@@ -192,6 +402,10 @@ instance Pretty FileDoesNotExistError where
   pPrint (FileDoesNotExistError file) =
     text $ "File " <> file <> " does not exist."
 
+instance HFErrorProject FileDoesNotExistError where
+  eBase _ = 170
+  eDesc _ = "A file that is supposed to exist does not exist (oops)"
+
 -- | The file already exists
 -- (e.g. when we use isolated installs with the same path).
 -- (e.g. This is done to prevent any overwriting)
@@ -202,6 +416,10 @@ instance Pretty FileAlreadyExistsError where
   pPrint (FileAlreadyExistsError file) =
     text $ "File " <> file <> " Already exists."
 
+instance HFErrorProject FileAlreadyExistsError where
+  eBase _ = 180
+  eDesc _ = "A file already exists that wasn't expected to exist"
+
 data TarDirDoesNotExist = TarDirDoesNotExist TarDir
   deriving Show
 
@@ -209,6 +427,10 @@ instance Pretty TarDirDoesNotExist where
   pPrint (TarDirDoesNotExist dir) =
     text "Tar directory does not exist:" <+> pPrint dir
 
+instance HFErrorProject TarDirDoesNotExist where
+  eBase _ = 190
+  eDesc _ = "The tar directory (e.g. inside an archive) does not exist"
+
 -- | File digest verification failed.
 data DigestError = DigestError FilePath Text Text
   deriving Show
@@ -219,7 +441,11 @@ instance Pretty DigestError where
       <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest <+> text
       "\nConsider removing the file in case it's cached and try again."
 
--- | File digest verification failed.
+instance HFErrorProject DigestError where
+  eBase _ = 200
+  eDesc _ = "File digest verification failed"
+
+-- | File PGP verification failed.
 data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs)
 
 deriving instance Show GPGError
@@ -227,6 +453,10 @@ deriving instance Show GPGError
 instance Pretty GPGError where
   pPrint (GPGError reason) = text "GPG verify failed:" <+> pPrint reason
 
+instance HFErrorProject GPGError where
+  eBase _ = 210
+  eDesc _ = "File PGP verification failed"
+
 -- | Unexpected HTTP status.
 data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
   deriving Show
@@ -235,6 +465,10 @@ instance Pretty HTTPStatusError where
   pPrint (HTTPStatusError status _) =
     text "Unexpected HTTP status:" <+> pPrint status
 
+instance HFErrorProject HTTPStatusError where
+  eBase _ = 220
+  eDesc _ = "Unexpected HTTP status error (e.g. during downloads)"
+
 -- | Malformed headers.
 data MalformedHeaders = MalformedHeaders Text
   deriving Show
@@ -243,6 +477,10 @@ instance Pretty MalformedHeaders where
   pPrint (MalformedHeaders h) =
     text "Headers are malformed: " <+> pPrint h
 
+instance HFErrorProject MalformedHeaders where
+  eBase _ = 230
+  eDesc _ = "Malformed headers during download"
+
 -- | Unexpected HTTP status.
 data HTTPNotModified = HTTPNotModified Text
   deriving Show
@@ -251,13 +489,21 @@ instance Pretty HTTPNotModified where
   pPrint (HTTPNotModified etag) =
     text "Remote resource not modifed, etag was:" <+> pPrint etag
 
+instance HFErrorProject HTTPNotModified where
+  eBase _ = 240
+  eDesc _ = "Not modified HTTP status error (e.g. during downloads)."
+
 -- | The 'Location' header was expected during a 3xx redirect, but not found.
 data NoLocationHeader = NoLocationHeader
   deriving Show
 
 instance Pretty NoLocationHeader where
   pPrint NoLocationHeader =
-    text "The 'Location' header was expected during a 3xx redirect, but not found."
+    text (eDesc (Proxy :: Proxy NoLocationHeader))
+
+instance HFErrorProject NoLocationHeader where
+  eBase _ = 250
+  eDesc _ = "The 'Location' header was expected during a 3xx redirect, but not found."
 
 -- | Too many redirects.
 data TooManyRedirs = TooManyRedirs
@@ -265,7 +511,11 @@ data TooManyRedirs = TooManyRedirs
 
 instance Pretty TooManyRedirs where
   pPrint TooManyRedirs =
-    text "Too many redirections."
+    text (eDesc (Proxy :: Proxy TooManyRedirs))
+
+instance HFErrorProject TooManyRedirs where
+  eBase _ = 260
+  eDesc _ = "Too many redirections."
 
 -- | A patch could not be applied.
 data PatchFailed = PatchFailed
@@ -273,7 +523,11 @@ data PatchFailed = PatchFailed
 
 instance Pretty PatchFailed where
   pPrint PatchFailed =
-    text "A patch could not be applied."
+    text (eDesc (Proxy :: Proxy PatchFailed))
+
+instance HFErrorProject PatchFailed where
+  eBase _ = 270
+  eDesc _ = "A patch could not be applied."
 
 -- | The tool requirements could not be found.
 data NoToolRequirements = NoToolRequirements
@@ -281,7 +535,11 @@ data NoToolRequirements = NoToolRequirements
 
 instance Pretty NoToolRequirements where
   pPrint NoToolRequirements =
-    text "The Tool requirements could not be found."
+    text (eDesc (Proxy :: Proxy NoToolRequirements))
+
+instance HFErrorProject NoToolRequirements where
+  eBase _ = 280
+  eDesc _ = "The Tool requirements could not be found."
 
 data InvalidBuildConfig = InvalidBuildConfig Text
   deriving Show
@@ -290,6 +548,10 @@ instance Pretty InvalidBuildConfig where
   pPrint (InvalidBuildConfig reason) =
     text "The build config is invalid. Reason was:" <+> pPrint reason
 
+instance HFErrorProject InvalidBuildConfig where
+  eBase _ = 290
+  eDesc _ = "The build config is invalid."
+
 data NoToolVersionSet = NoToolVersionSet Tool
   deriving Show
 
@@ -297,19 +559,31 @@ instance Pretty NoToolVersionSet where
   pPrint (NoToolVersionSet tool) =
     text "No version is set for tool" <+> pPrint tool <+> text "."
 
+instance HFErrorProject NoToolVersionSet where
+  eBase _ = 300
+  eDesc _ = "No version is set for tool (but was expected)."
+
 data NoNetwork = NoNetwork
   deriving Show
 
 instance Pretty NoNetwork where
   pPrint NoNetwork =
-    text "A download was required or requested, but '--offline' was specified."
+    text (eDesc (Proxy :: Proxy NoNetwork))
+
+instance HFErrorProject NoNetwork where
+  eBase _ = 310
+  eDesc _ = "A download was required or requested, but '--offline' was specified."
 
 data HadrianNotFound = HadrianNotFound
   deriving Show
 
 instance Pretty HadrianNotFound where
   pPrint HadrianNotFound =
-    text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
+    text (eDesc (Proxy :: Proxy HadrianNotFound))
+
+instance HFErrorProject HadrianNotFound where
+  eBase _ = 320
+  eDesc _ = "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
 
 data ToolShadowed = ToolShadowed
                        Tool
@@ -332,12 +606,43 @@ instance Pretty ToolShadowed where
          <> " in PATH."
          )
 
+instance HFErrorProject ToolShadowed where
+  eBase _ = 330
+  eDesc _ = "A tool is shadowed in PATH."
+
+-- | File content length verification failed.
+data ContentLengthError = ContentLengthError (Maybe FilePath) (Maybe Integer) Integer
+  deriving Show
+
+instance Pretty ContentLengthError where
+  pPrint (ContentLengthError Nothing Nothing expectedSize) =
+    text "Content length exceeded expected size:"
+      <+> text (show expectedSize)
+      <+> text "\nConsider removing the file in case it's cached and try again."
+  pPrint (ContentLengthError Nothing (Just currentSize) expectedSize) =
+    text "Content length error. Expected"
+      <+> text (show expectedSize) <+> text "but got" <+> pPrint currentSize <+> text
+      "\nConsider removing the file in case it's cached and try again."
+  pPrint (ContentLengthError (Just fp) (Just currentSize) expectedSize) =
+    text "Content length error for" <+> text (fp <> ": expected")
+      <+> text (show expectedSize) <+> text "but got" <+> pPrint currentSize <+> text
+      "\nConsider removing the file in case it's cached and try again."
+  pPrint (ContentLengthError (Just fp) Nothing expectedSize) =
+    text "Content length error for" <+> text (fp <> ": expected")
+      <+> text (show expectedSize) <+> text "\nConsider removing the file in case it's cached and try again."
+
+instance Exception ContentLengthError
+
+instance HFErrorProject ContentLengthError where
+  eBase _ = 340
+  eDesc _ = "File content length verification failed"
+
     -------------------------
     --[ High-level errors ]--
     -------------------------
 
 -- | A download failed. The underlying error is encapsulated.
-data DownloadFailed = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => DownloadFailed (V xs)
+data DownloadFailed = forall xs . (HFErrorProject (V xs), ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => DownloadFailed (V xs)
 
 instance Pretty DownloadFailed where
   pPrint (DownloadFailed reason) =
@@ -347,7 +652,12 @@ instance Pretty DownloadFailed where
 
 deriving instance Show DownloadFailed
 
-data InstallSetError = forall xs1 xs2 . (Show (V xs1), Pretty (V xs1), Show (V xs2), Pretty (V xs2)) => InstallSetError (V xs1) (V xs2)
+instance HFErrorProject DownloadFailed where
+  eBase _ = 5000
+  eNum (DownloadFailed xs) = 5000 + eNum xs
+  eDesc _ = "A download failed."
+
+data InstallSetError = forall xs1 xs2 . (Show (V xs1), Pretty (V xs1), HFErrorProject (V xs1), Show (V xs2), Pretty (V xs2), HFErrorProject (V xs2)) => InstallSetError (V xs1) (V xs2)
 
 instance Pretty InstallSetError where
   pPrint (InstallSetError reason1 reason2) =
@@ -358,9 +668,15 @@ instance Pretty InstallSetError where
 
 deriving instance Show InstallSetError
 
+instance HFErrorProject InstallSetError where
+  eBase _ = 7000
+  -- will there be collisions?
+  eNum (InstallSetError xs1 xs2) = 7000 + eNum xs1 + eNum xs2
+  eDesc _ = "Installation or setting the tool failed."
+
 
 -- | A build failed.
-data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)
+data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es), HFErrorProject (V es)) => BuildFailed FilePath (V es)
 
 instance Pretty BuildFailed where
   pPrint (BuildFailed path reason) =
@@ -370,18 +686,28 @@ instance Pretty BuildFailed where
 
 deriving instance Show BuildFailed
 
+instance HFErrorProject BuildFailed where
+  eBase _ = 8000
+  eNum (BuildFailed _ xs2) = 8000 + eNum xs2
+  eDesc _ = "The build failed."
+
 
 -- | Setting the current GHC version failed.
-data GHCupSetError = forall es . (ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es, Show (V es), Pretty (V es)) => GHCupSetError (V es)
+data GHCupSetError = forall es . (ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es, Show (V es), Pretty (V es), HFErrorProject (V es)) => GHCupSetError (V es)
 
 instance Pretty GHCupSetError where
   pPrint (GHCupSetError reason) =
     case reason of
       VMaybe (_ :: GHCupSetError) -> pPrint reason
-      _ -> text "Setting the current GHC version failed:" <+> pPrint reason
+      _ -> text "Setting the current version failed:" <+> pPrint reason
 
 deriving instance Show GHCupSetError
 
+instance HFErrorProject GHCupSetError where
+  eBase _ = 9000
+  eNum (GHCupSetError xs) = 9000 + eNum xs
+  eDesc _ = "Setting the current version failed."
+
 
     ---------------------------------------------
     --[ True Exceptions (e.g. for MonadThrow) ]--
@@ -398,6 +724,10 @@ instance Pretty ParseError where
 
 instance Exception ParseError
 
+instance HFErrorProject ParseError where
+  eBase _ = 500
+  eDesc _ = "A parse error occured."
+
 
 data UnexpectedListLength = UnexpectedListLength String
   deriving Show
@@ -408,6 +738,10 @@ instance Pretty UnexpectedListLength where
 
 instance Exception UnexpectedListLength
 
+instance HFErrorProject UnexpectedListLength where
+  eBase _ = 510
+  eDesc _ = "A list had an unexpected length."
+
 data NoUrlBase = NoUrlBase Text
   deriving Show
 
@@ -417,6 +751,10 @@ instance Pretty NoUrlBase where
 
 instance Exception NoUrlBase
 
+instance HFErrorProject NoUrlBase where
+  eBase _ = 520
+  eDesc _ = "URL does not have a base filename."
+
 
 
     ------------------------
@@ -436,6 +774,23 @@ instance
          Right x -> pPrint x
          Left xs -> pPrint xs
 
+instance HFErrorProject (V '[]) where
+   {-# INLINABLE eBase #-}
+   eBase _ = undefined
+   {-# INLINABLE eDesc #-}
+   eDesc _ = undefined
+
+instance
+   ( HFErrorProject x
+   , HFErrorProject (V xs)
+   ) => HFErrorProject (V (x ': xs))
+   where
+      eNum v = case popVariantHead v of
+         Right x -> eNum x
+         Left xs -> eNum xs
+      eDesc _ = undefined
+      eBase _ = undefined
+
 instance Pretty URIParseError where
   pPrint (MalformedScheme reason) =
     text "Failed to parse URI. Malformed scheme:" <+> text (show reason)
@@ -454,6 +809,22 @@ instance Pretty URIParseError where
   pPrint (OtherError err) =
     text "Failed to parse URI:" <+> pPrint err
 
+instance HFErrorProject URIParseError where
+  eBase _ = 800
+
+  eNum (MalformedScheme NonAlphaLeading) = 801
+  eNum (MalformedScheme InvalidChars) = 802
+  eNum (MalformedScheme MissingColon) = 803
+  eNum MalformedUserInfo   = 804
+  eNum MalformedQuery      = 805
+  eNum MalformedFragment   = 806
+  eNum MalformedHost       = 807
+  eNum MalformedPort       = 808
+  eNum MalformedPath       = 809
+  eNum (OtherError _)      = 810
+
+  eDesc _ = "Failed to parse URI."
+
 instance Pretty ArchiveResult where
   pPrint ArchiveFatal = text "Archive result: fatal"
   pPrint ArchiveFailed = text "Archive result: failed"
@@ -462,5 +833,37 @@ instance Pretty ArchiveResult where
   pPrint ArchiveOk = text "Archive result: Ok"
   pPrint ArchiveEOF = text "Archive result: EOF"
 
+instance HFErrorProject ArchiveResult where
+  eBase _ = 820
+
+  eNum ArchiveFatal  = 821
+  eNum ArchiveFailed = 822
+  eNum ArchiveWarn   = 823
+  eNum ArchiveRetry  = 824
+  eNum ArchiveOk     = 825
+  eNum ArchiveEOF    = 826
+
+  eDesc _ = "Archive extraction result."
+
 instance Pretty T.Text where
   pPrint = text . T.unpack
+
+instance Pretty ProcessError where
+  pPrint (NonZeroExit e exe args) =
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
+  pPrint (PTerminated exe args) =
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
+  pPrint (PStopped exe args) =
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
+  pPrint (NoSuchPid exe args) =
+    text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
+
+instance HFErrorProject ProcessError where
+  eBase _ = 840
+
+  eNum NonZeroExit{}     = 841
+  eNum (PTerminated _ _) = 842
+  eNum (PStopped _ _)    = 843
+  eNum (NoSuchPid _ _)   = 844
+
+  eDesc _ = "A process exited prematurely."

lib/GHCup/GHC.hs

@@ -109,6 +109,7 @@ fetchGHCSrc :: ( MonadFail m
             -> Maybe FilePath
             -> Excepts
                  '[ DigestError
+                  , ContentLengthError
                   , GPGError
                   , DownloadFailed
                   , NoDownload
@@ -152,6 +153,7 @@ installGHCBindist :: ( MonadFail m
                        '[ AlreadyInstalled
                         , BuildFailed
                         , DigestError
+                        , ContentLengthError
                         , GPGError
                         , DownloadFailed
                         , NoDownload
@@ -357,6 +359,7 @@ installGHCBin :: ( MonadFail m
                    '[ AlreadyInstalled
                     , BuildFailed
                     , DigestError
+                    , ContentLengthError
                     , GPGError
                     , DownloadFailed
                     , NoDownload
@@ -456,7 +459,7 @@ setGHC ver sghc mBinDir = do
       when (targetFile == "ghc") $
         liftIO (isShadowed fullF) >>= \case
           Nothing -> pure ()
-          Just pa -> lift $ logWarn $ T.pack $ prettyShow (ToolShadowed GHC pa fullF (_tvVersion ver))
+          Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed GHC pa fullF (_tvVersion ver))
 
   when (isNothing mBinDir) $ do
     -- create symlink for share dir
@@ -628,6 +631,7 @@ compileGHC :: ( MonadMask m
                 '[ AlreadyInstalled
                  , BuildFailed
                  , DigestError
+                 , ContentLengthError
                  , GPGError
                  , DownloadFailed
                  , GHCupSetError
@@ -676,7 +680,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
                          (view dlSubdir dlInfo)
         liftE $ applyAnyPatch patches (fromGHCupPath workdir)
 
-        pure (workdir, tmpUnpack, tver)
+        pure (workdir, tmpUnpack, Just tver)
 
       RemoteDist uri -> do
         lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
@@ -684,7 +688,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
         -- download source tarball
         tmpDownload <- lift withGHCupTmpDir
         tmpUnpack <- lift mkGhcupTmpDir
-        tar <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpDownload) Nothing False
+        tar <- liftE $ download uri Nothing Nothing Nothing (fromGHCupPath tmpDownload) Nothing False
         (bf, tver) <- liftE $ cleanUpOnError @'[UnknownArchive, ArchiveResult, ProcessError] tmpUnpack $ do
           liftE $ unpackToDir (fromGHCupPath tmpUnpack) tar
           let regex = [s|^(.*/)*boot$|] :: B.ByteString
@@ -694,18 +698,19 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
                            execBlank
                            regex
             )
-          tver <- liftE $ getGHCVer (appendGHCupPath tmpUnpack (takeDirectory bootFile))
+          tver <- liftE $ catchAllE @_ @'[ProcessError, ParseError] @'[] (\_ -> pure Nothing) $ fmap Just $ getGHCVer
+            (appendGHCupPath tmpUnpack (takeDirectory bootFile))
           pure (bootFile, tver)
 
         let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
 
-        pure (workdir, tmpUnpack, mkTVer tver)
+        pure (workdir, tmpUnpack, mkTVer <$> tver)
 
       -- clone from git
       GitDist GitBranch{..} -> do
         tmpUnpack <- lift mkGhcupTmpDir
         let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
-        tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] DownloadFailed $ do
+        tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError] DownloadFailed $ do
           let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
           lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
           lEM $ git [ "init" ]
@@ -715,7 +720,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
                     , fromString rep ]
 
           -- figure out if we can do a shallow clone
-          remoteBranches <- catchE @ProcessError @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] @'[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed, GPGError] (\(_ :: ProcessError) -> pure [])
+          remoteBranches <- catchE @ProcessError @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError] @'[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed, GPGError] (\(_ :: ProcessError) -> pure [])
               $ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
           let shallow_clone
                 | isCommitHash ref                     = True
@@ -745,20 +750,23 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
           liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
 
           -- bootstrap
-          tver <- liftE $ getGHCVer tmpUnpack
+          tver <- liftE $ catchAllE @_ @'[ProcessError, ParseError] @'[] (\_ -> pure Nothing) $ fmap Just $ getGHCVer
+            tmpUnpack
           liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
           lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n  " <>
-                           "GHC version (from Makefile): " <> prettyVer tver <>
+                           "GHC version (from Makefile): " <> T.pack (show (prettyVer <$> tver)) <>
                            (if not shallow_clone then "\n  " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
                            (if isCommitHash ref then mempty else "\n  " <> "commit hash: " <> chash)
           liftIO $ threadDelay 5000000 -- give the user a sec to intervene
 
           pure tver
 
-        pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
+        pure (tmpUnpack, tmpUnpack, mkTVer <$> tver)
     -- the version that's installed may differ from the
     -- compiled version, so the user can overwrite it
-    let installVer = maybe tver (\ov' -> tver { _tvVersion = ov' }) ov
+    installVer <- if | Just ov'   <- ov   -> pure (mkTVer ov')
+                     | Just tver' <- tver -> pure tver'
+                     | otherwise          -> fail "Newer GHCs don't support discovering the version in git. Complain to GHC devs: https://gitlab.haskell.org/ghc/ghc/-/issues/22322"
 
     alreadyInstalled <- lift $ ghcInstalled installVer
     alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
@@ -781,8 +789,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
       tmpUnpack
       (do
         b <- if hadrian
-             then compileHadrianBindist tver (fromGHCupPath workdir) ghcdir
+             -- prefer 'tver', because the real version carries out compatibility checks
-             else compileMakeBindist tver (fromGHCupPath workdir) ghcdir
+             -- we don't want the user to do funny things with it
+             then compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
+             else compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
         bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk $ fromGHCupPath workdir)
         pure (b, bmk)
       )
@@ -826,14 +836,14 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
                , MonadThrow m
                )
             => GHCupPath
-            -> Excepts '[ProcessError] m Version
+            -> Excepts '[ProcessError, ParseError] m Version
   getGHCVer tmpUnpack = do
     lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
     lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
     CapturedProcess {..} <- lift $ makeOut
       ["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
     case _exitCode of
-      ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
+      ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
       ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
 
   defaultConf =

lib/GHCup/HLS.hs

@@ -68,7 +68,6 @@ import qualified Data.List.NonEmpty            as NE
 import qualified Data.ByteString               as B
 import qualified Data.Text                     as T
 import qualified Text.Megaparsec               as MP
-import Text.PrettyPrint.HughesPJClass (prettyShow)
 
 
 data HLSVer = SourceDist Version
@@ -105,6 +104,7 @@ installHLSBindist :: ( MonadMask m
                        '[ AlreadyInstalled
                         , CopyError
                         , DigestError
+                        , ContentLengthError
                         , GPGError
                         , DownloadFailed
                         , NoDownload
@@ -297,6 +297,7 @@ installHLSBin :: ( MonadMask m
                    '[ AlreadyInstalled
                     , CopyError
                     , DigestError
+                    , ContentLengthError
                     , GPGError
                     , DownloadFailed
                     , NoDownload
@@ -344,6 +345,7 @@ compileHLS :: ( MonadMask m
                        , GPGError
                        , DownloadFailed
                        , DigestError
+                       , ContentLengthError
                        , UnknownArchive
                        , TarDirDoesNotExist
                        , ArchiveResult
@@ -401,7 +403,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
       -- download source tarball
       tmpDownload <- lift withGHCupTmpDir
       tmpUnpack <- lift mkGhcupTmpDir
-      tar <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpDownload) Nothing False
+      tar <- liftE $ download uri Nothing Nothing Nothing (fromGHCupPath tmpDownload) Nothing False
       (cf, tver) <- liftE $ cleanUpOnError tmpUnpack $ do
         unpackToDir (fromGHCupPath tmpUnpack) tar
         let regex = [s|^(.*/)*haskell-language-server\.cabal$|] :: B.ByteString
@@ -481,7 +483,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
 
   liftE $ runBuildAction
     tmpUnpack
-    (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
+    (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, ContentLengthError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
       let tmpInstallDir = fromGHCupPath workdir </> "out"
       liftIO $ createDirRecursive' tmpInstallDir
 
@@ -497,7 +499,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
           | otherwise -> pure (takeFileName cp)
         Just (Right uri) -> do
           tmpUnpack' <- lift withGHCupTmpDir
-          cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack') (Just "cabal.project") False
+          cp <- liftE $ download uri Nothing Nothing Nothing (fromGHCupPath tmpUnpack') (Just "cabal.project") False
           copyFileE cp (fromGHCupPath workdir </> "cabal.project") False
           pure "cabal.project"
         Nothing
@@ -511,7 +513,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
           | otherwise -> pure "cabal.project"
       forM_ cabalProjectLocal $ \uri -> do
         tmpUnpack' <- lift withGHCupTmpDir
-        cpl <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack') (Just (cp <.> "local")) False
+        cpl <- liftE $ download uri Nothing Nothing Nothing (fromGHCupPath tmpUnpack') (Just (cp <.> "local")) False
         copyFileE cpl (fromGHCupPath workdir </> cp <.> "local") False
       artifacts <- forM (sort ghcs) $ \ghc -> do
         let ghcInstallDir = tmpInstallDir </> T.unpack (prettyVer ghc)
@@ -631,7 +633,7 @@ setHLS ver shls mBinDir = do
 
       liftIO (isShadowed wrapper) >>= \case
         Nothing -> pure ()
-        Just pa -> lift $ logWarn $ T.pack $ prettyShow (ToolShadowed HLS pa wrapper ver)
+        Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed HLS pa wrapper ver)
 
 
 unsetHLS :: ( MonadMask m

lib/GHCup/Prelude.hs

@@ -41,24 +41,26 @@ import GHCup.Prelude.Posix
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
 import           Haskus.Utils.Variant.Excepts
-import           Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
+import           Text.PrettyPrint.HughesPJClass ( Pretty )
 import qualified Data.Text                     as T
 
 
 
 -- for some obscure reason... this won't type-check if we move it to a different module
 catchWarn :: forall es m env . ( Pretty (V es)
+                             , HFErrorProject (V es)
                              , MonadReader env m
                              , HasLog env
                              , MonadIO m
                              , Monad m) => Excepts es m () -> Excepts '[] m ()
-catchWarn = catchAllE @_ @es (\v -> lift $ logWarn (T.pack . prettyShow $ v))
+catchWarn = catchAllE @_ @es (\v -> lift $ logWarn (T.pack . prettyHFError $ v))
 
 
 runBothE' :: forall e m a b .
              ( Monad m
              , Show (V e)
              , Pretty (V e)
+             , HFErrorProject (V e)
              , PopVariant InstallSetError e
              , LiftVariant' e (InstallSetError ': e)
              , e :<< (InstallSetError ': e)

lib/GHCup/Prelude/File/Posix.hs

@@ -48,6 +48,7 @@ import           Streamly.Internal.Data.Unfold.Type
 import qualified Streamly.Internal.Data.Unfold as U
 import           Streamly.Internal.Control.Concurrent ( withRunInIO )
 import           Streamly.Internal.Data.IOFinalizer   ( newIOFinalizer, runIOFinalizer )
+import GHC.IO.Exception (IOException(ioe_type), IOErrorType (..))
 
 
 -- | On unix, we can use symlinks, so we just get the
@@ -116,8 +117,18 @@ copyFile from to fail' = do
         let dflags = [ FD.oNofollow
                      , if fail' then FD.oExcl else FD.oTrunc
                      ]
+        let openFdHandle' = openFdHandle to SPI.WriteOnly dflags $ Just sourceFileMode
         bracket
-          (openFdHandle to SPI.WriteOnly dflags $ Just sourceFileMode)
+          (handleIO (\e -> if
+                              -- if we copy from regular file to symlink, we need
+                              -- to delete the symlink
+                              | ioe_type e == InvalidArgument
+                              , not fail' -> do
+                                 removeLink to
+                                 openFdHandle'
+                              | otherwise -> throwIO e
+                    )
+            openFdHandle')
           (hClose . snd)
           $ \(_, tH) -> do
               hSetBinaryMode fH True

lib/GHCup/Prelude/File/Posix/Traversals.hs

@@ -36,8 +36,8 @@ import System.Posix.Internals (peekFilePath)
 ----------------------------------------------------------
 -- dodgy stuff
 
-type CDir = ()
+data {-# CTYPE "DIR" #-} CDir
-type CDirent = ()
+data {-# CTYPE "struct dirent" #-} CDirent
 
 -- Posix doesn't export DirStream, so to re-use that type we need to use
 -- unsafeCoerce.  It's just a newtype, so this is a legitimate usage.
@@ -56,7 +56,7 @@ foreign import ccall unsafe "__hscore_free_dirent"
 foreign import ccall unsafe "__hscore_d_name"
   c_name :: Ptr CDirent -> IO CString
 
-foreign import ccall unsafe "__posixdir_d_type"
+foreign import capi unsafe "dirutils.h __posixdir_d_type"
   c_type :: Ptr CDirent -> IO DirType
 
 ----------------------------------------------------------

lib/GHCup/Stack.hs

@@ -50,7 +50,6 @@ import           System.FilePath
 import           System.IO.Error
 
 import qualified Data.Text                     as T
-import Text.PrettyPrint.HughesPJClass (prettyShow)
 
 
 
@@ -82,6 +81,7 @@ installStackBin :: ( MonadMask m
                      '[ AlreadyInstalled
                       , CopyError
                       , DigestError
+                      , ContentLengthError
                       , GPGError
                       , DownloadFailed
                       , NoDownload
@@ -120,6 +120,7 @@ installStackBindist :: ( MonadMask m
                          '[ AlreadyInstalled
                           , CopyError
                           , DigestError
+                          , ContentLengthError
                           , GPGError
                           , DownloadFailed
                           , NoDownload
@@ -232,7 +233,7 @@ setStack ver = do
 
   liftIO (isShadowed stackbin) >>= \case
     Nothing -> pure ()
-    Just pa -> lift $ logWarn $ T.pack $ prettyShow (ToolShadowed Cabal pa stackbin ver)
+    Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Cabal pa stackbin ver)
 
   pure ()
 

lib/GHCup/Types.hs

@@ -35,7 +35,7 @@ import           Data.Text                      ( Text )
 import           Data.Versions
 import           GHC.IO.Exception               ( ExitCode )
 import           Optics                         ( makeLenses )
-import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text, (<+>))
+import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
 import           URI.ByteString
 #if defined(BRICK)
 import           Graphics.Vty                   ( Key(..) )
@@ -262,6 +262,7 @@ data DownloadInfo = DownloadInfo
   { _dlUri    :: URI
   , _dlSubdir :: Maybe TarDir
   , _dlHash   :: Text
+  , _dlCSize  :: Maybe Integer
   }
   deriving (Eq, Ord, GHC.Generic, Show)
 
@@ -297,10 +298,16 @@ instance NFData URLSource
 instance NFData (URIRef Absolute) where
   rnf (URI !_ !_ !_ !_ !_) = ()
 
+data MetaMode = Strict
+              | Lax
+  deriving (Show, Read, Eq, GHC.Generic)
+
+instance NFData MetaMode
 
 data UserSettings = UserSettings
   { uCache       :: Maybe Bool
   , uMetaCache   :: Maybe Integer
+  , uMetaMode    :: Maybe MetaMode
   , uNoVerify    :: Maybe Bool
   , uVerbose     :: Maybe Bool
   , uKeepDirs    :: Maybe KeepDirs
@@ -314,13 +321,14 @@ data UserSettings = UserSettings
   deriving (Show, GHC.Generic)
 
 defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
 fromSettings Settings{..} Nothing =
   UserSettings {
       uCache = Just cache
     , uMetaCache = Just metaCache
+    , uMetaMode = Just metaMode
     , uNoVerify = Just noVerify
     , uVerbose = Just verbose
     , uKeepDirs = Just keepDirs
@@ -346,6 +354,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
   in UserSettings {
       uCache = Just cache
     , uMetaCache = Just metaCache
+    , uMetaMode = Just metaMode
     , uNoVerify = Just noVerify
     , uVerbose = Just verbose
     , uKeepDirs = Just keepDirs
@@ -426,6 +435,7 @@ instance NFData LeanAppState
 data Settings = Settings
   { cache            :: Bool
   , metaCache        :: Integer
+  , metaMode         :: MetaMode
   , noVerify         :: Bool
   , keepDirs         :: KeepDirs
   , downloader       :: Downloader
@@ -442,7 +452,7 @@ defaultMetaCache :: Integer
 defaultMetaCache = 300 -- 5 minutes
 
 defaultSettings :: Settings
-defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False Nothing
+defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing
 
 instance NFData Settings
 
@@ -622,15 +632,7 @@ data ProcessError = NonZeroExit Int FilePath [String]
                   | NoSuchPid FilePath [String]
                   deriving Show
 
-instance Pretty ProcessError where
+
-  pPrint (NonZeroExit e exe args) =
-    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
-  pPrint (PTerminated exe args) =
-    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
-  pPrint (PStopped exe args) =
-    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
-  pPrint (NoSuchPid exe args) =
-    text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
 data CapturedProcess = CapturedProcess
   { _exitCode :: ExitCode
   , _stdOut   :: BL.ByteString

lib/GHCup/Types/JSON.hs

@@ -43,6 +43,7 @@ import qualified Text.Megaparsec               as MP
 import qualified Text.Megaparsec.Char          as MPC
 
 
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMode
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep

lib/GHCup/Utils.hs

@@ -1035,13 +1035,13 @@ applyAnyPatch :: ( MonadReader env m
                  , MonadIO m)
               => Maybe (Either FilePath [URI])
               -> FilePath
-              -> Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
+              -> Excepts '[PatchFailed, DownloadFailed, DigestError, ContentLengthError, GPGError] m ()
 applyAnyPatch Nothing _                   = pure ()
 applyAnyPatch (Just (Left pdir)) workdir  = liftE $ applyPatches pdir workdir
 applyAnyPatch (Just (Right uris)) workdir = do
   tmpUnpack <- fromGHCupPath <$> lift withGHCupTmpDir
   forM_ uris $ \uri -> do
-    patch <- liftE $ download uri Nothing Nothing tmpUnpack Nothing False
+    patch <- liftE $ download uri Nothing Nothing Nothing tmpUnpack Nothing False
     liftE $ applyPatch patch workdir
 
 
@@ -1172,7 +1172,7 @@ ensureGlobalTools :: ( MonadMask m
                      , MonadUnliftIO m
                      , MonadFail m
                      )
-                  => Excepts '[GPGError, DigestError , DownloadFailed, NoDownload] m ()
+                  => Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
 ensureGlobalTools
   | isWindows = do
       (GHCupInfo _ _ gTools) <- lift getGHCupInfo
@@ -1184,8 +1184,8 @@ ensureGlobalTools
           lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
           lift $ logDebug ("rm -f " <> T.pack (fromGHCupPath (cacheDir dirs) </> "gs.exe"))
           lift $ hideError doesNotExistErrorType $ recycleFile (fromGHCupPath (cacheDir dirs) </> "gs.exe")
-          liftE @'[GPGError, DigestError , DownloadFailed] $ dl
+          liftE @'[GPGError, DigestError, ContentLengthError, DownloadFailed] $ dl
-        ) `catchE` liftE @'[GPGError, DigestError , DownloadFailed] dl
+        ) `catchE` liftE @'[GPGError, DigestError, ContentLengthError, DownloadFailed] dl
   | otherwise = pure ()
 
 
@@ -1270,11 +1270,13 @@ warnAboutHlsCompatibility = do
   case (currentGHC, currentHLS) of
     (Just gv, Just hv) | gv `notElem` supportedGHC -> do
       logWarn $
-        "GHC " <> T.pack (prettyShow gv) <> " is not compatible with " <>
+        "GHC-" <> T.pack (prettyShow gv) <> " appears to have no corresponding HLS-" <> T.pack (prettyShow hv) <> " binary." <> "\n" <>
-        "Haskell Language Server " <> T.pack (prettyShow hv) <> "." <> "\n" <>
+        "Haskell IDE support may not work." <> "\n" <>
-        "Haskell IDE support may not work until this is fixed." <> "\n" <>
+        "You can try to either: " <> "\n" <>
-        "Install a different HLS version, or install and set one of the following GHCs:" <> "\n" <>
+        "  1. Install a different HLS version (e.g. downgrade for older GHCs)" <> "\n" <>
-        T.pack (prettyShow supportedGHC)
+        "  2. Install and set one of the following GHCs: " <> T.pack (prettyShow supportedGHC) <> "\n" <>
+        "  3. Let GHCup compile HLS for you, e.g. run: ghcup compile hls -g " <> T.pack (prettyShow hv) <> " --ghc " <> T.pack (prettyShow gv) <> " --cabal-update\n" <>
+        "     (see https://www.haskell.org/ghcup/guide/#hls for more information)"
 
     _ -> return ()
 
@@ -1299,7 +1301,7 @@ gitOut args dir = do
     ExitSuccess   -> pure $ T.pack $ stripNewlineEnd $ T.unpack $ decUTF8Safe' _stdOut
     ExitFailure c -> do
       let pe = NonZeroExit c "git" args
-      lift $ logDebug $ T.pack (prettyShow pe)
+      lift $ logDebug $ T.pack (prettyHFError pe)
       throwE pe
 
 processBranches :: T.Text -> [String]

lib/GHCup/Utils/Dirs.hs

@@ -465,15 +465,22 @@ withGHCupTmpDir :: ( MonadReader env m
                    , MonadMask m
                    , MonadIO m)
                 => m GHCupPath
-withGHCupTmpDir = snd <$> withRunInIO (\run ->
+withGHCupTmpDir = do
-  run
+  Settings{keepDirs} <- getSettings
-    $ allocate
+  snd <$> withRunInIO (\run ->
-        (run mkGhcupTmpDir)
+    run
-        (\fp ->
+      $ allocate
-            handleIO (\e -> run
+          (run mkGhcupTmpDir)
-                $ logDebug ("Resource cleanup failed for " <> T.pack (fromGHCupPath fp) <> ", error was: " <> T.pack (displayException e)))
+          (\fp -> if -- we don't know whether there was a failure, so can only
-            . removePathForcibly
+                     -- decide for 'Always'
-            $ fp))
+                     | keepDirs == Always -> pure ()
+                     | otherwise -> handleIO (\e -> run
+                        $ logDebug ("Resource cleanup failed for "
+                                   <> T.pack (fromGHCupPath fp)
+                                   <> ", error was: "
+                                   <> T.pack (displayException e)))
+                        . removePathForcibly
+                        $ fp))
 
 
 

mkdocs.yml

@@ -1,10 +1,10 @@
 site_name: GHCup
 site_url: https://www.haskell.org/ghcup
-site_description: GHCup is an installer for the general purpose language Haskell.
+site_description: GHCup is the main installer for the general purpose language Haskell.
 site_author: GHCup Team
 site_favicon: haskell_logo.png
 
-repo_url: https://gitlab.haskell.org/haskell/ghcup-hs
+repo_url: https://github.com/haskell/ghcup-hs
 
 theme:
     name: mkdocs

scripts/bootstrap/bootstrap-haskell

@@ -287,7 +287,7 @@ download_ghcup() {
             elif freebsd-version | grep -E '^13.*' ; then
                 freebsd_ver=13
             else
-                die "Unsupported FreeBSD version! Please report a bug at https://gitlab.haskell.org/haskell/ghcup-hs/-/issues"
+                die "Unsupported FreeBSD version! Please report a bug at https://github.com/haskell/ghcup-hs/issues"
             fi
 
 			case "${arch}" in

scripts/bootstrap/bootstrap-haskell.ps1

@@ -38,9 +38,13 @@ param (
     # Specify the cabal root directory (default: '$InstallDir\cabal')
     [string]$CabalDir,
     # Whether to disable use of curl.exe
-    [switch]$DisableCurl
+    [switch]$DisableCurl,
+    # The Msys2 version to download (e.g. 20221216)
+    [string]$Msys2Version
 )
 
+$DefaultMsys2Version = "20221216"
+
 $Silent = !$Interactive
 
 function Print-Msg {
@@ -423,12 +427,15 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
 	Start-Sleep -s 5
 
     # Download the archive
-    Print-Msg -msg 'Downloading Msys2 archive...'
+	if (!($Msys2Version)) {
-    $archive = 'msys2-x86_64-latest.sfx.exe'
+		$Msys2Version = $DefaultMsys2Version
+	}
+    Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
+    $archive = ('msys2-base-x86_64-{0}.sfx.exe' -f $Msys2Version)
     $archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
-    
+
     if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
-      Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/{0}' -f "$archive")
+      Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
     } else {
       Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
     }
@@ -603,7 +610,7 @@ if ($DisableCurl) {
 if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
   Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]]  && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
 } else {
-  Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]]  && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
+  Exec "$Msys2Shell" '-mingw64' '-mintty'  '-shell' 'bash' '-c' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]]  && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
 }
 
 

test/GHCup/Prelude/File/Posix/TraversalsSpec.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE CPP #-}
+
+module GHCup.Prelude.File.Posix.TraversalsSpec where
+
+
+#if !defined(IS_WINDOWS)
+import           GHCup.Prelude.File.Posix.Traversals
+
+import           Control.Monad.IO.Class (liftIO)
+import           Data.List
+import           System.Posix.Directory
+import           Unsafe.Coerce
+#endif
+
+import           Test.Hspec
+
+
+
+spec :: Spec
+spec = do
+#if defined(IS_WINDOWS)
+  pure ()
+#else
+  -- https://github.com/haskell/ghcup-hs/issues/415
+  describe "GHCup.Prelude.File.Posix.Traversals" $ do
+    it "readDirEnt" $ do
+      dirstream <- liftIO $ openDirStream "test/data"
+      (dt1, fp1) <- readDirEnt dirstream
+      (dt2, fp2) <- readDirEnt dirstream
+      (dt3, fp3) <- readDirEnt dirstream
+      (dt4, fp4) <- readDirEnt dirstream
+      let xs = sortOn snd [ (dt1, fp1), (dt2, fp2)
+                          , (dt3, fp3), (dt4, fp4)
+                          ]
+      xs `shouldBe` [(unsafeCoerce (4 :: Int),".")
+                    ,(unsafeCoerce (4 :: Int),"..")
+                    ,(unsafeCoerce (4 :: Int),"dir")
+                    ,(unsafeCoerce (8 :: Int),"file")
+                    ]
+#endif

test/GHCup/Types/JSONSpec.hs

@@ -5,6 +5,7 @@ module GHCup.Types.JSONSpec where
 import           GHCup.ArbitraryTypes ()
 import           GHCup.Types hiding ( defaultSettings )
 import           GHCup.Types.JSON ()
+import           GHCup.Prelude
 
 import           Test.Aeson.GenericSpecs
 import           Test.Hspec
@@ -13,5 +14,9 @@ import           Test.Hspec
 
 spec :: Spec
 spec = do
-  roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName "test/golden" }) (Proxy @GHCupInfo)
+  roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir }) (Proxy @GHCupInfo)
+ where
+  goldenDir
+    | isWindows = "test/golden/windows"
+    | otherwise = "test/golden/unix"