Fix

Co-authored-by: tomjaguarpaw <tom-github.com@jaguarpaw.co.uk>

.cirrus.yml

@@ -0,0 +1,25 @@
+freebsd_instance:
+  image_family: freebsd-13-1
+
+task:
+  env:
+    GHC_VER: 9.2.4
+    CABAL_VER: 3.6.2.0
+    ARTIFACT: "x86_64-portbld-freebsd-ghcup"
+    ARCH: 64
+    RUNNER_OS: FreeBSD
+    DISTRO: na
+    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:
+    - tzsetup Etc/GMT
+    - adjkerntz -a
+    - bash .github/scripts/build.sh
+    - bash .github/scripts/test.sh
+  binaries_artifacts:
+    path: "out/*"

.github/ghcup-run.files

@@ -0,0 +1,37 @@
+.
+./cabal
+./ghc
+./ghc-8.10.7
+./ghc-pkg
+./ghc-pkg-8.10.7
+./ghci
+./ghci-8.10.7
+./haddock
+./haddock-8.10.7
+./haskell-language-server-8.10.6
+./haskell-language-server-8.10.6~1.6.1.0
+./haskell-language-server-8.10.7
+./haskell-language-server-8.10.7~1.6.1.0
+./haskell-language-server-8.6.5
+./haskell-language-server-8.6.5~1.6.1.0
+./haskell-language-server-8.8.4
+./haskell-language-server-8.8.4~1.6.1.0
+./haskell-language-server-9.0.1
+./haskell-language-server-9.0.1~1.6.1.0
+./haskell-language-server-9.0.2
+./haskell-language-server-9.0.2~1.6.1.0
+./haskell-language-server-9.2.1
+./haskell-language-server-9.2.1~1.6.1.0
+./haskell-language-server-wrapper
+./haskell-language-server-wrapper-1.6.1.0
+./hp2ps
+./hp2ps-8.10.7
+./hpc
+./hpc-8.10.7
+./hsc2hs
+./hsc2hs-8.10.7
+./runghc
+./runghc-8.10.7
+./runhaskell
+./runhaskell-8.10.7
+./stack

.github/ghcup-run.files.alpine

@@ -0,0 +1,31 @@
+.
+./cabal
+./ghc
+./ghc-8.10.7
+./ghc-pkg
+./ghc-pkg-8.10.7
+./ghci
+./ghci-8.10.7
+./haddock
+./haddock-8.10.7
+./haskell-language-server-8.10.7
+./haskell-language-server-8.10.7~1.6.1.0
+./haskell-language-server-8.8.4
+./haskell-language-server-8.8.4~1.6.1.0
+./haskell-language-server-9.0.2
+./haskell-language-server-9.0.2~1.6.1.0
+./haskell-language-server-9.2.1
+./haskell-language-server-9.2.1~1.6.1.0
+./haskell-language-server-wrapper
+./haskell-language-server-wrapper-1.6.1.0
+./hp2ps
+./hp2ps-8.10.7
+./hpc
+./hpc-8.10.7
+./hsc2hs
+./hsc2hs-8.10.7
+./runghc
+./runghc-8.10.7
+./runhaskell
+./runhaskell-8.10.7
+./stack

.github/ghcup-run.files.windows

@@ -0,0 +1,81 @@
+.
+./cabal.exe
+./cabal.shim
+./ghc-8.10.7.exe
+./ghc-8.10.7.shim
+./ghc-pkg-8.10.7.exe
+./ghc-pkg-8.10.7.shim
+./ghc-pkg.exe
+./ghc-pkg.shim
+./ghc.exe
+./ghc.shim
+./ghci-8.10.7.exe
+./ghci-8.10.7.shim
+./ghci.exe
+./ghci.shim
+./ghcii-8.10.7.sh-8.10.7.exe
+./ghcii-8.10.7.sh-8.10.7.shim
+./ghcii-8.10.7.sh.exe
+./ghcii-8.10.7.sh.shim
+./ghcii.sh-8.10.7.exe
+./ghcii.sh-8.10.7.shim
+./ghcii.sh.exe
+./ghcii.sh.shim
+./haddock-8.10.7.exe
+./haddock-8.10.7.shim
+./haddock.exe
+./haddock.shim
+./haskell-language-server-8.10.6.exe
+./haskell-language-server-8.10.6.shim
+./haskell-language-server-8.10.6~1.6.1.0.exe
+./haskell-language-server-8.10.6~1.6.1.0.shim
+./haskell-language-server-8.10.7.exe
+./haskell-language-server-8.10.7.shim
+./haskell-language-server-8.10.7~1.6.1.0.exe
+./haskell-language-server-8.10.7~1.6.1.0.shim
+./haskell-language-server-8.6.5.exe
+./haskell-language-server-8.6.5.shim
+./haskell-language-server-8.6.5~1.6.1.0.exe
+./haskell-language-server-8.6.5~1.6.1.0.shim
+./haskell-language-server-8.8.4.exe
+./haskell-language-server-8.8.4.shim
+./haskell-language-server-8.8.4~1.6.1.0.exe
+./haskell-language-server-8.8.4~1.6.1.0.shim
+./haskell-language-server-9.0.1.exe
+./haskell-language-server-9.0.1.shim
+./haskell-language-server-9.0.1~1.6.1.0.exe
+./haskell-language-server-9.0.1~1.6.1.0.shim
+./haskell-language-server-9.0.2.exe
+./haskell-language-server-9.0.2.shim
+./haskell-language-server-9.0.2~1.6.1.0.exe
+./haskell-language-server-9.0.2~1.6.1.0.shim
+./haskell-language-server-9.2.1.exe
+./haskell-language-server-9.2.1.shim
+./haskell-language-server-9.2.1~1.6.1.0.exe
+./haskell-language-server-9.2.1~1.6.1.0.shim
+./haskell-language-server-wrapper-1.6.1.0.exe
+./haskell-language-server-wrapper-1.6.1.0.shim
+./haskell-language-server-wrapper.exe
+./haskell-language-server-wrapper.shim
+./hp2ps-8.10.7.exe
+./hp2ps-8.10.7.shim
+./hp2ps.exe
+./hp2ps.shim
+./hpc-8.10.7.exe
+./hpc-8.10.7.shim
+./hpc.exe
+./hpc.shim
+./hsc2hs-8.10.7.exe
+./hsc2hs-8.10.7.shim
+./hsc2hs.exe
+./hsc2hs.shim
+./runghc-8.10.7.exe
+./runghc-8.10.7.shim
+./runghc.exe
+./runghc.shim
+./runhaskell-8.10.7.exe
+./runhaskell-8.10.7.shim
+./runhaskell.exe
+./runhaskell.shim
+./stack.exe
+./stack.shim

.github/scripts/bootstrap.sh

@@ -0,0 +1,16 @@
+#!/usr/bin/env bash
+
+set -eux
+
+. .github/scripts/prereq.sh
+
+mkdir -p "$CI_PROJECT_DIR"/.local/bin
+
+git describe --always
+
+### build
+
+./scripts/bootstrap/bootstrap-haskell
+
+[ "$(ghc --numeric-version)" = "${BOOTSTRAP_HASKELL_GHC_VERSION}" ]
+

.github/scripts/build.sh

@@ -0,0 +1,76 @@
+#!/bin/sh
+
+set -eux
+
+. .github/scripts/prereq.sh
+. .github/scripts/common.sh
+
+
+# ensure ghcup
+if ! command -v ghcup ; then
+	install_ghcup
+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
+	if [ "${DISTRO}" != "Debian" ] ; then # ! armv7 or aarch64 linux
+		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"
+fi
+
+git_describe
+
+
+# build
+ecabal update
+
+if [ "${RUNNER_OS}" = "Linux" ] ; then
+	if [ "${ARCH}" = "32" ] ; then
+		build_with_cache -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui --enable-tests
+	elif [ "${ARCH}" = "64" ] ; then
+		build_with_cache -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui --enable-tests
+	else
+		build_with_cache -w "${GHC}" -ftui --enable-tests
+	fi
+elif [ "${RUNNER_OS}" = "FreeBSD" ] ; then
+	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
+	build_with_cache -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" --enable-tests
+else
+	build_with_cache -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui --enable-tests
+fi
+
+
+# set up artifacts
+mkdir -p out
+binary=$(cabal list-bin ghcup)
+binary_test=$(cabal list-bin ghcup-test)
+ver=$("${binary}" --numeric-version)
+strip_binary "${binary}"
+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/experimental5/i386-linux-cabal-cache
+					;;
+				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-linux-cabal-cache
+					;;
+				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/aarch64-linux-cabal-cache
+					;;
+				"ARM") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/armv7-linux-cabal-cache
+					;;
+			esac
+			;;
+		"FreeBSD")
+			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-portbld-freebsd-cabal-cache
+			;;
+		"Windows")
+			exe=".exe"
+			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-mingw64-cabal-cache
+			;;
+		"macOS")
+			case "${ARCH}" in
+				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/aarch64-apple-darwin-cabal-cache
+					;;
+				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/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 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=yes 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

@@ -0,0 +1,73 @@
+#!/usr/bin/env bash
+
+set -eux
+
+. .github/scripts/prereq.sh
+. .github/scripts/common.sh
+
+mkdir -p "$CI_PROJECT_DIR"/.local/bin
+
+### build
+
+
+
+if [ "${OS}" = "Windows" ] ; then
+	GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
+else
+	GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
+fi
+
+rm -rf "${GHCUP_DIR}"
+mkdir -p "${GHCUP_BIN}"
+
+ls -lah out
+find out
+cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
+chmod +x "$GHCUP_BIN/ghcup${ext}"
+echo "$PATH"
+
+"$GHCUP_BIN/ghcup${ext}" --version
+eghcup --version
+sha_sum "$GHCUP_BIN/ghcup${ext}"
+sha_sum "$(raw_eghcup --offline whereis ghcup)"
+
+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
+
+(
+	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 -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
+[ ! -e "${GHCUP_DIR}" ]
+

.github/scripts/prereq.sh

@@ -0,0 +1,66 @@
+#!/bin/sh
+
+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
+	CI_PROJECT_DIR="$(pwd)"
+	export CI_PROJECT_DIR
+    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"
+    export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/.ghcup/bin"
+    export PATH="$GHCUP_BIN:$PATH"
+    export CABAL_DIR="$CI_PROJECT_DIR/cabal"
+    export CABAL_CACHE="$CI_PROJECT_DIR/cabal-cache"
+fi
+
+if [ "${RUNNER_OS}" = "Linux" ] ; then
+	if [ "${DISTRO}" = "Alpine" ] ; then
+		:
+	elif [ "${DISTRO}" = "Ubuntu" ] ; then
+		export DEBIAN_FRONTEND=noninteractive
+		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
+		[ -e "$HOME/.brew" ] ||
+			git clone --depth=1 https://github.com/Homebrew/brew "$HOME/.brew"
+		export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
+		brew update
+	fi
+	if ! command -v git ; then
+		brew install git
+	fi
+	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

@@ -0,0 +1,263 @@
+#!/usr/bin/env bash
+
+set -eux
+
+. .github/scripts/prereq.sh
+. .github/scripts/common.sh
+
+
+if [ "${OS}" = "Windows" ] ; then
+	GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
+else
+	GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
+fi
+
+git_describe
+
+rm -rf "${GHCUP_DIR}"
+mkdir -p "${GHCUP_BIN}"
+
+cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
+cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}"
+chmod +x "$GHCUP_BIN/ghcup${ext}"
+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
+
+eghcup install ghc ${GHC_VER}
+eghcup unset ghc ${GHC_VER}
+ls -lah "$(eghcup whereis -d ghc ${GHC_VER})"
+[ "`$(eghcup whereis ghc ${GHC_VER}) --numeric-version`" = "${GHC_VER}" ]
+[ "`eghcup run --ghc ${GHC_VER} -- ghc --numeric-version`" = "${GHC_VER}" ]
+[ "`ghcup run --ghc ${GHC_VER} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VER}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
+eghcup set ghc ${GHC_VER}
+eghcup install cabal ${CABAL_VER}
+[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
+eghcup unset cabal
+"$GHCUP_BIN"/cabal --version && exit 1 || echo yes
+
+# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
+# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
+[ "`eghcup run --cabal ${CABAL_VER} -- cabal --numeric-version`" = "${CABAL_VER}" ]
+eghcup set cabal ${CABAL_VER}
+
+[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
+
+if [ "${OS}" != "FreeBSD" ] ; then
+	if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
+		eghcup run --ghc 8.10.7 --cabal 3.4.1.0 --hls 1.6.1.0 --stack 2.7.3 --install --bindir "$(pwd)/.bin"
+		if [ "${OS}" = "Windows" ] ; then
+			cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files.windows" | sort > expected.txt
+		elif [ "${DISTRO}" = "Alpine" ] ; then
+			cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files.alpine" | sort > expected.txt
+		else
+			cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files" | sort > expected.txt
+		fi
+		(cd ".bin" && find . | sort) > actual.txt
+		diff --strip-trailing-cr -w -u actual.txt expected.txt
+		rm actual.txt expected.txt
+		rm -rf .bin
+	fi
+fi
+
+cabal --version
+
+eghcup debug-info
+
+# also test etags
+eghcup list
+eghcup list -t ghc
+eghcup list -t cabal
+
+ghc_ver=$(ghc --numeric-version)
+ghc --version
+ghc-${ghc_ver} --version
+if [ "${OS}" != "Windows" ] ; then
+		ghci --version
+		ghci-${ghc_ver} --version
+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
+	# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
+	if [ "${OS}" = "Linux" ] ; then
+		eghcup --downloader=wget prefetch ghc 8.10.3
+		eghcup --offline install ghc 8.10.3
+		if [ "${ARCH}" = "64" ] ; then
+		    if [ "${DISTRO}" = "Alpine" ] ; then
+				(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.alpine.files" | sort) > expected.txt
+			else
+				(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort) > expected.txt
+			fi
+			(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort) > actual.txt
+			# ignore docs
+		    sed -i '/share\/doc/d' actual.txt
+		    sed -i '/share\/doc/d' expected.txt
+			diff --strip-trailing-cr -w -u actual.txt expected.txt
+			rm actual.txt expected.txt
+		fi
+	elif [ "${OS}" = "Windows" ] ; then
+		eghcup prefetch ghc 8.10.3
+		eghcup --offline install ghc 8.10.3
+		(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort) > expected.txt
+		(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort) > actual.txt
+		diff --strip-trailing-cr -w -u actual.txt expected.txt
+		rm actual.txt expected.txt
+	else
+		eghcup prefetch ghc 8.10.3
+		eghcup --offline install ghc 8.10.3
+	fi
+	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
+	eghcup --offline set 8.10.3
+	eghcup set 8.10.3
+	[ "$(ghc --numeric-version)" = "8.10.3" ]
+	eghcup set ${GHC_VER}
+	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
+	eghcup unset ghc
+    "$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
+	eghcup set ${GHC_VER}
+	eghcup --offline rm 8.10.3
+	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
+
+
+	ls -lah "$GHCUP_BIN"
+
+	if [ "${OS}" = "macOS" ] ; then
+		eghcup install hls
+		$(eghcup whereis hls) --version
+
+		eghcup install stack
+		$(eghcup whereis stack) --version
+	elif [ "${OS}" = "Linux" ] ; then
+		if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
+			eghcup install hls
+			haskell-language-server-wrapper --version
+			eghcup unset hls
+			"$GHCUP_BIN"/haskell-language-server-wrapper --version && exit 1 || echo yes
+
+			eghcup install stack
+			stack --version
+			eghcup unset stack
+			"$GHCUP_BIN"/stack --version && exit 1 || echo yes
+		fi
+	fi
+fi
+
+
+
+# check that lazy loading works for 'whereis'
+cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
+echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
+eghcup whereis ghc $(ghc --numeric-version)
+mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
+
+eghcup rm $(ghc --numeric-version)
+
+# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
+if [ "${OS}" = "Linux" ] ; then
+	if [ "${ARCH}" = "64" ] ; then
+		eghcup install cabal -u https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.7.0.0-pre20220407/cabal-install-3.7-x86_64-linux-alpine.tar.xz 3.4.0.0-rc4
+		eghcup rm cabal 3.4.0.0-rc4
+	fi
+fi
+
+eghcup gc -c
+
+# test etags
+rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
+raw_eghcup -s https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml list
+# snapshot yaml and etags file
+etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
+sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
+# invalidate access time timer, which is 5minutes, so we re-download
+touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
+# redownload same file with some newlines added
+raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
+# snapshot new yaml and etags file
+etag2=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
+sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
+# compare
+[ "${etag}" != "${etag2}" ]
+[ "${sha}" != "${sha2}" ]
+# invalidate access time timer, which is 5minutes, but don't expect a re-download
+touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
+# this time, we expect the same hash and etag
+raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
+etag3=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
+sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
+[ "${etag2}" = "${etag3}" ]
+[ "${sha2}" = "${sha3}" ]
+
+# test isolated installs
+if [ "${DISTRO}" != "Alpine" ] ; then
+	eghcup install ghc -i "$(pwd)/isolated" 8.10.5
+	[ "$(isolated/bin/ghc --numeric-version)" = "8.10.5" ]
+	! eghcup install ghc -i "$(pwd)/isolated" 8.10.5
+	if [ "${ARCH}" = "64" ] ; then
+		if [ "${OS}" = "Linux" ] || [ "${OS}" = "Windows" ] ; then
+			eghcup install cabal -i "$(pwd)/isolated" 3.4.0.0
+			[ "$(isolated/cabal --numeric-version)" = "3.4.0.0" ]
+			eghcup install stack -i "$(pwd)/isolated" 2.7.3
+			[ "$(isolated/stack --numeric-version)" = "2.7.3" ]
+			eghcup install hls -i "$(pwd)/isolated" 1.3.0
+			[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0" ] ||
+				[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0.0" ]
+
+			# test that isolated installs don't clean up target directory
+			cat <<EOF > "${GHCUP_BIN}/gmake"
+#!/bin/bash
+exit 1
+EOF
+			chmod +x "${GHCUP_BIN}/gmake"
+			mkdir isolated_tainted/
+			touch isolated_tainted/lol
+
+			! eghcup install ghc -i "$(pwd)/isolated_tainted" 8.10.5 --force
+			[ -e "$(pwd)/isolated_tainted/lol" ]
+			rm "${GHCUP_BIN}/gmake"
+		fi
+	fi
+fi
+
+eghcup upgrade
+eghcup upgrade -f
+
+# restore old ghcup, because we want to test nuke
+cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
+chmod +x "$GHCUP_BIN/ghcup${ext}"
+
+# test that doing fishy symlinks into GHCup dir doesn't cause weird stuff on 'ghcup nuke'
+mkdir no_nuke/
+mkdir no_nuke/bar
+echo 'foo' > no_nuke/file
+echo 'bar' > no_nuke/bar/file
+ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/cache/no_nuke
+ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/logs/no_nuke
+
+# nuke
+eghcup nuke
+[ ! -e "${GHCUP_DIR}" ]
+
+# make sure nuke doesn't resolve symlinks
+[ -e "$CI_PROJECT_DIR"/no_nuke/file ]
+[ -e "$CI_PROJECT_DIR"/no_nuke/bar/file ]
+

.github/workflows/bootstrap.yaml

@@ -0,0 +1,48 @@
+name: Bootstrap tests
+
+on:
+  push:
+    branches:
+      - master
+    tags:
+      - 'v*'
+  pull_request:
+    branches:
+      - master
+
+jobs:
+  bootstrap:
+    name: bootstrap
+    runs-on: ${{ matrix.os }}
+    env:
+      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:
+          - os: ubuntu-latest
+            DISTRO: Ubuntu
+          - os: macOS-10.15
+            DISTRO: na
+          - os: windows-latest
+            DISTRO: na
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+        with:
+          submodules: 'true'
+
+      - if: runner.os != 'Windows'
+        name: Run bootstrap
+        run: sh ./.github/scripts/bootstrap.sh
+        env:
+          DISTRO: ${{ matrix.DISTRO }}
+
+      - if: runner.os == 'Windows'
+        name: Run bootstrap
+        run: ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ${GITHUB_WORKSPACE}/bootstrap-haskell -InBash
+        shell: pwsh

.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/hlint.yaml

@@ -0,0 +1,26 @@
+name: Hlint
+
+on:
+  push:
+    branches:
+      - master
+    tags:
+      - 'v*'
+  pull_request:
+    branches:
+      - master
+
+jobs:
+  hlint:
+    name: hlint
+    runs-on: ubuntu-latest
+    env:
+      JSON_VERSION: "0.0.7"
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+        with:
+          submodules: 'true'
+
+      - name: Run hlint
+        run: curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s -- -r lib/ test/

.github/workflows/mkdocs.yaml

@@ -0,0 +1,33 @@
+name: MkDocs
+
+on:
+  push:
+    branches:
+      - master
+    tags:
+      - 'v*'
+  pull_request:
+    branches:
+      - master
+
+jobs:
+  mkdocs:
+    name: mkdocs
+    runs-on: ubuntu-latest
+    env:
+      JSON_VERSION: "0.0.7"
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+        with:
+          submodules: 'true'
+
+      - name: Install mkdocs deps
+        run: |
+          sudo apt-get update -y
+          sudo apt-get install -y python3-pip
+          sudo pip3 install mkdocs
+
+      - name: Run mkdocs
+        run: |
+          mkdocs build

.github/workflows/release.yaml

@@ -1,109 +1,460 @@
-name: Create Release
+name: Build and release
 
 on:
   push:
+    branches:
+      - master
     tags:
       - 'v*'
+  pull_request:
+    branches:
+      - master
+  schedule:
+    - cron: '0 2 * * *'
 
 jobs:
-  draft_release:
-    name: Draft Release
-    runs-on: ubuntu-latest
-    outputs:
-      upload_url: ${{ steps.create_release.outputs.upload_url }}
-
-    steps:
-      - name: Create Release
-        id: create_release
-        uses: actions/create-release@v1
-        env:
-          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-        with:
-          tag_name: ${{ github.ref }}
-          release_name: Release ${{ github.ref }}
-          body: |
-            Changes in this Release
-            - First Change
-            - Second Change
-          draft: true
-          prerelease: false
-
-  release-mac:
-    name: Create Release
-    needs: draft_release
+  build-linux:
+    name: Build linux binary
     runs-on: ${{ matrix.os }}
     env:
-      MACOSX_DEPLOYMENT_TARGET: 10.13
+      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:
-        os:
-          - macOS-10.15
+        include:
+          - os: ubuntu-latest
+            ARTIFACT: "i386-linux-ghcup"
+            GHC_VER: 8.10.7
+            ARCH: 32
+          - os: ubuntu-latest
+            ARTIFACT: "x86_64-linux-ghcup"
+            GHC_VER: 8.10.7
+            ARCH: 64
     steps:
       - name: Checkout code
-        uses: actions/checkout@v2
-
-      - uses: haskell/actions/setup@v1.2
+        uses: actions/checkout@v3
         with:
-          ghc-version: 8.10.7
-          cabal-version: 3.6.2.0
+          submodules: 'true'
 
-      - name: create ~/.local/bin
-        run: mkdir -p "$HOME/.local/bin"
-        shell: bash
-
-      - name: Add ~/.local/bin to PATH
-        run: echo "$HOME/.local/bin" >> $GITHUB_PATH
-        shell: bash
-
-      - name: Update cabal cache
-        run: cabal update
-        shell: bash
-
-      - name: Install cabal dependencies
-        run: cabal build --only-dependencies --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui
-        shell: bash
-
-      - name: Build
-        run: cabal build --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui
-        shell: bash
-
-      - name: Install
-        run: cp "$(cabal list-bin exe:ghcup)" ~/.local/bin/ghcup
-        shell: bash
-
-      - name: Strip
-        run: strip ~/.local/bin/ghcup
-        shell: bash
-
-      - name: Run tests
-        run: cabal test --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" all
-        shell: bash
-
-      - name: Install git
-        run: brew install git
-
-      - name: set HOME
-        run: echo "HOME=$HOME" >> $GITHUB_ENV
-        shell: bash
-
-      - name: Set ASSET_PATH
-        run: echo "ASSET_PATH=$HOME/.local/bin/ghcup" >> $GITHUB_ENV
-        shell: bash
-
-      - name: Upload Release Asset
-        id: upload-release-asset
-        uses: actions/upload-release-asset@v1
+      - 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:
-          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+          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:
-          upload_url: ${{ needs.draft_release.outputs.upload_url }}
-          asset_path: ${{ env.ASSET_PATH }}
-          asset_name: ghcup-${{ matrix.os }}
-          asset_content_type: application/octet-stream
+          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()
-        uses: actions/upload-artifact@v2
+        name: Upload artifact
+        uses: actions/upload-artifact@v3
         with:
-          name: plan.json
-          path: ./dist-newstyle/cache/plan.json
+          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
+            ARCH: ARM64
+          - os: macOS-10.15
+            ARTIFACT: "x86_64-apple-darwin-ghcup"
+            GHC_VER: 9.2.5
+            ARCH: 64
+          - os: windows-latest
+            ARTIFACT: "x86_64-mingw64-ghcup"
+            GHC_VER: 8.10.7
+            ARCH: 64
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+        with:
+          submodules: 'true'
+
+      - 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
+        uses: actions/upload-artifact@v3
+        with:
+          name: artifacts
+          path: |
+            ./out/*
+
+
+  test-linux:
+    name: Test linux
+    needs: "build-linux"
+    runs-on: ${{ matrix.os }}
+    env:
+      CABAL_VER: 3.6.2.0
+      JSON_VERSION: "0.0.7"
+    strategy:
+      matrix:
+        include:
+          - os: ubuntu-latest
+            ARTIFACT: "i386-linux-ghcup"
+            GHC_VER: 8.10.7
+            ARCH: 32
+            DISTRO: Alpine
+          - os: ubuntu-latest
+            ARTIFACT: "x86_64-linux-ghcup"
+            GHC_VER: 8.10.7
+            ARCH: 64
+            DISTRO: Alpine
+          - os: ubuntu-latest
+            ARTIFACT: "x86_64-linux-ghcup"
+            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
+            ARCH: ARM64
+            DISTRO: na
+          - os: macOS-10.15
+            ARTIFACT: "x86_64-apple-darwin-ghcup"
+            GHC_VER: 9.2.5
+            ARCH: 64
+            DISTRO: na
+          - os: windows-latest
+            ARTIFACT: "x86_64-mingw64-ghcup"
+            GHC_VER: 8.10.7
+            ARCH: 64
+            DISTRO: na
+
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+        with:
+          submodules: 'true'
+
+      - uses: actions/download-artifact@v3
+        with:
+          name: artifacts
+          path: ./out
+
+      - name: Run test (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-linux
+    runs-on: ubuntu-latest
+    env:
+      GHC_VERSION: "8.10.7"
+      HLS_TARGET_VERSION: "1.8.0.0"
+      CABAL_VERSION: "3.6.2.0"
+      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
+        with:
+          submodules: 'true'
+
+      - uses: actions/download-artifact@v3
+        with:
+          name: artifacts
+          path: ./out
+
+      - name: Run hls build
+        run: sh .github/scripts/hls.sh
+        env:
+          APT_GET: "sudo apt-get"
+
+  release:
+    name: release
+    needs: ["test-linux", "test-arm", "test-macwin", "hls"]
+    runs-on: ubuntu-latest
+    if: startsWith(github.ref, 'refs/tags/v')
+    steps:
+      - name: Download artifacts
+        uses: actions/download-artifact@v3
+        with:
+          name: artifacts
+          path: ./out
+
+      - name: Release
+        uses: softprops/action-gh-release@v1
+        with:
+          draft: true
+          files: |
+            ./out/*

.github/workflows/shellcheck.yaml

@@ -0,0 +1,28 @@
+name: Shellcheck
+
+on:
+  push:
+    branches:
+      - master
+    tags:
+      - 'v*'
+  pull_request:
+    branches:
+      - master
+
+jobs:
+  shellcheck:
+    name: shellcheck
+    runs-on: ubuntu-latest
+    env:
+      JSON_VERSION: "0.0.7"
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+        with:
+          submodules: 'true'
+
+      - name: Run shellcheck
+        uses: docker://koalaman/shellcheck-alpine
+        with:
+          args: shellcheck scripts/bootstrap/bootstrap-haskell

CHANGELOG.md

@@ -1,5 +1,36 @@
 # Revision history for ghcup
 
+## 0.1.18.1 -- 2022-08-06
+
+* fix sdist and unbreak hackage, wrt [#399](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/399)
+
+## 0.1.18.0 -- 2022-07-30
+
+* Fix tui set wrt [#266](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/266) by Arjun Kathuria
+    - Ask the user to install the tool via prompt when setting an non-installed version
+* improvements to safe (un-)installations
+    - bindists that don't support `make DESTDIR=/some/tmp/dir install` are now unsupported
+    - installed GHC files are now recorded to avoid use of `removePathForcibly`
+    - internally uses a newtype wrapper for user-input paths and restrict destructive operations to validated paths
+* Add `--disable-ld-override` for darwin bindists wrt #391
+* Allow passing bindist configure args wrt #377
+* use of `TMPDIR` is dropped... now uses an internal tmp dir `~/.ghcup/tmp`
+* improvements to error handling and warnings
+* Require --isolate to have an absolute directory, fixes #367
+* Fix mingw PATH handling wrt #371
+* Add --mingw-path switch to `ghcup run`
+* Fix `ghcup run` on windows, fixes #375
+* Improve `ghcup compile <hls|ghc>`
+    - short hashes now work
+    - print the long hash in addition to the detected version
+* Improve `ghcup compile hls`
+    - add `--git-describe-version` switch as an alternative to `--overwrite-version`
+    - Allow to build HLS from hackage (now is the default)
+	- Allow to run 'cabal update' automatically before the HLS build
+	- Fix parser and completer for 'ghcup compile hls --version'
+* Improve `ghcup compile ghc`
+    - Allow to build from arbitrary GHC source dists
+
 ## 0.1.17.10 -- 2022-05-12
 
 * windows hotfix (hackage-only release)

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/AnsiMain.hs

@@ -0,0 +1,621 @@
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE MultiWayIf        #-}
+
+module AnsiMain where
+
+import           GHCup
+import           GHCup.Download
+import           GHCup.Errors
+import           GHCup.Prelude                  ( decUTF8Safe )
+import           GHCup.Prelude.File
+import           GHCup.Prelude.Logger
+import           GHCup.Prelude.Process
+import           GHCup.Prompts
+import           GHCup.Types             hiding ( LeanAppState(..) )
+import           GHCup.Types.Optics             ( getDirs )
+import           GHCup.Utils
+
+import           Data.List (sort, intersperse)
+import           Data.Versions (prettyPVP, prettyVer)
+import           Codec.Archive
+import           Control.Monad.IO.Class
+-- import           System.Console.ANSI
+import           System.Console.ANSI
+import           Terminal.Game
+import           Text.PrettyPrint.HughesPJClass ( prettyShow )
+
+import           Control.Exception.Safe
+import           Control.Monad                  ( when, forM_ )
+import           Control.Monad.ST
+import           Control.Monad.Reader           ( ReaderT(runReaderT), MonadReader, ask, lift )
+import           Control.Monad.Trans.Except
+import           Control.Monad.Trans.Resource
+import           Data.Functor
+import           Data.STRef
+import           Data.IORef
+import           Data.Maybe                     ( fromMaybe, catMaybes )
+import qualified Data.Text                     as Tx
+import qualified Data.Tuple                    as T
+import qualified Data.Vector                   as V
+import           GHC.IO                         ( unsafePerformIO )
+import           Haskus.Utils.Variant.Excepts
+import           System.Exit
+import           System.Environment (getExecutablePath)
+import qualified Data.Text                     as T
+import qualified Data.Text.Lazy.Builder        as B
+import qualified Data.Text.Lazy                as L
+import           System.FilePath
+import           URI.ByteString (serializeURIRef')
+
+
+
+data Direction = Up
+               | Down
+  deriving (Show, Eq)
+
+data BrickData = BrickData
+  { lr :: [ListResult]
+  }
+  deriving Show
+
+data BrickSettings = BrickSettings
+  { showAllVersions :: Bool
+  , showAllTools    :: Bool
+  }
+  deriving Show
+
+data BrickInternalState = BrickInternalState
+  { clr :: V.Vector ListResult
+  , ix  :: Int
+  }
+  deriving Show
+
+data BrickState = BrickState
+  { appData      :: BrickData
+  , appSettings  :: BrickSettings
+  , appState     :: BrickInternalState
+  , appKeys      :: KeyBindings
+  , appQuit      :: Bool
+  , appRestart   :: Bool
+  , appMoreInput :: Maybe String
+  }
+  deriving Show
+
+
+startGame :: BrickState -> IO BrickState
+startGame g = do
+  g'@BrickState { appRestart } <- errorPress $ playGameT liftIO (ghcupGame g)
+  if appRestart
+  then do
+    putStrLn "Press enter to continue"
+    _ <- getLine
+    startGame $ g' { appRestart = False }
+  else pure g'
+
+ansiMain :: AppState -> IO ()
+ansiMain s = do
+  writeIORef settings' s
+
+  eAppData <- getAppData (Just $ ghcupInfo s)
+  case eAppData of
+    Right ad -> do
+      let g = BrickState ad
+                         defaultAppSettings
+                         (constructList ad defaultAppSettings Nothing)
+                         (keyBindings (s :: AppState))
+                         False
+                         False
+                         Nothing
+
+
+      sizeCheck
+      void $ startGame g
+      cleanAndExit
+    Left e -> do
+      flip runReaderT s $ logError $ "Error building app state: " <> Tx.pack
+        (show e)
+      exitWith $ ExitFailure 2
+
+
+ where
+  sizeCheck :: IO ()
+  sizeCheck = let (w, h) = T.swap . snd $ boundaries in assertTermDims w h
+
+
+ghcupGame :: BrickState -> Game BrickState
+ghcupGame bs = Game 13
+                    bs                                    -- ticks per second
+                    (\ge s e -> logicFun ge s e)          -- logic function
+                    (\r s -> centerFull r $ drawFun s r)  -- draw function
+                    (\s -> appQuit s || appRestart s)  -- quit function
+
+
+drawFun :: BrickState -> GEnv -> Plane
+drawFun (BrickState {..}) GEnv{..} =
+  let focus pl = maybe pl
+                   (\ix -> V.update pl (V.singleton (ix + 1, fmap invert $ pl V.! (ix + 1))))
+                   mix
+      rows = V.fromList [header, [box (mw - 2) 1 '=']] V.++ renderItems
+      cols = V.foldr (\xs ys -> zipWith (:) xs ys) (repeat []) $ V.filter ((==5) . length) rows
+      padded  = focus $ V.map (\xs -> zipWith padTo xs lengths) rows
+      lengths :: [Int]
+      lengths = fmap (maximum . fmap (fst . planeSize)) cols
+  in blankPlane mw mh
+    & (1, 1)   % box 1        1        'X' -- '┌'
+    & (2, 1)   % box 1        (mh - 3) '|' -- '│'
+    & (1, 2)   % box (mw - 2) 1        '=' -- '─'
+    & (2, mw)  % box 1        (mh - 3) '|' -- '│'
+    & (1, mw)  % box 1        1        'X' -- '┐'
+    & (mh-1, 2)  % box (mw - 2) 1      '=' -- '─'
+    & (mh-1, 1)  % box 1        1      'X' -- '└'
+    & (mh-1, mw) % box 1        1      'X' -- '┘'
+    & (2, 2)   % box (mw - 2) (mh - 3) ' ' -- ' '
+    & (2, 2)   % vcat (hcat <$> V.toList padded)
+    & (mh, 1)  % footer
+    & (1, mw `div` 2 - 2) % stringPlane "GHCup"
+ where
+
+  padTo :: Plane -> Int -> Plane
+  padTo plane x =
+    let lstr = fst $ planeSize plane
+        add' = x - lstr + 1
+    in  if add' < 0 then plane else plane ||| stringPlane (replicate add' ' ')
+  mh :: Height
+  mw :: Width
+  (mh, mw) = T.swap eTermDims
+  footer = hcat
+         . intersperse (stringPlane "  ")
+         . fmap stringPlane
+         $ ["q:Quit", "i:Install", "u:Uninstall", "s:Set", "c:Changelog", "a:all versions", "↑:Up", "↓:Down"]
+  header = fmap stringPlane [" ", "Tool", "Version", "Tags", "Notes"]
+  (renderItems, mix) = drawListElements renderItem appState
+  renderItem _ _ listResult@ListResult{..} =
+    let marks = if
+          | lSet       -> color Green Vivid $ stringPlane "IS"
+          | lInstalled -> color Green Vivid $ stringPlane "I "
+          | otherwise  -> color Red Vivid $ stringPlane "X "
+        ver = case lCross of
+          Nothing -> stringPlane . Tx.unpack . prettyVer $ lVer
+          Just c  -> stringPlane . Tx.unpack $ (c <> "-" <> prettyVer lVer)
+        tool = printTool lTool
+        tag = let l = catMaybes . fmap printTag $ sort lTag
+              in  if null l then blankPlane 1 1 else foldr1 (\x y -> x ||| stringPlane "," ||| y) l
+        notes = let n = printNotes listResult
+                in  if null n
+                      then blankPlane 1 1
+                      else foldr1 (\x y -> x ||| stringPlane "," ||| y) n
+
+    in [marks ||| space, tool, ver, tag, notes]
+
+  printTag Recommended    = Just $ color Green Dull $ stringPlane "recommended"
+  printTag Latest         = Just $ color Yellow Dull $ stringPlane "latest"
+  printTag Prerelease     = Just $ color Red Dull $ stringPlane "prerelease"
+  printTag (Base pvp'')   = Just $ stringPlane ("base-" ++ T.unpack (prettyPVP pvp''))
+  printTag Old            = Nothing
+  printTag (UnknownTag t) = Just $ stringPlane t
+
+  printTool Cabal = stringPlane "cabal"
+  printTool GHC   = stringPlane "GHC"
+  printTool GHCup = stringPlane "GHCup"
+  printTool HLS   = stringPlane "HLS"
+  printTool Stack = stringPlane "Stack"
+
+  printNotes ListResult {..} =
+    (if hlsPowered then [color Green Dull $ stringPlane "hls-powered"] else mempty
+      )
+      ++ (if fromSrc then [color Blue Dull $ stringPlane "compiled"] else mempty)
+      ++ (if lStray then [color Blue Dull $ stringPlane "stray"] else mempty)
+
+  space = stringPlane " "
+
+  -- | Draws the list elements.
+  --
+  -- Evaluates the underlying container up to, and a bit beyond, the
+  -- selected element. The exact amount depends on available height
+  -- for drawing and 'listItemHeight'. At most, it will evaluate up to
+  -- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the
+  -- available height.
+  drawListElements :: (Int -> Bool -> ListResult -> [Plane])
+                   -> BrickInternalState
+                   -> (V.Vector [Plane], Maybe Int)
+  drawListElements drawElem is@(BrickInternalState clr _) =
+      let es = clr
+          listSelected        = fmap fst $ listSelectedElement' is
+
+          (drawnElements, selIx) = runST $ do
+            ref <- newSTRef (Nothing :: Maybe Int)
+            vec <- newSTRef (mempty :: V.Vector [Plane])
+            elem' <- newSTRef 0
+            void $ flip V.imapM es $ \i' e -> do
+              let isSelected  = Just i' == listSelected
+                  elemWidget  = drawElem i' isSelected e
+              case es V.!? (i' - 1) of
+                    Just e' | lTool e' /= lTool e -> do
+                      modifySTRef elem' (+2)
+                      i <- readSTRef elem'
+                      when isSelected $ writeSTRef ref (Just i)
+                      modifySTRef vec (`V.snoc` [hBorder])
+                      modifySTRef vec (`V.snoc` elemWidget)
+                      pure ()
+                    _ -> do
+                      modifySTRef elem' (+1)
+                      i <- readSTRef elem'
+                      when isSelected $ writeSTRef ref (Just i)
+                      modifySTRef vec (`V.snoc` elemWidget)
+                      pure ()
+            i <- readSTRef ref
+            arr <- readSTRef vec
+            pure (arr, i)
+        in (makeVisible drawnElements (mh - 5) selIx, selIx)
+   where
+    makeVisible :: V.Vector [Plane] -> Height -> Maybe Int -> V.Vector [Plane]
+    makeVisible listElements drawableHeight (Just ix) =
+      let listHeight = V.length listElements
+      in if | listHeight <= 0 -> listElements
+            | listHeight > drawableHeight ->
+              if | ix <= drawableHeight -> makeVisible (V.init listElements) drawableHeight (Just ix)
+                 | otherwise            -> makeVisible (V.tail listElements) drawableHeight (Just (ix - 1))
+            | otherwise -> listElements
+    makeVisible listElements _ Nothing = listElements
+
+    hBorder = box (mw - 2) 1 '='
+
+
+logicFun :: GEnv -> BrickState -> Event -> IO BrickState
+logicFun _ gs (KeyPress 'q') = pure gs { appQuit = True }
+logicFun _ gs@BrickState{appMoreInput = Nothing} (KeyPress '\ESC') = pure gs { appMoreInput = Just "\ESC" }
+logicFun _ gs@BrickState{appMoreInput = Just "\ESC"} (KeyPress '[') = pure gs { appMoreInput = Just "\ESC[" }
+logicFun _ gs@BrickState{appMoreInput = Just "\ESC[", appState = s'} (KeyPress 'A')
+ = pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Up }
+logicFun _ gs@BrickState{appMoreInput = Just "\ESC[", appState = s'} (KeyPress 'B')
+ = pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Down }
+logicFun _ gs@BrickState{appMoreInput = Just _} _ = pure gs { appMoreInput = Nothing }
+logicFun _ gs (KeyPress 'i') = do
+  bs <- withIOAction install' gs
+  pure bs { appRestart = True }
+logicFun _ gs (KeyPress 'u') = do
+  bs <- withIOAction del' gs
+  pure bs { appRestart = True }
+logicFun _ gs (KeyPress 's') = do
+  bs <- withIOAction set' gs
+  pure bs { appRestart = True }
+logicFun _ gs (KeyPress 'c') = do
+  bs <- withIOAction changelog' gs
+  pure bs { appRestart = True }
+logicFun _ gs (KeyPress 'a') = pure $ hideShowHandler (not . showAllVersions) showAllTools gs
+ where
+  hideShowHandler :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> BrickState -> BrickState
+  hideShowHandler f p BrickState{..} =
+    let newAppSettings   = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
+        newInternalState = constructList appData newAppSettings (Just appState)
+    in  BrickState appData newAppSettings newInternalState appKeys appQuit appRestart appMoreInput
+
+-- windows powershell
+logicFun _ gs@BrickState{ appState = s' } (KeyPress 'P') = pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Down }
+logicFun _ gs@BrickState{ appState = s' } (KeyPress 'H') = pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Up }
+
+logicFun _ gs Tick           = pure gs
+logicFun _ gs (KeyPress _)   = pure gs
+
+withIOAction :: (BrickState
+                 -> (Int, ListResult)
+                 -> ReaderT AppState IO (Either String a))
+             -> BrickState
+             -> IO BrickState
+withIOAction action as = case listSelectedElement' (appState as) of
+  Nothing      -> pure as
+  Just (ix, e) -> do
+    clearScreen
+
+    settings <- readIORef settings'
+    flip runReaderT settings $ action as (ix, e) >>= \case
+      Left  err -> liftIO $ putStrLn ("Error: " <> err)
+      Right _   -> liftIO $ putStrLn "Success"
+    getAppData Nothing >>= \case
+      Right data' -> do
+        pure (updateList data' as)
+      Left err -> throwIO $ userError err
+
+moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
+moveCursor steps ais@BrickInternalState{..} direction =
+  let newIx = if direction == Down then ix + steps else ix - steps
+  in  case clr V.!? newIx of
+        Just _  -> BrickInternalState { ix = newIx, .. }
+        Nothing -> ais
+
+defaultAppSettings :: BrickSettings
+defaultAppSettings =
+  BrickSettings { showAllVersions = False, showAllTools = False }
+
+-- | Update app data and list internal state based on new evidence.
+-- This synchronises @BrickInternalState@ with @BrickData@
+-- and @BrickSettings@.
+updateList :: BrickData -> BrickState -> BrickState
+updateList appD BrickState{..} =
+  let newInternalState = constructList appD appSettings (Just appState)
+  in  BrickState { appState    = newInternalState
+                 , appData     = appD
+                 , appSettings = appSettings
+                 , appKeys     = appKeys
+                 , appQuit     = appQuit
+                 , appRestart  = appRestart
+                 , appMoreInput = appMoreInput
+                 }
+
+constructList
+  :: BrickData
+  -> BrickSettings
+  -> Maybe BrickInternalState
+  -> BrickInternalState
+constructList appD appSettings = replaceLR
+  (filterVisible (showAllVersions appSettings) (showAllTools appSettings))
+  (lr appD)
+
+
+-- | Replace the @appState@ or construct it based on a filter function
+-- and a new @[ListResult]@ evidence.
+-- When passed an existing @appState@, tries to keep the selected element.
+replaceLR
+  :: (ListResult -> Bool)
+  -> [ListResult]
+  -> Maybe BrickInternalState
+  -> BrickInternalState
+replaceLR filterF lr s =
+  let oldElem = s >>= listSelectedElement'
+      newVec  = V.fromList . filter filterF $ lr
+      newSelected =
+        case oldElem >>= \(_, oldE) -> V.findIndex (toolEqual oldE) newVec of
+          Just ix -> ix
+          Nothing -> selectLatest newVec
+  in  BrickInternalState newVec newSelected
+ where
+  toolEqual e1 e2 =
+    lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
+
+
+filterVisible :: Bool -> Bool -> ListResult -> Bool
+filterVisible v t e
+  | lInstalled e                   = True
+  | v, not t, lTool e `notElem` hiddenTools = True
+  | not v, t, Old `notElem` lTag e = True
+  | v, t                           = True
+  | otherwise = (Old `notElem` lTag e) && (lTool e `notElem` hiddenTools)
+
+
+hiddenTools :: [Tool]
+hiddenTools = []
+
+
+selectLatest :: V.Vector ListResult -> Int
+selectLatest = fromMaybe 0
+  . V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
+
+
+listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
+listSelectedElement' BrickInternalState {..} = fmap (ix, ) $ clr V.!? ix
+
+
+boundaries :: (Coords, Coords)
+boundaries = ((1, 1), (24, 80))
+
+install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
+         => BrickState
+         -> (Int, ListResult)
+         -> m (Either String ())
+install' _ (_, ListResult {..}) = do
+  AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
+
+  let run =
+        runResourceT
+          . runE
+            @'[ AlreadyInstalled
+              , ArchiveResult
+              , UnknownArchive
+              , FileDoesNotExistError
+              , CopyError
+              , NoDownload
+              , NotInstalled
+              , BuildFailed
+              , TagNotFound
+              , DigestError
+              , ContentLengthError
+              , GPGError
+              , DownloadFailed
+              , DirNotEmpty
+              , NoUpdate
+              , TarDirDoesNotExist
+              , FileAlreadyExistsError
+              , ProcessError
+              , ToolShadowed
+              , UninstallFailed
+              , MergeFileTreeError
+              ]
+
+  run (do
+      ce <- liftIO $ fmap (either (const Nothing) Just) $
+        try @_ @SomeException $ getExecutablePath >>= canonicalizePath
+      dirs <- lift getDirs
+      case lTool of
+        GHC   -> do
+          let vi = getVersionInfo lVer GHC dls
+          liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce)
+        Cabal -> do
+          let vi = getVersionInfo lVer Cabal dls
+          liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
+        GHCup -> do
+          let vi = snd <$> getLatest dls GHCup
+          liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
+        HLS   -> do
+          let vi = getVersionInfo lVer HLS dls
+          liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
+        Stack -> do
+          let vi = getVersionInfo lVer Stack dls
+          liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
+    )
+    >>= \case
+          VRight (vi, Dirs{..}, Just ce) -> do
+            forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
+            case lTool of
+              GHCup -> do
+                up <- liftIO $ fmap (either (const Nothing) Just)
+                  $ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
+                when ((normalise <$> up) == Just (normalise ce)) $
+                  -- TODO: track cli arguments of previous invocation
+                  void $ liftIO $ exec ce ["tui"] Nothing Nothing
+                logInfo "Please restart 'ghcup' for the changes to take effect"
+              _ -> pure ()
+            pure $ Right ()
+          VRight (vi, _, _) -> do
+            forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
+            logInfo "Please restart 'ghcup' for the changes to take effect"
+            pure $ Right ()
+          VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
+          VLeft (V NoUpdate) -> pure $ Right ()
+          VLeft e -> pure $ Left $ prettyShow e <> "\n"
+            <> "Also check the logs in ~/.ghcup/logs"
+
+
+set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
+     => BrickState
+     -> (Int, ListResult)
+     -> m (Either String ())
+set' bs input@(_, ListResult {..}) = do
+  settings <- liftIO $ readIORef settings'
+
+  let run =
+        flip runReaderT settings
+          . runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
+
+  run (do
+      case lTool of
+        GHC   -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly Nothing $> ()
+        Cabal -> liftE $ setCabal lVer $> ()
+        HLS   -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
+        Stack -> liftE $ setStack lVer $> ()
+        GHCup -> pure ()
+    )
+    >>= \case
+          VRight _ -> pure $ Right ()
+          VLeft  e -> case e of
+            (V (NotInstalled tool _)) -> do
+              promptAnswer <- getUserPromptResponse userPrompt
+              case promptAnswer of
+                PromptYes -> do
+                  res <- install' bs input
+                  case res of
+                    (Left err) -> pure $ Left err
+                    (Right _) -> do
+                      logInfo "Setting now..."
+                      set' bs input
+
+                PromptNo -> pure $ Left (prettyShow e)
+              where
+                userPrompt = L.toStrict . B.toLazyText . B.fromString $
+                  "This Version of "
+                  <> show tool
+                  <> " you are trying to set is not installed.\n"
+                  <> "Would you like to install it first? [Y/N]: "
+
+            _ -> pure $ Left (prettyShow e)
+
+
+
+del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)
+     => BrickState
+     -> (Int, ListResult)
+     -> m (Either String ())
+del' _ (_, ListResult {..}) = do
+  AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
+
+  let run = runE @'[NotInstalled, UninstallFailed]
+
+  run (do
+      let vi = getVersionInfo lVer lTool dls
+      case lTool of
+        GHC   -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
+        Cabal -> liftE $ rmCabalVer lVer $> vi
+        HLS   -> liftE $ rmHLSVer lVer $> vi
+        Stack -> liftE $ rmStackVer lVer $> vi
+        GHCup -> pure Nothing
+    )
+    >>= \case
+          VRight vi -> do
+            forM_ (_viPostRemove =<< vi) $ \msg ->
+              logInfo msg
+            pure $ Right ()
+          VLeft  e -> pure $ Left (prettyShow e)
+
+
+changelog' :: (MonadReader AppState m, MonadIO m)
+           => BrickState
+           -> (Int, ListResult)
+           -> m (Either String ())
+changelog' _ (_, ListResult {..}) = do
+  AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
+  case getChangeLog dls lTool (Left lVer) of
+    Nothing -> pure $ Left $
+      "Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
+    Just uri -> do
+      let cmd = case _rPlatform pfreq of
+            Darwin  -> "open"
+            Linux _ -> "xdg-open"
+            FreeBSD -> "xdg-open"
+            Windows -> "start"
+      exec cmd [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing >>= \case
+        Right _ -> pure $ Right ()
+        Left  e -> pure $ Left $ prettyShow e
+
+
+settings' :: IORef AppState
+{-# NOINLINE settings' #-}
+settings' = unsafePerformIO $ do
+  dirs <- getAllDirs
+  let loggerConfig = LoggerConfig { lcPrintDebug  = False
+                                  , consoleOutter = \_ -> pure ()
+                                  , fileOutter    = \_ -> pure ()
+                                  , fancyColors   = True
+                                  }
+  newIORef $ AppState defaultSettings
+                      dirs
+                      defaultKeyBindings
+                      (GHCupInfo mempty mempty mempty)
+                      (PlatformRequest A_64 Darwin Nothing)
+                      loggerConfig
+
+
+getAppData :: Maybe GHCupInfo -> IO (Either String BrickData)
+getAppData mgi = runExceptT $ do
+  r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
+  liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
+  settings <- liftIO $ readIORef settings'
+
+  flip runReaderT settings $ do
+    lV <- listVersions Nothing Nothing
+    pure $ BrickData (reverse lV)
+
+
+getGHCupInfo :: IO (Either String GHCupInfo)
+getGHCupInfo = do
+  settings <- readIORef settings'
+
+  r        <-
+    flip runReaderT settings
+    . runE
+      @'[ DigestError
+        , ContentLengthError
+        , GPGError
+        , JSONError
+        , DownloadFailed
+        , FileDoesNotExistError
+        ]
+    $ liftE getDownloadsF
+
+  case r of
+    VRight a -> pure $ Right a
+    VLeft  e -> pure $ Left (prettyShow e)
+
+

app/ghcup/BrickMain.hs

@@ -13,10 +13,12 @@ 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
 import           GHCup.Prelude.Process
+import           GHCup.Prompts
 
 import           Brick
 import           Brick.Widgets.Border
@@ -52,6 +54,8 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           URI.ByteString
 
 import qualified Data.Text                     as T
+import qualified Data.Text.Lazy.Builder        as B
+import qualified Data.Text.Lazy                as L
 import qualified Graphics.Vty                  as Vty
 import qualified Data.Vector                   as V
 import System.Environment (getExecutablePath)
@@ -98,7 +102,7 @@ keyHandlers KeyBindings {..} =
   [ (bQuit, const "Quit"     , halt)
   , (bInstall, const "Install"  , withIOAction install')
   , (bUninstall, const "Uninstall", withIOAction del')
-  , (bSet, const "Set"      , withIOAction ((liftIO .) . set'))
+  , (bSet, const "Set"      , withIOAction set')
   , (bChangelog, const "ChangeLog", withIOAction changelog')
   , ( bShowAllVersions
     , \BrickSettings {..} ->
@@ -430,6 +434,7 @@ install' _ (_, ListResult {..}) = do
               , BuildFailed
               , TagNotFound
               , DigestError
+              , ContentLengthError
               , GPGError
               , DownloadFailed
               , DirNotEmpty
@@ -482,13 +487,16 @@ 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"
 
 
-set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
-set' _ (_, ListResult {..}) = do
-  settings <- readIORef settings'
+set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
+     => BrickState
+     -> (Int, ListResult)
+     -> m (Either String ())
+set' bs input@(_, ListResult {..}) = do
+  settings <- liftIO $ readIORef settings'
 
   let run =
         flip runReaderT settings
@@ -504,7 +512,28 @@ set' _ (_, ListResult {..}) = do
     )
     >>= \case
           VRight _ -> pure $ Right ()
-          VLeft  e -> pure $ Left (prettyShow e)
+          VLeft  e -> case e of
+            (V (NotInstalled tool _)) -> do
+              promptAnswer <- getUserPromptResponse userPrompt
+              case promptAnswer of
+                PromptYes -> do
+                  res <- install' bs input
+                  case res of
+                    (Left err) -> pure $ Left err
+                    (Right _) -> do
+                      logInfo "Setting now..."
+                      set' bs input
+
+                PromptNo -> pure $ Left (prettyHFError e)
+              where
+                userPrompt = L.toStrict . B.toLazyText . B.fromString $
+                  "This Version of "
+                  <> show tool
+                  <> " you are trying to set is not installed.\n"
+                  <> "Would you like to install it first? [Y/N]: "
+
+            _ -> pure $ Left (prettyHFError e)
+
 
 
 del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)
@@ -527,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)
@@ -550,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
@@ -603,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,14 @@ 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
   , optKeepDirs    :: Maybe KeepDirs
@@ -103,10 +104,14 @@ data Command
   | Nuke
 #if defined(BRICK)
   | Interactive
+#endif
+#if defined(ANSI)
+  | InteractiveAnsi
 #endif
   | Prefetch PrefetchCommand
   | GC GCOptions
   | Run RunOptions
+  | PrintAppErrors
 
 
 
@@ -115,7 +120,18 @@ 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)
+        (  short 'p'
+        <> long "platform"
+        <> metavar "PLATFORM"
+        <> help
+             "Override for platform (triple matching ghc tarball names), e.g. x86_64-fedora27-linux"
+        )
+      )
     <*> optional
           (option
             (eitherReader parseUri)
@@ -171,8 +187,19 @@ opts =
 com :: Parser Command
 com =
   subparser
-#if defined(BRICK)
+#if defined(ANSI)
       (  command
+          "tui-ansi"
+          (   (\_ -> InteractiveAnsi)
+          <$> info
+                helper
+                (  progDesc "Start the interactive GHCup UI (ansi)"
+                )
+          )
+          <>
+#endif
+#if defined(BRICK)
+        command
           "tui"
           (   (\_ -> Interactive)
           <$> info
@@ -182,7 +209,7 @@ com =
           )
       <>  command
 #else
-      (  command
+          command
 #endif
           "install"
           (   Install
@@ -329,3 +356,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
 
 
     -------------
@@ -452,9 +454,11 @@ tagCompleter tool add = listIOCompleter $ do
       pure $ nub $ (add ++) $ fmap tagToString allTags
     VLeft _ -> pure  (nub $ ["recommended", "latest"] ++ add)
 
-
 versionCompleter :: Maybe ListCriteria -> Tool -> Completer
-versionCompleter criteria tool = listIOCompleter $ do
+versionCompleter criteria tool = versionCompleter' criteria tool (const True)
+
+versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
+versionCompleter' criteria tool filter' = listIOCompleter $ do
   dirs' <- liftIO getAllDirs
   let loggerConfig = LoggerConfig
         { lcPrintDebug   = False
@@ -483,7 +487,7 @@ versionCompleter criteria tool = listIOCompleter $ do
           runEnv = flip runReaderT appState
 
       installedVersions <- runEnv $ listVersions (Just tool) criteria
-      return $ T.unpack . prettyVer . lVer <$> installedVersions
+      return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
 
 
 toolDlCompleter :: Tool -> Completer
@@ -787,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

@@ -12,6 +12,8 @@ module GHCup.OptParse.Compile where
 
 
 import           GHCup
+import qualified GHCup.GHC as GHC
+import qualified GHCup.HLS as HLS
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
@@ -30,18 +32,18 @@ import           Control.Monad.Trans.Resource
 import           Data.Bifunctor
 import           Data.Functor
 import           Data.Maybe
-import           Data.Versions                  ( Version, prettyVer, version )
+import           Data.Versions                  ( Version, prettyVer, version, pvp )
+import qualified Data.Versions as V
 import           Data.Text                      ( Text )
 import           Haskus.Utils.Variant.Excepts
 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
-import Control.Exception.Safe (MonadMask)
+import Control.Exception.Safe (MonadMask, displayException)
 import System.FilePath (isPathSeparator)
 import Text.Read (readEither)
 
@@ -64,7 +66,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
 
 
 data GHCCompileOptions = GHCCompileOptions
-  { targetGhc    :: Either Version GitBranch
+  { targetGhc    :: GHC.GHCVer Version
   , bootstrapGhc :: Either Version FilePath
   , jobs         :: Maybe Int
   , buildConfig  :: Maybe FilePath
@@ -78,10 +80,12 @@ data GHCCompileOptions = GHCCompileOptions
   , isolateDir   :: Maybe FilePath
   }
 
+
 data HLSCompileOptions = HLSCompileOptions
-  { targetHLS    :: Either Version GitBranch
+  { targetHLS    :: HLS.HLSVer
   , jobs         :: Maybe Int
   , setCompile   :: Bool
+  , updateCabal  :: Bool
   , ovewrwiteVer :: Either Bool Version
   , isolateDir   :: Maybe FilePath
   , cabalProject :: Maybe (Either FilePath URI)
@@ -149,10 +153,10 @@ Examples:
   These need to be available in PATH prior to compilation.
 
 Examples:
-  # compile 1.7.0.0 for ghc 8.10.5 and 8.10.7, passing '--allow-newer' to cabal
-  ghcup compile hls -v 1.7.0.0 -j 12 --ghc 8.10.5 --ghc 8.10.7 -- --allow-newer
-  # compile from master for ghc 9.2.3 and use 'git describe' to name the binary
-  ghcup compile hls -g master --git-describe-version --ghc 9.2.3
+  # compile 1.7.0.0 from hackage for 8.10.7, running 'cabal update' before the build
+  ghcup compile hls --version 1.7.0.0 --ghc 8.10.7 --cabal-update
+  # compile from master for ghc 9.2.3 using 'git describe' to name the binary and ignore the pinned index state
+  ghcup compile hls -g master --git-describe-version --ghc 9.2.3 -- --index-state=@(date '+%s')
   # compile a specific commit for ghc 9.2.3 and set a specifc version for the binary name
   ghcup compile hls -g a32db0b -o 1.7.0.0-p1 --ghc 9.2.3|]
 
@@ -160,7 +164,7 @@ Examples:
 ghcCompileOpts :: Parser GHCCompileOptions
 ghcCompileOpts =
   GHCCompileOptions
-    <$> ((Left <$> option
+    <$> ((GHC.SourceDist <$> option
           (eitherReader
             (first (const "Not a valid version") . version . T.pack)
           )
@@ -169,7 +173,7 @@ ghcCompileOpts =
             <> (completer $ versionCompleter Nothing GHC)
           )
           ) <|>
-          (Right <$> (GitBranch <$> option
+          (GHC.GitDist <$> (GitBranch <$> option
           str
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from"
@@ -178,7 +182,18 @@ ghcCompileOpts =
             short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
             <> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"])
             ))
-          )))
+          ))
+          <|>
+          (
+           GHC.RemoteDist <$> (option
+            (eitherReader uriParser)
+            (long "remote-source-dist" <> metavar "URI" <> help
+              "URI (https/http/file) to a GHC source distribution"
+              <> completer fileUri
+            )
+          )
+          )
+          )
     <*> option
           (eitherReader
             (\x ->
@@ -270,16 +285,17 @@ ghcCompileOpts =
 hlsCompileOpts :: Parser HLSCompileOptions
 hlsCompileOpts =
   HLSCompileOptions
-    <$> ((Left <$> option
+    <$> ((HLS.HackageDist <$> option
           (eitherReader
-            (first (const "Not a valid version") . version . T.pack)
+            ((>>= first displayException . V.version . V.prettyPVP) . first (const "Not a valid PVP version") . pvp . T.pack)
           )
           (short 'v' <> long "version" <> metavar "VERSION" <> help
-            "The tool version to compile"
-            <> (completer $ versionCompleter Nothing HLS)
+            "The version to compile (pulled from hackage)"
+            <> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
           )
-          ) <|>
-          (Right <$> (GitBranch <$> option
+          )
+          <|>
+          (HLS.GitDist <$> (GitBranch <$> option
           str
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from (accepts anything 'git checkout' accepts)"
@@ -287,7 +303,28 @@ hlsCompileOpts =
           optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to HLS upstream)"
             <> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
           ))
-          )))
+          ))
+          <|>
+          (HLS.SourceDist <$> (option
+            (eitherReader
+              (first (const "Not a valid version") . version . T.pack)
+            )
+          (long "source-dist" <> metavar "VERSION" <> help
+            "The version to compile (pulled from packaged git sources)"
+            <> (completer $ versionCompleter Nothing HLS)
+          )
+          ))
+          <|>
+          (
+           HLS.RemoteDist <$> (option
+            (eitherReader uriParser)
+            (long "remote-source-dist" <> metavar "URI" <> help
+              "URI (https/http/file) to a HLS source distribution"
+              <> completer fileUri
+            )
+          )
+          )
+          )
     <*> optional
           (option
             (eitherReader (readEither @Int))
@@ -297,6 +334,7 @@ hlsCompileOpts =
             )
           )
     <*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
+    <*> switch (long "cabal-update" <> help "Run 'cabal update' before the build")
     <*>
          (
           (Right <$> option
@@ -381,6 +419,7 @@ hlsCompileOpts =
 type GHCEffects = '[ AlreadyInstalled
                   , BuildFailed
                   , DigestError
+                  , ContentLengthError
                   , GPGError
                   , DownloadFailed
                   , GHCupSetError
@@ -404,6 +443,7 @@ type GHCEffects = '[ AlreadyInstalled
 type HLSEffects = '[ AlreadyInstalled
                   , BuildFailed
                   , DigestError
+                  , ContentLengthError
                   , GPGError
                   , DownloadFailed
                   , GHCupSetError
@@ -468,7 +508,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
     (CompileHLS HLSCompileOptions { .. }) -> do
       runCompileHLS runAppState (do
         case targetHLS of
-          Left targetVer -> do
+          HLS.SourceDist targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer HLS dls
             forM_ (_viPreCompile =<< vi) $ \msg -> do
@@ -476,7 +516,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
               lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
               liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
-          Right _ -> pure ()
+          _ -> pure ()
         ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
         targetVer <- liftE $ compileHLS
                     targetHLS
@@ -486,6 +526,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
                     (maybe GHCupInternal IsolateDir isolateDir)
                     cabalProject
                     cabalProjectLocal
+                    updateCabal
                     patches
                     cabalArgs
         GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -504,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
-                  _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
+                  Never -> runLogger $ logError $ T.pack $ prettyHFError err
+                  _ -> 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!"
@@ -519,7 +560,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
     (CompileGHC GHCCompileOptions {..}) ->
       runCompileGHC runAppState (do
         case targetGhc of
-          Left targetVer -> do
+          GHC.SourceDist targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer GHC dls
             forM_ (_viPreCompile =<< vi) $ \msg -> do
@@ -527,9 +568,12 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
               lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
               liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
-          Right _ -> pure ()
+          _ -> pure ()
         targetVer <- liftE $ compileGHC
-                    (first (GHCTargetVersion crossTarget) targetGhc)
+                    ((\case
+                        GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v
+                        GHC.GitDist g -> GHC.GitDist g
+                        GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
                     ovewrwiteVer
                     bootstrapGhc
                     jobs
@@ -563,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
-                  _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
+                  Never -> runLogger $ logError $ T.pack $ prettyHFError err
+                  _ -> 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
@@ -131,7 +132,8 @@ updateSettings UserSettings{..} Settings{..} =
        urlSource'  = fromMaybe urlSource uUrlSource
        noNetwork'  = fromMaybe noNetwork uNoNetwork
        gpgSetting' = fromMaybe gpgSetting uGPGSetting
-   in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
+       platformOverride' = uPlatformOverride <|> platformOverride
+   in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
 
 
 
@@ -187,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
@@ -66,7 +65,6 @@ data InstallCommand = InstallGHC InstallOptions
 
 data InstallOptions = InstallOptions
   { instVer      :: Maybe ToolVersion
-  , instPlatform :: Maybe PlatformRequest
   , instBindist  :: Maybe URI
   , instSet      :: Bool
   , isolateDir   :: Maybe FilePath
@@ -171,23 +169,13 @@ Examples:
   ghcup install ghc 8.10.2
 
   # install GHC head fedora bindist
-  ghcup install ghc -u https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27 head|]
+  ghcup install ghc -u 'https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz?job=x86_64-linux-fedora33-release' head|]
 
 
 installOpts :: Maybe Tool -> Parser InstallOptions
 installOpts tool =
-  (\p (u, v) b is f -> InstallOptions v p u b is f)
-    <$> optional
-          (option
-            (eitherReader platformParser)
-            (  short 'p'
-            <> long "platform"
-            <> metavar "PLATFORM"
-            <> help
-                 "Override for platform (triple matching ghc tarball names), e.g. x86_64-fedora27-linux"
-            )
-          )
-    <*> (   (   (,)
+  (\(u, v) b is f -> InstallOptions v u b is f)
+    <$> (   (   (,)
             <$> optional
                   (option
                     (eitherReader uriParser)
@@ -254,6 +242,7 @@ type InstallEffects = '[ AlreadyInstalled
                        , BuildFailed
                        , TagNotFound
                        , DigestError
+                       , ContentLengthError
                        , GPGError
                        , DownloadFailed
                        , TarDirDoesNotExist
@@ -268,11 +257,10 @@ type InstallEffects = '[ AlreadyInstalled
 
 
 runInstTool :: AppState
-            -> Maybe PlatformRequest
             -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
             -> IO (VEither InstallEffects a)
-runInstTool appstate' mInstPlatform =
-  flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
+runInstTool appstate' =
+  flip runReaderT appstate'
   . runResourceT
   . runE
     @InstallEffects
@@ -283,6 +271,7 @@ type InstallGHCEffects = '[ AlreadyInstalled
                           , BuildFailed
                           , CopyError
                           , DigestError
+                          , ContentLengthError
                           , DirNotEmpty
                           , DownloadFailed
                           , FileAlreadyExistsError
@@ -302,11 +291,10 @@ type InstallGHCEffects = '[ AlreadyInstalled
                           ]
 
 runInstGHC :: AppState
-           -> Maybe PlatformRequest
            -> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
            -> IO (VEither InstallGHCEffects a)
-runInstGHC appstate' mInstPlatform =
-  flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
+runInstGHC appstate' =
+  flip runReaderT appstate'
   . runResourceT
   . runE
     @InstallGHCEffects
@@ -331,7 +319,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
   installGHC InstallOptions{..} = do
     s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
     (case instBindist of
-       Nothing -> runInstGHC s' instPlatform $ do
+       Nothing -> runInstGHC s' $ do
          (v, vi) <- liftE $ fromVersion instVer GHC
          liftE $ runBothE' (installGHCBin
                      (_tvVersion v)
@@ -342,10 +330,10 @@ install installCommand settings getAppState' runLogger = case installCommand of
                    $ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing
          pure vi
        Just uri -> do
-         runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
+         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
@@ -362,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
@@ -379,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)
-                  _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
+                  Never -> runLogger (logError $ T.pack $ prettyHFError err)
+                  _ -> 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)
-                  _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
+                  Never -> runLogger (logError $ T.pack $ prettyHFError err)
+                  _ -> 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
 
@@ -403,7 +391,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
   installCabal InstallOptions{..} = do
     s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
     (case instBindist of
-       Nothing -> runInstTool s' instPlatform $ do
+       Nothing -> runInstTool s' $ do
          (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
          liftE $ runBothE' (installCabalBin
                                     v
@@ -412,10 +400,10 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                   ) $ when instSet $ when (isNothing isolateDir) $ liftE $ setCabal v
          pure vi
        Just uri -> do
-         runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
+         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
@@ -429,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 $
@@ -444,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 +440,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
   installHLS InstallOptions{..} = do
      s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
      (case instBindist of
-       Nothing -> runInstTool s' instPlatform $ do
+       Nothing -> runInstTool s' $ do
          (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
          liftE $ runBothE' (installHLSBin
                                     v
@@ -461,11 +449,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                   ) $ when instSet $ when (isNothing isolateDir) $ liftE $ setHLS v SetHLSOnly Nothing
          pure vi
        Just uri -> do
-         runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
+         runInstTool s'{ settings = settings { noVerify = True}} $ do
            (_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
@@ -479,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 $
@@ -494,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
 
@@ -502,7 +490,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
   installStack InstallOptions{..} = do
      s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
      (case instBindist of
-        Nothing -> runInstTool s' instPlatform $ do
+        Nothing -> runInstTool s' $ do
           (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
           liftE $ runBothE' (installStackBin
                                      v
@@ -511,10 +499,10 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                    ) $ when instSet $ when (isNothing isolateDir) $ liftE $ setStack v
           pure vi
         Just uri -> do
-          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
+          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
@@ -528,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 $
@@ -543,7 +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/List.hs

@@ -12,6 +12,7 @@ module GHCup.OptParse.List where
 
 import           GHCup
 import           GHCup.Prelude
+import           GHCup.Prelude.Ansi
 import           GHCup.Types
 import           GHCup.OptParse.Common
 
@@ -155,89 +156,6 @@ printListResult no_color raw lr = do
         add' = x - lstr
     in  if add' < 0 then str' else str' ++ replicate add' ' '
 
-  -- | Calculate the render width of a string, considering
-  -- wide characters (counted as double width), ANSI escape codes
-  -- (not counted), and line breaks (in a multi-line string, the longest
-  -- line determines the width).
-  strWidth :: String -> Int
-  strWidth =
-    maximum
-      . (0 :)
-      . map (foldr (\a b -> charWidth a + b) 0)
-      . lines
-      . stripAnsi
-
-  -- | Strip ANSI escape sequences from a string.
-  --
-  -- >>> stripAnsi "\ESC[31m-1\ESC[m"
-  -- "-1"
-  stripAnsi :: String -> String
-  stripAnsi s' =
-    case
-        MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s'
-      of
-        Nothing -> error "Bad ansi escape"  -- PARTIAL: should not happen
-        Just xs -> concat xs
-   where
-      -- This parses lots of invalid ANSI escape codes, but that should be fine
-    ansi =
-      MPC.string "\ESC[" *> digitSemicolons *> suffix MP.<?> "ansi" :: MP.Parsec
-          Void
-          String
-          Char
-    digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';')
-    suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']
-
-  -- | Get the designated render width of a character: 0 for a combining
-  -- character, 1 for a regular character, 2 for a wide character.
-  -- (Wide characters are rendered as exactly double width in apps and
-  -- fonts that support it.) (From Pandoc.)
-  charWidth :: Char -> Int
-  charWidth c = case c of
-    _ | c < '\x0300'                     -> 1
-      | c >= '\x0300' && c <= '\x036F'   -> 0
-      |  -- combining
-        c >= '\x0370' && c <= '\x10FC'   -> 1
-      | c >= '\x1100' && c <= '\x115F'   -> 2
-      | c >= '\x1160' && c <= '\x11A2'   -> 1
-      | c >= '\x11A3' && c <= '\x11A7'   -> 2
-      | c >= '\x11A8' && c <= '\x11F9'   -> 1
-      | c >= '\x11FA' && c <= '\x11FF'   -> 2
-      | c >= '\x1200' && c <= '\x2328'   -> 1
-      | c >= '\x2329' && c <= '\x232A'   -> 2
-      | c >= '\x232B' && c <= '\x2E31'   -> 1
-      | c >= '\x2E80' && c <= '\x303E'   -> 2
-      | c == '\x303F'                    -> 1
-      | c >= '\x3041' && c <= '\x3247'   -> 2
-      | c >= '\x3248' && c <= '\x324F'   -> 1
-      | -- ambiguous
-        c >= '\x3250' && c <= '\x4DBF'   -> 2
-      | c >= '\x4DC0' && c <= '\x4DFF'   -> 1
-      | c >= '\x4E00' && c <= '\xA4C6'   -> 2
-      | c >= '\xA4D0' && c <= '\xA95F'   -> 1
-      | c >= '\xA960' && c <= '\xA97C'   -> 2
-      | c >= '\xA980' && c <= '\xABF9'   -> 1
-      | c >= '\xAC00' && c <= '\xD7FB'   -> 2
-      | c >= '\xD800' && c <= '\xDFFF'   -> 1
-      | c >= '\xE000' && c <= '\xF8FF'   -> 1
-      | -- ambiguous
-        c >= '\xF900' && c <= '\xFAFF'   -> 2
-      | c >= '\xFB00' && c <= '\xFDFD'   -> 1
-      | c >= '\xFE00' && c <= '\xFE0F'   -> 1
-      | -- ambiguous
-        c >= '\xFE10' && c <= '\xFE19'   -> 2
-      | c >= '\xFE20' && c <= '\xFE26'   -> 1
-      | c >= '\xFE30' && c <= '\xFE6B'   -> 2
-      | c >= '\xFE70' && c <= '\xFEFF'   -> 1
-      | c >= '\xFF01' && c <= '\xFF60'   -> 2
-      | c >= '\xFF61' && c <= '\x16A38'  -> 1
-      | c >= '\x1B000' && c <= '\x1B001' -> 2
-      | c >= '\x1D000' && c <= '\x1F1FF' -> 1
-      | c >= '\x1F200' && c <= '\x1F251' -> 2
-      | c >= '\x1F300' && c <= '\x1F773' -> 1
-      | c >= '\x20000' && c <= '\x3FFFD' -> 2
-      | otherwise                        -> 1
-
 
 
 

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 $ logInfo msg
+              runLogger $ logGHCPostRm ghcVer
+              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 ->
-                runLogger $ logInfo msg
+              postRmLog vi
               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 ->
-                runLogger $ logInfo msg
+              postRmLog vi
               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 ->
-                runLogger $ logInfo msg
+              postRmLog vi
               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

@@ -32,8 +32,8 @@ import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 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)
@@ -268,6 +268,13 @@ whereis :: ( Monad m
 whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
   Dirs{ .. }  <- runReaderT getDirs leanAppstate
   case (whereisCommand, whereisOptions) of
+    (WhereisTool GHCup _, WhereisOptions{..}) -> do
+      loc <- liftIO (getExecutablePath >>= canonicalizePath )
+      if directory
+      then liftIO $ putStr $ takeDirectory loc
+      else liftIO $ putStr loc
+      pure ExitSuccess
+
     (WhereisTool tool (Just (GHCVersion v)), WhereisOptions{..}) ->
       runLeanWhereIs leanAppstate (do
         loc <- liftE $ whereIsTool tool v
@@ -280,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
@@ -294,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
@@ -310,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

@@ -13,7 +13,12 @@ module Main where
 #if defined(BRICK)
 import           BrickMain                    ( brickMain )
 #endif
+#if defined(ANSI)
+import           AnsiMain                     ( ansiMain )
+#endif
 
+import qualified GHCup.GHC as GHC
+import qualified GHCup.HLS as HLS
 import           GHCup.OptParse
 
 import           GHCup.Download
@@ -77,6 +82,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
@@ -85,6 +91,7 @@ toSettings options = do
          urlSource   = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
          noNetwork   = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
          gpgSetting  = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
+         platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
      in (Settings {..}, keyBindings)
 #if defined(INTERNAL_DOWNLOADER)
    defaultDownloader = Internal
@@ -158,7 +165,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)
@@ -196,25 +203,25 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
 
           let appState = do
-                pfreq <- (
-                  runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
-                  ) >>= \case
-                          VRight r -> pure r
-                          VLeft e -> do
-                            runLogger
-                              (logError $ T.pack $ prettyShow e)
-                            exitWith (ExitFailure 2)
+                pfreq <- case platformOverride settings of
+                           Just pfreq' -> return pfreq'
+                           Nothing -> (runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest) >>= \case
+                                          VRight r -> pure r
+                                          VLeft e -> do
+                                            runLogger
+                                              (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
 
@@ -230,6 +237,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   UnSet _ -> pure ()
 #if defined(BRICK)
                   Interactive -> pure ()
+#endif
+#if defined(ANSI)
+                  InteractiveAnsi -> pure ()
 #endif
                   -- check for new tools
                   _
@@ -250,7 +260,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
@@ -262,7 +272,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'
 
@@ -288,6 +298,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             Interactive -> do
               s' <- appState
               liftIO $ brickMain s' >> pure ExitSuccess
+#endif
+#if defined(ANSI)
+            InteractiveAnsi -> do
+              s' <- appState
+              liftIO $ ansiMain s' >> pure ExitSuccess
 #endif
             Install installCommand     -> install installCommand settings appState runLogger
             InstallCabalLegacy iopts   -> install (Left (InstallCabal iopts)) settings appState runLogger
@@ -307,6 +322,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 ()
@@ -338,11 +354,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
   alreadyInstalling (Install (Left (InstallStack InstallOptions{..})))   (Stack, ver) = cmp' Stack instVer ver
   alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
     (GHC, ver)   = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
-  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
+  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
     (GHC, ver)   = cmp' GHC (Just $ ToolVersion tver) ver
   alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over }))
     (HLS, ver)   = cmp' HLS (Just $ ToolVersion over) ver
-  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.SourceDist tver }))
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion tver) ver
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))
     (HLS, ver)   = cmp' HLS (Just $ ToolVersion tver) ver
   alreadyInstalling (Upgrade {}) (GHCup, _) = pure True
   alreadyInstalling _ _ = pure False

cabal.project

@@ -6,7 +6,7 @@ optimization: 2
 
 package ghcup
     tests: True
-    flags: +tui
+    flags: +tui-ansi
 
 source-repository-package
   type: git

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:
@@ -75,3 +81,14 @@ url-source:
   # AddSource:
     # - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
     # - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
+
+# This is a way to override platform detection, e.g. when you're running
+# a Ubuntu derivate based on 18.04, you could do:
+#
+# platform-override:
+#   arch: A_64
+#   platform:
+#     contents: Ubuntu
+#     tag: Linux
+#   version: '18.04'
+platform-override: null

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 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 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://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
@@ -60,6 +60,29 @@ All you wanted to know about GHCup.
 3. handling cabal projects
 4. being a stack alternative
 
+## Distribution policies
+
+Like most Linux distros and other distribution channels, GHCup also
+follows certain policies. These are as follows:
+
+1. The end-user experience is our primary concern
+    - ghcup in CI systems as a use case is a first class citizen
+2. We strive to collaborate with all maintainers of all the tools we support and maintain a good relationship
+3. We may fix build system or other distribution bugs in upstream bindists
+    - these are always communicated upstream
+4. We may even patch source code of supported tools in very rare cases if that is required to ensure that the end-user experience does not break
+    - we'll first try to upstream any such required patch and request a new release to avoid downstream patching
+    - patches will be communicated to the maintainers either way and we'll strive to get their review
+    - they will also be communicated to the end-user
+    - they will be uploaded along with the bindist
+    - we will avoid maintaining long-running downstream patches (currently zero)
+5. We may add bindists for platforms that upstream does not support
+    - this is currently the case for GHC for e.g. Alpine and possibly FreeBSD in the future
+    - this is currently also the case for stack on darwin M1
+    - we don't guarantee for unofficial bindists that the test suite passes at the moment (this may change in the future)
+6. We GPG sign all the GHCup metadata as well as the unofficial bindists
+    - any trust issues relating to missing checksums or GPG signatures is a bug and given high priority
+
 ## How
 
 Installs a specified GHC version into `~/.ghcup/ghc/<ver>`, and places `ghc-<ver>` symlinks in `~/.ghcup/bin/`.
@@ -75,15 +98,15 @@ cabal-install/HLS/stack are installed in `~/.ghcup/bin/<tool>-<ver>` and have un
 ## Known users
 
 * CI:
-	- [Github actions/virtual-environments](https://github.com/actions/virtual-environments)
-	- [Github haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
-	- [haskell-ci](https://github.com/haskell-CI/haskell-ci)
+    - [Github actions/virtual-environments](https://github.com/actions/virtual-environments)
+    - [Github haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
+    - [haskell-ci](https://github.com/haskell-CI/haskell-ci)
 * mirrors:
-	- [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
+    - [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
 * tools:
-	- [vscode-haskell](https://github.com/haskell/vscode-haskell)
-	- [nvim-lsp-installer](https://github.com/williamboman/nvim-lsp-installer)
-	- [vabal](https://github.com/Franciman/vabal)
+    - [vscode-haskell](https://github.com/haskell/vscode-haskell)
+    - [nvim-lsp-installer](https://github.com/williamboman/nvim-lsp-installer)
+    - [vabal](https://github.com/Franciman/vabal)
 
 ## Known problems
 
@@ -155,6 +178,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

@@ -4,7 +4,7 @@ This is a more in-depth guide specific to GHCup. `ghcup --help` is your friend.
 
 ## Basic usage
 
-For the simple interactive TUI (not available on windows), run:
+For the simple, interactive, text-based user interface (TUI) (not available on windows), run:
 
 ```sh
 ghcup tui
@@ -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,10 +67,24 @@ 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.
 
+## Overriding distro detection
+
+If you're running e.g. an Ubuntu derivate based on 18.04 and ghcup is picking bindists that
+don't work well, you could do this in `config.yaml`:
+
+```yml
+platform-override:
+  arch: A_64
+  platform:
+    contents: Ubuntu
+    tag: Linux
+  version: '18.04'
+```
+
 ## Env variables
 
 This is the complete list of env variables that change GHCup behavior:
@@ -83,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.
@@ -133,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:
@@ -184,8 +202,97 @@ 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://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
+  for Unix-like operating systems
+* [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).
+
+The effect of the scripts can be customised by setting one or more
+`BOOTSTRAP_HASKELL_*` environment variables (as set out in the first script)
+and, in the case of Windows, by specifying parameters (as set out in the
+PowerShell script).
+
+For example, you can toggle:
+
+* non-interactive installation
+* a more verbose installation
+* whether to install only GHCup (and, on Windows, MSYS2)
+* not to trigger the upgrade of GHCup
+* whether to install the latest version of HLS
+* whether to install the latest version of Stack
+* whether to respect the XDG Base Directory Specification
+* whether to adjust (prepend) the PATH in `bashrc`
+* on Windows, whether to adjust MINGW paths in `cabal.config`
+
+You can also specify:
+
+* the GHC version to install
+* the Cabal version to install
+* which downloader to use (the default is `curl`)
+* the base URL for the download of the GHCup binary distribution
+
+On Windows, you can also use the parameters to:
+
+* toggle whether to overwrite a previous installation
+* specify the GHCup installation root directory
+* specify the Cabal root directory
+* specify the directory of an existing installation of MSYS2 (for example,
+  the one supplied by Stack)
+* specify the URL of the final bootstrap script
+* toggle whether to run the final bootstrap script via `bash` (instead of in a
+  new MSYS2 shell)
+
 ## Installing custom bindists
 
 There are a couple of good use cases to install custom bindists:
@@ -193,7 +300,8 @@ There are a couple of good use cases to install custom bindists:
 1. manually built bindists (e.g. with patches)
     - example: `ghcup install ghc -u 'file:///home/mearwald/tmp/ghc-eff-patches/ghc-8.10.2-x86_64-deb10-linux.tar.xz' 8.10.2-eff`
 2. GHC head CI bindists
-    - example: `ghcup install ghc -u 'https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27' head`
+    - example specifying a branch (`master`): `ghcup install ghc -u 'https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz?job=x86_64-linux-fedora33-release' head`
+    - example specifying a job id (`1129565`): `ghcup install ghc -u ' https://gitlab.haskell.org/api/v4/projects/1/jobs/1129565/artifacts/ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz' mr7847`
 3. DWARF bindists
     - example: `ghcup install ghc -u 'https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-deb10-linux-dwarf.tar.xz' 8.10.2-dwarf`
 
@@ -202,18 +310,78 @@ and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
 GHCup always needs to know which version the bindist corresponds to (this is not automatically
 detected).
 
-## Compiling GHC from source
+## Compiling from source
+
+### GHC
 
 Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`
 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).
 
 Make sure your system meets all the [prerequisites](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/preparation).
 
+### HLS
+
+There are 3 main ways to compile HLS from source.
+
+1. from hackage (should have up to date version bounds)
+    - `ghcup compile hls --version 1.7.0.0 --ghc 9.2.3`
+2. from git (allows to build latest sources and PRs)
+    - `ghcup compile hls --git-ref master --ghc 9.2.3`
+    - `ghcup compile hls --git-ref a32db0b --ghc 9.2.3`
+    - `ghcup compile hls --git-ref 1.7.0.0 --ghc 9.2.3`
+3. from source distribution that's packaged during release from the corresponding git sources
+    - `ghcup compile hls --source-dist 1.7.0.0 --ghc 9.2.3`
+
+All these use `cabal v2-install` under the hood, so all build components are cached.
+You can pass arbitrary arguments to cabal, e.g. set the index state like so:
+
+```sh
+ghcup compile hls --git-ref master --ghc 9.2.3 -- --index-state=2022-06-12T00:00:00Z --allow-newer
+```
+
+You can pass `--ghc <ver>` multiple times to install for many GHCs at once.
+
+When building from git sources, ghcup will auto-detect the HLS version that the git commit corresponds to
+from the `haskell-language-server.cabal` file. This version might not have been updated since the last release.
+If you want to avoid overwriting the existing installed HLS version, you can instruct ghcup to use `git describe`
+to set the HLS version instead:
+
+```sh
+ghcup compile hls --git-ref master --ghc 9.2.3 --git-describe-version
+```
+
+You can also set the version explicitly:
+
+```sh
+ghcup compile hls --git-ref master --ghc 9.2.3 --overwrite-version 1.7.0.0-p1
+```
+
+To instruct cabal to run `cabal update` before building, run `ghcup compile hls --version 1.7.0.0 --ghc 9.2.3 --cabal-update`
+
+As always, check `ghcup compile hls --help`.
+
+#### Updating HLS for a new GHC version
+
+First try to build from hackage with some tricks:
+
+```sh
+ghcup compile hls --version 1.7.0.0 --ghc 9.2.4 --cabal-update -- --allow-newer --index-state=2022-06-12T00:00:00Z
+```
+
+This augments the currently installed 1.7.0.0 official bindists in ghcup with new GHC versions support.
+
+If that fails (since `--allow-newer` is quite brutal), you can install from HLS master branch (which may contain new fixes) like so:
+```
+ghcup compile hls --git-ref master --git-describe-version --ghc 8.10.7 --ghc 9.2.4 --cabal-update
+```
+
+This however will create a new HLS version in ghcup, e.g. `1.7.0.0-105-gdc682ba1`, for both 8.10.7 and 9.2.4. If you want to switch back to the official bindists, run `ghcup set hls 1.7.0.0`.
+
 ### Cross support
 
 ghcup can compile and install a cross GHC for any target. However, this
@@ -241,41 +409,43 @@ You need to use the `--isolate` or `-i` flag followed by the directory path.
 
 Examples:
 
-1. install an isolated GHC version at location /home/user/isolated_dir/ghc/  
+1. install an isolated GHC version at location /home/user/isolated_dir/ghc/
     - `ghcup install ghc 8.10.5 --isolate /home/user/isolated_dir/ghc`
 
-2. isolated install Cabal at a location you desire  
+2. isolated install Cabal at a location you desire
     - `ghcup install cabal --isolate /home/username/my_isolated_dir/`
 
-3. do an isolated install with a custom bindist  
-    - `ghcup install ghc --isolate /home/username/my_isolated_dir/ -u 'https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27' head`
+3. do an isolated install with a custom bindist
+    - `ghcup install ghc --isolate /home/username/my_isolated_dir/ -u 'https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz?job=x86_64-linux-fedora33-release' head`
 
-4. isolated install HLS  
+4. isolated install HLS
     - `ghcup install hls --isolate /home/username/dir/hls/`
 
-5. you can even compile ghc to an isolated location.  
-    - `ghcup compile ghc -j 4 -v 9.0.1 -b 8.10.5 -i /home/username/my/dir/ghc` 
+5. you can even compile ghc to an isolated location.
+    - `ghcup compile ghc -j 4 -v 9.0.1 -b 8.10.5 -i /home/username/my/dir/ghc`
 
 ## Continuous integration
 
-On windows, ghcup can be installed automatically on a CI runner non-interactively like so:
+On Windows, GHCup can be installed automatically on a CI runner
+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
 curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
 ```
 
-This will just install `ghcup` and on windows additionally `msys2`.
+This will just install `ghcup` and on Windows additionally MSYS2.
 
-For the full list of env variables and parameters to tweak the script behavior, see:
-
-* [bootstrap-haskell for linux/darwin/freebsd](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
-* [bootstrap-haskell.ps1 for windows](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
+See the installation scripts referred to above for the full list of environment
+variables and, in the case of Windows, parameters to tweak the script behavior.
 
 ### github workflows
 
@@ -347,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`
-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`
+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://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,10 +13,10 @@ 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">Getting Started</a>
+<a href="install/" class="btn btn-primary" role="button">Installation</a>
 <a href="steps/" class="btn btn-primary" role="button">First steps</a>
 <a href="guide/" class="btn btn-primary" role="button">User Guide</a>
 </div>
@@ -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

@@ -1,10 +1,10 @@
-# Getting started
+# Installation
 
 GHCup makes it easy to install specific versions of GHC on GNU/Linux,
 macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./install/#supported-tools) from scratch.
 It follows the UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well). Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
 
-## Installation
+## How to install
 
 The following commands will download the `ghcup` binary into `~/.ghcup/bin` (or `C:\ghcup\bin` on windows) and then
 run it to interactively install the [Haskell Toolchain](#supported-tools). These commands should be run as **non-root/non-admin
@@ -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?
 
@@ -34,6 +34,53 @@ GHCup has two main channels for every tool: **recommended** and **latest**. By d
 
 Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information.
 
+## System requirements
+
+### Linux Debian
+
+The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
+
+### Linux Ubuntu
+
+The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
+
+### Linux Fedora
+
+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`
+
+### Linux Alpine
+
+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.
+
+### Darwin
+
+On OS X, in the course of running ghcup you will be given a dialog box to install the command line tools. Accept and the requirements will be installed for you. You will then need to run the command again.
+On Darwin M1 you might also need a working llvm installed (e.g. via brew) and have the toolchain exposed in PATH.
+
+### FreeBSD
+
+The following distro packages are required: `curl gcc gmp gmake ncurses perl5 libffi libiconv`
+
+### Windows
+
+On Windows, msys2 should already have been set up during the installation, so most users should just proceed. If you are installing manually, make sure to have a working mingw64 toolchain and shell.
+
 ## Next steps
 
 1. Follow the [First steps guide](../steps) on how to build a "Hello world" program, use `ghc`, run an interactive REPL and create a Haskell project
@@ -55,12 +102,17 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>9.2.3</td><td><span style="color:blue">latest</span>, base-4.16.2.0</td></tr>
+<tr><td>9.4.3</td><td><span style="color:blue">latest</span>, base-4.17.0.0</td></tr>
+<tr><td>9.4.2</td><td>base-4.17.0.0</td></tr>
+<tr><td>9.4.1</td><td>base-4.17.0.0</td></tr>
+<tr><td>9.2.5</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
+<tr><td>9.2.4</td><td>base-4.16.3.0</td></tr>
+<tr><td>9.2.3</td><td>base-4.16.2.0</td></tr>
 <tr><td>9.2.2</td><td>base-4.16.1.0</td></tr>
 <tr><td>9.2.1</td><td>base-4.16.0.0</td></tr>
 <tr><td>9.0.2</td><td>base-4.15.1.0</td></tr>
 <tr><td>9.0.1</td><td>base-4.15.0.0</td></tr>
-<tr><td>8.10.7</td><td><span style="color:green">recommended</span>, base-4.14.3.0</td></tr>
+<tr><td>8.10.7</td><td>base-4.14.3.0</td></tr>
 <tr><td>8.10.6</td><td>base-4.14.3.0</td></tr>
 <tr><td>8.10.5</td><td>base-4.14.2.0</td></tr>
 <tr><td>8.10.4</td><td>base-4.14.1.0</td></tr>
@@ -91,7 +143,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>3.6.2.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+<tr><td>3.8.1.0</td><td><span style="color:blue">latest</span></td></tr>
+<tr><td>3.6.2.0</td><td><span style="color:green">recommended</span></td></tr>
 <tr><td>3.6.0.0</td><td></td></tr>
 <tr><td>3.4.1.0</td><td></td></tr>
 <tr><td>3.4.0.0</td><td></td></tr>
@@ -106,7 +159,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>1.7.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+<tr><td>1.8.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+<tr><td>1.7.0.0</td><td></td></tr>
 <tr><td>1.6.1.0</td><td></td></tr>
 <tr><td>1.6.0.0</td><td></td></tr>
 <tr><td>1.5.1</td><td></td></tr>
@@ -123,7 +177,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>2.7.5</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+<tr><td>2.9.1</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+<tr><td>2.7.5</td><td></td></tr>
 <tr><td>2.7.3</td><td></td></tr>
 <tr><td>2.7.1</td><td></td></tr>
 <tr><td>2.5.1</td><td></td></tr>
@@ -183,7 +238,7 @@ HLS bindists are experimental.
 
 Lower availability of bindists. Stack and HLS binaries are experimental.
 
-## Manual install
+## Manual installation
 
 Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
 and place it into your `PATH` anywhere.
@@ -208,10 +263,12 @@ The developers of the Haskell Language Server offer an [extension](https://githu
 3. Make sure your project uses the GHC version installed from GHCup (otherwise HLS is likely to fail on launch):
     - instructions for [stack](https://docs.haskellstack.org/en/stable/yaml_configuration/#system-ghc)
 
+On Linux, some users have reported an issue when VSCode is not launched from a terminal ("cannot find ghc version"). A solution is to [let HLS know about your GHCup on $PATH](https://github.com/haskell/vscode-haskell#stackcabalghc-can-not-be-found).
+
 ## 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

@@ -177,7 +177,7 @@ A more thorough introduction to GHCi can be found in the
 ### Using external packages in ghci
 
 By default, GHCi can only load and use packages that are
-[included with the GHC installation](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/9.2.2-notes.html#included-libraries).
+[included with the GHC installation](https://downloads.haskell.org/ghc/9.4.2/docs/users_guide/9.4.2-notes.html#included-libraries).
 
 However, users of the [cabal-install](https://www.haskell.org/cabal) and
 [stack](http://haskellstack.org) build tools can download and load external packages
@@ -335,7 +335,7 @@ see the [Cabal user guide](https://cabal.readthedocs.io/en/stable/getting-starte
 
 To learn Haskell, try any of those:
 
-- A beginner friendly [4-lectures course](https://github.com/haskell-beginners-2022/course-plan) with exercises (by [Kowainik](https://kowainik.github.io/))
+- A beginner friendly [4-lectures course](https://github.com/haskell-beginners-2022/course-plan) with exercises (by [Dmitrii Kovanikov](https://kodimensional.dev/))
 - An in-depth university [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises (by [Brent Yorgey](https://byorgey.wordpress.com/))
 
 ## Projects to contribute to
@@ -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

@@ -1,13 +1,13 @@
 cabal-version:      3.0
 name:               ghcup
-version:            0.1.18.0
+version:            0.1.18.1
 license:            LGPL-3.0-only
 license-file:       LICENSE
 copyright:          Julian Ospald 2020
 maintainer:         hasufell@posteo.de
 author:             Julian Ospald
-homepage:           https://gitlab.haskell.org/haskell/ghcup-hs
-bug-reports:        https://gitlab.haskell.org/haskell/ghcup-hs/issues
+homepage:           https://github.com/haskell/ghcup-hs
+bug-reports:        https://github.com/haskell/ghcup-hs/issues/
 synopsis:           ghc toolchain installer
 description:
   A rewrite of the shell script ghcup, for providing
@@ -21,13 +21,18 @@ extra-doc-files:
   README.md
 
 extra-source-files:
+  cbits/dirutils.c
+  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:
@@ -36,6 +41,11 @@ flag tui
   default:     False
   manual:      True
 
+flag tui-ansi
+  description: Build the ansi-terminal powered tui (ghcup tui-ansi).
+  default:     False
+  manual:      True
+
 flag internal-downloader
   description:
     Compile the internal downloader, which links against OpenSSL. This is disabled on windows.
@@ -60,6 +70,7 @@ library
     GHCup.List
     GHCup.Platform
     GHCup.Prelude
+    GHCup.Prelude.Ansi
     GHCup.Prelude.File
     GHCup.Prelude.File.Search
     GHCup.Prelude.Internal
@@ -69,6 +80,7 @@ library
     GHCup.Prelude.Process
     GHCup.Prelude.String.QQ
     GHCup.Prelude.Version.QQ
+    GHCup.Prompts
     GHCup.Requirements
     GHCup.Stack
     GHCup.Types
@@ -118,7 +130,7 @@ library
     , directory             ^>=1.3.6.0
     , disk-free-space       ^>=0.1.0.1
     , exceptions            ^>=0.10
-    , filepath              ^>=1.4.2.1
+    , filepath              ==1.4.2.1
     , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  ^>=3.2.1
     , libarchive            ^>=3.0.3.0
@@ -161,28 +173,31 @@ library
       , terminal-progress-bar  >=0.4.1
 
   if os(windows)
-    cpp-options:   -DIS_WINDOWS
+    cpp-options:     -DIS_WINDOWS
     other-modules:
       GHCup.Prelude.File.Windows
       GHCup.Prelude.Windows
-    -- GHCup.OptParse.Run uses this
-    exposed-modules:
-      GHCup.Prelude.Process.Windows
 
+    -- GHCup.OptParse.Run uses this
+    exposed-modules: GHCup.Prelude.Process.Windows
     build-depends:
       , bzlib
       , process  ^>=1.6.11.0
-      , Win32    ^>=2.10
+      , Win32    >=2.10
 
   else
     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
 
-    c-sources:     cbits/dirutils.c
+    include-dirs:     cbits
+    includes:         dirutils.h
+    install-includes: dirutils.h
+    c-sources:        cbits/dirutils.c
     build-depends:
       , bz2              >=0.5.0.5 && <1.1
       , terminal-size    ^>=0.3.2.1
@@ -236,12 +251,13 @@ executable ghcup
     , aeson-pretty          ^>=0.8.8
     , async                 ^>=2.2.3
     , base                  >=4.12     && <5
-    , bytestring            >=0.10       && <0.12
+    , 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
-    , filepath              ^>=1.4.2.1
+    , filepath              ==1.4.2.1
     , ghcup
     , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  ^>=3.2.1
@@ -269,6 +285,14 @@ executable ghcup
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER
 
+  if flag(tui-ansi)
+    cpp-options:   -DANSI
+    other-modules: AnsiMain
+    build-depends:
+      , ansi-terminal
+      , ansi-terminal-game
+      , transformers        ^>=0.5
+
   if (flag(tui) && !os(windows))
     cpp-options:   -DBRICK
     other-modules: BrickMain
@@ -296,6 +320,7 @@ test-suite ghcup-test
     GHCup.ArbitraryTypes
     GHCup.Types.JSONSpec
     GHCup.Utils.FileSpec
+    GHCup.Prelude.File.Posix.TraversalsSpec
     Spec
 
   default-language:   Haskell2010
@@ -313,13 +338,13 @@ test-suite ghcup-test
 
   build-depends:
     , base                      >=4.12    && <5
-    , bytestring            >=0.10       && <0.12
+    , bytestring                >=0.10    && <0.12
     , containers                ^>=0.6
     , directory                 ^>=1.3.6.0
-    , filepath                  ^>=1.4.2.1
-    , generic-arbitrary         >=0.1.0  && < 0.2.1 || >=0.2.2 && <0.3
+    , 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
@@ -327,3 +352,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

@@ -33,8 +33,8 @@ module GHCup (
 
 
 import           GHCup.Cabal
-import           GHCup.GHC
-import           GHCup.HLS
+import           GHCup.GHC             hiding ( GHCVer(..) )
+import           GHCup.HLS             hiding ( HLSVer(..) )
 import           GHCup.Stack
 import           GHCup.List
 import           GHCup.Download
@@ -73,11 +73,11 @@ import           Prelude                 hiding ( abs
 import           System.Environment
 import           System.FilePath
 import           System.IO.Error
+import           System.IO.Temp
 import           Text.Regex.Posix
 
 import qualified Data.Text                     as T
 import qualified Streamly.Prelude              as S
-import Text.PrettyPrint.HughesPJClass (prettyShow)
 
 
 
@@ -105,6 +105,7 @@ fetchToolBindist :: ( MonadFail m
                  -> Maybe FilePath
                  -> Excepts
                       '[ DigestError
+                       , ContentLengthError
                        , GPGError
                        , DownloadFailed
                        , NoDownload
@@ -133,6 +134,7 @@ rmTool :: ( MonadReader env m
           => ListResult
           -> Excepts '[NotInstalled, UninstallFailed] m ()
 rmTool ListResult {lVer, lTool, lCross} = do
+  logInfo $ "removing " <> T.pack (show lTool) <> " version " <> prettyVer lVer
   case lTool of
     GHC ->
       let ghcTargetVersion = GHCTargetVersion lCross lVer
@@ -206,9 +208,8 @@ rmGhcupDirs = do
       | isWindows = removeDirIfEmptyOrIsSymlink binDir
       | otherwise = do
           isXDGStyle <- liftIO useXDG
-          if not isXDGStyle
-            then removeDirIfEmptyOrIsSymlink binDir
-            else pure ()
+          when (not isXDGStyle) $
+            removeDirIfEmptyOrIsSymlink binDir
 
     reportRemainingFiles :: (MonadMask m, MonadIO m) => FilePath -> m [FilePath]
     reportRemainingFiles dir = do
@@ -287,6 +288,7 @@ upgradeGHCup :: ( MonadMask m
              -> Excepts
                   '[ CopyError
                    , DigestError
+                   , ContentLengthError
                    , GPGError
                    , GPGError
                    , DownloadFailed
@@ -307,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
@@ -325,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
 
@@ -365,11 +367,12 @@ rmGhcup = do
   if isWindows
   then do
     -- since it doesn't seem possible to delete a running exe on windows
-    -- we move it to temp dir, to be deleted at next reboot
-    tempFilepath <- mkGhcupTmpDir
+    -- we move it to system temp dir, to be deleted at next reboot
+    tmp <- liftIO $ getCanonicalTemporaryDirectory >>= \t -> createTempDirectory t "ghcup"
+    logDebug $ "mv " <> T.pack ghcupFilepath <> " " <> T.pack (tmp </> "ghcup")
     hideError UnsupportedOperation $
               liftIO $ hideError NoSuchThing $
-              moveFile ghcupFilepath (fromGHCupPath tempFilepath </> "ghcup")
+              moveFile ghcupFilepath (tmp </> "ghcup")
   else
     -- delete it.
     hideError doesNotExistErrorType $ rmFile ghcupFilepath

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)
-               . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
+           else handleIO (\e -> case metaMode of
+                                  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
-download uri gpgUri eDigest dest mfn etags
-  | scheme == "https" = dl
-  | scheme == "http"  = dl
+         -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
+download uri gpgUri eDigest eCSize dest mfn etags
+  | scheme == "https" = liftE 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)
-              => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
+  curlEtagsDL :: ( MonadReader env 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)
-              => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
+  wgetEtagsDL :: ( MonadReader env 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
-              Right (r', _) -> r'
-            Nothing -> 0
+              Left  _       -> Nothing
+              Right (r', _) -> Just r'
+            Nothing -> Nothing
 
-      (mpb :: Maybe (ProgressBar ())) <- if progressBar
-        then Just <$> newProgressBar defStyle 10 (Progress 0 size ())
-        else pure Nothing
+      forM_ size $ \s -> forM_ eCSize $ \es -> when (es /= s) $ throwIO (ContentLengthError Nothing (Just s) es)
+      let size' = eCSize <|> size
+
+      (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
@@ -138,8 +325,11 @@ data AlreadyInstalled = AlreadyInstalled Tool Version
 instance Pretty AlreadyInstalled where
   pPrint (AlreadyInstalled tool ver') =
     (pPrint tool <> text "-" <> pPrint ver') <+> text "is already installed;"
-    <+> text "if you really want to reinstall it, you may want to run 'ghcup install cabal --force" <+> (pPrint ver' <> text "'")
+    <+> 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

@@ -80,6 +80,12 @@ import qualified Data.Text.Encoding            as E
 import qualified Text.Megaparsec               as MP
 
 
+data GHCVer v = SourceDist v
+              | GitDist GitBranch
+              | RemoteDist URI
+
+
+
     ---------------------
     --[ Tool fetching ]--
     ---------------------
@@ -103,6 +109,7 @@ fetchGHCSrc :: ( MonadFail m
             -> Maybe FilePath
             -> Excepts
                  '[ DigestError
+                  , ContentLengthError
                   , GPGError
                   , DownloadFailed
                   , NoDownload
@@ -146,6 +153,7 @@ installGHCBindist :: ( MonadFail m
                        '[ AlreadyInstalled
                         , BuildFailed
                         , DigestError
+                        , ContentLengthError
                         , GPGError
                         , DownloadFailed
                         , NoDownload
@@ -295,8 +303,9 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
   | otherwise = do
       PlatformRequest {..} <- lift getPlatformReq
 
-      let alpineArgs
-           | ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
+      let ldOverride
+           | ver >= [vver|8.2.2|]
+           , _rPlatform `elem` [Linux Alpine, Darwin]
            = ["--disable-ld-override"]
            | otherwise
            = []
@@ -304,7 +313,7 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
       lift $ logInfo "Installing GHC (this may take a while)"
       lEM $ execLogged "sh"
                        ("./configure" : ("--prefix=" <> fromInstallDir inst)
-                        : (alpineArgs <> (T.unpack <$> addConfArgs))
+                        : (ldOverride <> (T.unpack <$> addConfArgs))
                        )
                        (Just $ fromGHCupPath path)
                        "ghc-configure"
@@ -350,6 +359,7 @@ installGHCBin :: ( MonadFail m
                    '[ AlreadyInstalled
                     , BuildFailed
                     , DigestError
+                    , ContentLengthError
                     , GPGError
                     , DownloadFailed
                     , NoDownload
@@ -449,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
@@ -607,7 +617,7 @@ compileGHC :: ( MonadMask m
               , MonadUnliftIO m
               , MonadFail m
               )
-           => Either GHCTargetVersion GitBranch          -- ^ version to install
+           => GHCVer GHCTargetVersion
            -> Maybe Version            -- ^ overwrite version
            -> Either Version FilePath  -- ^ version to bootstrap with
            -> Maybe Int                -- ^ jobs
@@ -621,6 +631,7 @@ compileGHC :: ( MonadMask m
                 '[ AlreadyInstalled
                  , BuildFailed
                  , DigestError
+                 , ContentLengthError
                  , GPGError
                  , DownloadFailed
                  , GHCupSetError
@@ -650,7 +661,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
     (workdir, tmpUnpack, tver) <- case targetGhc of
       -- unpack from version tarball
-      Left tver -> do
+      SourceDist tver -> do
         lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
 
         -- download source tarball
@@ -669,13 +680,37 @@ 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)
+
+        -- download source tarball
+        tmpDownload <- lift withGHCupTmpDir
+        tmpUnpack <- lift mkGhcupTmpDir
+        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
+          [bootFile] <- liftIO $ findFilesDeep
+            tmpUnpack
+            (makeRegexOpts compExtended
+                           execBlank
+                           regex
+            )
+          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)
 
       -- clone from git
-      Right GitBranch{..} -> do
+      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" ]
@@ -685,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
@@ -715,27 +750,23 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
           liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
 
           -- bootstrap
-          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)
-          tver <- case _exitCode of
-            ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
-            ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
-
+          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)
@@ -758,8 +789,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
       tmpUnpack
       (do
         b <- if hadrian
-             then compileHadrianBindist tver (fromGHCupPath workdir) ghcdir
-             else compileMakeBindist tver (fromGHCupPath workdir) ghcdir
+             -- prefer 'tver', because the real version carries out compatibility checks
+             -- 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)
       )
@@ -795,11 +828,29 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
     pure installVer
 
  where
+  getGHCVer :: ( MonadReader env m
+               , HasSettings env
+               , HasDirs env
+               , HasLog env
+               , MonadIO m
+               , MonadThrow m
+               )
+            => GHCupPath
+            -> 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 -> 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 =
     let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
         default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
     in case targetGhc of
-         Left (GHCTargetVersion (Just _) _) -> cross_mk
+         SourceDist (GHCTargetVersion (Just _) _) -> cross_mk
          _ -> default_mk
 
   compileHadrianBindist :: ( MonadReader env m
@@ -976,7 +1027,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
    -- for cross, we need Stage1Only
     case targetGhc of
-      Left (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
+      SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
         (InvalidBuildConfig
           [s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
         )

lib/GHCup/HLS.hs

@@ -68,7 +68,12 @@ 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
+            | GitDist GitBranch
+            | HackageDist Version
+            | RemoteDist URI
 
 
 
@@ -99,6 +104,7 @@ installHLSBindist :: ( MonadMask m
                        '[ AlreadyInstalled
                         , CopyError
                         , DigestError
+                        , ContentLengthError
                         , GPGError
                         , DownloadFailed
                         , NoDownload
@@ -291,6 +297,7 @@ installHLSBin :: ( MonadMask m
                    '[ AlreadyInstalled
                     , CopyError
                     , DigestError
+                    , ContentLengthError
                     , GPGError
                     , DownloadFailed
                     , NoDownload
@@ -324,34 +331,39 @@ compileHLS :: ( MonadMask m
               , MonadUnliftIO m
               , MonadFail m
               )
-           => Either Version GitBranch
+           => HLSVer
            -> [Version]
            -> Maybe Int
            -> Either Bool Version
            -> InstallDir
            -> Maybe (Either FilePath URI)
            -> Maybe URI
+           -> Bool
            -> Maybe (Either FilePath [URI])  -- ^ patches
            -> [Text]                   -- ^ additional args to cabal install
            -> Excepts '[ NoDownload
                        , GPGError
                        , DownloadFailed
                        , DigestError
+                       , ContentLengthError
                        , UnknownArchive
                        , TarDirDoesNotExist
                        , ArchiveResult
                        , BuildFailed
                        , NotInstalled
                        ] m Version
-compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patches cabalArgs = do
+compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
   PlatformRequest { .. } <- lift getPlatformReq
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   Dirs { .. } <- lift getDirs
 
+  when updateCabal $ reThrowAll @_ @'[ProcessError] DownloadFailed $ do
+    lift $ logInfo "Updating cabal DB"
+    lEM $ exec "cabal" ["update"] (Just $ fromGHCupPath tmpDir) Nothing
 
-  (workdir, tver, git_describe) <- case targetHLS of
+  (workdir, tmpUnpack, tver, git_describe) <- case targetHLS of
     -- unpack from version tarball
-    Left tver -> do
+    SourceDist tver -> do
       lift $ logDebug $ "Requested to compile: " <> prettyVer tver
 
       -- download source tarball
@@ -369,10 +381,47 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
                        (liftE . intoSubdir tmpUnpack)
                        (view dlSubdir dlInfo)
 
-      pure (workdir, tver, Nothing)
+      pure (workdir, tmpUnpack, tver, Nothing)
+
+    HackageDist tver -> do
+      lift $ logDebug $ "Requested to compile (from hackage): " <> prettyVer tver
+
+      -- download source tarball
+      tmpUnpack <- lift mkGhcupTmpDir
+      let hls = "haskell-language-server-" <> T.unpack (prettyVer tver)
+      reThrowAll @_ @'[ProcessError] DownloadFailed $ do
+        -- unpack
+        lEM $ exec "cabal" ["unpack", hls] (Just $ fromGHCupPath tmpUnpack) Nothing
+
+      let workdir = appendGHCupPath tmpUnpack hls
+
+      pure (workdir, tmpUnpack, tver, Nothing)
+
+    RemoteDist uri -> do
+      lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
+
+      -- download source tarball
+      tmpDownload <- lift withGHCupTmpDir
+      tmpUnpack <- lift mkGhcupTmpDir
+      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
+        [cabalFile] <- liftIO $ findFilesDeep
+          tmpUnpack
+          (makeRegexOpts compExtended
+                         execBlank
+                         regex
+          )
+        tver <- getCabalVersion (fromGHCupPath tmpUnpack </> cabalFile)
+        pure (cabalFile, tver)
+
+      let workdir = appendGHCupPath tmpUnpack (takeDirectory cf)
+
+      pure (workdir, tmpUnpack, tver, Nothing)
 
     -- clone from git
-    Right GitBranch{..} -> do
+    GitDist GitBranch{..} -> do
       tmpUnpack <- lift mkGhcupTmpDir
       let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
       reThrowAll @_ @'[ProcessError] DownloadFailed $ do
@@ -409,15 +458,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
                         then pure Nothing
                         else fmap Just $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
         chash <- gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
-        (Just gpd) <- parseGenericPackageDescriptionMaybe
-          <$> liftIO (B.readFile (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal"))
-        let tver = (\c -> Version Nothing c [] Nothing)
-                 . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
-                 . versionNumbers
-                 . pkgVersion
-                 . package
-                 . packageDescription
-                 $ gpd
+        tver <- getCabalVersion (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal")
 
         liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
         lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n  " <>
@@ -425,7 +466,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
                                     (if not shallow_clone then "\n  " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
                                     (if isCommitHash ref then mempty else "\n  " <> "commit hash: " <> chash)
 
-        pure (tmpUnpack, tver, git_describe)
+        pure (tmpUnpack, tmpUnpack, tver, git_describe)
 
   -- the version that's installed may differ from the
   -- compiled version, so the user can overwrite it
@@ -441,8 +482,8 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
                   Right v -> pure v
 
   liftE $ runBuildAction
-    workdir
-    (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
+    tmpUnpack
+    (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, ContentLengthError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
       let tmpInstallDir = fromGHCupPath workdir </> "out"
       liftIO $ createDirRecursive' tmpInstallDir
 
@@ -457,14 +498,22 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
               pure "cabal.project"
           | otherwise -> pure (takeFileName cp)
         Just (Right uri) -> do
-          tmpUnpack <- lift withGHCupTmpDir
-          cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just "cabal.project") False
+          tmpUnpack' <- lift withGHCupTmpDir
+          cp <- liftE $ download uri Nothing Nothing Nothing (fromGHCupPath tmpUnpack') (Just "cabal.project") False
           copyFileE cp (fromGHCupPath workdir </> "cabal.project") False
           pure "cabal.project"
-        Nothing -> pure "cabal.project"
+        Nothing
+          | HackageDist _ <- targetHLS -> do
+              liftIO $ B.writeFile (fromGHCupPath workdir </> "cabal.project") "packages: ./"
+              pure "cabal.project"
+          | RemoteDist _ <- targetHLS -> do
+              let cabalFile = fromGHCupPath workdir </> "cabal.project"
+              liftIO $ whenM (not <$> doesFileExist cabalFile) $ B.writeFile cabalFile "packages: ./"
+              pure "cabal.project"
+          | otherwise -> pure "cabal.project"
       forM_ cabalProjectLocal $ \uri -> do
-        tmpUnpack <- lift withGHCupTmpDir
-        cpl <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just (cp <.> "local")) False
+        tmpUnpack' <- lift withGHCupTmpDir
+        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)
@@ -584,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
@@ -658,3 +707,19 @@ rmHLSVer ver = do
     case headMay . reverse . sort $ hlsVers of
       Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
       Nothing        -> pure ()
+
+
+getCabalVersion :: (MonadIO m, MonadFail m) => FilePath -> m Version
+getCabalVersion fp = do
+  contents <- liftIO $ B.readFile fp
+  gpd <- case parseGenericPackageDescriptionMaybe contents of
+           Nothing -> fail $ "could not parse cabal file: " <> fp
+           Just r -> pure r
+  let tver = (\c -> Version Nothing c [] Nothing)
+           . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
+           . versionNumbers
+           . pkgVersion
+           . package
+           . packageDescription
+           $ gpd
+  pure tver

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/Ansi.hs

@@ -0,0 +1,92 @@
+module GHCup.Prelude.Ansi where
+
+import           Control.Applicative
+import           Data.Char
+import           Data.Void
+
+import qualified Text.Megaparsec               as MP
+import qualified Text.Megaparsec.Char          as MPC
+
+
+-- | Calculate the render width of a string, considering
+-- wide characters (counted as double width), ANSI escape codes
+-- (not counted), and line breaks (in a multi-line string, the longest
+-- line determines the width).
+strWidth :: String -> Int
+strWidth =
+  maximum
+    . (0 :)
+    . map (foldr (\a b -> charWidth a + b) 0)
+    . lines
+    . stripAnsi
+
+-- | Strip ANSI escape sequences from a string.
+--
+-- >>> stripAnsi "\ESC[31m-1\ESC[m"
+-- "-1"
+stripAnsi :: String -> String
+stripAnsi s' =
+  case
+      MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s'
+    of
+      Nothing -> error "Bad ansi escape"  -- PARTIAL: should not happen
+      Just xs -> concat xs
+ where
+    -- This parses lots of invalid ANSI escape codes, but that should be fine
+  ansi =
+    MPC.string "\ESC[" *> digitSemicolons *> suffix MP.<?> "ansi" :: MP.Parsec
+        Void
+        String
+        Char
+  digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';')
+  suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']
+
+-- | Get the designated render width of a character: 0 for a combining
+-- character, 1 for a regular character, 2 for a wide character.
+-- (Wide characters are rendered as exactly double width in apps and
+-- fonts that support it.) (From Pandoc.)
+charWidth :: Char -> Int
+charWidth c = case c of
+  _ | c < '\x0300'                     -> 1
+    | c >= '\x0300' && c <= '\x036F'   -> 0
+    |  -- combining
+      c >= '\x0370' && c <= '\x10FC'   -> 1
+    | c >= '\x1100' && c <= '\x115F'   -> 2
+    | c >= '\x1160' && c <= '\x11A2'   -> 1
+    | c >= '\x11A3' && c <= '\x11A7'   -> 2
+    | c >= '\x11A8' && c <= '\x11F9'   -> 1
+    | c >= '\x11FA' && c <= '\x11FF'   -> 2
+    | c >= '\x1200' && c <= '\x2328'   -> 1
+    | c >= '\x2329' && c <= '\x232A'   -> 2
+    | c >= '\x232B' && c <= '\x2E31'   -> 1
+    | c >= '\x2E80' && c <= '\x303E'   -> 2
+    | c == '\x303F'                    -> 1
+    | c >= '\x3041' && c <= '\x3247'   -> 2
+    | c >= '\x3248' && c <= '\x324F'   -> 1
+    | -- ambiguous
+      c >= '\x3250' && c <= '\x4DBF'   -> 2
+    | c >= '\x4DC0' && c <= '\x4DFF'   -> 1
+    | c >= '\x4E00' && c <= '\xA4C6'   -> 2
+    | c >= '\xA4D0' && c <= '\xA95F'   -> 1
+    | c >= '\xA960' && c <= '\xA97C'   -> 2
+    | c >= '\xA980' && c <= '\xABF9'   -> 1
+    | c >= '\xAC00' && c <= '\xD7FB'   -> 2
+    | c >= '\xD800' && c <= '\xDFFF'   -> 1
+    | c >= '\xE000' && c <= '\xF8FF'   -> 1
+    | -- ambiguous
+      c >= '\xF900' && c <= '\xFAFF'   -> 2
+    | c >= '\xFB00' && c <= '\xFDFD'   -> 1
+    | c >= '\xFE00' && c <= '\xFE0F'   -> 1
+    | -- ambiguous
+      c >= '\xFE10' && c <= '\xFE19'   -> 2
+    | c >= '\xFE20' && c <= '\xFE26'   -> 1
+    | c >= '\xFE30' && c <= '\xFE6B'   -> 2
+    | c >= '\xFE70' && c <= '\xFEFF'   -> 1
+    | c >= '\xFF01' && c <= '\xFF60'   -> 2
+    | c >= '\xFF61' && c <= '\x16A38'  -> 1
+    | c >= '\x1B000' && c <= '\x1B001' -> 2
+    | c >= '\x1D000' && c <= '\x1F1FF' -> 1
+    | c >= '\x1F200' && c <= '\x1F251' -> 2
+    | c >= '\x1F300' && c <= '\x1F773' -> 1
+    | c >= '\x20000' && c <= '\x3FFFD' -> 2
+    | otherwise                        -> 1

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 = ()
-type CDirent = ()
+data {-# CTYPE "DIR" #-} CDir
+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/Prompts.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module GHCup.Prompts
+  ( PromptQuestion,
+    PromptResponse (..),
+    getUserPromptResponse,
+  )
+where
+
+import Control.Monad.Reader
+import qualified Data.Text.IO as TIO
+import GHCup.Prelude.Logger
+import GHCup.Types.Optics
+import GHCup.Types (PromptQuestion, PromptResponse(..))
+
+getUserPromptResponse :: ( HasLog env
+                         , MonadReader env m
+                         , MonadIO m)
+                      => PromptQuestion
+                      -> m PromptResponse
+
+getUserPromptResponse prompt = do
+  logInfo prompt
+  resp <- liftIO TIO.getLine
+  if resp `elem` ["YES", "yes", "y", "Y"]
+    then pure PromptYes
+    else pure PromptNo

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
@@ -309,17 +316,19 @@ data UserSettings = UserSettings
   , uUrlSource   :: Maybe URLSource
   , uNoNetwork   :: Maybe Bool
   , uGPGSetting  :: Maybe GPGSetting
+  , uPlatformOverride    :: Maybe PlatformRequest
   }
   deriving (Show, GHC.Generic)
 
 defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings 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
@@ -328,22 +337,24 @@ fromSettings Settings{..} Nothing =
     , uKeyBindings = Nothing
     , uUrlSource = Just urlSource
     , uGPGSetting = Just gpgSetting
+    , uPlatformOverride = platformOverride
   }
 fromSettings Settings{..} (Just KeyBindings{..}) =
   let ukb = UserKeyBindings
-            { kUp           = Just bUp        
-            , kDown         = Just bDown      
-            , kQuit         = Just bQuit      
-            , kInstall      = Just bInstall   
-            , kUninstall    = Just bUninstall 
-            , kSet          = Just bSet       
-            , kChangelog    = Just bChangelog 
+            { kUp           = Just bUp
+            , kDown         = Just bDown
+            , kQuit         = Just bQuit
+            , kInstall      = Just bInstall
+            , kUninstall    = Just bUninstall
+            , kSet          = Just bSet
+            , kChangelog    = Just bChangelog
             , kShowAll      = Just bShowAllVersions
             , kShowAllTools = Just bShowAllTools
             }
   in UserSettings {
       uCache = Just cache
     , uMetaCache = Just metaCache
+    , uMetaMode = Just metaMode
     , uNoVerify = Just noVerify
     , uVerbose = Just verbose
     , uKeepDirs = Just keepDirs
@@ -352,6 +363,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
     , uKeyBindings = Just ukb
     , uUrlSource = Just urlSource
     , uGPGSetting = Just gpgSetting
+    , uPlatformOverride = platformOverride
   }
 
 data UserKeyBindings = UserKeyBindings
@@ -421,16 +433,18 @@ instance NFData LeanAppState
 
 
 data Settings = Settings
-  { cache      :: Bool
-  , metaCache  :: Integer
-  , noVerify   :: Bool
-  , keepDirs   :: KeepDirs
-  , downloader :: Downloader
-  , verbose    :: Bool
-  , urlSource  :: URLSource
-  , noNetwork  :: Bool
-  , gpgSetting :: GPGSetting
-  , noColor    :: Bool -- this also exists in LoggerConfig
+  { cache            :: Bool
+  , metaCache        :: Integer
+  , metaMode         :: MetaMode
+  , noVerify         :: Bool
+  , keepDirs         :: KeepDirs
+  , downloader       :: Downloader
+  , verbose          :: Bool
+  , urlSource        :: URLSource
+  , noNetwork        :: Bool
+  , gpgSetting       :: GPGSetting
+  , noColor          :: Bool -- this also exists in LoggerConfig
+  , platformOverride :: Maybe PlatformRequest
   }
   deriving (Show, GHC.Generic)
 
@@ -438,7 +452,7 @@ defaultMetaCache :: Integer
 defaultMetaCache = 300 -- 5 minutes
 
 defaultSettings :: Settings
-defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False
+defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing
 
 instance NFData Settings
 
@@ -618,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
@@ -657,10 +663,7 @@ isSafeDir (IsolateDirResolved _) = False
 isSafeDir (GHCupDir _)           = True
 isSafeDir (GHCupBinDir _)        = False
 
+type PromptQuestion = Text
 
-
-
-
-
-
-
+data PromptResponse = PromptYes | PromptNo
+  deriving (Show, Eq)

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
@@ -56,6 +57,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Global
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
+deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "r-") . T.pack . kebab . tail $ str' } ''PlatformRequest
 
 instance ToJSON Tag where
   toJSON Latest             = String "Latest"

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
 
 
@@ -1097,7 +1097,8 @@ runBuildAction bdir action = do
 
 -- | Clean up the given directory if the action fails,
 -- depending on the Settings.
-cleanUpOnError :: ( MonadReader env m
+cleanUpOnError :: forall e m a env .
+                  ( MonadReader env m
                   , HasDirs env
                   , HasSettings env
                   , MonadIO m
@@ -1171,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
@@ -1183,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
-        ) `catchE` liftE @'[GPGError, DigestError , DownloadFailed] dl
+          liftE @'[GPGError, DigestError, ContentLengthError, DownloadFailed] $ dl
+        ) `catchE` liftE @'[GPGError, DigestError, ContentLengthError, DownloadFailed] dl
   | otherwise = pure ()
 
 
@@ -1269,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 " <>
-        "Haskell Language Server " <> T.pack (prettyShow hv) <> "." <> "\n" <>
-        "Haskell IDE support may not work until this is fixed." <> "\n" <>
-        "Install a different HLS version, or install and set one of the following GHCs:" <> "\n" <>
-        T.pack (prettyShow supportedGHC)
+        "GHC-" <> T.pack (prettyShow gv) <> " appears to have no corresponding HLS-" <> T.pack (prettyShow hv) <> " binary." <> "\n" <>
+        "Haskell IDE support may not work." <> "\n" <>
+        "You can try to either: " <> "\n" <>
+        "  1. Install a different HLS version (e.g. downgrade for older GHCs)" <> "\n" <>
+        "  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 ()
 
@@ -1298,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 ->
-  run
-    $ allocate
-        (run mkGhcupTmpDir)
-        (\fp ->
-            handleIO (\e -> run
-                $ logDebug ("Resource cleanup failed for " <> T.pack (fromGHCupPath fp) <> ", error was: " <> T.pack (displayException e)))
-            . removePathForcibly
-            $ fp))
+withGHCupTmpDir = do
+  Settings{keepDirs} <- getSettings
+  snd <$> withRunInIO (\run ->
+    run
+      $ allocate
+          (run mkGhcupTmpDir)
+          (\fp -> if -- we don't know whether there was a failure, so can only
+                     -- decide for 'Always'
+                     | 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
@@ -13,7 +13,7 @@ theme:
 
 nav:
   - Home: index.md
-  - "Getting started": install.md
+  - "Installation": install.md
   - "First steps": steps.md
   - "User Guide": guide.md
   - "Developer Guide": dev.md

scripts/bootstrap/bootstrap-haskell

@@ -12,7 +12,8 @@
 #   * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
 #   * BOOTSTRAP_HASKELL_GHC_VERSION - the ghc version to install
 #   * BOOTSTRAP_HASKELL_CABAL_VERSION - the cabal version to install
-#   * BOOTSTRAP_HASKELL_INSTALL_STACK - whether to install latest stack
+#   * BOOTSTRAP_HASKELL_INSTALL_NO_STACK - disable installation of stack
+#   * BOOTSTRAP_HASKELL_INSTALL_NO_STACK_HOOK - disable installation stack ghcup hook
 #   * BOOTSTRAP_HASKELL_INSTALL_HLS - whether to install latest hls
 #   * BOOTSTRAP_HASKELL_ADJUST_BASHRC - whether to adjust PATH in bashrc (prepend)
 #   * BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG - whether to adjust mingw paths in cabal.config on windows
@@ -27,7 +28,7 @@
 
 plat="$(uname -s)"
 arch=$(uname -m)
-ghver="0.1.17.8"
+ghver="0.1.18.0"
 : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
 
 export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -135,13 +136,18 @@ _eghcup() {
     fi
 }
 
-ecabal() {
-	edo _ecabal "$@"
+_ecabal() {
+    # shellcheck disable=SC2317
+    if [ -n "${CABAL_BIN}" ] ; then
+        "${CABAL_BIN}" "$@"
+    else
+        # shellcheck disable=SC2086
+        "${GHCUP_BIN}/cabal" "$@"
+    fi
 }
 
-_ecabal() {
-    # shellcheck disable=SC2086
-    "${GHCUP_BIN}/cabal" "$@"
+ecabal() {
+	edo _ecabal "$@"
 }
 
 _done() {
@@ -281,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
@@ -398,7 +404,11 @@ download_ghcup() {
 find_shell() {
 	case $SHELL in
 		*/zsh) # login shell is zsh
-			GHCUP_PROFILE_FILE="$HOME/.zshrc"
+			if [ -n "$ZDOTDIR" ]; then
+				GHCUP_PROFILE_FILE="$ZDOTDIR/.zshrc"
+			else
+				GHCUP_PROFILE_FILE="$HOME/.zshrc"
+			fi
 			MY_SHELL="zsh" ;;
 		*/bash) # login shell is bash
 			GHCUP_PROFILE_FILE="$HOME/.bashrc"
@@ -655,7 +665,7 @@ ask_hls() {
 		warn "Do you want to install haskell-language-server (HLS)?"
 		warn "HLS is a language-server that provides IDE-like functionality"
 		warn "and can integrate with different editors, such as Vim, Emacs, VS Code, Atom, ..."
-		warn "Also see https://github.com/haskell/haskell-language-server/blob/master/README.md"
+		warn "Also see https://haskell-language-server.readthedocs.io/en/stable/"
 		warn ""
 		warn "[Y] Yes  [N] No  [?] Help (default is \"N\")."
 		warn ""
@@ -688,40 +698,44 @@ ask_hls() {
 }
 
 ask_stack() {
-	if [ -n "${BOOTSTRAP_HASKELL_INSTALL_STACK}" ] ; then
+    if [ -n "${BOOTSTRAP_HASKELL_INSTALL_NO_STACK}" ] ; then
+		return 0
+    elif [ -n "${BOOTSTRAP_HASKELL_INSTALL_NO_STACK_HOOK}" ] ; then
 		return 1
 	fi
 
 	if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
 		echo "-------------------------------------------------------------------------------"
 
-		warn "Do you want to install stack?"
-		warn "Stack is a haskell build tool similar to cabal that is used by some projects."
-		warn "Also see https://docs.haskellstack.org/"
+		warn "Do you want to enable better integration of stack with GHCup?"
+        warn "This means that stack won't install its own GHC versions, but uses GHCup's."
+        warn "For more information see:"
+        warn "  https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation-experimental"
+        warn "If you want to keep stacks vanilla behavior, answer 'No'."
 		warn ""
-		warn "[Y] Yes  [N] No  [?] Help (default is \"N\")."
+		warn "[Y] Yes  [N] No  [?] Help (default is \"Y\")."
 		warn ""
 
 		while true; do
 			read -r stack_answer </dev/tty
 
 			case $stack_answer in
-				[Yy]*)
+				[Yy]* | "")
+					return 2 ;;
+				[Nn]*)
 					return 1 ;;
-				[Nn]* | "")
-					return 0 ;;
 				*)
 					echo "Possible choices are:"
 					echo
-					echo "Y - Yes, install stack"
-					echo "N - No, don't install anything more (default)"
+                    echo "Y - Yes, enable better integration (default)"
+					echo "N - No, keep stacks vanilla behavior"
 					echo
 					echo "Please make your choice and press ENTER."
 					;;
 			esac
 		done
 	else
-		return 0
+		return 2
 	fi
 
 	unset stack_answer
@@ -738,7 +752,7 @@ echo "This script can download and install the following binaries:"
 echo "  * ghcup - The Haskell toolchain installer"
 echo "  * ghc   - The Glasgow Haskell Compiler"
 echo "  * cabal - The Cabal build tool for managing Haskell software"
-echo "  * stack - (optional) A cross-platform program for developing Haskell projects"
+echo "  * stack - A cross-platform program for developing Haskell projects (similar to cabal)"
 echo "  * hls   - (optional) A language server for developers to integrate with their editor/IDE"
 echo
 if [ -z "${GHCUP_USE_XDG_DIRS}" ] ; then
@@ -817,7 +831,7 @@ else # don't install ghc and cabal
 				# we'll remove it afterwards
 				tmp_dir="$(mktemp -d)"
 				eghcup --cache install cabal -i "${tmp_dir}" "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
-				PATH="${tmp_dir}:$PATH" do_cabal_config_init $ask_cabal_config_init_answer
+				CABAL_BIN="${tmp_dir}/cabal" do_cabal_config_init $ask_cabal_config_init_answer
 				rm "${tmp_dir}/cabal"
 				unset tmp_dir
 				;;
@@ -835,7 +849,35 @@ esac
 
 case $ask_stack_answer in
 	1)
-		_eghcup --cache install stack || warn "Stack installation failed, continuing anyway"
+		_eghcup --cache install stack || die "Stack installation failed"
+		;;
+	2)
+		_eghcup --cache install stack || die "Stack installation failed"
+        edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
+        hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
+        hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
+
+        if [ -e "${hook_exe}" ] ; then
+            warn "$hook_exe already exists, skipping hook installation."
+            warn "If you want to reinstall the hook, delete it manually and re-run"
+            warn "this script!"
+        else
+            case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
+                "curl")
+                    # shellcheck disable=SC2086
+                    edo curl -Lf ${GHCUP_CURL_OPTS} "${hook_url}" > "${hook_exe}"
+                    ;;
+                "wget")
+                    # shellcheck disable=SC2086
+                    edo wget -O /dev/stdout ${GHCUP_WGET_OPTS} "${hook_url}" > "${hook_exe}"
+                    ;;
+                *)
+                    die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
+                    ;;
+            esac
+            edo chmod +x "${hook_exe}"
+        fi
+
 		;;
 	*) ;;
 esac

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...'
-    $archive = 'msys2-x86_64-latest.sfx.exe'
+	if (!($Msys2Version)) {
+		$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
     }
@@ -577,8 +584,8 @@ $Msys2Shell = ('{0}\msys2_shell.cmd' -f $MsysDir)
 # The bootstrap script is always silent, since we ask relevant questions here
 $SilentExport = 'export BOOTSTRAP_HASKELL_NONINTERACTIVE=1 ;'
 
-if ($InstallStack) {
-  $StackInstallExport = 'export BOOTSTRAP_HASKELL_INSTALL_STACK=1 ;'
+if (!($InstallStack)) {
+  $StackInstallExport = 'export BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 ;'
 }
 
 if ($InstallHLS) {
@@ -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)
 }
 
 

scripts/hooks/stack/ghc-install.sh

@@ -0,0 +1,24 @@
+#!/bin/sh
+
+# !! KEEP THIS SCRIPT POSIX COMPLIANT !!
+
+# see https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation-experimental
+# for documentation about hooks
+
+set -eu
+
+case $HOOK_GHC_TYPE in
+    bindist)
+        ghcdir=$(ghcup whereis --directory ghc "$HOOK_GHC_VERSION" || ghcup run --ghc "$HOOK_GHC_VERSION" --install) || exit 3
+        printf "%s/ghc" "${ghcdir}"
+        ;;
+    git)
+        # TODO: should be somewhat possible
+        >&2 echo "Hook doesn't support installing from source"
+        exit 1
+        ;;
+    *)
+        >&2 echo "Unsupported GHC installation type: $HOOK_GHC_TYPE"
+        exit 2
+        ;;
+esac

stack.yaml

@@ -6,6 +6,7 @@ packages:
 extra-deps:
   - Cabal-3.6.2.0@sha256:e2266e14758c1f799220fad7f0d4b0b4ec567d81b7ba3faea17ff76d4c31de95,12437
   - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
+  - ansi-terminal-game-1.8.0.0@sha256:001cf786098d9f1056ac6055ff3f598054b5c231b7343e76abb686d4f485855d,6977
   - ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
   - base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
   - brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
@@ -27,6 +28,7 @@ extra-deps:
   - http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
   - libarchive-3.0.3.0
   - libyaml-streamly-0.2.1
+  - linebreak-1.1.0.1@sha256:b253873c3f98189eb22a5a9f0405677cde125c09666b63c3117f497c01c95893,1397
   - lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
   - optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
   - optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
@@ -36,8 +38,10 @@ extra-deps:
   - primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
   - regex-posix-clib-2.7
   - streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
-  - unicode-data-0.3.0@sha256:0545e079705a5381d0893f8fe8daaa08fc9174baeab269b9cf651817d8eadbc6,5123
   - strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
+  - timers-tick-0.5.0.1@sha256:91d4b03266715c6969b82cb24e57a6b47191a4d2f95e9a92e0ad3f7301cc7c8b,1552
+  - unicode-data-0.3.0@sha256:0545e079705a5381d0893f8fe8daaa08fc9174baeab269b9cf651817d8eadbc6,5123
+  - unidecode-0.1.0.4@sha256:99581ee1ea334a4596a09ae3642e007808457c66893b587e965b31f15cbf8c4d,1144
   - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
   - yaml-streamly-0.12.1
 
@@ -60,6 +64,9 @@ flags:
   streamly:
     use-unliftio: true
 
+  ghcup:
+    tui-ansi: true
+
 ghc-options:
   "$locals": -O2
   streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

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"
 

vendored/ansi-terminal-game-1.8.0.0/COPYING

@@ -0,0 +1,674 @@
+              GNU GENERAL PUBLIC LICENSE
+                Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                     Preamble
+
+  The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+  The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.  We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors.  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+  To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights.  Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received.  You must make sure that they, too, receive
+or can get the source code.  And you must show them these terms so they
+know their rights.
+
+  Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+  For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software.  For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+  Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so.  This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software.  The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable.  Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products.  If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+  Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary.  To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                TERMS AND CONDITIONS
+
+  0. Definitions.
+
+  "This License" refers to version 3 of the GNU General Public License.
+
+  "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+  "The Program" refers to any copyrightable work licensed under this
+License.  Each licensee is addressed as "you".  "Licensees" and
+"recipients" may be individuals or organizations.
+
+  To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy.  The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+  A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+  To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy.  Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+  To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies.  Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+  An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License.  If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+  1. Source Code.
+
+  The "source code" for a work means the preferred form of the work
+for making modifications to it.  "Object code" means any non-source
+form of a work.
+
+  A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+  The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form.  A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+  The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities.  However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work.  For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+  The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+  The Corresponding Source for a work in source code form is that
+same work.
+
+  2. Basic Permissions.
+
+  All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met.  This License explicitly affirms your unlimited
+permission to run the unmodified Program.  The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work.  This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+  You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force.  You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright.  Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+  Conveying under any other circumstances is permitted solely under
+the conditions stated below.  Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+  No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+  When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+  4. Conveying Verbatim Copies.
+
+  You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+  You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+  5. Conveying Modified Source Versions.
+
+  You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+    a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+
+    b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under section
+    7.  This requirement modifies the requirement in section 4 to
+    "keep intact all notices".
+
+    c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy.  This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged.  This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+
+    d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+  A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit.  Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+  6. Conveying Non-Source Forms.
+
+  You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+    a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+
+    b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the
+    Corresponding Source from a network server at no charge.
+
+    c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source.  This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+
+    d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge.  You need not require recipients to copy the
+    Corresponding Source along with the object code.  If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source.  Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+
+    e) Convey the object code using peer-to-peer transmission, provided
+    you inform other peers where the object code and Corresponding
+    Source of the work are being offered to the general public at no
+    charge under subsection 6d.
+
+  A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+  A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling.  In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage.  For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product.  A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+  "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source.  The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+  If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information.  But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+  The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed.  Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+  Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+  7. Additional Terms.
+
+  "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law.  If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+  When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it.  (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.)  You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+  Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+    a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+
+    b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+
+    c) Prohibiting misrepresentation of the origin of that material, or
+    requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+
+    d) Limiting the use for publicity purposes of names of licensors or
+    authors of the material; or
+
+    e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+
+    f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions of
+    it) with contractual assumptions of liability to the recipient, for
+    any liability that these contractual assumptions directly impose on
+    those licensors and authors.
+
+  All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10.  If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term.  If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+  If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+  Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+  8. Termination.
+
+  You may not propagate or modify a covered work except as expressly
+provided under this License.  Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+  However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+  Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+  Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License.  If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+  9. Acceptance Not Required for Having Copies.
+
+  You are not required to accept this License in order to receive or
+run a copy of the Program.  Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance.  However,
+nothing other than this License grants you permission to propagate or
+modify any covered work.  These actions infringe copyright if you do
+not accept this License.  Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+  10. Automatic Licensing of Downstream Recipients.
+
+  Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License.  You are not responsible
+for enforcing compliance by third parties with this License.
+
+  An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations.  If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+  You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License.  For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+  11. Patents.
+
+  A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based.  The
+work thus licensed is called the contributor's "contributor version".
+
+  A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version.  For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+  Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+  In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement).  To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+  If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients.  "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+  If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+  A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License.  You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+  Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+  12. No Surrender of Others' Freedom.
+
+  If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all.  For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+  13. Use with the GNU Affero General Public License.
+
+  Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work.  The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+  14. Revised Versions of this License.
+
+  The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+  Each version is given a distinguishing version number.  If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation.  If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+  If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+  Later license versions may give you additional or different
+permissions.  However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+  15. Disclaimer of Warranty.
+
+  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. Limitation of Liability.
+
+  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+  17. Interpretation of Sections 15 and 16.
+
+  If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+              END OF TERMS AND CONDITIONS
+
+     How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+  If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+    <program>  Copyright (C) <year>  <name of author>
+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+  You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<http://www.gnu.org/licenses/>.
+
+  The GNU General Public License does not permit incorporating your program
+into proprietary programs.  If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library.  If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.  But first, please read
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.

vendored/ansi-terminal-game-1.8.0.0/NEWS

@@ -0,0 +1,275 @@
+1.8.0.0
+-------
+
+- Fixed testing facilities `recordGame`, `testGame`, `narrateGame` and
+  similar functions. `testGame` in particular is able to precisely
+  emulate recorded environment (so if your game has a bug only at a
+  specific size, `testGame` will now catch it).
+  Check `cabal run -f alone-playback examples ` to see a replay in action
+  and `test/Terminal/Game/Layer/ImperativeSpec.hs` for pure test ideas.
+- Added information on how to have an hot-reload mode, albeit only for
+  non-interactive game replays. Check `example/MainHotReload.hs` if
+  interested.
+- Added a new exception, `DisplayTooSmall`, which expands gracefully to
+  a “please resize your terminal” message to the player if uncaught.
+  Nothing changes if you do not already use `asserTermDims`.
+- `assertTermDims` is now curries (`Width -> Height -> IO ()` instead
+  of `Dimensions -> IO ()`) to better fit the rest of the API.
+- Modified behaviour of functions `vcat`, `hcat`, `stringPlane`,
+  `stringPlaneTrans`. They will not error on empty list, rather return
+  a transparent, 1×1 plane.
+- Changed licence and changes files to COPYING and NEWS.
+
+1.7.0.0
+-------
+
+- After some feedback from library users, I decided to eliminate
+  `simpleGame` from the API.
+  To reiterate hte migration guide, if your type was:
+
+    Game 80 24 13 initState logicFun drawFun quitFun
+    -- or
+    -- simpleGame (80, 24) 13 initState logicFun drawFun quitFun
+
+  You just need to modify it like this:
+
+    Game 13 initState
+                (const logicFun)
+                (\e s -> centerFull e $ drawFun s)
+                quitFun
+        -- notice how we lost `80 24`. You can still have a screen size
+        -- check with `assertTermDims`, as described below.
+- Added `blankPlaneFull` and `centerFull` convenience functions (to work
+  with GEnv terminal dimensions).
+- Added assertTermDims, a quick way to check your user terminal is big
+  enough at the start of the game.
+- minimal blitting optimisation (you should be able to see a 1–2
+  FPS improvement).
+- improved documentation on various functions.
+
+1.6.0.2
+-------
+
+- lun 15 nov 2021, 02:21:08
+- more doc tweaking
+
+1.6.0.1
+-------
+
+- released lun 15 nov 2021, 00:35:41
+- minor documentation / spelling fixes
+
+1.6.0.0
+-------
+
+Summary and tl;dr migration guide:
+- This version introduces a breaking changes in the main way to make
+  a `Game`. I will detail the changes below, but first a three-lines
+  migration guide:
+    the only thing you should have to do is to replace your `Game`
+    data constructor with `simpleGame` smart constructor, and substitute
+    the first to `c` `r` arguments (col/row) with a `(c, r)` tuple.
+  And of course, if you are interested in displaying FPS and adapt to
+  screen size modifications at game-time (“liquid” layout), read along!
+
+Changes:
+- This version introduces GEnv, a structure that exposes current frame
+  rate (in FPS) and current terminal size (in Width, Height).
+- `GEnv` is added as a parameter to logic and draw functions, which
+  now have these signatures:
+    gLogicFunction :: GEnv -> s -> Event -> slightly
+    gDrawFunction :: GEnv -> s -> plane
+- If you do not want to dabble with GEnv, you can still use `simpleGame`
+  smart constructor, which mimicks the old `Game`. `simpleGame` has some
+  nice defaults:
+    - if the terminal is too small it will ask the player to resize it
+      (even in the middle of the game), blocking any input;
+    - if the terminal is bigger, it will paste `Plane` in the middle
+      of the screen.
+- For this reason, `DisplayTooSmall` exception exists no more.
+- the new `Game` does not have those defaults, but allows you to get
+  creative with screen resizes, e.g. accomodating as much gameworld
+  as possible etc. Check `cabal run -f examples balls` and resize the
+  screen to see it in action.
+- Minor change: I have introduced a `Dimensions` alias for
+  `(Width, Height)`.
+
+Future work:
+- these changes lay the path for an even more general `Game` type,
+  adding effects like reading form a game configuration, writing to it
+  etc.
+  I would like to have these wrapped in a pure interface (maybe à la
+  Response/Request? Maybe callbacks?) and for sure want them to be
+  composable with current test scaffolding (testGame,
+  narrateGame, etc.). It will not be easy to design; if are reading
+  this and have any suggestion, please write to me.
+
+Released dom 14 nov 2021, 20:25:19
+
+1.5.0.0
+-------
+
+- `timers-tick` has released a new version: all timers function (creaTimer,
+  creaBoolTimer, creaTimerLoop, creaBoolTimerLoop, creaAnimation,
+  creaLoopAnimation, ticks) are slightly more robust now (will `error`
+  on nonsenical arguments, e.g. frame duration <1).
+  This should not impact any of your current projects, it just makes
+  catching bugs easier.
+- Removed `getFrames` from Animation interface.
+- Updated `Random` interface to fit the new `random`. This is a breaking
+  change but it should be easy to fix by updating your `Random` constraints
+  to `UniformRange`.
+  Be mindful that `recordGame` could play slightly differently, as the
+  update function for the StdGen in `random` has changed.
+- Removed `getRandomList` from Random interface.
+- Added `pickRandom` to Random interface.
+- Removed unuseful `creaStaticAnimation` from Animation interface.
+- Released mar 9 nov 2021, 15:56:14.
+
+1.4.0.0
+-------
+
+- Fixed an annoying bug that made a game run slower than expected on
+  low TPS. Now if you select 5 ticks per second, you can rest assured
+  that after 50 ticks, 5 seconds have elapsed.
+- Renamed `FPS` to `TPS` (ticks per second); highlight logic speed is
+  constant timewise on all machines, while FPS might be different on
+  differently efficient terminals.
+  This will allow in future releases to provide a function to easily
+  calculate actual FPS of the game.
+- Added alternative origin combinators `%^>`, `%.<`, `%.>`; they are
+  useful when you want to — e.g. — «paste a plane one row from
+  bottom-right corner».
+
+1.3.0.0
+-------
+
+- `displaySize` and `playGame`/`playGameS` now throw an exception
+  (of type `ATGException`) instead of `error`ing. These exeptions are
+  `CannotGetDisplaySize` and `DisplayTooSmall`; they are synchronous,
+  for easier catching. (requested by sm)
+- Released sab 16 ott 2021, 21:09:22
+
+1.2.1.0
+-------
+
+- Fixed textBox, textBoxHyphen bug (boxes were not transparent, contrary
+  to what stated in docs) (reported by sm).
+- Released lun 11 ott 2021, 22:29:40
+
+1.2.0.0
+-------
+
+- Added textBoxHyphen and textBoxHyphenLiquid and a handful of `Hypenator`s.
+  This will allow you to have autohyphenation in textboxes. Compare:
+    (normal textbox)                       (hyphenated textbox)
+    Rimasi un po’ a meditare nel buio      Rimasi un po’ a meditare nel buio
+    velato appena dal barlume azzurrino    velato appena dal barlume azzurrino
+    del fornello a gas, su cui             del fornello a gas, su cui sobbol-
+    sobbollliva quieta la pentola.         liva quieta la pentola.
+- Switched `Width`, `Height`, `Row`, `Col` from `Integer` to `Int`.
+  This is unfortunate, but will make playing with `base` simpler. I will
+  switch it back once `Prelude` handles both integers appropriately
+  or exports the relevant function. (request by sm)
+- Changed signature for `box`, `textBox` and `textBoxLiquid`. Now
+  width/height parameters come *before* the character/string. E.g.:
+    textBoxLiquid :: String -> Width -> Plane  -- this was before
+    textBoxLiquid :: Width -> String -> Plane  -- this is now
+  This felt more ergonomic while writing games.
+- `paperPlane` is now `planePaper` (to respect SVO order)
+
+1.1.1.0
+-------
+
+- Added (***) (centre blit) (request by sm)
+- Released gio 30 set 2021, 12:29:22
+
+1.1.0.0
+-------
+
+- Added Plane justapoxition functions (===, |||, vcat, hcat).
+- Added `word` and and `textBoxLiquid` drawing functions.
+- Added `subPlane`, `displaySize` Plane functions.
+- Removed unused `trimPlane`.
+- Sanitized non-ASCII chars on Win32 console.
+- Wed 03 Feb 2021 18:41:20 CET
+
+1.0.0.0
+-------
+
+- Milestone release.
+- Beefed up documentation.
+- Released Sun 08 Dec 2019 04:19:33 CET
+
+0.7.2.0
+-------
+
+- Fixed 0.7.1.0 unbumped dependency.
+- Released Fri 22 Nov 2019 16:51:25 CET
+
+0.7.1.0
+-------
+
+- Fixed 0.7.0.0 (deprecated) interface.
+- Released Fri 22 Nov 2019 14:51:40 CET
+
+0.7.0.0
+-------
+
+- Simplified Animation interface (breaking changes).
+- Added `creaLoopAnimation` and `creaStaticAnimation`.
+- Released Fri 22 Nov 2019 14:40:44 CET
+
+0.6.1.0
+-------
+
+- Reworked Timers/Animations interface and documentation.
+- Added `lapse` (for Timers/Animations).
+- Released Fri 22 Nov 2019 01:03:37 CET
+
+0.6.0.1
+-------
+
+- Add public repo (requested by sm).
+- Released Tue 19 Nov 2019 22:38:34 CET
+
+0.6.0.0
+-------
+
+- Add random generation functions.
+- Released Sun 10 Nov 2019 13:44:32 CET
+
+0.5.0.0
+-------
+
+- Add `setupGame` to setup games before playtesting (skip menus, etc.).
+- Fixed screen corruption on Windows.
+- Released Fri 08 Nov 2019 13:52:39 CET
+
+0.4.0.0
+-------
+
+- Exposed new functions in API.
+- Greatly improved haddock documentation.
+- Released Tue 25 Jun 2019 16:08:53 CEST
+
+0.2.1.0
+-------
+
+- Improved haddock documentation a bit.
+- Cleanup runs regardless of exception.
+- Released on Sun 18 Mar 2018 03:04:07 CET.
+
+0.2.0.0
+-------
+
+- Added dependencies constraints.
+- Removed internal module.
+- Fixed changelog.
+- Released on Fri 16 Mar 2018 00:42:41 CET.
+
+0.1.0.0
+-------
+
+- Initial release.
+- Released on Fri 16 Mar 2018 00:33:18 CET.

vendored/ansi-terminal-game-1.8.0.0/README

@@ -0,0 +1,46 @@
+==================
+ansi-terminal-game
+==================
+
+`ansi-terminal-game` is a library for creating games in a terminal setting.
+
+Goals
+-----
+
+- be cross platform (linux/win/mac). If you plan to have your executable
+  unix only, I invite you to check brick [1] or other, more expressive
+  libraries.
+- be simple: no curses/ncurses/pdcurses/etc. dependencies, all
+  functionality built on a standard input / ANSI terminal base.
+
+[1] http://hackage.haskell.org/package/brick
+
+Learn
+-----
+
+- run the basic example with `cabal new-run -f examples alone`;
+- check the source in `examples/Alone.hs`;
+- open the 'Terminal.Game' haddock documentation (start reading from
+  `Data.Game`).
+
+A full game can be found at:
+
+    http://www.ariis.it/static/articles/venzone/page.html
+
+Other games made with a-t-g
+---------------------------
+
+- caverunner:
+    https://github.com/simonmichael/games/blob/main/caverunner/caverunner.hs
+- pigafetta: http://www.ariis.it/link/repos/pigafetta/
+- avoidance: https://sabadev.xyz/avoidance_game
+
+If you want yours to be added to this list, write to me.
+
+Contact
+-------
+
+For any feedback or report, contact me at:
+
+    http://ariis.it/static/articles/mail/page.html
+

vendored/ansi-terminal-game-1.8.0.0/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

vendored/ansi-terminal-game-1.8.0.0/ansi-terminal-game.cabal

@@ -0,0 +1,188 @@
+name:                ansi-terminal-game
+version:             1.8.0.0
+synopsis:            sdl-like functions for terminal applications, based on
+                     ansi-terminal
+description:         Library which aims to replicate standard 2d game
+                     functions (blit, ticks, timers, etc.) in a terminal
+                     setting; features double buffering to optimise
+                     performance.
+                     Aims to be cross compatible (based on "ansi-terminal",
+                     no unix-only dependencies), practical.
+                     See @examples@ folder for some minimal programs.  A
+                     full game: <http://www.ariis.it/static/articles/venzone/page.html venzone>.
+homepage:            http://www.ariis.it/static/articles/ansi-terminal-game/page.html
+license:             GPL-3
+license-file:        COPYING
+author:              Francesco Ariis
+maintainer:          fa-ml@ariis.it
+copyright:           © 2017-2021 Francesco Ariis
+category:            Game
+build-type:          Simple
+extra-source-files:  README,
+                     NEWS,
+                     test/records/alone-record-test.gr
+                     test/records/balls-dims.gr
+                     test/records/balls-slow.gr
+cabal-version:       >=1.10
+
+flag examples
+  description:       builds examples
+  default:           False
+
+source-repository head
+    type:     darcs
+    location: http://www.ariis.it/link/repos/ansi-terminal-game/
+
+library
+  exposed-modules:     Terminal.Game
+  other-modules:       Terminal.Game.Animation,
+                       Terminal.Game.Character,
+                       Terminal.Game.Draw,
+                       Terminal.Game.Layer.Imperative,
+                       Terminal.Game.Layer.Object,
+                       Terminal.Game.Layer.Object.GameIO,
+                       Terminal.Game.Layer.Object.Interface,
+                       Terminal.Game.Layer.Object.IO,
+                       Terminal.Game.Layer.Object.Narrate,
+                       Terminal.Game.Layer.Object.Primitive,
+                       Terminal.Game.Layer.Object.Record,
+                       Terminal.Game.Layer.Object.Test,
+                       Terminal.Game.Utils,
+                       Terminal.Game.Plane,
+                       Terminal.Game.Random,
+                       Terminal.Game.Timer
+  build-depends:       base == 4.*,
+                       ansi-terminal == 0.11.*,
+                       array == 0.5.*,
+                       bytestring >= 0.10 && < 0.12,
+                       cereal == 0.5.*,
+                       clock >= 0.7 && < 0.9,
+                       containers == 0.6.*,
+                       exceptions == 0.10.*,
+                       linebreak == 1.1.*,
+                       mintty == 0.1.*,
+                       mtl == 2.2.*,
+                       QuickCheck >= 2.13 && < 2.15,
+                       random >= 1.2 && < 1.3,
+                       split == 0.2.*,
+                       terminal-size == 0.3.*,
+                       unidecode >= 0.1.0 && < 0.2,
+                       timers-tick > 0.5 && < 0.6
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+
+  if os(windows)
+    hs-source-dirs: platform-dep/windows
+  if !os(windows)
+    hs-source-dirs: platform-dep/non-win
+
+test-suite test
+  default-language:    Haskell2010
+  hs-Source-Dirs:      test, src, example
+  main-is:             Test.hs
+  other-modules:       Alone,
+                       Balls,
+                       Terminal.Game,
+                       Terminal.Game.Animation,
+                       Terminal.Game.Character,
+                       Terminal.Game.Draw,
+                       Terminal.Game.DrawSpec,
+                       Terminal.Game.Layer.Imperative,
+                       Terminal.Game.Layer.ImperativeSpec,
+                       Terminal.Game.Layer.Object,
+                       Terminal.Game.Layer.Object.GameIO,
+                       Terminal.Game.Layer.Object.Interface,
+                       Terminal.Game.Layer.Object.IO,
+                       Terminal.Game.Layer.Object.Narrate,
+                       Terminal.Game.Layer.Object.Primitive,
+                       Terminal.Game.Layer.Object.Record,
+                       Terminal.Game.Layer.Object.Test,
+                       Terminal.Game.Utils,
+                       Terminal.Game.Plane,
+                       Terminal.Game.PlaneSpec
+                       Terminal.Game.Random,
+                       Terminal.Game.RandomSpec
+  build-depends:       base == 4.*,
+                       ansi-terminal == 0.11.*,
+                       array == 0.5.*,
+                       bytestring >= 0.10 && < 0.12,
+                       cereal == 0.5.*,
+                       clock >= 0.7 && < 0.9,
+                       containers == 0.6.*,
+                       exceptions == 0.10.*,
+                       linebreak == 1.1.*,
+                       mintty == 0.1.*,
+                       mtl == 2.2.*,
+                       QuickCheck >= 2.13 && < 2.15,
+                       random >= 1.2 && < 1.3,
+                       split == 0.2.*,
+                       terminal-size == 0.3.*,
+                       unidecode >= 0.1.0 && < 0.2,
+                       timers-tick > 0.5 && < 0.6
+                       -- the above plus hspec
+                       , hspec
+  type:                exitcode-stdio-1.0
+  ghc-options:         -Wall
+
+  if os(windows)
+    hs-source-dirs: platform-dep/windows
+  if !os(windows)
+    hs-source-dirs: platform-dep/non-win
+
+executable alone
+    if flag(examples)
+      build-depends:  base == 4.*,
+                      ansi-terminal-game
+    else
+      buildable:      False
+
+    hs-source-dirs:   example
+    main-is:          MainAlone.hs
+    other-modules:    Alone
+    default-language: Haskell2010
+    ghc-options:      -threaded
+                      -Wall
+
+executable alone-playback
+    if flag(examples)
+      build-depends:  base == 4.*,
+                      ansi-terminal-game,
+                      temporary == 1.3.*
+    else
+      buildable:      False
+
+    hs-source-dirs:   example
+    main-is:          MainPlayback.hs
+    other-modules:    Alone
+    default-language: Haskell2010
+    ghc-options:      -threaded
+                      -Wall
+
+executable balls
+    if flag(examples)
+      build-depends:  base == 4.*,
+                      ansi-terminal-game
+    else
+      buildable:      False
+
+    hs-source-dirs:   example
+    main-is:          MainBalls.hs
+    other-modules:    Balls
+    default-language: Haskell2010
+    ghc-options:      -threaded
+                      -Wall
+
+executable hot-reload
+    if flag(examples)
+      build-depends:  base == 4.*,
+                      ansi-terminal-game
+    else
+      buildable:      False
+
+    hs-source-dirs:   example
+    main-is:          MainHotReload.hs
+    other-modules:    Alone
+    default-language: Haskell2010
+    ghc-options:      -threaded
+                      -Wall

vendored/ansi-terminal-game-1.8.0.0/example/Alone.hs

@@ -0,0 +1,90 @@
+module Alone where
+
+-- Alone in a room, game definition (logic & draw)
+-- run with: cabal new-run -f examples alone
+
+import Terminal.Game
+
+import qualified Data.Tuple as T
+
+-- game specification
+aloneInARoom :: Game MyState
+aloneInARoom = Game 13                       -- ticks per second
+                    (MyState (10, 10)
+                             Stop False)     -- init state
+                    (\_ s e -> logicFun s e) -- logic function
+                    (\r s -> centerFull r $
+                               drawFun s)    -- draw function
+                    gsQuit                   -- quit function
+
+sizeCheck :: IO ()
+sizeCheck = let (w, h) = T.swap . snd $ boundaries
+            in assertTermDims w h
+
+-------------------------------------------------------------------------------
+-- Types
+
+data MyState = MyState { gsCoord :: Coords,
+                         gsMove  :: Move,
+                         gsQuit  :: Bool }
+             deriving (Show, Eq)
+
+data Move = N | S | E | W | Stop
+          deriving (Show, Eq)
+
+boundaries :: (Coords, Coords)
+boundaries = ((1, 1), (24, 80))
+
+-------------------------------------------------------------------------------
+-- Logic
+
+logicFun :: MyState -> Event -> MyState
+logicFun gs (KeyPress 'q') = gs { gsQuit = True }
+logicFun gs Tick           = gs { gsCoord = pos (gsMove gs) (gsCoord gs) }
+logicFun gs (KeyPress c)   = gs { gsMove = move (gsMove gs) c }
+
+-- SCI movement
+move :: Move -> Char -> Move
+move N 'w' = Stop
+move S 's' = Stop
+move W 'a' = Stop
+move E 'd' = Stop
+move _ 'w' = N
+move _ 's' = S
+move _ 'a' = W
+move _ 'd' = E
+move m _   = m
+
+pos :: Move -> (Width, Height) -> (Width, Height)
+pos m oldcs | oob newcs = oldcs
+            | otherwise = newcs
+    where
+          newcs = new m oldcs
+
+          new Stop cs = cs
+          new N    (r, c) = (r-1, c  )
+          new S    (r, c) = (r+1, c  )
+          new E    (r, c) = (r  , c+1)
+          new W    (r, c) = (r  , c-1)
+
+          ((lr, lc), (hr, hc)) = boundaries
+          oob (r, c) = r <= lr || c <= lc ||
+                       r >= hr || c >= hc
+
+-------------------------------------------------------------------------------
+-- Draw
+
+drawFun :: MyState -> Plane
+drawFun (MyState (r, c) _ _) =
+                           blankPlane mw     mh            &
+                (1, 1)   % box mw mh '-'                   &
+                (2, 2)   % box (mw-2) (mh-2) ' '           &
+                (15, 20) % textBox 10 4
+                                   "Tap WASD to move, tap again to stop." &
+                (20, 60) % textBox 8 10
+                                   "Press Q to quit." # color Blue Vivid &
+                (r, c) % cell '@' # invert
+    where
+          mh :: Height
+          mw :: Width
+          (mh, mw) = snd boundaries

vendored/ansi-terminal-game-1.8.0.0/example/Balls.hs

@@ -0,0 +1,189 @@
+module Balls where
+
+-- library module for `balls`
+
+import Terminal.Game
+
+import qualified Data.Bool as B
+import qualified Data.Ix as I
+import qualified Data.Maybe as M
+import qualified Data.Tuple as T
+
+{-
+   There are three things I will showcase in this example:
+
+   1. ** How you can display current FPS. **
+      This is done using `Game` to create your game rather than
+      `simpleGame`. `Game` is a bit more complex but you gain
+      additional infos to manipulate/blit, like FPS.
+
+   2. ** How your game can gracefully handle screen resize. **
+      Notice how if you resize the terminal, balls will still
+      fill the entire screen. This is again possible using `Game`
+      and the information passed via GameEnv (in this case, terminal
+      dimensions).
+
+   3. ** That — while FPS can change  — game speed does not. **
+      Check the timer: even when screen is crowded and frames are
+      dropped, it is not slowed down.
+
+
+   This game runs at 60 FPS, you will almost surely never need such
+   a high TPS! 15–20 is more than enough in most cases.
+-}
+
+-------------------------------------------------------------------------------
+-- Ball
+
+data Ball = Ball { pChar :: Plane,
+                   pSpeed :: Timed Bool,
+                   pDir :: Coords,
+                   pPos :: Coords }
+
+-- change direction is necessary, then and move
+modPar :: Dimensions -> Ball -> Maybe Ball
+modPar ds b@(Ball _ _ d _) =
+            -- tick the ball and check it is time to move
+            let b' = tickBall b in
+            if not (fetchFrame . pSpeed $ b')
+              then Just b' -- no time to move for you
+            else
+
+            -- check all popssible directions
+            let pd = [d, togR d, togC d, togB d]
+                bs  = map (\ld -> b' { pDir = ld })  pd
+                bs' = filter (isIn ds) $ map modPos bs in
+
+            -- returns a moved ball nor nothing to mark it “to eliminate”
+            case bs' of
+              [] -> Nothing
+              (cp:_) -> Just cp
+    where
+          togR (wr, wc) = (-wr,  wc)
+          togC (wr, wc) = ( wr, -wc)
+          togB (wr, wc) = (-wr, -wc)
+
+tickBall :: Ball -> Ball
+tickBall b = b { pSpeed = tick (pSpeed b) }
+
+modPos :: Ball -> Ball
+modPos (Ball p t d@(dr, dc) (r, c)) = Ball p t d (r+dr, c+dc)
+
+isIn :: Dimensions -> Ball -> Bool
+isIn (w, h) (Ball p _ _ (pr, pc)) =
+            let (pw, ph) = planeSize p
+            in pr >= 1 &&
+               pr+ph-1 <= h &&
+               pc >= 1 &&
+               pc+pw-1 <= w
+
+dpart :: Ball -> (Coords, Plane)
+dpart (Ball p _ _ cs) = (cs, p)
+
+genBall :: StdGen -> Dimensions -> (Ball, StdGen)
+genBall g ds =
+                let (c, g1) = pickRandom [minBound..] g
+                    (s, g2) = getRandom (1, 3) g1
+                    (v, g3) = pickRandom dirs g2
+                    (p, g4) = ranIx ((1,1), T.swap ds) g3
+                    b = Ball (cell 'o' # color c Vivid)
+                             (creaBoolTimerLoop s) v p
+                in (b, g4)
+        where
+              dirs = [(1, 1), (1, -1), (-1, 1), (-1, -1)]
+
+              -- tuples instances are yet to be added to `random`
+              -- as nov 21; this will do meanwhile.
+              ranIx :: I.Ix a => (a, a) -> StdGen -> (a, StdGen)
+              ranIx r wg = pickRandom (I.range r) wg
+
+-------------------------------------------------------------------------------
+-- Timer
+
+type Timer = (Timed Bool, Integer)
+
+ctimer :: TPS -> Timer
+ctimer tps = (creaBoolTimerLoop tps, 0)
+
+ltimer :: Timer -> Timer
+ltimer (t, i) = let t' = tick t
+                    k = B.bool 0 1 (fetchFrame t')
+                in (t', i+k)
+
+dtimer :: Timer -> Plane
+dtimer (_, i) = word . show $ i
+
+-------------------------------------------------------------------------------
+-- Game
+
+data GState = GState { gen :: StdGen,
+                       quit :: Bool,
+                       timer :: Timer,
+                       balls :: [Ball],
+                       bslow :: Bool }
+            -- pSlow is not used in game, it is there just
+            -- for the test suite
+
+fireworks :: StdGen -> Game GState
+fireworks g = Game tps istate lfun dfun qfun
+    where
+          tps = 60
+
+          istate :: GState
+          istate = GState g False (ctimer tps) [] False
+
+-------------------------------------------------------------------------------
+-- Logic
+
+lfun :: GEnv -> GState -> Event -> GState
+lfun e s (KeyPress 's') =
+            let g = gen s
+                ds = eTermDims e
+                (b, g1) = genBall g ds
+            in s { gen = g1,
+                   balls = b : balls s }
+lfun _ s (KeyPress 'q') = s { quit = True }
+lfun _ s (KeyPress _)   = s
+lfun r s Tick           =
+            let ds = eTermDims r
+
+                ps = balls s
+                ps' = M.mapMaybe (modPar ds) ps
+
+                bs = eFPS r < 30
+            in s { timer = ltimer (timer s),
+                   balls = filter (isIn ds)  ps',
+                   bslow = bs }
+
+qfun :: GState -> Bool
+qfun s = quit s
+
+-------------------------------------------------------------------------------
+-- Draw
+
+dfun :: GEnv -> GState -> Plane
+dfun r s =             mergePlanes
+                         (uncurry blankPlane ds)
+                         (map dpart $ balls s) &
+            (1, 2) %^> tui # trans &
+            (1, 2) %.< inst # trans # bold
+    where
+          ds = eTermDims r
+          tm = timer s
+
+          tui :: Plane
+          tui = let fps = eFPS r
+                    np = length $ balls s
+
+                    l1 = word "FPS: " ||| word (show fps)
+                    l2 = word "Timer: " ||| dtimer tm
+                    l3 = word ("Balls: " ++ show np)
+                    l4 = word ("Term. dims.: " ++ show ds)
+                in vcat [l1, l2, l3, l4]
+
+          inst :: Plane
+          inst = word "Press (s) to spawn" ===
+                 word "Press (q) to quit"
+
+          trans :: Draw
+          trans = makeTransparent ' '

vendored/ansi-terminal-game-1.8.0.0/example/MainAlone.hs

@@ -0,0 +1,12 @@
+module Main where
+
+
+import Alone ( aloneInARoom, sizeCheck )
+
+import Terminal.Game
+
+-- run with: cabal new-run -f examples alone
+
+main :: IO ()
+main = do sizeCheck
+          errorPress $ playGame aloneInARoom

vendored/ansi-terminal-game-1.8.0.0/example/MainBalls.hs

@@ -0,0 +1,12 @@
+module Main where
+
+import Balls
+
+import Terminal.Game
+
+-- Balls Main module. The meat of the game is in `examples/Balls.hs`
+
+main :: IO ()
+main = getStdGen >>= \g ->
+       playGame (fireworks g)
+

vendored/ansi-terminal-game-1.8.0.0/example/MainHotReload.hs

@@ -0,0 +1,31 @@
+module Main where
+
+import Alone ( aloneInARoom, sizeCheck )
+
+import Terminal.Game
+
+-- Hot reloading is a handy feature while writing a game. Here I will
+-- show you how to do that with ansi-terminal-game.
+--
+-- 1. install `entr` from your repositories;
+-- 2. run `find example/*.hs | entr -cr cabal run -f examples hot-reload`;
+-- 3. now modify example/Alone.hs and see your changes live!
+--
+-- Caveat: entr and similar applications do *not* work with interactive
+-- programs, so you need — as shown below — to load a record and play
+-- it as a demo.
+-- This is still useful to iteratively build NPCs’ behaviour, GUIs, etc.
+--
+-- Remember that you can use `recordGame` to record a session. If you
+-- need something fancier for your game (e.g. hot-reload with input),
+-- `venzone` [1] (module Watcher) has a builtin /watch mode/ you can
+-- take inspiration from.
+--
+-- [1] https://hackage.haskell.org/package/venzone
+
+main :: IO ()
+main = do
+        sizeCheck
+        gr <- readRecord "test/records/alone-record-test.gr"
+                -- check `readRecord
+        () <$ narrateGame aloneInARoom gr

vendored/ansi-terminal-game-1.8.0.0/example/MainPlayback.hs

@@ -0,0 +1,30 @@
+module Main where
+
+import Alone ( aloneInARoom, sizeCheck )
+
+import Terminal.Game
+
+import System.IO.Temp ( emptySystemTempFile )
+
+-- plays the game and, once you quit, shows a replay of the session
+-- run with: cabal new-run -f examples alone-playback
+
+main :: IO ()
+main = do
+        sizeCheck
+        tf <- emptySystemTempFile "alone-record.gr"
+        playback tf
+
+playback :: FilePath -> IO ()
+playback f = do
+        prompt "Press <Enter> to play the game."
+        recordGame aloneInARoom f
+        prompt "Press <Enter> to watch playback."
+        es <- readRecord f
+        _ <- narrateGame aloneInARoom es
+        prompt "Playback over! Press <Enter> to quit."
+    where
+          prompt :: String -> IO ()
+          prompt s = putStrLn s >> () <$ getLine
+
+

vendored/ansi-terminal-game-1.8.0.0/platform-dep/non-win/Terminal/Game/Utils.hs

@@ -0,0 +1,14 @@
+--------------------------------------------------------------------------------
+-- Nonbuffering getChar
+-- 2017 Francesco Ariis GPLv3                                             80cols
+--------------------------------------------------------------------------------
+
+module Terminal.Game.Utils ( inputCharTerminal,
+                             isWin32Console )
+                           where
+
+inputCharTerminal :: IO Char
+inputCharTerminal = getChar
+
+isWin32Console :: IO Bool
+isWin32Console = return False